(let ((min (point-max))
(max 0)
first second)
- (mapc (function (lambda (entry)
- (if (eq :undone-exposure (car entry))
- nil
- (setq first (cadr entry)
- second (caddr entry))
- (if (< (min first second) min)
- (setq min (min first second)))
- (if (> (max first second) max)
- (setq max (max first second))))))
+ (mapc (lambda (entry)
+ (if (eq :undone-exposure (car entry))
+ nil
+ (setq first (cadr entry)
+ second (caddr entry))
+ (if (< (min first second) min)
+ (setq min (min first second)))
+ (if (> (max first second) max)
+ (setq max (max first second)))))
allout-widgets-changes-record)
(> (- max min) allout-widgets-adjust-message-size-threshold)))
(let ((prior (current-message)))
Generally invoked via `allout-exposure-change-functions'."
- (let ((changes (sort changes (function (lambda (this next)
- (< (cadr this) (cadr next))))))
+ (let ((changes (sort changes (lambda (this next)
+ (< (cadr this) (cadr next)))))
;; have to distinguish between concealing and exposing so that, eg,
;; `allout-expose-topic's mix is handled properly.
handled-expose
end (or end (point-max)))
(if (> start end) (let ((interim start)) (setq start end end interim)))
(let ((button-overlays (delq nil
- (mapcar (function (lambda (o)
- (if (overlay-get o 'button)
- o)))
+ (mapcar (lambda (o)
+ (if (overlay-get o 'button)
+ o))
(overlays-in start end)))))
(length button-overlays)))
(index 0))
;; miscellaneous attributes
(mapc
- (function (lambda (e)
- (aset map index e)
- (setq index (1+ index)) ))
+ (lambda (e)
+ (aset map index e)
+ (setq index (1+ index)) )
ansi-color-faces-vector)
;; foreground attributes
(setq index 30)
(mapc
- (function (lambda (e)
- (aset map index
- (ansi-color-make-face 'foreground
- (if (consp e) (car e) e)))
- (setq index (1+ index)) ))
+ (lambda (e)
+ (aset map index
+ (ansi-color-make-face 'foreground
+ (if (consp e) (car e) e)))
+ (setq index (1+ index)) )
ansi-color-names-vector)
;; background attributes
(setq index 40)
(mapc
- (function (lambda (e)
- (aset map index
- (ansi-color-make-face 'background
- (if (consp e) (cdr e) e)))
- (setq index (1+ index)) ))
+ (lambda (e)
+ (aset map index
+ (ansi-color-make-face 'background
+ (if (consp e) (cdr e) e)))
+ (setq index (1+ index)) )
ansi-color-names-vector)
map))
(interactive)
(let ((description (make-char-table 'case-table)))
(map-char-table
- (function (lambda (key value)
- (if (not (natnump value))
- (if (consp key)
- (set-char-table-range description key "case-invariant")
- (aset description key "case-invariant"))
- (let (from to)
- (if (consp key)
- (setq from (car key) to (cdr key))
- (setq from (setq to key)))
- (while (<= from to)
- (aset
- description from
- (cond ((/= from (downcase from))
- (concat "uppercase, matches "
- (char-to-string (downcase from))))
- ((/= from (upcase from))
- (concat "lowercase, matches "
- (char-to-string (upcase from))))
- (t "case-invariant")))
- (setq from (1+ from)))))))
+ (lambda (key value)
+ (if (not (natnump value))
+ (if (consp key)
+ (set-char-table-range description key "case-invariant")
+ (aset description key "case-invariant"))
+ (let (from to)
+ (if (consp key)
+ (setq from (car key) to (cdr key))
+ (setq from (setq to key)))
+ (while (<= from to)
+ (aset
+ description from
+ (cond ((/= from (downcase from))
+ (concat "uppercase, matches "
+ (char-to-string (downcase from))))
+ ((/= from (upcase from))
+ (concat "lowercase, matches "
+ (char-to-string (upcase from))))
+ (t "case-invariant")))
+ (setq from (1+ from))))))
(current-case-table))
(save-excursion
(with-output-to-temp-buffer "*Help*"
(setq rest (cdr rest))))
(if tags (error "optimizer error: missed tags %s" tags))
;; Remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* )
- (mapcar (function (lambda (elt)
- (if (numberp elt)
- elt
- (cdr elt))))
+ (mapcar (lambda (elt)
+ (if (numberp elt)
+ elt
+ (cdr elt)))
(nreverse lap))))
\f
(list (list
(if (listp reread)
reread
- (delq nil (mapcar (function (lambda (c)
- (cond ((eq reread t)
- (car c))
- ((cdr c)
- (car c)))))
+ (delq nil (mapcar (lambda (c)
+ (cond ((eq reread t)
+ (car c))
+ ((cdr c)
+ (car c))))
gnus-agent-article-alist)))
'del '(read)))
gnus-command-method)
"Construct a function similar to `hippie-expand'.
Make it use the expansion functions in TRY-LIST. An optional second
argument VERBOSE non-nil makes the function verbose."
- `(function (lambda (arg)
- ,(concat
- "Try to expand text before point, using the following functions: \n"
- (mapconcat 'prin1-to-string (eval try-list) ", "))
- (interactive "P")
- (let ((hippie-expand-try-functions-list ,try-list)
- (hippie-expand-verbose ,verbose))
- (hippie-expand arg)))))
+ `(lambda (arg)
+ ,(concat
+ "Try to expand text before point, using the following functions: \n"
+ (mapconcat 'prin1-to-string (eval try-list) ", "))
+ (interactive "P")
+ (let ((hippie-expand-try-functions-list ,try-list)
+ (hippie-expand-verbose ,verbose))
+ (hippie-expand arg))))
;;; Here follows the try-functions and their requisites:
(setq he-expand-list
(and (not (equal he-search-string ""))
(sort (all-completions he-search-string obarray
- (function (lambda (sym)
+ (lambda (sym)
(or (boundp sym)
(fboundp sym)
- (symbol-plist sym)))))
+ (symbol-plist sym))))
'string-lessp)))))
(while (and he-expand-list
(he-string-member (car he-expand-list) he-tried-table))
(if (not (string= he-search-string ""))
(setq expansion
(try-completion he-search-string obarray
- (function (lambda (sym)
+ (lambda (sym)
(or (boundp sym)
(fboundp sym)
- (symbol-plist sym)))))))
+ (symbol-plist sym))))))
(if (or (eq expansion t)
(string= expansion he-search-string)
(he-string-member expansion he-tried-table))
(he-init-string (he-dabbrev-beg) (point))
(setq he-expand-list
(and (not (equal he-search-string ""))
- (mapcar (function (lambda (sym)
+ (mapcar (lambda (sym)
(if (and (boundp sym) (vectorp (eval sym)))
(abbrev-expansion (downcase he-search-string)
- (eval sym)))))
+ (eval sym))))
(append '(local-abbrev-table
global-abbrev-table)
abbrev-table-name-list))))))
0)))
1)
))))))
- (sort codings (function (lambda (x y)
- (> (funcall func x) (funcall func y))))))))
+ (sort codings (lambda (x y)
+ (> (funcall func x) (funcall func y)))))))
(defun find-coding-systems-region (from to)
"Return a list of proper coding systems to encode a text between FROM and TO.
;; Change elements of the list to (coding . base-coding).
(setq default-coding-system
- (mapcar (function (lambda (x) (cons x (coding-system-base x))))
+ (mapcar (lambda (x) (cons x (coding-system-base x)))
default-coding-system))
(if (and auto-cs (not no-other-defaults))
(if (fboundp select-safe-coding-system-function)
(funcall select-safe-coding-system-function
(point-min) (point-max) coding
- (function (lambda (x) (coding-system-get x :mime-charset))))
+ (lambda (x) (coding-system-get x :mime-charset)))
coding)))
\f
;;; Language support stuff.
(name (completing-read prompt
language-info-alist
(and key
- (function (lambda (elm) (and (listp elm) (assq key elm)))))
+ (lambda (elm) (and (listp elm) (assq key elm))))
t nil nil default)))
(if (and (> (length name) 0)
(or (not key)
(mapconcat
(if (and coding-system (eq (coding-system-type coding-system) 'iso-2022))
;; Try to get a pretty description for ISO 2022 escape sequences.
- (function (lambda (x) (or (cdr (assq x iso-2022-control-alist))
- (format "#x%02X" x))))
- (function (lambda (x) (format "#x%02X" x))))
+ (lambda (x) (or (cdr (assq x iso-2022-control-alist))
+ (format "#x%02X" x)))
+ (lambda (x) (format "#x%02X" x)))
str " "))
(defun encode-coding-char (char coding-system &optional charset)
(defun quail-keyseq-translate (keyseq)
(apply 'string
- (mapcar (function (lambda (x) (quail-keyboard-translate x)))
+ (mapcar (lambda (x) (quail-keyboard-translate x))
keyseq)))
(defun quail-insert-kbd-layout (kbd-layout)
(setq str
(format "%s[%s]"
str
- (concat (sort (mapcar (function (lambda (x) (car x)))
+ (concat (sort (mapcar (lambda (x) (car x))
(cdr map))
'<)))))
;; Show list of translations.
((consp translation)
(setq translation (cdr translation))
(let ((multibyte nil))
- (mapc (function (lambda (x)
- ;; Accept only non-ASCII chars not
- ;; listed in IGNORES.
- (if (and (if (integerp x) (> x 127)
- (string-match-p "[^[:ascii:]]" x))
- (not (member x ignores)))
- (setq multibyte t))))
+ (mapc (lambda (x)
+ ;; Accept only non-ASCII chars not
+ ;; listed in IGNORES.
+ (if (and (if (integerp x) (> x 127)
+ (string-match-p "[^[:ascii:]]" x))
+ (not (member x ignores)))
+ (setq multibyte t)))
translation)
(when multibyte
(setcdr decode-map
should be made by `quail-build-decode-map' (which see)."
(setq decode-map
(sort (cdr decode-map)
- (function (lambda (x y)
- (setq x (car x) y (car y))
- (or (> (length x) (length y))
- (and (= (length x) (length y))
- (not (string< x y))))))))
+ (lambda (x y)
+ (setq x (car x) y (car y))
+ (or (> (length x) (length y))
+ (and (= (length x) (length y))
+ (not (string< x y)))))))
(let ((window-width (window-width (get-buffer-window
(current-buffer) 'visible)))
(single-trans-width 4)
by `jka-compr-installed'."
;; Delete from inhibit-local-variables-suffixes what jka-compr-install added.
(mapc
- (function (lambda (x)
- (and (jka-compr-info-strip-extension x)
- (setq inhibit-local-variables-suffixes
- (delete (jka-compr-info-regexp x)
- inhibit-local-variables-suffixes)))))
+ (lambda (x)
+ (and (jka-compr-info-strip-extension x)
+ (setq inhibit-local-variables-suffixes
+ (delete (jka-compr-info-regexp x)
+ inhibit-local-variables-suffixes))))
jka-compr-compression-info-list--internal)
(let* ((fnha (cons nil file-name-handler-alist))
(or (file-exists-p database)
(error "Database file %s does not exist" database))
(let ((locate-make-command-line
- (function (lambda (string)
- (cons locate-command
- (list (concat "--database="
- (expand-file-name database))
- string))))))
+ (lambda (string)
+ (cons locate-command
+ (list (concat "--database="
+ (expand-file-name database))
+ string)))))
(locate search-string)))
(defun locate-do-redisplay (&optional arg test-for-subdir)
(setq result (cons (substring definition start end) result)
start (and end (match-end 0)))))
(setq definition
- (mapconcat (function (lambda (x)
+ (mapconcat (lambda (x)
(or (mail-resolve-all-aliases-1
- (intern-soft (downcase x) mail-abbrevs)
- (cons sym so-far))
- x)))
+ (intern-soft (downcase x) mail-abbrevs)
+ (cons sym so-far))
+ x))
(nreverse result)
mail-alias-separator-string))
(set sym definition))))
(_ (aref (standard-syntax-table) ?_))
(w (aref (standard-syntax-table) ?w)))
(map-char-table
- (function (lambda (key value)
- (if (null value)
- ;; Fetch the inherited value
- (setq value (aref tab key)))
- (if (equal value _)
- (set-char-table-range tab key w))))
+ (lambda (key value)
+ (if (null value)
+ ;; Fetch the inherited value
+ (setq value (aref tab key)))
+ (if (equal value _)
+ (set-char-table-range tab key w)))
tab)
(modify-syntax-entry ?@ "w" tab)
(modify-syntax-entry ?% "w" tab)
that note messages to be refiled."
(let ((seqs ()))
(cond (save-refiles
- (mh-mapc (function (lambda (seq) ; Save the refiling sequences
- (if (mh-folder-name-p (mh-seq-name seq))
- (setq seqs (cons seq seqs)))))
+ (mh-mapc (lambda (seq) ; Save the refiling sequences
+ (if (mh-folder-name-p (mh-seq-name seq))
+ (setq seqs (cons seq seqs))))
mh-seq-list)))
(save-excursion
(if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
;; Apply eudc-duplicate-attribute-handling-method
(if (not (eq 'list eudc-duplicate-attribute-handling-method))
(mapc
- (function (lambda (record)
- (setq final-result
- (append (eudc-filter-duplicate-attributes record)
- final-result))))
+ (lambda (record)
+ (setq final-result
+ (append (eudc-filter-duplicate-attributes record)
+ final-result)))
result))
final-result))
;; Sort by score
(apply #'vector
(sort artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
+ (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y))))))))
;; Swish-E interface.
(defun nnir-run-swish-e (query server &optional _group)
;; Sort by score
(apply #'vector
(sort artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
+ (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y))))))))
;; HyREX interface
(defun nnir-run-hyrex (query server &optional group)
(message "Massaging hyrex-search output...done.")
(apply #'vector
(sort artlist
- (function (lambda (x y)
- (if (string-lessp (nnir-artitem-group x)
- (nnir-artitem-group y))
- t
- (< (nnir-artitem-number x)
- (nnir-artitem-number y)))))))
+ (lambda (x y)
+ (if (string-lessp (nnir-artitem-group x)
+ (nnir-artitem-group y))
+ t
+ (< (nnir-artitem-number x)
+ (nnir-artitem-number y))))))
)))
;; Namazu interface
;; sort artlist by score
(apply #'vector
(sort artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
+ (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y))))))))
(defun nnir-run-notmuch (query server &optional groups)
"Run QUERY with GROUPS from SERVER against notmuch.
and generates the overview, one line per target name."
(insert
(mapconcat
- (function (lambda (item)
- (let* ((target-name (car item))
- (no-prereqs (not (member target-name prereq-list)))
- (needs-rebuild (or no-prereqs
- (funcall
- makefile-query-one-target-method-function
- target-name
- filename))))
- (format "\t%s%s"
- target-name
- (cond (no-prereqs " .. has no prerequisites")
- (needs-rebuild " .. NEEDS REBUILD")
- (t " .. is up to date"))))
- ))
+ (lambda (item)
+ (let* ((target-name (car item))
+ (no-prereqs (not (member target-name prereq-list)))
+ (needs-rebuild (or no-prereqs
+ (funcall
+ makefile-query-one-target-method-function
+ target-name
+ filename))))
+ (format "\t%s%s"
+ target-name
+ (cond (no-prereqs " .. has no prerequisites")
+ (needs-rebuild " .. NEEDS REBUILD")
+ (t " .. is up to date")))))
target-table "\n"))
(goto-char (point-min))
(delete-file filename)) ; remove the tmpfile
(defun makefile-prompt-for-gmake-funargs (function-name prompt-list)
(mapconcat
- (function (lambda (one-prompt)
- (read-string (format "[%s] %s: " function-name one-prompt)
- nil)))
+ (lambda (one-prompt)
+ (read-string (format "[%s] %s: " function-name one-prompt)
+ nil))
prompt-list
","))
permanently, remove the group from `shadow-literal-groups' or
`shadow-regexp-groups'."
(interactive)
- (map-y-or-n-p (function (lambda (pair)
- (format "Cancel copying %s to %s? "
- (car pair) (cdr pair))))
- (function (lambda (pair)
- (shadow-remove-from-todo pair)))
+ (map-y-or-n-p (lambda (pair)
+ (format "Cancel copying %s to %s? "
+ (car pair) (cdr pair)))
+ (lambda (pair)
+ (shadow-remove-from-todo pair))
shadow-files-to-copy
'("shadow" "shadows" "cancel copy"))
(message "There are %d shadows to be updated."
shadow-homedir))
(canonical-file (shadow-contract-file-name absolute-file))
(shadows
- (mapcar (function (lambda (shadow)
- (cons absolute-file shadow)))
+ (mapcar (lambda (shadow)
+ (cons absolute-file shadow))
(append
(shadow-shadows-of-1
canonical-file shadow-literal-groups nil)
(narrow-to-region beg end)
(goto-char (point-min))
(sort-subr reverse
- (function (lambda () (skip-chars-forward "\n")))
+ (lambda () (skip-chars-forward "\n"))
'forward-page))))
\f
(defvar sort-fields-syntax-table nil)
;;region to sort."
;; (interactive "p\nr")
;; (sort-fields-1 field beg end
-;; (function (lambda ()
-;; (sort-skip-fields field)
-;; (string-to-number
-;; (buffer-substring
-;; (point)
-;; (save-excursion
-;; (re-search-forward
-;; "[+-]?[0-9]*\\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
-;; (point))))))
-;; nil))
+;; (lambda ()
+;; (sort-skip-fields field)
+;; (string-to-number
+;; (buffer-substring
+;; (point)
+;; (save-excursion
+;; (re-search-forward
+;; "[+-]?[0-9]*\\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
+;; (point)))))
+;; nil))
;;;###autoload
(defun sort-fields (field beg end)
(let ;; To make `end-of-line' and etc. to ignore fields.
((inhibit-field-text-motion t))
(sort-fields-1 field beg end
- (function (lambda ()
- (sort-skip-fields field)
- nil))
- (function (lambda () (skip-chars-forward "^ \t\n"))))))
+ (lambda ()
+ (sort-skip-fields field)
+ nil)
+ (lambda () (skip-chars-forward "^ \t\n")))))
(defun sort-fields-1 (field beg end startkeyfun endkeyfun)
(let ((tbl (syntax-table)))
(goto-char (match-beginning 0))
(sort-subr reverse
'sort-regexp-fields-next-record
- (function (lambda ()
- (goto-char sort-regexp-record-end)))
- (function (lambda ()
- (let ((n 0))
- (cond ((numberp key-regexp)
- (setq n key-regexp))
- ((re-search-forward
- key-regexp sort-regexp-record-end t)
- (setq n 0))
- (t (throw 'key nil)))
- (condition-case ()
- (cons (match-beginning n)
- (match-end n))
- ;; if there was no such register
- (error (throw 'key nil)))))))))))
+ (lambda ()
+ (goto-char sort-regexp-record-end))
+ (lambda ()
+ (let ((n 0))
+ (cond ((numberp key-regexp)
+ (setq n key-regexp))
+ ((re-search-forward
+ key-regexp sort-regexp-record-end t)
+ (setq n 0))
+ (t (throw 'key nil)))
+ (condition-case ()
+ (cons (match-beginning n)
+ (match-end n))
+ ;; if there was no such register
+ (error (throw 'key nil))))))))))
\f
(defvar sort-columns-subprocess t)
"Convert a key sequence to a list of events."
(if (vectorp key)
(append key nil)
- (mapcar (function (lambda (c)
- (if (> c 127)
- (logxor c listify-key-sequence-1)
- c)))
+ (mapcar (lambda (c)
+ (if (> c 127)
+ (logxor c listify-key-sequence-1)
+ c))
key)))
(defun eventp (object)
;; On such terminals, Emacs should sacrifice the first and last character of
;; each mode line, rather than a whole screen column!
(add-hook 'kill-emacs-hook
- (function (lambda () (interactive)
- (send-string-to-terminal
- (concat "\ea23R" (1+ (frame-width)) "C\eG0"))))))
+ (lambda () (interactive)
+ (send-string-to-terminal
+ (concat "\ea23R" (1+ (frame-width)) "C\eG0")))))
(defun enable-arrow-keys ()
"To be called by `tty-setup-hook'. Overrides 6 Emacs standard keys
(progn
(require 'ehelp)
(with-electric-help
- (function (lambda ()
- ;;This shouldn't be necessary: with-electric-help needs
- ;; an optional argument telling it about the smallest
- ;; acceptable window-height of the help buffer.
- ;;(if (< (window-height) 15)
- ;; (enlarge-window
- ;; (- 15 (ispell-adjusted-window-height))))
- (princ "Selections are:
+ (lambda ()
+ ;;This shouldn't be necessary: with-electric-help needs
+ ;; an optional argument telling it about the smallest
+ ;; acceptable window-height of the help buffer.
+ ;;(if (< (window-height) 15)
+ ;; (enlarge-window
+ ;; (- 15 (ispell-adjusted-window-height))))
+ (princ "Selections are:
DIGIT: Replace the word with a digit offered in the *Choices* buffer.
SPC: Accept word this time.
`C-l': Redraw screen.
`C-r': Recursive edit.
`C-z': Suspend Emacs or iconify frame.")
- nil))))
+ nil)))
(let ((help-1 (concat "[r/R]eplace word; [a/A]ccept for this session; "
Generated from `ispell-tex-skip-alists'."
(concat
;; raw tex keys
- (mapconcat (function (lambda (lst) (car lst)))
+ (mapconcat (lambda (lst) (car lst))
(car ispell-tex-skip-alists)
"\\|")
"\\|"
;; keys wrapped in begin{}
- (mapconcat (function (lambda (lst)
- (concat "\\\\begin[ \t\n]*{[ \t\n]*"
- (car lst)
- "[ \t\n]*}")))
+ (mapconcat (lambda (lst)
+ (concat "\\\\begin[ \t\n]*{[ \t\n]*"
+ (car lst)
+ "[ \t\n]*}"))
(car (cdr ispell-tex-skip-alists))
"\\|")))
;; NEXTRECFUN is called with point at the end of the
;; previous record. It moves point to the start of the
;; next record.
- (function (lambda ()
- (re-search-forward page-delimiter nil t)
- (skip-chars-forward " \t\n")
- ))
+ (lambda ()
+ (re-search-forward page-delimiter nil t)
+ (skip-chars-forward " \t\n"))
;; ENDRECFUN is called with point within the record.
;; It should move point to the end of the record.
- (function (lambda ()
- (if (re-search-forward
- page-delimiter
- nil
- t)
- (goto-char (match-beginning 0))
- (goto-char (point-max))))))))
+ (lambda ()
+ (if (re-search-forward
+ page-delimiter
+ nil
+ t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max)))))))
(define-obsolete-function-alias 'sort-pages-buffer #'pages-sort-buffer "27.1")
(defun pages-sort-buffer (&optional reverse)
(forward-paragraph 1)
(setq end (point))
(setq found
- (refer-every (function (lambda (keyword)
- (goto-char begin)
- (re-search-forward keyword end t)))
+ (refer-every (lambda (keyword)
+ (goto-char begin)
+ (re-search-forward keyword end t))
keywords-list))
(if (not found)
(progn
(if (and url (not (string-match "^#" url)))
;; Need to nuke newlines and spaces in the URL, or we open
;; ourselves up to potential security holes.
- (setq url (mapconcat (function (lambda (x)
- (if (memq x '(? ?\n ?\r))
- ""
- (char-to-string x))))
+ (setq url (mapconcat (lambda (x)
+ (if (memq x '(? ?\n ?\r))
+ ""
+ (char-to-string x)))
url "")))
;; Need to figure out how/where to expand the fragment relative to
projects / emacs.git / commitdiff