mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-06 11:55:48 +00:00
Remove redundant 'function's around lambdas
* lisp/allout.el (allout-latex-verb-quote): * lisp/edmacro.el (edmacro-format-keys): * lisp/ffap.el (ffap-all-subdirs-loop) (ffap-kpathsea-expand-path, ffap-menu-rescan): * lisp/files.el (save-buffers-kill-emacs): * lisp/find-lisp.el (find-lisp-find-dired-internal) (find-lisp-insert-directory): * lisp/gnus/gnus-agent.el (gnus-agent-expire-unagentized-dirs): * lisp/gnus/nnmairix.el (nnmairix-create-message-line-for-search) (nnmairix-widget-get-values) (nnmairix-widget-make-query-from-widgets) (nnmairix-widget-build-editable-fields): * lisp/international/mule-cmds.el (sort-coding-systems): * lisp/international/mule-diag.el (list-character-sets-1): * lisp/international/quail.el (quail-insert-decode-map): * lisp/mail/reporter.el (reporter-dump-state): * lisp/mail/supercite.el (sc-attribs-filter-namelist): * lisp/pcmpl-gnu.el (pcmpl-gnu-zipped-files) (pcmpl-gnu-bzipped-files): * lisp/progmodes/cperl-mode.el (cperl-find-tags) (cperl-write-tags, cperl-tags-hier-init, cperl-tags-treeify) (cperl-menu-to-keymap, cperl-pod-spell): * lisp/progmodes/gdb-mi.el (gdb-parent-mode): * lisp/progmodes/make-mode.el (makefile-browser-fill): * lisp/simple.el (transpose-lines): * lisp/term.el: * lisp/term/w32-win.el (w32-find-non-USB-fonts): * lisp/textmodes/table.el (table--generate-source-scan-lines): Remove redundant 'function's around lambdas.
This commit is contained in:
Stefan Kangas
parent
68e57e0046
commit
43ad3c175d
@ -5583,12 +5583,11 @@ used verbatim."
|
||||
"Return copy of STRING for literal reproduction across LaTeX processing.
|
||||
Expresses the original characters (including carriage returns) of the
|
||||
string across LaTeX processing."
|
||||
(mapconcat (function
|
||||
(lambda (char)
|
||||
(cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
|
||||
(concat "\\char" (number-to-string char) "{}"))
|
||||
((= char ?\n) "\\\\")
|
||||
(t (char-to-string char)))))
|
||||
(mapconcat (lambda (char)
|
||||
(cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
|
||||
(concat "\\char" (number-to-string char) "{}"))
|
||||
((= char ?\n) "\\\\")
|
||||
(t (char-to-string char))))
|
||||
string
|
||||
""))
|
||||
;;;_ > allout-latex-verbatim-quote-curr-line ()
|
||||
|
||||
@ -535,32 +535,31 @@ doubt, use whitespace."
|
||||
(setq bind-len (1+ text)))
|
||||
(t
|
||||
(setq desc (mapconcat
|
||||
(function
|
||||
(lambda (ch)
|
||||
(cond
|
||||
((integerp ch)
|
||||
(concat
|
||||
(cl-loop for pf across "ACHMsS"
|
||||
for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
|
||||
?\M-\^@ ?\s-\^@ ?\S-\^@)
|
||||
when (/= (logand ch bit) 0)
|
||||
concat (format "%c-" pf))
|
||||
(let ((ch2 (logand ch (1- (ash 1 18)))))
|
||||
(cond ((<= ch2 32)
|
||||
(pcase ch2
|
||||
(0 "NUL") (9 "TAB") (10 "LFD")
|
||||
(13 "RET") (27 "ESC") (32 "SPC")
|
||||
(_
|
||||
(format "C-%c"
|
||||
(+ (if (<= ch2 26) 96 64)
|
||||
ch2)))))
|
||||
((= ch2 127) "DEL")
|
||||
((<= ch2 maxkey) (char-to-string ch2))
|
||||
(t (format "\\%o" ch2))))))
|
||||
((symbolp ch)
|
||||
(format "<%s>" ch))
|
||||
(t
|
||||
(error "Unrecognized item in macro: %s" ch)))))
|
||||
(lambda (ch)
|
||||
(cond
|
||||
((integerp ch)
|
||||
(concat
|
||||
(cl-loop for pf across "ACHMsS"
|
||||
for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
|
||||
?\M-\^@ ?\s-\^@ ?\S-\^@)
|
||||
when (/= (logand ch bit) 0)
|
||||
concat (format "%c-" pf))
|
||||
(let ((ch2 (logand ch (1- (ash 1 18)))))
|
||||
(cond ((<= ch2 32)
|
||||
(pcase ch2
|
||||
(0 "NUL") (9 "TAB") (10 "LFD")
|
||||
(13 "RET") (27 "ESC") (32 "SPC")
|
||||
(_
|
||||
(format "C-%c"
|
||||
(+ (if (<= ch2 26) 96 64)
|
||||
ch2)))))
|
||||
((= ch2 127) "DEL")
|
||||
((<= ch2 maxkey) (char-to-string ch2))
|
||||
(t (format "\\%o" ch2))))))
|
||||
((symbolp ch)
|
||||
(format "<%s>" ch))
|
||||
(t
|
||||
(error "Unrecognized item in macro: %s" ch))))
|
||||
(or fkey key) " "))))
|
||||
(if prefix
|
||||
(setq desc (concat (edmacro-sanitize-for-string prefix) desc)))
|
||||
|
||||
30
lisp/ffap.el
30
lisp/ffap.el
@ -690,14 +690,13 @@ Optional DEPTH limits search depth."
|
||||
(setq depth (1- depth))
|
||||
(cons dir
|
||||
(and (not (eq depth -1))
|
||||
(apply 'nconc
|
||||
(apply #'nconc
|
||||
(mapcar
|
||||
(function
|
||||
(lambda (d)
|
||||
(cond
|
||||
((not (file-directory-p d)) nil)
|
||||
((file-symlink-p d) (list d))
|
||||
(t (ffap-all-subdirs-loop d depth)))))
|
||||
(lambda (d)
|
||||
(cond
|
||||
((not (file-directory-p d)) nil)
|
||||
((file-symlink-p d) (list d))
|
||||
(t (ffap-all-subdirs-loop d depth))))
|
||||
(directory-files dir t "\\`[^.]")
|
||||
)))))
|
||||
|
||||
@ -710,13 +709,12 @@ Set to 0 to avoid all searching, or nil for no limit.")
|
||||
The subdirs begin with the original directory, and the depth of the
|
||||
search is bounded by `ffap-kpathsea-depth'. This is intended to mimic
|
||||
kpathsea, a library used by some versions of TeX."
|
||||
(apply 'nconc
|
||||
(apply #'nconc
|
||||
(mapcar
|
||||
(function
|
||||
(lambda (dir)
|
||||
(if (string-match "[^/]//\\'" dir)
|
||||
(ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
|
||||
(list dir))))
|
||||
(lambda (dir)
|
||||
(if (string-match "[^/]//\\'" dir)
|
||||
(ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
|
||||
(list dir)))
|
||||
path)))
|
||||
|
||||
(defun ffap-locate-file (file nosuffix path)
|
||||
@ -1793,8 +1791,7 @@ Applies `ffap-menu-text-plist' text properties at all matches."
|
||||
;; Remove duplicates.
|
||||
(setq ffap-menu-alist ; sort by item
|
||||
(sort ffap-menu-alist
|
||||
(function
|
||||
(lambda (a b) (string-lessp (car a) (car b))))))
|
||||
(lambda (a b) (string-lessp (car a) (car b)))))
|
||||
(let ((ptr ffap-menu-alist)) ; remove duplicates
|
||||
(while (cdr ptr)
|
||||
(if (equal (car (car ptr)) (car (car (cdr ptr))))
|
||||
@ -1802,8 +1799,7 @@ Applies `ffap-menu-text-plist' text properties at all matches."
|
||||
(setq ptr (cdr ptr)))))
|
||||
(setq ffap-menu-alist ; sort by position
|
||||
(sort ffap-menu-alist
|
||||
(function
|
||||
(lambda (a b) (< (cdr a) (cdr b)))))))
|
||||
(lambda (a b) (< (cdr a) (cdr b))))))
|
||||
|
||||
|
||||
;;; Mouse Support (`ffap-at-mouse'):
|
||||
|
||||
@ -7370,9 +7370,9 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
|
||||
(save-some-buffers arg t)
|
||||
(let ((confirm confirm-kill-emacs))
|
||||
(and
|
||||
(or (not (memq t (mapcar (function
|
||||
(lambda (buf) (and (buffer-file-name buf)
|
||||
(buffer-modified-p buf))))
|
||||
(or (not (memq t (mapcar (lambda (buf)
|
||||
(and (buffer-file-name buf)
|
||||
(buffer-modified-p buf)))
|
||||
(buffer-list))))
|
||||
(progn (setq confirm nil)
|
||||
(yes-or-no-p "Modified buffers exist; exit anyway? ")))
|
||||
|
||||
@ -221,15 +221,12 @@ It is a function which takes two arguments, the directory and its parent."
|
||||
|
||||
(make-local-variable 'revert-buffer-function)
|
||||
(setq revert-buffer-function
|
||||
(function
|
||||
(lambda (_ignore1 _ignore2)
|
||||
(find-lisp-insert-directory
|
||||
default-directory
|
||||
find-lisp-file-predicate
|
||||
find-lisp-directory-predicate
|
||||
'ignore)
|
||||
)
|
||||
))
|
||||
(lambda (_ignore1 _ignore2)
|
||||
(find-lisp-insert-directory
|
||||
default-directory
|
||||
find-lisp-file-predicate
|
||||
find-lisp-directory-predicate
|
||||
'ignore)))
|
||||
|
||||
;; Set subdir-alist so that Tree Dired will work:
|
||||
(if (fboundp 'dired-simple-subdir-alist)
|
||||
@ -267,11 +264,10 @@ It is a function which takes two arguments, the directory and its parent."
|
||||
(insert find-lisp-line-indent "\n")
|
||||
;; Run the find function
|
||||
(mapc
|
||||
(function
|
||||
(lambda (file)
|
||||
(find-lisp-find-dired-insert-file
|
||||
(substring file len)
|
||||
(current-buffer))))
|
||||
(lambda (file)
|
||||
(find-lisp-find-dired-insert-file
|
||||
(substring file len)
|
||||
(current-buffer)))
|
||||
(sort files 'string-lessp))
|
||||
;; FIXME: Sort function is ignored for now
|
||||
;; (funcall sort-function files))
|
||||
|
||||
@ -3567,22 +3567,21 @@ articles in every agentized group? "))
|
||||
(let* (delete-recursive
|
||||
files f
|
||||
(delete-recursive
|
||||
(function
|
||||
(lambda (f-or-d)
|
||||
(ignore-errors
|
||||
(if (file-directory-p f-or-d)
|
||||
(condition-case nil
|
||||
(delete-directory f-or-d)
|
||||
(file-error
|
||||
(setq files (directory-files f-or-d))
|
||||
(while files
|
||||
(setq f (pop files))
|
||||
(or (member f '("." ".."))
|
||||
(funcall delete-recursive
|
||||
(nnheader-concat
|
||||
f-or-d f))))
|
||||
(delete-directory f-or-d)))
|
||||
(delete-file f-or-d)))))))
|
||||
(lambda (f-or-d)
|
||||
(ignore-errors
|
||||
(if (file-directory-p f-or-d)
|
||||
(condition-case nil
|
||||
(delete-directory f-or-d)
|
||||
(file-error
|
||||
(setq files (directory-files f-or-d))
|
||||
(while files
|
||||
(setq f (pop files))
|
||||
(or (member f '("." ".."))
|
||||
(funcall delete-recursive
|
||||
(nnheader-concat
|
||||
f-or-d f))))
|
||||
(delete-directory f-or-d)))
|
||||
(delete-file f-or-d))))))
|
||||
(funcall delete-recursive dir)))))))))
|
||||
|
||||
;;;###autoload
|
||||
|
||||
@ -1548,9 +1548,8 @@ See %s for details" proc nnmairix-mairix-output-buffer)))
|
||||
(defun nnmairix-create-message-line-for-search ()
|
||||
"Create message line for interactive query in minibuffer."
|
||||
(mapconcat
|
||||
(function
|
||||
(lambda (cur)
|
||||
(format "%c=%s" (car cur) (nth 3 cur))))
|
||||
(lambda (cur)
|
||||
(format "%c=%s" (car cur) (nth 3 cur)))
|
||||
nnmairix-interactive-query-parameters ","))
|
||||
|
||||
(defun nnmairix-replace-illegal-chars (header)
|
||||
@ -1811,13 +1810,12 @@ If VERSION is a string: must be contained in mairix version output."
|
||||
(gnus-summary-toggle-header 1)
|
||||
(set-buffer gnus-article-buffer)
|
||||
(mapcar
|
||||
(function
|
||||
(lambda (field)
|
||||
(list (car (cddr field))
|
||||
(if (car field)
|
||||
(nnmairix-replace-illegal-chars
|
||||
(gnus-fetch-field (car field)))
|
||||
nil))))
|
||||
(lambda (field)
|
||||
(list (car (cddr field))
|
||||
(if (car field)
|
||||
(nnmairix-replace-illegal-chars
|
||||
(gnus-fetch-field (car field)))
|
||||
nil)))
|
||||
nnmairix-widget-fields-list))))
|
||||
|
||||
|
||||
@ -1911,14 +1909,13 @@ If WITHVALUES is t, query is based on current article."
|
||||
(when (member 'flags nnmairix-widget-other)
|
||||
(setq flag
|
||||
(mapconcat
|
||||
(function
|
||||
(lambda (flag)
|
||||
(setq temp
|
||||
(widget-value (cadr (assoc (car flag) nnmairix-widgets))))
|
||||
(if (string= "yes" temp)
|
||||
(cadr flag)
|
||||
(if (string= "no" temp)
|
||||
(concat "-" (cadr flag))))))
|
||||
(lambda (flag)
|
||||
(setq temp
|
||||
(widget-value (cadr (assoc (car flag) nnmairix-widgets))))
|
||||
(if (string= "yes" temp)
|
||||
(cadr flag)
|
||||
(if (string= "no" temp)
|
||||
(concat "-" (cadr flag)))))
|
||||
'(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
|
||||
(when (not (zerop (length flag)))
|
||||
(push (concat "F:" flag) query)))
|
||||
@ -1968,32 +1965,31 @@ VALUES may contain values for editable fields from current article."
|
||||
;; how can this be done less ugly?
|
||||
(let ((ret))
|
||||
(mapc
|
||||
(function
|
||||
(lambda (field)
|
||||
(setq field (car (cddr field)))
|
||||
(setq ret
|
||||
(nconc
|
||||
(list
|
||||
(list
|
||||
(concat "c" field)
|
||||
(widget-create 'checkbox
|
||||
:tag field
|
||||
:notify (lambda (widget &rest ignore)
|
||||
(nnmairix-widget-toggle-activate widget))
|
||||
nil)))
|
||||
(list
|
||||
(list
|
||||
(concat "e" field)
|
||||
(widget-create 'editable-field
|
||||
:size 60
|
||||
:format (concat " " field ":"
|
||||
(make-string (- 11 (length field)) ?\ )
|
||||
"%v")
|
||||
:value (or (cadr (assoc field values)) ""))))
|
||||
ret))
|
||||
(widget-insert "\n")
|
||||
;; Deactivate editable field
|
||||
(widget-apply (cadr (nth 1 ret)) :deactivate)))
|
||||
(lambda (field)
|
||||
(setq field (car (cddr field)))
|
||||
(setq ret
|
||||
(nconc
|
||||
(list
|
||||
(list
|
||||
(concat "c" field)
|
||||
(widget-create 'checkbox
|
||||
:tag field
|
||||
:notify (lambda (widget &rest ignore)
|
||||
(nnmairix-widget-toggle-activate widget))
|
||||
nil)))
|
||||
(list
|
||||
(list
|
||||
(concat "e" field)
|
||||
(widget-create 'editable-field
|
||||
:size 60
|
||||
:format (concat " " field ":"
|
||||
(make-string (- 11 (length field)) ?\ )
|
||||
"%v")
|
||||
:value (or (cadr (assoc field values)) ""))))
|
||||
ret))
|
||||
(widget-insert "\n")
|
||||
;; Deactivate editable field
|
||||
(widget-apply (cadr (nth 1 ret)) :deactivate))
|
||||
nnmairix-widget-fields-list)
|
||||
ret))
|
||||
|
||||
|
||||
@ -441,56 +441,55 @@ non-nil, it is used to sort CODINGS instead."
|
||||
(most-preferred (car from-priority))
|
||||
(lang-preferred (get-language-info current-language-environment
|
||||
'coding-system))
|
||||
(func (function
|
||||
(lambda (x)
|
||||
(let ((base (coding-system-base x)))
|
||||
;; We calculate the priority number 0..255 by
|
||||
;; using the 8 bits PMMLCEII as this:
|
||||
;; P: 1 if most preferred.
|
||||
;; MM: greater than 0 if mime-charset.
|
||||
;; L: 1 if one of the current lang. env.'s codings.
|
||||
;; C: 1 if one of codings listed in the category list.
|
||||
;; E: 1 if not XXX-with-esc
|
||||
;; II: if iso-2022 based, 0..3, else 1.
|
||||
(logior
|
||||
(ash (if (eq base most-preferred) 1 0) 7)
|
||||
(ash
|
||||
(let ((mime (coding-system-get base :mime-charset)))
|
||||
;; Prefer coding systems corresponding to a
|
||||
;; MIME charset.
|
||||
(if mime
|
||||
;; Lower utf-16 priority so that we
|
||||
;; normally prefer utf-8 to it, and put
|
||||
;; x-ctext below that.
|
||||
(cond ((string-match-p "utf-16"
|
||||
(symbol-name mime))
|
||||
2)
|
||||
((string-match-p "^x-" (symbol-name mime))
|
||||
1)
|
||||
(t 3))
|
||||
0))
|
||||
5)
|
||||
(ash (if (memq base lang-preferred) 1 0) 4)
|
||||
(ash (if (memq base from-priority) 1 0) 3)
|
||||
(ash (if (string-match-p "-with-esc\\'"
|
||||
(symbol-name base))
|
||||
0 1) 2)
|
||||
(if (eq (coding-system-type base) 'iso-2022)
|
||||
(let ((category (coding-system-category base)))
|
||||
;; For ISO based coding systems, prefer
|
||||
;; one that doesn't use designation nor
|
||||
;; locking/single shifting.
|
||||
(cond
|
||||
((or (eq category 'coding-category-iso-8-1)
|
||||
(eq category 'coding-category-iso-8-2))
|
||||
2)
|
||||
((or (eq category 'coding-category-iso-7-tight)
|
||||
(eq category 'coding-category-iso-7))
|
||||
1)
|
||||
(t
|
||||
0)))
|
||||
1)
|
||||
))))))
|
||||
(func (lambda (x)
|
||||
(let ((base (coding-system-base x)))
|
||||
;; We calculate the priority number 0..255 by
|
||||
;; using the 8 bits PMMLCEII as this:
|
||||
;; P: 1 if most preferred.
|
||||
;; MM: greater than 0 if mime-charset.
|
||||
;; L: 1 if one of the current lang. env.'s codings.
|
||||
;; C: 1 if one of codings listed in the category list.
|
||||
;; E: 1 if not XXX-with-esc
|
||||
;; II: if iso-2022 based, 0..3, else 1.
|
||||
(logior
|
||||
(ash (if (eq base most-preferred) 1 0) 7)
|
||||
(ash
|
||||
(let ((mime (coding-system-get base :mime-charset)))
|
||||
;; Prefer coding systems corresponding to a
|
||||
;; MIME charset.
|
||||
(if mime
|
||||
;; Lower utf-16 priority so that we
|
||||
;; normally prefer utf-8 to it, and put
|
||||
;; x-ctext below that.
|
||||
(cond ((string-match-p "utf-16"
|
||||
(symbol-name mime))
|
||||
2)
|
||||
((string-match-p "^x-" (symbol-name mime))
|
||||
1)
|
||||
(t 3))
|
||||
0))
|
||||
5)
|
||||
(ash (if (memq base lang-preferred) 1 0) 4)
|
||||
(ash (if (memq base from-priority) 1 0) 3)
|
||||
(ash (if (string-match-p "-with-esc\\'"
|
||||
(symbol-name base))
|
||||
0 1) 2)
|
||||
(if (eq (coding-system-type base) 'iso-2022)
|
||||
(let ((category (coding-system-category base)))
|
||||
;; For ISO based coding systems, prefer
|
||||
;; one that doesn't use designation nor
|
||||
;; locking/single shifting.
|
||||
(cond
|
||||
((or (eq category 'coding-category-iso-8-1)
|
||||
(eq category 'coding-category-iso-8-2))
|
||||
2)
|
||||
((or (eq category 'coding-category-iso-7-tight)
|
||||
(eq category 'coding-category-iso-7))
|
||||
1)
|
||||
(t
|
||||
0)))
|
||||
1)
|
||||
)))))
|
||||
(sort codings (lambda (x y)
|
||||
(> (funcall func x) (funcall func y)))))))
|
||||
|
||||
|
||||
@ -136,13 +136,12 @@ SORT-KEY should be `name' or `iso-spec' (default `name')."
|
||||
|
||||
((eq sort-key 'iso-spec)
|
||||
;; Sort by DIMENSION CHARS FINAL-CHAR
|
||||
(function
|
||||
(lambda (x y)
|
||||
(or (< (nth 1 x) (nth 1 y))
|
||||
(and (= (nth 1 x) (nth 1 y))
|
||||
(or (< (nth 2 x) (nth 2 y))
|
||||
(and (= (nth 2 x) (nth 2 y))
|
||||
(< (nth 3 x) (nth 3 y)))))))))
|
||||
(lambda (x y)
|
||||
(or (< (nth 1 x) (nth 1 y))
|
||||
(and (= (nth 1 x) (nth 1 y))
|
||||
(or (< (nth 2 x) (nth 2 y))
|
||||
(and (= (nth 2 x) (nth 2 y))
|
||||
(< (nth 3 x) (nth 3 y))))))))
|
||||
(t
|
||||
(error "Invalid charset sort key: %s" sort-key))))
|
||||
|
||||
|
||||
@ -2478,14 +2478,13 @@ should be made by `quail-build-decode-map' (which see)."
|
||||
'face 'font-lock-comment-face))
|
||||
(quail-indent-to max-key-width)
|
||||
(if (vectorp (cdr elt))
|
||||
(mapc (function
|
||||
(lambda (x)
|
||||
(let ((width (if (integerp x) (char-width x)
|
||||
(string-width x))))
|
||||
(when (> (+ (current-column) 1 width) window-width)
|
||||
(insert "\n")
|
||||
(quail-indent-to max-key-width))
|
||||
(insert " " x))))
|
||||
(mapc (lambda (x)
|
||||
(let ((width (if (integerp x) (char-width x)
|
||||
(string-width x))))
|
||||
(when (> (+ (current-column) 1 width) window-width)
|
||||
(insert "\n")
|
||||
(quail-indent-to max-key-width))
|
||||
(insert " " x)))
|
||||
(cdr elt))
|
||||
(insert " " (cdr elt)))
|
||||
(insert ?\n))
|
||||
|
||||
@ -250,14 +250,12 @@ dumped."
|
||||
(insert "(setq\n")
|
||||
(lisp-indent-line)
|
||||
(mapc
|
||||
(function
|
||||
(lambda (varsym-or-cons-cell)
|
||||
(let ((varsym (or (car-safe varsym-or-cons-cell)
|
||||
varsym-or-cons-cell))
|
||||
(printer (or (cdr-safe varsym-or-cons-cell)
|
||||
'reporter-dump-variable)))
|
||||
(funcall printer varsym mailbuf)
|
||||
)))
|
||||
(lambda (varsym-or-cons-cell)
|
||||
(let ((varsym (or (car-safe varsym-or-cons-cell)
|
||||
varsym-or-cons-cell))
|
||||
(printer (or (cdr-safe varsym-or-cons-cell)
|
||||
'reporter-dump-variable)))
|
||||
(funcall printer varsym mailbuf)))
|
||||
varlist)
|
||||
(lisp-indent-line)
|
||||
(insert ")\n"))
|
||||
|
||||
@ -1028,17 +1028,16 @@ supplied, is used instead of the line point is on in the current buffer."
|
||||
(setq position (1+ position))
|
||||
(let ((keep-p t))
|
||||
(mapc
|
||||
(function
|
||||
(lambda (filter)
|
||||
(let ((regexp (car filter))
|
||||
(pos (cdr filter)))
|
||||
(if (and (string-match regexp name)
|
||||
(or (and (numberp pos)
|
||||
(= pos position))
|
||||
(and (eq pos 'last)
|
||||
(= position (1- elements)))
|
||||
(eq pos 'any)))
|
||||
(setq keep-p nil)))))
|
||||
(lambda (filter)
|
||||
(let ((regexp (car filter))
|
||||
(pos (cdr filter)))
|
||||
(if (and (string-match regexp name)
|
||||
(or (and (numberp pos)
|
||||
(= pos position))
|
||||
(and (eq pos 'last)
|
||||
(= position (1- elements)))
|
||||
(eq pos 'any)))
|
||||
(setq keep-p nil))))
|
||||
sc-name-filter-alist)
|
||||
(if keep-p
|
||||
(setq keepers (cons position keepers)))))
|
||||
|
||||
@ -65,15 +65,14 @@
|
||||
"Find all zipped or unzipped files: the inverse of UNZIP-P."
|
||||
(pcomplete-entries
|
||||
nil
|
||||
(function
|
||||
(lambda (entry)
|
||||
(or (file-directory-p entry)
|
||||
(when (and (file-readable-p entry)
|
||||
(file-regular-p entry))
|
||||
(let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'"
|
||||
entry)))
|
||||
(or (and unzip-p zipped)
|
||||
(and (not unzip-p) (not zipped))))))))))
|
||||
(lambda (entry)
|
||||
(or (file-directory-p entry)
|
||||
(when (and (file-readable-p entry)
|
||||
(file-regular-p entry))
|
||||
(let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'"
|
||||
entry)))
|
||||
(or (and unzip-p zipped)
|
||||
(and (not unzip-p) (not zipped)))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun pcomplete/bzip2 ()
|
||||
@ -92,13 +91,12 @@
|
||||
"Find all zipped or unzipped files: the inverse of UNZIP-P."
|
||||
(pcomplete-entries
|
||||
nil
|
||||
(function
|
||||
(lambda (entry)
|
||||
(when (and (file-readable-p entry)
|
||||
(file-regular-p entry))
|
||||
(let ((zipped (string-match "\\.\\(t?z2\\|bz2\\)\\'" entry)))
|
||||
(or (and unzip-p zipped)
|
||||
(and (not unzip-p) (not zipped)))))))))
|
||||
(lambda (entry)
|
||||
(when (and (file-readable-p entry)
|
||||
(file-regular-p entry))
|
||||
(let ((zipped (string-match "\\.\\(t?z2\\|bz2\\)\\'" entry)))
|
||||
(or (and unzip-p zipped)
|
||||
(and (not unzip-p) (not zipped))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun pcomplete/make ()
|
||||
|
||||
@ -5442,11 +5442,10 @@ indentation and initial hashes. Behaves usually outside of comment."
|
||||
(cperl-init-faces))))
|
||||
((not cperl-faces-init)
|
||||
(add-hook 'font-lock-mode-hook
|
||||
(function
|
||||
(lambda ()
|
||||
(if (memq major-mode '(perl-mode cperl-mode))
|
||||
(progn
|
||||
(or cperl-faces-init (cperl-init-faces)))))))
|
||||
(lambda ()
|
||||
(if (memq major-mode '(perl-mode cperl-mode))
|
||||
(progn
|
||||
(or cperl-faces-init (cperl-init-faces))))))
|
||||
(eval-after-load
|
||||
"ps-print"
|
||||
'(or cperl-faces-init (cperl-init-faces))))))
|
||||
@ -6073,9 +6072,8 @@ side-effect of memorizing only. Examples in `cperl-style-examples'."
|
||||
(list (completing-read "Enter style: " cperl-style-alist nil 'insist)))
|
||||
(or cperl-old-style
|
||||
(setq cperl-old-style
|
||||
(mapcar (function
|
||||
(lambda (name)
|
||||
(cons name (eval name))))
|
||||
(mapcar (lambda (name)
|
||||
(cons name (eval name)))
|
||||
cperl-styles-entries)))
|
||||
(let ((style (cdr (assoc style cperl-style-alist))) setting)
|
||||
(while style
|
||||
@ -6527,22 +6525,21 @@ Does not move point."
|
||||
(setq lst (cdr (assoc "+Unsorted List+..." ind))))
|
||||
(setq lst
|
||||
(mapcar
|
||||
(function
|
||||
(lambda (elt)
|
||||
(cond ((string-match "^[_a-zA-Z]" (car elt))
|
||||
(goto-char (cdr elt))
|
||||
(beginning-of-line) ; pos should be of the start of the line
|
||||
(list (car elt)
|
||||
(point)
|
||||
(1+ (count-lines 1 (point))) ; 1+ since at beg-o-l
|
||||
(buffer-substring (progn
|
||||
(goto-char (cdr elt))
|
||||
;; After name now...
|
||||
(or (eolp) (forward-char 1))
|
||||
(point))
|
||||
(progn
|
||||
(beginning-of-line)
|
||||
(point))))))))
|
||||
(lambda (elt)
|
||||
(cond ((string-match "^[_a-zA-Z]" (car elt))
|
||||
(goto-char (cdr elt))
|
||||
(beginning-of-line) ; pos should be of the start of the line
|
||||
(list (car elt)
|
||||
(point)
|
||||
(1+ (count-lines 1 (point))) ; 1+ since at beg-o-l
|
||||
(buffer-substring (progn
|
||||
(goto-char (cdr elt))
|
||||
;; After name now...
|
||||
(or (eolp) (forward-char 1))
|
||||
(point))
|
||||
(progn
|
||||
(beginning-of-line)
|
||||
(point)))))))
|
||||
lst))
|
||||
(erase-buffer)
|
||||
(while lst
|
||||
@ -6645,16 +6642,15 @@ Use as
|
||||
(setq cperl-unreadable-ok t)
|
||||
nil) ; Return empty list
|
||||
(error "Aborting: unreadable directory %s" file)))))))
|
||||
(mapc (function
|
||||
(lambda (file)
|
||||
(cond
|
||||
((string-match cperl-noscan-files-regexp file)
|
||||
nil)
|
||||
((not (file-directory-p file))
|
||||
(if (string-match cperl-scan-files-regexp file)
|
||||
(cperl-write-tags file erase recurse nil t noxs topdir)))
|
||||
((not recurse) nil)
|
||||
(t (cperl-write-tags file erase recurse t t noxs topdir)))))
|
||||
(mapc (lambda (file)
|
||||
(cond
|
||||
((string-match cperl-noscan-files-regexp file)
|
||||
nil)
|
||||
((not (file-directory-p file))
|
||||
(if (string-match cperl-scan-files-regexp file)
|
||||
(cperl-write-tags file erase recurse nil t noxs topdir)))
|
||||
((not recurse) nil)
|
||||
(t (cperl-write-tags file erase recurse t t noxs topdir))))
|
||||
files)))
|
||||
(t
|
||||
(setq xs (string-match "\\.xs$" file))
|
||||
@ -6768,11 +6764,10 @@ One may build such TAGS files from CPerl mode menu."
|
||||
(or tags-table-list
|
||||
(call-interactively 'visit-tags-table))
|
||||
(mapc
|
||||
(function
|
||||
(lambda (tagsfile)
|
||||
(message "Updating list of classes... %s" tagsfile)
|
||||
(set-buffer (get-file-buffer tagsfile))
|
||||
(cperl-tags-hier-fill)))
|
||||
(lambda (tagsfile)
|
||||
(message "Updating list of classes... %s" tagsfile)
|
||||
(set-buffer (get-file-buffer tagsfile))
|
||||
(cperl-tags-hier-fill))
|
||||
tags-table-list)
|
||||
(message "Updating list of classes... postprocessing...")
|
||||
(mapc remover (car cperl-hierarchy))
|
||||
@ -6816,24 +6811,23 @@ One may build such TAGS files from CPerl mode menu."
|
||||
l1 head cons1 cons2 ord writeto recurse
|
||||
root-packages root-functions
|
||||
(move-deeper
|
||||
(function
|
||||
(lambda (elt)
|
||||
(cond ((and (string-match regexp (car elt))
|
||||
(or (eq ord 1) (match-end 2)))
|
||||
(setq head (substring (car elt) 0 (match-end 1))
|
||||
recurse t)
|
||||
(if (setq cons1 (assoc head writeto)) nil
|
||||
;; Need to init new head
|
||||
(setcdr writeto (cons (list head (list "Packages: ")
|
||||
(list "Methods: "))
|
||||
(cdr writeto)))
|
||||
(setq cons1 (nth 1 writeto)))
|
||||
(setq cons2 (nth ord cons1)) ; Either packs or meths
|
||||
(setcdr cons2 (cons elt (cdr cons2))))
|
||||
((eq ord 2)
|
||||
(setq root-functions (cons elt root-functions)))
|
||||
(t
|
||||
(setq root-packages (cons elt root-packages))))))))
|
||||
(lambda (elt)
|
||||
(cond ((and (string-match regexp (car elt))
|
||||
(or (eq ord 1) (match-end 2)))
|
||||
(setq head (substring (car elt) 0 (match-end 1))
|
||||
recurse t)
|
||||
(if (setq cons1 (assoc head writeto)) nil
|
||||
;; Need to init new head
|
||||
(setcdr writeto (cons (list head (list "Packages: ")
|
||||
(list "Methods: "))
|
||||
(cdr writeto)))
|
||||
(setq cons1 (nth 1 writeto)))
|
||||
(setq cons2 (nth ord cons1)) ; Either packs or meths
|
||||
(setcdr cons2 (cons elt (cdr cons2))))
|
||||
((eq ord 2)
|
||||
(setq root-functions (cons elt root-functions)))
|
||||
(t
|
||||
(setq root-packages (cons elt root-packages)))))))
|
||||
(setcdr to l1) ; Init to dynamic space
|
||||
(setq writeto to)
|
||||
(setq ord 1)
|
||||
@ -6903,16 +6897,15 @@ One may build such TAGS files from CPerl mode menu."
|
||||
(let (list)
|
||||
(cons 'keymap
|
||||
(mapcar
|
||||
(function
|
||||
(lambda (elt)
|
||||
(cond ((listp (cdr elt))
|
||||
(setq list (cperl-list-fold
|
||||
(cdr elt) (car elt) imenu-max-items))
|
||||
(cons nil
|
||||
(cons (car elt)
|
||||
(cperl-menu-to-keymap list))))
|
||||
(t
|
||||
(list (cdr elt) (car elt) t))))) ; t is needed in 19.34
|
||||
(lambda (elt)
|
||||
(cond ((listp (cdr elt))
|
||||
(setq list (cperl-list-fold
|
||||
(cdr elt) (car elt) imenu-max-items))
|
||||
(cons nil
|
||||
(cons (car elt)
|
||||
(cperl-menu-to-keymap list))))
|
||||
(t
|
||||
(list (cdr elt) (car elt) t)))) ; t is needed in 19.34
|
||||
(cperl-list-fold menu "Root" imenu-max-items)))))
|
||||
|
||||
|
||||
@ -8239,15 +8232,14 @@ If a region is highlighted, restricts to the region."
|
||||
end (max (mark) (point)))
|
||||
(setq beg (point-min)
|
||||
end (point-max)))
|
||||
(cperl-map-pods-heres (function
|
||||
(lambda (s e _p)
|
||||
(if do-heres
|
||||
(setq e (save-excursion
|
||||
(goto-char e)
|
||||
(forward-line -1)
|
||||
(point))))
|
||||
(ispell-region s e)
|
||||
t))
|
||||
(cperl-map-pods-heres (lambda (s e _p)
|
||||
(if do-heres
|
||||
(setq e (save-excursion
|
||||
(goto-char e)
|
||||
(forward-line -1)
|
||||
(point))))
|
||||
(ispell-region s e)
|
||||
t)
|
||||
(if do-heres 'here-doc-group 'in-pod)
|
||||
beg end))))
|
||||
|
||||
|
||||
@ -1617,17 +1617,16 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
|
||||
;; (if it has an associated update trigger)
|
||||
(add-hook
|
||||
'kill-buffer-hook
|
||||
(function
|
||||
(lambda ()
|
||||
(let ((trigger (gdb-rules-update-trigger
|
||||
(gdb-current-buffer-rules))))
|
||||
(when trigger
|
||||
(gdb-delete-subscriber
|
||||
gdb-buf-publisher
|
||||
;; This should match gdb-add-subscriber done in
|
||||
;; gdb-get-buffer-create
|
||||
(cons (current-buffer)
|
||||
(gdb-bind-function-to-buffer trigger (current-buffer))))))))
|
||||
(lambda ()
|
||||
(let ((trigger (gdb-rules-update-trigger
|
||||
(gdb-current-buffer-rules))))
|
||||
(when trigger
|
||||
(gdb-delete-subscriber
|
||||
gdb-buf-publisher
|
||||
;; This should match gdb-add-subscriber done in
|
||||
;; gdb-get-buffer-create
|
||||
(cons (current-buffer)
|
||||
(gdb-bind-function-to-buffer trigger (current-buffer)))))))
|
||||
nil t))
|
||||
|
||||
;; Partial-output buffer : This accumulates output from a command executed on
|
||||
|
||||
@ -1370,13 +1370,11 @@ Fill comments, backslashed lines, and variable definitions specially."
|
||||
(goto-char (point-min))
|
||||
(erase-buffer)
|
||||
(mapconcat
|
||||
(function
|
||||
(lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n")))
|
||||
(lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n"))
|
||||
targets
|
||||
"")
|
||||
(mapconcat
|
||||
(function
|
||||
(lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n")))
|
||||
(lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n"))
|
||||
macros
|
||||
"")
|
||||
(sort-lines nil (point-min) (point-max))
|
||||
|
||||
@ -7435,18 +7435,17 @@ are interchanged."
|
||||
With argument ARG, takes previous line and moves it past ARG lines.
|
||||
With argument 0, interchanges line point is in with line mark is in."
|
||||
(interactive "*p")
|
||||
(transpose-subr (function
|
||||
(lambda (arg)
|
||||
(if (> arg 0)
|
||||
(progn
|
||||
;; Move forward over ARG lines,
|
||||
;; but create newlines if necessary.
|
||||
(setq arg (forward-line arg))
|
||||
(if (/= (preceding-char) ?\n)
|
||||
(setq arg (1+ arg)))
|
||||
(if (> arg 0)
|
||||
(newline arg)))
|
||||
(forward-line arg))))
|
||||
(transpose-subr (lambda (arg)
|
||||
(if (> arg 0)
|
||||
(progn
|
||||
;; Move forward over ARG lines,
|
||||
;; but create newlines if necessary.
|
||||
(setq arg (forward-line arg))
|
||||
(if (/= (preceding-char) ?\n)
|
||||
(setq arg (1+ arg)))
|
||||
(if (> arg 0)
|
||||
(newline arg)))
|
||||
(forward-line arg)))
|
||||
arg))
|
||||
|
||||
;; FIXME seems to leave point BEFORE the current object when ARG = 0,
|
||||
|
||||
13
lisp/term.el
13
lisp/term.el
@ -123,13 +123,12 @@
|
||||
;; full advantage of this package
|
||||
;;
|
||||
;; (add-hook 'term-mode-hook
|
||||
;; (function
|
||||
;; (lambda ()
|
||||
;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *")
|
||||
;; (setq-local mouse-yank-at-point t)
|
||||
;; (setq-local transient-mark-mode nil)
|
||||
;; (auto-fill-mode -1)
|
||||
;; (setq tab-width 8 ))))
|
||||
;; (lambda ()
|
||||
;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *")
|
||||
;; (setq-local mouse-yank-at-point t)
|
||||
;; (setq-local transient-mark-mode nil)
|
||||
;; (auto-fill-mode -1)
|
||||
;; (setq tab-width 8)))
|
||||
;;
|
||||
;; ----------------------------------------
|
||||
;;
|
||||
|
||||
@ -567,46 +567,45 @@ default font on FRAME, or its best approximation."
|
||||
(x-list-fonts "-*-*-medium-r-normal-*-*-*-*-*-*-iso10646-1"
|
||||
'default frame)))
|
||||
val)
|
||||
(mapc (function
|
||||
(lambda (script-desc)
|
||||
(let* ((script (car script-desc))
|
||||
(script-chars (vconcat (cdr script-desc)))
|
||||
(nchars (length script-chars))
|
||||
(fntlist all-fonts)
|
||||
(entry (list script))
|
||||
fspec ffont font-obj glyphs idx)
|
||||
;; For each font in FNTLIST, determine whether it
|
||||
;; supports the representative character(s) of any
|
||||
;; scripts that have no USBs defined for it.
|
||||
(dolist (fnt fntlist)
|
||||
(setq fspec (ignore-errors (font-spec :name fnt)))
|
||||
(if fspec
|
||||
(setq ffont (find-font fspec frame)))
|
||||
(when ffont
|
||||
(setq font-obj
|
||||
(open-font ffont size frame))
|
||||
;; Ignore fonts for which open-font returns nil:
|
||||
;; they are buggy fonts that we cannot use anyway.
|
||||
(setq glyphs
|
||||
(if font-obj
|
||||
(font-get-glyphs font-obj
|
||||
0 nchars script-chars)
|
||||
'[nil]))
|
||||
;; Does this font support ALL of the script's
|
||||
;; representative characters?
|
||||
(setq idx 0)
|
||||
(while (and (< idx nchars) (not (null (aref glyphs idx))))
|
||||
(setq idx (1+ idx)))
|
||||
(if (= idx nchars)
|
||||
;; It does; add this font to the script's entry in alist.
|
||||
(let ((font-family (font-get font-obj :family)))
|
||||
;; Unifont is an ugly font, and it is already
|
||||
;; present in the default fontset.
|
||||
(unless (string= (downcase (symbol-name font-family))
|
||||
"unifont")
|
||||
(push font-family entry))))))
|
||||
(if (> (length entry) 1)
|
||||
(push (nreverse entry) val)))))
|
||||
(mapc (lambda (script-desc)
|
||||
(let* ((script (car script-desc))
|
||||
(script-chars (vconcat (cdr script-desc)))
|
||||
(nchars (length script-chars))
|
||||
(fntlist all-fonts)
|
||||
(entry (list script))
|
||||
fspec ffont font-obj glyphs idx)
|
||||
;; For each font in FNTLIST, determine whether it
|
||||
;; supports the representative character(s) of any
|
||||
;; scripts that have no USBs defined for it.
|
||||
(dolist (fnt fntlist)
|
||||
(setq fspec (ignore-errors (font-spec :name fnt)))
|
||||
(if fspec
|
||||
(setq ffont (find-font fspec frame)))
|
||||
(when ffont
|
||||
(setq font-obj
|
||||
(open-font ffont size frame))
|
||||
;; Ignore fonts for which open-font returns nil:
|
||||
;; they are buggy fonts that we cannot use anyway.
|
||||
(setq glyphs
|
||||
(if font-obj
|
||||
(font-get-glyphs font-obj
|
||||
0 nchars script-chars)
|
||||
'[nil]))
|
||||
;; Does this font support ALL of the script's
|
||||
;; representative characters?
|
||||
(setq idx 0)
|
||||
(while (and (< idx nchars) (not (null (aref glyphs idx))))
|
||||
(setq idx (1+ idx)))
|
||||
(if (= idx nchars)
|
||||
;; It does; add this font to the script's entry in alist.
|
||||
(let ((font-family (font-get font-obj :family)))
|
||||
;; Unifont is an ugly font, and it is already
|
||||
;; present in the default fontset.
|
||||
(unless (string= (downcase (symbol-name font-family))
|
||||
"unifont")
|
||||
(push font-family entry))))))
|
||||
(if (> (length entry) 1)
|
||||
(push (nreverse entry) val))))
|
||||
(w32--filter-USB-scripts))
|
||||
;; We've opened a lot of fonts, so clear the font caches to free
|
||||
;; some memory.
|
||||
|
||||
@ -3270,34 +3270,33 @@ Currently this method is for LaTeX only."
|
||||
(let* ((span 1) ;; spanning length
|
||||
(first-p t) ;; first in a row
|
||||
(insert-column ;; a function that processes one column/multicolumn
|
||||
(function
|
||||
(lambda (from to)
|
||||
(let ((line (table--buffer-substring-and-trim
|
||||
(table--goto-coordinate (cons from y))
|
||||
(table--goto-coordinate (cons to y)))))
|
||||
;; escape special characters
|
||||
(with-temp-buffer
|
||||
(insert line)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
|
||||
(if (match-beginning 1)
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 1))
|
||||
(insert "\\"))
|
||||
(if (match-beginning 2)
|
||||
(replace-match "$\\backslash$" t t)
|
||||
(replace-match (concat "$" (match-string 3) "$")) t t)))
|
||||
(setq line (buffer-substring (point-min) (point-max))))
|
||||
;; insert a column separator and column/multicolumn contents
|
||||
(with-current-buffer dest-buffer
|
||||
(unless first-p
|
||||
(insert (if (eq (char-before) ?\s) "" " ") "& "))
|
||||
(if (> span 1)
|
||||
(insert (format "\\multicolumn{%d}{%sl|}{%s}" span (if first-p "|" "") line))
|
||||
(insert line)))
|
||||
(setq first-p nil)
|
||||
(setq span 1)
|
||||
(setq start (nth i col-list)))))))
|
||||
(lambda (from to)
|
||||
(let ((line (table--buffer-substring-and-trim
|
||||
(table--goto-coordinate (cons from y))
|
||||
(table--goto-coordinate (cons to y)))))
|
||||
;; escape special characters
|
||||
(with-temp-buffer
|
||||
(insert line)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
|
||||
(if (match-beginning 1)
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 1))
|
||||
(insert "\\"))
|
||||
(if (match-beginning 2)
|
||||
(replace-match "$\\backslash$" t t)
|
||||
(replace-match (concat "$" (match-string 3) "$")) t t)))
|
||||
(setq line (buffer-substring (point-min) (point-max))))
|
||||
;; insert a column separator and column/multicolumn contents
|
||||
(with-current-buffer dest-buffer
|
||||
(unless first-p
|
||||
(insert (if (eq (char-before) ?\s) "" " ") "& "))
|
||||
(if (> span 1)
|
||||
(insert (format "\\multicolumn{%d}{%sl|}{%s}" span (if first-p "|" "") line))
|
||||
(insert line)))
|
||||
(setq first-p nil)
|
||||
(setq span 1)
|
||||
(setq start (nth i col-list))))))
|
||||
(setq start x0)
|
||||
(setq i 1)
|
||||
(while (setq c (nth i border-char-list))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user