-;;; 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)
(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
;; 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