"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 ()
(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)))
(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 "\\`[^.]")
)))))
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)
;; 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))))
(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))))))
\f
;;; Mouse Support (`ffap-at-mouse'):
(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? ")))
(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)
(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))
(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
(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)
(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))))
(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)))
;; 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))
(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)))))))
((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))))
'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))
(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"))
(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)))))
"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 ()
"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 ()
(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))))))
(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
(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
(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))
(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))
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)
(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)))))
\f
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))))
;; (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
(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))
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,
;; 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)))
;;
;; ----------------------------------------
;;
(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.
(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))
projects / emacs.git / commitdiff