-;;; subr.el --- basic lisp subroutines for Emacs
+;;; subr.el --- basic lisp subroutines for Emacs -*- coding: utf-8 -*-
;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2011
;; Free Software Foundation, Inc.
;; depend on backquote.el.
(list 'function (cons 'lambda cdr)))
-;; Partial application of functions (similar to "currying").
-;; This function is here rather than in subr.el because it uses CL.
(defun apply-partially (fun &rest args)
"Return a function that is a partial application of FUN to ARGS.
ARGS is a list of the first N arguments to pass to FUN.
Bindings are always added before any inherited map.
-The order of bindings in a keymap matters when it is used as a menu."
+The order of bindings in a keymap only matters when it is used as
+a menu, so this function is not useful for non-menu keymaps."
(unless after (setq after t))
(or (keymapp keymap)
(signal 'wrong-type-argument (list 'keymapp keymap)))
(defun keymap--menu-item-with-binding (item binding)
"Build a menu-item like ITEM but with its binding changed to BINDING."
(cond
+ ((not (consp item)) binding) ;Not a menu-item.
((eq 'menu-item (car item))
(setq item (copy-sequence item))
(let ((tail (nthcdr 2 item)))
,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
,@body))
-(defmacro with-wrapper-hook (var args &rest body)
- "Run BODY wrapped with the VAR hook.
-VAR is a special hook: its functions are called with a first argument
-which is the \"original\" code (the BODY), so the hook function can wrap
-the original function, or call it any number of times (including not calling
-it at all). This is similar to an `around' advice.
-VAR is normally a symbol (a variable) in which case it is treated like
-a hook, with a buffer-local and a global part. But it can also be an
-arbitrary expression.
-ARGS is a list of variables which will be passed as additional arguments
-to each function, after the initial argument, and which the first argument
-expects to receive when called."
- (declare (indent 2) (debug t))
+(defmacro with-wrapper-hook (hook args &rest body)
+ "Run BODY, using wrapper functions from HOOK with additional ARGS.
+HOOK is an abnormal hook. Each hook function in HOOK \"wraps\"
+around the preceding ones, like a set of nested `around' advices.
+
+Each hook function should accept an argument list consisting of a
+function FUN, followed by the additional arguments in ARGS.
+
+The FUN passed to the first hook function in HOOK performs BODY,
+if it is called with arguments ARGS. The FUN passed to each
+successive hook function is defined based on the preceding hook
+functions; if called with arguments ARGS, it does what the
+`with-wrapper-hook' call would do if the preceding hook functions
+were the only ones present in HOOK.
+
+In the function definition of each hook function, FUN can be
+called any number of times (including not calling it at all).
+That function definition is then used to construct the FUN passed
+to the next hook function, if any. The last (or \"outermost\")
+FUN is then called once."
+ (declare (indent 2) (debug (form sexp body)))
;; We need those two gensyms because CL's lexical scoping is not available
;; for function arguments :-(
(let ((funs (make-symbol "funs"))
;; Once there are no more functions on the hook, run
;; the original body.
(apply (lambda ,args ,@body) ,argssym)))))
- (funcall ,runrestofhook ,var
+ (funcall ,runrestofhook ,hook
;; The global part of the hook, if any.
- ,(if (symbolp var)
- `(if (local-variable-p ',var)
- (default-value ',var)))
+ ,(if (symbolp hook)
+ `(if (local-variable-p ',hook)
+ (default-value ',hook)))
(list ,@args)))))
(defun add-to-list (list-var element &optional append compare-fn)
(make-variable-buffer-local 'delayed-mode-hooks)
(put 'delay-mode-hooks 'permanent-local t)
+(defvar change-major-mode-after-body-hook nil
+ "Normal hook run in major mode functions, before the mode hooks.")
+
(defvar after-change-major-mode-hook nil
"Normal hook run at the very end of major mode functions.")
;; Normal case, just run the hook as before plus any delayed hooks.
(setq hooks (nconc (nreverse delayed-mode-hooks) hooks))
(setq delayed-mode-hooks nil)
- (apply 'run-hooks hooks)
+ (apply 'run-hooks (cons 'change-major-mode-after-body-hook hooks))
(run-hooks 'after-change-major-mode-hook)))
(defmacro delay-mode-hooks (&rest body)
(put 'eval-after-load 'lisp-indent-function 1)
(defun eval-after-load (file form)
- "Arrange that, if FILE is ever loaded, FORM will be run at that time.
+ "Arrange that if FILE is loaded, FORM will be run immediately afterwards.
If FILE is already loaded, evaluate FORM right now.
If a matching file is loaded again, FORM will be evaluated again.
(push elt after-load-alist))
;; Make sure `form' is evalled in the current lexical/dynamic code.
(setq form `(funcall ',(eval `(lambda () ,form) lexical-binding)))
- (when (symbolp regexp-or-feature)
- ;; For features, the after-load-alist elements get run when `provide' is
- ;; called rather than at the end of the file. So add an indirection to
- ;; make sure that `form' is really run "after-load" in case the provide
- ;; call happens early.
- (setq form
- `(when load-file-name
- (let ((fun (make-symbol "eval-after-load-helper")))
- (fset fun `(lambda (file)
- (if (not (equal file ',load-file-name))
- nil
- (remove-hook 'after-load-functions ',fun)
- ,',form)))
- (add-hook 'after-load-functions fun)))))
- ;; Add FORM to the element unless it's already there.
- (unless (member form (cdr elt))
- (nconc elt (purecopy (list form))))
-
;; Is there an already loaded file whose name (or `provide' name)
;; matches FILE?
- (if (if (stringp file)
- (load-history-filename-element regexp-or-feature)
- (featurep file))
- (eval form))))
+ (prog1 (if (if (stringp file)
+ (load-history-filename-element regexp-or-feature)
+ (featurep file))
+ (eval form))
+ (when (symbolp regexp-or-feature)
+ ;; For features, the after-load-alist elements get run when `provide' is
+ ;; called rather than at the end of the file. So add an indirection to
+ ;; make sure that `form' is really run "after-load" in case the provide
+ ;; call happens early.
+ (setq form
+ `(when load-file-name
+ (let ((fun (make-symbol "eval-after-load-helper")))
+ (fset fun `(lambda (file)
+ (if (not (equal file ',load-file-name))
+ nil
+ (remove-hook 'after-load-functions ',fun)
+ ,',form)))
+ (add-hook 'after-load-functions fun)))))
+ ;; Add FORM to the element unless it's already there.
+ (unless (member form (cdr elt))
+ (nconc elt (purecopy (list form)))))))
(defvar after-load-functions nil
"Special hook run after loading a file.
(or (not process)
(not (memq (process-status process) '(run stop open listen)))
(not (process-query-on-exit-flag process))
- (yes-or-no-p "Buffer has a running process; kill it? "))))
+ (yes-or-no-p
+ (format "Buffer %S has a running process; kill it? "
+ (buffer-name (current-buffer)))))))
(add-hook 'kill-buffer-query-functions 'process-kill-buffer-query-function)
(setq prompt (propertize prompt 'face 'minibuffer-prompt)))
(setq char (let ((inhibit-quit inhibit-keyboard-quit))
(read-key prompt)))
- (and show-help (buffer-live-p helpbuf)
+ (and show-help (buffer-live-p (get-buffer helpbuf))
(kill-buffer helpbuf))
(cond
((not (numberp char)))
;; where all the keys were unbound (i.e. it somehow got triggered
;; within read-key, apparently). I had to kill it.
(let ((answer 'recenter))
- (if (and (display-popup-menus-p)
- (listp last-nonmenu-event)
- use-dialog-box)
- (setq answer
- (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip))))
+ (cond
+ (noninteractive
+ (setq prompt (concat prompt
+ (if (eq ?\s (aref prompt (1- (length prompt))))
+ "" " ")
+ "(y or n) "))
+ (let ((temp-prompt prompt))
+ (while (not (memq answer '(act skip)))
+ (let ((str (read-string temp-prompt)))
+ (cond ((member str '("y" "Y")) (setq answer 'act))
+ ((member str '("n" "N")) (setq answer 'skip))
+ (t (setq temp-prompt (concat "Please answer y or n. "
+ prompt))))))))
+ ((and (display-popup-menus-p)
+ (listp last-nonmenu-event)
+ use-dialog-box)
+ (setq answer
+ (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
+ (t
(setq prompt (concat prompt
(if (eq ?\s (aref prompt (1- (length prompt))))
"" " ")
((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
(t t)))
(ding)
- (discard-input)))
+ (discard-input))))
(let ((ret (eq answer 'act)))
(unless noninteractive
(message "%s %s" prompt (if ret "y" "n")))
generated with `prin1' and similar functions in BODY goes into
the buffer.
-At the end of BODY, this marks buffer BUFNAME unmodifed and displays
+At the end of BODY, this marks buffer BUFNAME unmodified and displays
it in a window, but does not select it. The normal way to do this is
by calling `display-buffer', then running `temp-buffer-show-hook'.
However, if `temp-buffer-show-function' is non-nil, it calls that
NUM specifies which parenthesized expression in the last regexp.
Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
Zero means the entire text matched by the whole regexp or whole string.
-STRING should be given if the last search was by `string-match' on STRING."
+STRING should be given if the last search was by `string-match' on STRING.
+If STRING is nil, the current buffer should be the same buffer
+the search/match was performed in."
(if (match-beginning num)
(if string
(substring string (match-beginning num) (match-end num))
NUM specifies which parenthesized expression in the last regexp.
Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
Zero means the entire text matched by the whole regexp or whole string.
-STRING should be given if the last search was by `string-match' on STRING."
+STRING should be given if the last search was by `string-match' on STRING.
+If STRING is nil, the current buffer should be the same buffer
+the search/match was performed in."
(if (match-beginning num)
(if string
(substring-no-properties string (match-beginning num)
;; MIN-CHANGE
;; MIN-TIME])
;;
-;; This weirdeness is for optimization reasons: we want
+;; This weirdness is for optimization reasons: we want
;; `progress-reporter-update' to be as fast as possible, so
;; `(car reporter)' is better than `(aref reporter 0)'.
;;
HCoop / bpt / emacs.git / blobdiff