(aset vec (- range start) val-code))
(setq tail (cdr tail)))
(setq str "\002" val-code -1 count 0)
- (mapc #'(lambda (x)
- (if (= val-code x)
- (setq count (1+ count))
- (if (> count 2)
- (setq str (concat str (string val-code
- (+ count 128))))
- (if (= count 2)
- (setq str (concat str (string val-code val-code)))
- (if (= count 1)
- (setq str (concat str (string val-code))))))
- (setq val-code x count 1)))
+ (mapc (lambda (x)
+ (if (= val-code x)
+ (setq count (1+ count))
+ (if (> count 2)
+ (setq str (concat str (string val-code
+ (+ count 128))))
+ (if (= count 2)
+ (setq str (concat str (string val-code val-code)))
+ (if (= count 1)
+ (setq str (concat str (string val-code))))))
+ (setq val-code x count 1)))
vec)
(if (= count 128)
(if val
(defun unidata-gen-table-symbol (prop index default-value val-list)
(let ((table (unidata-gen-table prop index
- #'(lambda (x) (and (> (length x) 0)
- (intern x)))
+ (lambda (x) (and (> (length x) 0)
+ (intern x)))
default-value val-list)))
(set-char-table-extra-slot table 1 0)
(set-char-table-extra-slot table 2 1)
(defun unidata-gen-table-integer (prop index default-value val-list)
(let ((table (unidata-gen-table prop index
- #'(lambda (x) (and (> (length x) 0)
- (string-to-number x)))
+ (lambda (x) (and (> (length x) 0)
+ (string-to-number x)))
default-value val-list)))
(set-char-table-extra-slot table 1 0)
(set-char-table-extra-slot table 2 1)
(defun unidata-gen-table-numeric (prop index default-value val-list)
(let ((table (unidata-gen-table prop index
- #'(lambda (x)
- (if (string-match "/" x)
- (/ (float (string-to-number x))
- (string-to-number
- (substring x (match-end 0))))
- (if (> (length x) 0)
- (string-to-number x))))
+ (lambda (x)
+ (if (string-match "/" x)
+ (/ (float (string-to-number x))
+ (string-to-number
+ (substring x (match-end 0))))
+ (if (> (length x) 0)
+ (string-to-number x))))
default-value val-list)))
(set-char-table-extra-slot table 1 0)
(set-char-table-extra-slot table 2 2)
(cl-incf (alist-get elt (cdr word-list) 0)))))
(set-char-table-range table (cons start limit) vec))))))
(setq word-list (sort (cdr word-list)
- #'(lambda (x y) (> (cdr x) (cdr y)))))
+ (lambda (x y) (> (cdr x) (cdr y)))))
(setq tail word-list idx 0)
(while tail
(setcdr (car tail) (unidata-encode-word idx))
(defun unidata-describe-decomposition (val)
(mapconcat
- #'(lambda (x)
- (if (symbolp x) (symbol-name x)
- (concat (string ?')
- (compose-string (string x) 0 1 (string ?\t x ?\t))
- (string ?'))))
+ (lambda (x)
+ (if (symbolp x) (symbol-name x)
+ (concat (string ?')
+ (compose-string (string x) 0 1 (string ?\t x ?\t))
+ (string ?'))))
val " "))
(defun unidata-describe-bidi-bracket-type (val)
current-prefix-arg))
(apropos-command pattern nil
(if (or do-all apropos-do-all)
- #'(lambda (symbol)
- (and (boundp symbol)
- (get symbol 'variable-documentation)))
+ (lambda (symbol)
+ (and (boundp symbol)
+ (get symbol 'variable-documentation)))
#'custom-variable-p)))
;;;###autoload
(lambda ()
(setq timer (run-with-idle-timer
bookmark-search-delay 'repeat
- #'(lambda (buf)
- (with-current-buffer buf
- (bookmark-bmenu-filter-alist-by-regexp
- (minibuffer-contents))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (bookmark-bmenu-filter-alist-by-regexp
+ (minibuffer-contents))))
(current-buffer))))
(read-string "Pattern: ")
(when timer (cancel-timer timer) (setq timer nil)))
(let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic]
[nil 0 compose-gstring-for-graphic])))
(map-char-table
- #'(lambda (key val)
- (if (memq val '(Mn Mc Me))
- (set-char-table-range composition-function-table key elt)))
+ (lambda (key val)
+ (if (memq val '(Mn Mc Me))
+ (set-char-table-range composition-function-table key elt)))
unicode-category-table))
;; for dotted-circle
(aset composition-function-table #x25CC
(provide 'composite)
-\f
-
;;; composite.el ends here
;; called when `scan-sexps' ran perfectly, when it found
;; a parenthesis pointing in the direction of travel.
;; Also when travel started inside a comment and exited it.
- #'(lambda ()
- (setq outermost (list t))
- (unless innermost
- (setq innermost (list t)))))
+ (lambda ()
+ (setq outermost (list t))
+ (unless innermost
+ (setq innermost (list t)))))
(ended-prematurely-fn
;; called when `scan-sexps' crashed against a parenthesis
;; pointing opposite the direction of travel. After
;; traversing that character, the idea is to travel one sexp
;; in the opposite direction looking for a matching
;; delimiter.
- #'(lambda ()
- (let* ((pos (point))
- (matched
- (save-excursion
- (cond ((< direction 0)
- (condition-case nil
- (eq (char-after pos)
- (electric-pair--with-uncached-syntax
- (table)
- (matching-paren
- (char-before
- (scan-sexps (point) 1)))))
- (scan-error nil)))
- (t
- ;; In this case, no need to use
- ;; `scan-sexps', we can use some
- ;; `electric-pair--syntax-ppss' in this
- ;; case (which uses the quicker
- ;; `syntax-ppss' in some cases)
- (let* ((ppss (electric-pair--syntax-ppss
- (1- (point))))
- (start (car (last (nth 9 ppss))))
- (opener (char-after start)))
- (and start
- (eq (char-before pos)
- (or (with-syntax-table table
- (matching-paren opener))
- opener))))))))
- (actual-pair (if (> direction 0)
- (char-before (point))
- (char-after (point)))))
- (unless innermost
- (setq innermost (cons matched actual-pair)))
- (unless matched
- (setq outermost (cons matched actual-pair)))))))
+ (lambda ()
+ (let* ((pos (point))
+ (matched
+ (save-excursion
+ (cond ((< direction 0)
+ (condition-case nil
+ (eq (char-after pos)
+ (electric-pair--with-uncached-syntax
+ (table)
+ (matching-paren
+ (char-before
+ (scan-sexps (point) 1)))))
+ (scan-error nil)))
+ (t
+ ;; In this case, no need to use
+ ;; `scan-sexps', we can use some
+ ;; `electric-pair--syntax-ppss' in this
+ ;; case (which uses the quicker
+ ;; `syntax-ppss' in some cases)
+ (let* ((ppss (electric-pair--syntax-ppss
+ (1- (point))))
+ (start (car (last (nth 9 ppss))))
+ (opener (char-after start)))
+ (and start
+ (eq (char-before pos)
+ (or (with-syntax-table table
+ (matching-paren opener))
+ opener))))))))
+ (actual-pair (if (> direction 0)
+ (char-before (point))
+ (char-after (point)))))
+ (unless innermost
+ (setq innermost (cons matched actual-pair)))
+ (unless matched
+ (setq outermost (cons matched actual-pair)))))))
(save-excursion
(while (not outermost)
(condition-case err
quote, left double quote, and right double quote, respectively."
:version "26.1"
:type '(list character character character character)
- :safe #'(lambda (x)
- (pcase x
- (`(,(pred characterp) ,(pred characterp)
- ,(pred characterp) ,(pred characterp))
- t)))
+ :safe (lambda (x)
+ (pcase x
+ (`(,(pred characterp) ,(pred characterp)
+ ,(pred characterp) ,(pred characterp))
+ t)))
:group 'electricity)
(defcustom electric-quote-paragraph t
(defcustom cua-rectangle-mark-key [(control return)]
"Global key used to toggle the cua rectangle mark."
- :set #'(lambda (symbol value)
- (set symbol value)
- (when (and (boundp 'cua--keymaps-initialized)
- cua--keymaps-initialized)
- (define-key cua-global-keymap value
- #'cua-set-rectangle-mark)
- (when (boundp 'cua--rectangle-keymap)
- (define-key cua--rectangle-keymap value
- #'cua-clear-rectangle-mark)
- (define-key cua--region-keymap value
- #'cua-toggle-rectangle-mark))))
+ :set (lambda (symbol value)
+ (set symbol value)
+ (when (and (boundp 'cua--keymaps-initialized)
+ cua--keymaps-initialized)
+ (define-key cua-global-keymap value
+ #'cua-set-rectangle-mark)
+ (when (boundp 'cua--rectangle-keymap)
+ (define-key cua--rectangle-keymap value
+ #'cua-clear-rectangle-mark)
+ (define-key cua--region-keymap value
+ #'cua-toggle-rectangle-mark))))
:type 'key-sequence)
(defcustom cua-rectangle-modifier-key 'meta
May either be a string or a list of strings.")
(put 'epa-file-encrypt-to 'safe-local-variable
- #'(lambda (val)
- (or (stringp val)
- (and (listp val)
- (catch 'safe
- (mapc (lambda (elt)
- (unless (stringp elt)
- (throw 'safe nil)))
- val)
- t)))))
+ (lambda (val)
+ (or (stringp val)
+ (and (listp val)
+ (catch 'safe
+ (mapc (lambda (elt)
+ (unless (stringp elt)
+ (throw 'safe nil)))
+ val)
+ t)))))
(put 'epa-file-encrypt-to 'permanent-local t)
:tag "Font selection order"
:type '(list symbol symbol symbol symbol)
:group 'font-selection
- :set #'(lambda (symbol value)
- (set-default symbol value)
- (internal-set-font-selection-order value)))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (internal-set-font-selection-order value)))
;; In the absence of Fontconfig support, Monospace and Sans Serif are
:tag "Alternative font families to try"
:type '(repeat (repeat string))
:group 'font-selection
- :set #'(lambda (symbol value)
- (set-default symbol value)
- (internal-set-alternative-font-family-alist value)))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (internal-set-alternative-font-family-alist value)))
;; This is defined originally in xfaces.c.
:type '(repeat (repeat string))
:version "21.1"
:group 'font-selection
- :set #'(lambda (symbol value)
- (set-default symbol value)
- (internal-set-alternative-font-registry-alist value)))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (internal-set-alternative-font-registry-alist value)))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(:foundry
(list nil))
(:width
- (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
+ (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-width-table))
(:weight
- (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
+ (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-weight-table))
(:slant
- (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
+ (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-slant-table))
((or :inverse-video :extend)
- (mapcar #'(lambda (x) (cons (symbol-name x) x))
+ (mapcar (lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute)))
((or :underline :overline :strike-through :box)
(if (window-system frame)
- (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
+ (nconc (mapcar (lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))
- (mapcar #'(lambda (c) (cons c c))
+ (mapcar (lambda (c) (cons c c))
(defined-colors frame)))
- (mapcar #'(lambda (x) (cons (symbol-name x) x))
+ (mapcar (lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))))
((or :foreground :background)
- (mapcar #'(lambda (c) (cons c c))
+ (mapcar (lambda (c) (cons c c))
(defined-colors frame)))
(:height
'integerp)
x-bitmap-file-path)))))
(:inherit
(cons '("none" . nil)
- (mapcar #'(lambda (c) (cons (symbol-name c) c))
+ (mapcar (lambda (c) (cons (symbol-name c) c))
(face-list))))
(_
(error "Internal error")))))
(let* (term-init-func)
;; First, load the terminal initialization file, if it is
;; available and it hasn't been loaded already.
- (tty-find-type #'(lambda (type)
- (let ((file (locate-library (concat term-file-prefix type))))
- (and file
- (or (assoc file load-history)
- (load (replace-regexp-in-string
- "\\.el\\(\\.gz\\)?\\'" ""
- file)
- t t)))))
- type)
+ (tty-find-type (lambda (type)
+ (let ((file (locate-library (concat term-file-prefix type))))
+ (and file
+ (or (assoc file load-history)
+ (load (replace-regexp-in-string
+ "\\.el\\(\\.gz\\)?\\'" ""
+ file)
+ t t)))))
+ type)
;; Next, try to find a matching initialization function, and call it.
- (tty-find-type #'(lambda (type)
- (fboundp (setq term-init-func
- (intern (concat "terminal-init-" type)))))
+ (tty-find-type (lambda (type)
+ (fboundp (setq term-init-func
+ (intern (concat "terminal-init-" type)))))
type)
(when (fboundp term-init-func)
(funcall term-init-func))
(abbreviate-file-name file-name)))
((with-temp-buffer-window
"*Directory*" nil
- #'(lambda (window _value)
- (with-selected-window window
- (unwind-protect
- (yes-or-no-p (format "Recover auto save file %s? " file-name))
- (when (window-live-p window)
- (quit-restore-window window 'kill)))))
+ (lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (yes-or-no-p (format "Recover auto save file %s? " file-name))
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
(with-current-buffer standard-output
(let ((switches dired-listing-switches))
(if (file-symlink-p file)
(let ((this-dir-contents
;; Filter out "." and ".."
(delq nil
- (mapcar #'(lambda (name)
- (unless (string-match "\\`\\.\\.?\\'"
- (file-name-nondirectory name))
- name))
+ (mapcar (lambda (name)
+ (unless (string-match "\\`\\.\\.?\\'"
+ (file-name-nondirectory name))
+ name))
(directory-files (or dir ".") full
(wildcard-to-regexp nondir))))))
(setq contents
(nconc
(if (and dir (not full))
- (mapcar #'(lambda (name) (concat dir name))
+ (mapcar (lambda (name) (concat dir name))
this-dir-contents)
this-dir-contents)
contents)))))
If DEVICE is omitted or nil, it defaults to the selected
frame's terminal device."
(let* ((terminal (get-device-terminal device))
- (func #'(lambda (frame)
- (eq (frame-terminal frame) terminal))))
+ (func (lambda (frame)
+ (eq (frame-terminal frame) terminal))))
(filtered-frame-list func)))
(defun framep-on-display (&optional terminal)
`frame-set-background-mode' to update existing frames;
e.g. (mapc \\='frame-set-background-mode (frame-list))."
:group 'faces
- :set #'(lambda (var value)
- (set-default var value)
- (mapc #'frame-set-background-mode (frame-list)))
+ :set (lambda (var value)
+ (set-default var value)
+ (mapc #'frame-set-background-mode (frame-list)))
:initialize #'custom-initialize-changed
:type '(choice (const dark)
(const light)
properties, to enable buffer local values."
never))
:initialize 'custom-initialize-default
- :set #'(lambda (variable value)
- (set-default variable value)
- (if (eq value 'never)
- (help-at-pt-cancel-timer)
- (help-at-pt-set-timer)))
+ :set (lambda (variable value)
+ (set-default variable value)
+ (if (eq value 'never)
+ (help-at-pt-cancel-timer)
+ (help-at-pt-set-timer)))
:set-after '(help-at-pt-timer-delay)
:require 'help-at-pt)
(:fontset . "Fontset")
(:extend . "Extend")
(:inherit . "Inherit")))
- (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
+ (max-width (apply #'max (mapcar (lambda (x) (length (cdr x)))
attrs))))
(dolist (a attrs)
(let ((attr (face-attribute face (car a) frame)))
Setting this variable directly does not take effect;
use either \\[customize] or the function `ido-mode'."
- :set #'(lambda (_symbol value)
- (ido-mode (or value 0)))
+ :set (lambda (_symbol value)
+ (ido-mode (or value 0)))
:initialize #'custom-initialize-default
:require 'ido
:link '(emacs-commentary-link "ido.el")
(function-item :tag "Use `NET VIEW'"
:value ido-unc-hosts-net-view)
(function :tag "Your own function"))
- :set #'(lambda (symbol value)
- (set symbol value)
- (setq ido-unc-hosts-cache t)))
+ :set (lambda (symbol value)
+ (set symbol value)
+ (setq ido-unc-hosts-cache t)))
(defcustom ido-downcase-unc-hosts t
"Non-nil if UNC host names should be downcased."
the last search and the face from `hi-lock-read-face-name'."
(interactive)
(isearch--highlight-regexp-or-lines
- #'(lambda (regexp face lighter)
- (highlight-regexp regexp face nil lighter))))
+ (lambda (regexp face lighter)
+ (highlight-regexp regexp face nil lighter))))
(defun isearch-highlight-lines-matching-regexp ()
"Exit Isearch mode and call `highlight-lines-matching-regexp'.
regexp from the last search and the face from `hi-lock-read-face-name'."
(interactive)
(isearch--highlight-regexp-or-lines
- #'(lambda (regexp face _lighter)
- (highlight-lines-matching-regexp regexp face))))
+ (lambda (regexp face _lighter)
+ (highlight-lines-matching-regexp regexp face))))
\f
(defun isearch-delete-char ()
(kannada . ,kannada-composable-pattern)
(malayalam . ,malayalam-composable-pattern))))
(map-char-table
- #'(lambda (key val)
- (let ((slot (assq val script-regexp-alist)))
- (if slot
- (set-char-table-range
- composition-function-table key
- (list (vector (cdr slot) 0 #'font-shape-gstring))))))
+ (lambda (key val)
+ (let ((slot (assq val script-regexp-alist)))
+ (if slot
+ (set-char-table-range
+ composition-function-table key
+ (list (vector (cdr slot) 0 #'font-shape-gstring))))))
char-script-table))
(provide 'indian)
(let* ((chars (car l))
(len (length chars))
;; Replace `c', `t', `v' to consonant, tone, and vowel.
- (regexp (mapconcat #'(lambda (c)
- (cond ((= c ?c) consonant)
- ((= c ?t) tone)
- ((= c ?v) vowel-upper-lower)
- (t (string c))))
+ (regexp (mapconcat (lambda (c)
+ (cond ((= c ?c) consonant)
+ ((= c ?t) tone)
+ ((= c ?v) vowel-upper-lower)
+ (t (string c))))
(cdr l) ""))
;; Element of composition-function-table.
(elt (list (vector regexp 1 #'lao-composition-function)
(list
(apply #'vector
(mapcar
- #'(lambda (entry)
- (cl-assert (char-or-string-p entry) t)
- (format "%s%s" to-prepend
- (if (integerp entry) (string entry) entry)))
+ (lambda (entry)
+ (cl-assert (char-or-string-p entry) t)
+ (format "%s%s" to-prepend
+ (if (integerp entry) (string entry) entry)))
quail-keymap))))
(defun ipa-x-sampa-underscore-implosive (input-string length)
(append folders-changed (mh-index-execute-commands))))
;; Then refile messages
- (mapc #'(lambda (folder-msg-list)
- (let* ((dest-folder (symbol-name (car folder-msg-list)))
- (last (car (mh-translate-range dest-folder "last")))
- (msgs (cdr folder-msg-list)))
- (push dest-folder folders-changed)
- (setq redraw-needed-flag t)
- (apply #'mh-exec-cmd
- "refile" "-src" folder dest-folder
- (mh-coalesce-msg-list msgs))
- (mh-delete-scan-msgs msgs)
- ;; Preserve sequences in destination folder...
- (when mh-refile-preserves-sequences-flag
- (clrhash dest-map)
- (cl-loop
- for i from (1+ (or last 0))
- for msg in (sort (copy-sequence msgs) #'<)
- do (cl-loop for seq-name in (gethash msg seq-map)
- do (push i (gethash seq-name dest-map))))
- (maphash
- #'(lambda (seq msgs)
- ;; Can't be run in the background, since the
- ;; current folder is changed by mark this could
- ;; lead to a race condition with the next refile.
- (apply #'mh-exec-cmd "mark"
- "-sequence" (symbol-name seq) dest-folder
- "-add" (mapcar #'(lambda (x) (format "%s" x))
- (mh-coalesce-msg-list msgs))))
- dest-map))))
+ (mapc (lambda (folder-msg-list)
+ (let* ((dest-folder (symbol-name (car folder-msg-list)))
+ (last (car (mh-translate-range dest-folder "last")))
+ (msgs (cdr folder-msg-list)))
+ (push dest-folder folders-changed)
+ (setq redraw-needed-flag t)
+ (apply #'mh-exec-cmd
+ "refile" "-src" folder dest-folder
+ (mh-coalesce-msg-list msgs))
+ (mh-delete-scan-msgs msgs)
+ ;; Preserve sequences in destination folder...
+ (when mh-refile-preserves-sequences-flag
+ (clrhash dest-map)
+ (cl-loop
+ for i from (1+ (or last 0))
+ for msg in (sort (copy-sequence msgs) #'<)
+ do (cl-loop for seq-name in (gethash msg seq-map)
+ do (push i (gethash seq-name dest-map))))
+ (maphash
+ #'(lambda (seq msgs)
+ ;; Can't be run in the background, since the
+ ;; current folder is changed by mark this could
+ ;; lead to a race condition with the next refile.
+ (apply #'mh-exec-cmd "mark"
+ "-sequence" (symbol-name seq) dest-folder
+ "-add" (mapcar #'(lambda (x) (format "%s" x))
+ (mh-coalesce-msg-list msgs))))
+ dest-map))))
mh-refile-list)
(setq mh-refile-list ())
do (cl-loop for seq-name in (gethash msg seq-map)
do (push i (gethash seq-name allow-map))))
(maphash
- #'(lambda (seq msgs)
- ;; Can't be run in background, since the current
- ;; folder is changed by mark this could lead to a
- ;; race condition with the next refile/allowlist.
- (apply #'mh-exec-cmd "mark"
- "-sequence" (symbol-name seq) mh-inbox
- "-add" (mapcar #'(lambda(x) (format "%s" x))
- (mh-coalesce-msg-list msgs))))
+ (lambda (seq msgs)
+ ;; Can't be run in background, since the current
+ ;; folder is changed by mark this could lead to a
+ ;; race condition with the next refile/allowlist.
+ (apply #'mh-exec-cmd "mark"
+ "-sequence" (symbol-name seq) mh-inbox
+ "-add" (mapcar #'(lambda(x) (format "%s" x))
+ (mh-coalesce-msg-list msgs))))
allow-map))
(setq mh-allowlist nil)))
(when (consp part-index) (setq part-index (car part-index)))
(mh-folder-mime-action
part-index
- #'(lambda ()
- (let* ((part (get-text-property (point) 'mh-data))
- (type (mm-handle-media-type part))
- (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x))))
- (mailcap-mime-info type 'all)))
- (def (caar methods))
- (prompt (format-prompt "Viewer" def))
- (method (completing-read prompt methods nil nil nil nil def))
- (folder mh-show-folder-buffer)
- (buffer-read-only nil))
- (when (string-match "^[^% \t]+$" method)
- (setq method (concat method " %s")))
- (mh-flet
- ((mm-handle-set-external-undisplayer
- (handle function)
- (mh-handle-set-external-undisplayer folder handle function)))
- (unwind-protect (mm-display-external part method)
- (set-buffer-modified-p nil)))))
+ (lambda ()
+ (let* ((part (get-text-property (point) 'mh-data))
+ (type (mm-handle-media-type part))
+ (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x))))
+ (mailcap-mime-info type 'all)))
+ (def (caar methods))
+ (prompt (format-prompt "Viewer" def))
+ (method (completing-read prompt methods nil nil nil nil def))
+ (folder mh-show-folder-buffer)
+ (buffer-read-only nil))
+ (when (string-match "^[^% \t]+$" method)
+ (setq method (concat method " %s")))
+ (mh-flet
+ ((mm-handle-set-external-undisplayer
+ (handle function)
+ (mh-handle-set-external-undisplayer folder handle function)))
+ (unwind-protect (mm-display-external part method)
+ (set-buffer-modified-p nil)))))
nil))
;;;###mh-autoload
(ps-output-prologue (format "ETOP%d %d %d put\n" i (car font) index))
(setq index (1+ index))))
(ps-output-prologue (format "/VTOP%d [%s] def\n" i
- (mapconcat #'(lambda (x)
- (format "F%02X" (cdr x)))
+ (mapconcat (lambda (x)
+ (format "F%02X" (cdr x)))
font-list " ")))))
;; Redefine fonts f0, f1, f2, f3, h0, h1, H0.
(defun ps-color-scale (color)
;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
- (mapcar #'(lambda (value) (/ value ps-print-color-scale))
+ (mapcar (lambda (value) (/ value ps-print-color-scale))
(color-values color)))
(defun ps-background-pages (page-list func)
(if page-list
(mapcar
- #'(lambda (pages)
- (let ((start (if (consp pages) (car pages) pages))
- (end (if (consp pages) (cdr pages) pages)))
- (and (integerp start) (integerp end) (<= start end)
- (add-to-list 'ps-background-pages (vector start end func)))))
+ (lambda (pages)
+ (let ((start (if (consp pages) (car pages) pages))
+ (end (if (consp pages) (cdr pages) pages)))
+ (and (integerp start) (integerp end) (<= start end)
+ (add-to-list 'ps-background-pages (vector start end func)))))
page-list)
(setq ps-background-all-pages (cons func ps-background-all-pages))))
(defun ps-background-text ()
(mapcar
- #'(lambda (text)
- (setq ps-background-text-count (1+ ps-background-text-count))
- (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
- (ps-output-string (nth 0 text)) ; text
- (ps-output
- "\n"
- (ps-float-format (nth 4 text) 200.0) ; font size
- (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name
- (ps-float-format (nth 6 text)
- "PrintHeight PrintPageWidth atan") ; rotation
- (ps-float-format (nth 5 text) 0.85) ; gray
- (ps-float-format (nth 1 text) "0") ; x position
- (ps-float-format (nth 2 text) "0") ; y position
- "\nShowBackText}def\n")
- (ps-background-pages (nthcdr 7 text) ; page list
- (format "ShowBackText-%d\n"
- ps-background-text-count)))
+ (lambda (text)
+ (setq ps-background-text-count (1+ ps-background-text-count))
+ (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
+ (ps-output-string (nth 0 text)) ; text
+ (ps-output
+ "\n"
+ (ps-float-format (nth 4 text) 200.0) ; font size
+ (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name
+ (ps-float-format (nth 6 text)
+ "PrintHeight PrintPageWidth atan") ; rotation
+ (ps-float-format (nth 5 text) 0.85) ; gray
+ (ps-float-format (nth 1 text) "0") ; x position
+ (ps-float-format (nth 2 text) "0") ; y position
+ "\nShowBackText}def\n")
+ (ps-background-pages (nthcdr 7 text) ; page list
+ (format "ShowBackText-%d\n"
+ ps-background-text-count)))
ps-print-background-text))
(defun ps-background-image ()
(mapcar
- #'(lambda (image)
- (let ((image-file (expand-file-name (nth 0 image))))
- (when (file-readable-p image-file)
- (setq ps-background-image-count (1+ ps-background-image-count))
- (ps-output
- (format "/ShowBackImage-%d{\n--back-- "
- ps-background-image-count)
- (ps-float-format (nth 5 image) 0.0) ; rotation
- (ps-float-format (nth 3 image) 1.0) ; x scale
- (ps-float-format (nth 4 image) 1.0) ; y scale
- (ps-float-format (nth 1 image) ; x position
- "PrintPageWidth 2 div")
- (ps-float-format (nth 2 image) ; y position
- "PrintHeight 2 div BottomMargin add")
- "\nBeginBackImage\n")
- (ps-insert-file image-file)
- ;; coordinate adjustment to center image
- ;; around x and y position
- (let ((box (ps-get-boundingbox)))
- (with-current-buffer ps-spool-buffer
- (save-excursion
- (if (re-search-backward "^--back--" nil t)
- (replace-match
- (format "%s %s"
- (ps-float-format
- (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
- (aref box 0))))
- (ps-float-format
- (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
- (aref box 1)))))
- t)))))
- (ps-output "\nEndBackImage}def\n")
- (ps-background-pages (nthcdr 6 image) ; page list
- (format "ShowBackImage-%d\n"
- ps-background-image-count)))))
+ (lambda (image)
+ (let ((image-file (expand-file-name (nth 0 image))))
+ (when (file-readable-p image-file)
+ (setq ps-background-image-count (1+ ps-background-image-count))
+ (ps-output
+ (format "/ShowBackImage-%d{\n--back-- "
+ ps-background-image-count)
+ (ps-float-format (nth 5 image) 0.0) ; rotation
+ (ps-float-format (nth 3 image) 1.0) ; x scale
+ (ps-float-format (nth 4 image) 1.0) ; y scale
+ (ps-float-format (nth 1 image) ; x position
+ "PrintPageWidth 2 div")
+ (ps-float-format (nth 2 image) ; y position
+ "PrintHeight 2 div BottomMargin add")
+ "\nBeginBackImage\n")
+ (ps-insert-file image-file)
+ ;; coordinate adjustment to center image
+ ;; around x and y position
+ (let ((box (ps-get-boundingbox)))
+ (with-current-buffer ps-spool-buffer
+ (save-excursion
+ (if (re-search-backward "^--back--" nil t)
+ (replace-match
+ (format "%s %s"
+ (ps-float-format
+ (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
+ (aref box 0))))
+ (ps-float-format
+ (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
+ (aref box 1)))))
+ t)))))
+ (ps-output "\nEndBackImage}def\n")
+ (ps-background-pages (nthcdr 6 image) ; page list
+ (format "ShowBackImage-%d\n"
+ ps-background-image-count)))))
ps-print-background-image))
(defun ps-background (page-number)
(let (has-local-background)
- (mapc #'(lambda (range)
- (and (<= (aref range 0) page-number)
- (<= page-number (aref range 1))
- (if has-local-background
- (ps-output (aref range 2))
- (setq has-local-background t)
- (ps-output "/printLocalBackground{\n"
- (aref range 2)))))
+ (mapc (lambda (range)
+ (and (<= (aref range 0) page-number)
+ (<= page-number (aref range 1))
+ (if has-local-background
+ (ps-output (aref range 2))
+ (setq has-local-background t)
+ (ps-output "/printLocalBackground{\n"
+ (aref range 2)))))
ps-background-pages)
(and has-local-background (ps-output "}def\n"))))
(> (car page) 0)
(<= (car page) (cdr page))
(setq new (cons page new))))))
- (setq ps-selected-pages (sort new #'(lambda (one other)
- (< (car one) (car other))))
+ (setq ps-selected-pages (sort new (lambda (one other)
+ (< (car one) (car other))))
ps-last-selected-pages ps-selected-pages
ps-first-page nil
ps-last-page nil))
"unspecified-fg"
0.0)
ps-foreground-list (mapcar
- #'(lambda (arg)
- (ps-rgb-color arg "unspecified-fg" 0.0))
+ (lambda (arg)
+ (ps-rgb-color arg "unspecified-fg" 0.0))
(append (and (not (member ps-print-color-p
'(nil black-white)))
ps-fg-list)
(if (and (boundp 'ucs-mule-8859-to-mule-unicode)
(char-table-p ucs-mule-8859-to-mule-unicode))
(map-char-table
- #'(lambda (k v)
- (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v))
- (aset tbl k v)))
+ (lambda (k v)
+ (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v))
+ (aset tbl k v)))
ucs-mule-8859-to-mule-unicode))
tbl)
"Translation table for PostScript printing.
"Sort the list of menu elements L in ascending order.
The MENU-ITEM part of each menu element is compared."
(sort (copy-sequence l)
- #'(lambda (e1 e2)
- (recentf-string-lessp
- (recentf-menu-element-item e1)
- (recentf-menu-element-item e2)))))
+ (lambda (e1 e2)
+ (recentf-string-lessp
+ (recentf-menu-element-item e1)
+ (recentf-menu-element-item e2)))))
(defsubst recentf-sort-descending (l)
"Sort the list of menu elements L in descending order.
The MENU-ITEM part of each menu element is compared."
(sort (copy-sequence l)
- #'(lambda (e1 e2)
- (recentf-string-lessp
- (recentf-menu-element-item e2)
- (recentf-menu-element-item e1)))))
+ (lambda (e1 e2)
+ (recentf-string-lessp
+ (recentf-menu-element-item e2)
+ (recentf-menu-element-item e1)))))
(defsubst recentf-sort-basenames-ascending (l)
"Sort the list of menu elements L in ascending order.
Only filenames sans directory are compared."
(sort (copy-sequence l)
- #'(lambda (e1 e2)
- (recentf-string-lessp
- (file-name-nondirectory (recentf-menu-element-value e1))
- (file-name-nondirectory (recentf-menu-element-value e2))))))
+ (lambda (e1 e2)
+ (recentf-string-lessp
+ (file-name-nondirectory (recentf-menu-element-value e1))
+ (file-name-nondirectory (recentf-menu-element-value e2))))))
(defsubst recentf-sort-basenames-descending (l)
"Sort the list of menu elements L in descending order.
Only filenames sans directory are compared."
(sort (copy-sequence l)
- #'(lambda (e1 e2)
- (recentf-string-lessp
- (file-name-nondirectory (recentf-menu-element-value e2))
- (file-name-nondirectory (recentf-menu-element-value e1))))))
+ (lambda (e1 e2)
+ (recentf-string-lessp
+ (file-name-nondirectory (recentf-menu-element-value e2))
+ (file-name-nondirectory (recentf-menu-element-value e1))))))
(defsubst recentf-sort-directories-ascending (l)
"Sort the list of menu elements L in ascending order.
Compares directories then filenames to order the list."
(sort (copy-sequence l)
- #'(lambda (e1 e2)
- (recentf-directory-compare
- (recentf-menu-element-value e1)
- (recentf-menu-element-value e2)))))
+ (lambda (e1 e2)
+ (recentf-directory-compare
+ (recentf-menu-element-value e1)
+ (recentf-menu-element-value e2)))))
(defsubst recentf-sort-directories-descending (l)
"Sort the list of menu elements L in descending order.
Compares directories then filenames to order the list."
(sort (copy-sequence l)
- #'(lambda (e1 e2)
- (recentf-directory-compare
- (recentf-menu-element-value e2)
- (recentf-menu-element-value e1)))))
+ (lambda (e1 e2)
+ (recentf-directory-compare
+ (recentf-menu-element-value e2)
+ (recentf-menu-element-value e1)))))
(defun recentf-show-basenames (l &optional no-dir)
"Filter the list of menu elements L to show filenames sans directory.
(provide 'recentf)
(run-hooks 'recentf-load-hook)
-\f
+
;;; recentf.el ends here
(defun occur-engine-add-prefix (lines &optional prefix-face)
(mapcar
- #'(lambda (line)
- (concat (if prefix-face
- (propertize " :" 'font-lock-face prefix-face)
- " :")
- line "\n"))
+ (lambda (line)
+ (concat (if prefix-face
+ (propertize " :" 'font-lock-face prefix-face)
+ " :")
+ line "\n"))
lines))
(defun occur-accumulate-lines (count &optional keep-props pt)
(setq type 'C_STRING))
(t
(let (non-latin-1 non-unicode eight-bit)
- (mapc #'(lambda (x)
- (if (>= x #x100)
- (if (< x #x110000)
- (setq non-latin-1 t)
- (if (< x #x3FFF80)
- (setq non-unicode t)
- (setq eight-bit t)))))
+ (mapc (lambda (x)
+ (if (>= x #x100)
+ (if (< x #x110000)
+ (setq non-latin-1 t)
+ (if (< x #x3FFF80)
+ (setq non-unicode t)
+ (setq eight-bit t)))))
str)
(setq type (if (or non-unicode
(and
(defcustom server-use-tcp nil
"If non-nil, use TCP sockets instead of local sockets."
- :set #'(lambda (sym val)
- (unless (featurep 'make-network-process '(:family local))
- (setq val t)
- (unless load-in-progress
- (message "Local sockets unsupported, using TCP sockets")))
- (set-default sym val))
+ :set (lambda (sym val)
+ (unless (featurep 'make-network-process '(:family local))
+ (setq val t)
+ (unless load-in-progress
+ (message "Local sockets unsupported, using TCP sockets")))
+ (set-default sym val))
:type 'boolean
:version "22.1")
(push (cons (buffer-substring-no-properties (point) end)
(+ minrow x))
keys))
- (setq keys (sort keys #'(lambda (x y) (string< (car x) (car y)))))
+ (setq keys (sort keys (lambda (x y) (string< (car x) (car y)))))
;;Extract the lines in reverse sorted order
(or reverse
(setq keys (nreverse keys)))
(narrow-to-region beg1 end1)
(goto-char beg1)
(sort-subr reverse 'forward-line 'end-of-line
- #'(lambda () (move-to-column col-start) nil)
- #'(lambda () (move-to-column col-end) nil))))))))
+ (lambda () (move-to-column col-start) nil)
+ (lambda () (move-to-column col-end) nil))))))))
;;;###autoload
(defun reverse-region (beg end)
;; For Darwin nothing except UTF-8 makes sense.
(when (eq system-type 'darwin)
(add-hook 'before-init-hook
- #'(lambda ()
- (setq locale-coding-system 'utf-8-unix)
- (setq default-process-coding-system
- '(utf-8-unix . utf-8-unix)))))
+ (lambda ()
+ (setq locale-coding-system 'utf-8-unix)
+ (setq default-process-coding-system
+ '(utf-8-unix . utf-8-unix)))))
;; Mac OS X Lion introduces PressAndHold, which is unsupported by this port.
;; See this thread for more details:
See also the option `widget-image-conversion'."
(delq nil
(mapcar
- #'(lambda (fmt)
- (and (image-type-available-p (car fmt)) fmt))
+ (lambda (fmt)
+ (and (image-type-available-p (car fmt)) fmt))
widget-image-conversion)))
;; Buffer local cache of theme data.
(or whitespace-active-style whitespace-style)))
(bogus-list
(mapcar
- #'(lambda (option)
- (when force
- (push (car option) style))
- (goto-char rstart)
- (let ((regexp
- (cond
- ((eq (car option) 'indentation)
- (whitespace-indentation-regexp))
- ((eq (car option) 'indentation::tab)
- (whitespace-indentation-regexp 'tab))
- ((eq (car option) 'indentation::space)
- (whitespace-indentation-regexp 'space))
- ((eq (car option) 'space-after-tab)
- (whitespace-space-after-tab-regexp))
- ((eq (car option) 'space-after-tab::tab)
- (whitespace-space-after-tab-regexp 'tab))
- ((eq (car option) 'space-after-tab::space)
- (whitespace-space-after-tab-regexp 'space))
- ((eq (car option) 'missing-newline-at-eof)
- "[^\n]\\'")
- (t
- (cdr option)))))
- (when (re-search-forward regexp rend t)
- (unless has-bogus
- (setq has-bogus (memq (car option) style)))
- t)))
+ (lambda (option)
+ (when force
+ (push (car option) style))
+ (goto-char rstart)
+ (let ((regexp
+ (cond
+ ((eq (car option) 'indentation)
+ (whitespace-indentation-regexp))
+ ((eq (car option) 'indentation::tab)
+ (whitespace-indentation-regexp 'tab))
+ ((eq (car option) 'indentation::space)
+ (whitespace-indentation-regexp 'space))
+ ((eq (car option) 'space-after-tab)
+ (whitespace-space-after-tab-regexp))
+ ((eq (car option) 'space-after-tab::tab)
+ (whitespace-space-after-tab-regexp 'tab))
+ ((eq (car option) 'space-after-tab::space)
+ (whitespace-space-after-tab-regexp 'space))
+ ((eq (car option) 'missing-newline-at-eof)
+ "[^\n]\\'")
+ (t
+ (cdr option)))))
+ (when (re-search-forward regexp rend t)
+ (unless has-bogus
+ (setq has-bogus (memq (car option) style)))
+ t)))
whitespace-report-list)))
(when (pcase report-if-bogus ('nil t) ('never nil) (_ has-bogus))
(whitespace-kill-buffer whitespace-report-buffer-name)
"use `with-eval-after-load' instead." "28.1")
(run-hooks 'whitespace-load-hook)
-
;;; whitespace.el ends here
projects / emacs.git / commitdiff