diff options
author | Tom Tromey <tromey@redhat.com> | 2013-01-16 11:48:32 -0700 |
---|---|---|
committer | Tom Tromey <tromey@redhat.com> | 2013-01-16 11:48:32 -0700 |
commit | 6f4de085f065e11f4df3195d47479f28f5ef08ba (patch) | |
tree | 1211a00f1afc86c2b73624897993db02a4852943 /lisp/emacs-lisp | |
parent | e078a23febca14bc919c5806670479c395e3253e (diff) | |
parent | ffe04adc88e546c406f9b050238fb98a7243c7a0 (diff) | |
download | emacs-6f4de085f065e11f4df3195d47479f28f5ef08ba.tar.gz emacs-6f4de085f065e11f4df3195d47479f28f5ef08ba.tar.bz2 emacs-6f4de085f065e11f4df3195d47479f28f5ef08ba.zip |
merge from trunk
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r-- | lisp/emacs-lisp/advice.el | 34 | ||||
-rw-r--r-- | lisp/emacs-lisp/authors.el | 16 | ||||
-rw-r--r-- | lisp/emacs-lisp/crm.el | 59 | ||||
-rw-r--r-- | lisp/emacs-lisp/edebug.el | 8 | ||||
-rw-r--r-- | lisp/emacs-lisp/ert.el | 2 | ||||
-rw-r--r-- | lisp/emacs-lisp/nadvice.el | 40 | ||||
-rw-r--r-- | lisp/emacs-lisp/pcase.el | 29 | ||||
-rw-r--r-- | lisp/emacs-lisp/timer.el | 4 | ||||
-rw-r--r-- | lisp/emacs-lisp/trace.el | 32 |
9 files changed, 110 insertions, 114 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 7917b769ab8..3d03e894534 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -589,13 +589,11 @@ ;; Advice implements forward advice mainly via the following: 1) Separation ;; of advice definition and activation that makes it possible to accumulate ;; advice information without having the original function already defined, -;; 2) special versions of the built-in functions `fset/defalias' which check -;; for advice information whenever they define a function. If advice -;; information was found then the advice will immediately get activated when -;; the function gets defined. +;; 2) Use of the `defalias-fset-function' symbol property which lets +;; us advise the function when it gets defined. ;; Automatic advice activation means, that whenever a function gets defined -;; with either `defun', `defmacro', `fset' or by loading a byte-compiled +;; with either `defun', `defmacro', `defalias' or by loading a byte-compiled ;; file, and the function has some advice-info stored with it then that ;; advice will get activated right away. @@ -2868,10 +2866,8 @@ advised definition from scratch." (defun ad-preactivate-advice (function advice class position) "Preactivate FUNCTION and returns the constructed cache." - (let* ((function-defined-p (fboundp function)) - (old-definition - (if function-defined-p - (symbol-function function))) + (let* ((advicefunname (ad-get-advice-info-field function 'advicefunname)) + (old-advice (symbol-function advicefunname)) (old-advice-info (ad-copy-advice-info function)) (ad-advised-functions ad-advised-functions)) (unwind-protect @@ -2885,10 +2881,9 @@ advised definition from scratch." (list (ad-get-cache-definition function) (ad-get-cache-id function)))) (ad-set-advice-info function old-advice-info) - ;; Don't `fset' function to nil if it was previously unbound: - (if function-defined-p - (fset function old-definition) - (fmakunbound function))))) + (advice-remove function advicefunname) + (fset advicefunname old-advice) + (if old-advice (advice-add function :around advicefunname))))) ;; @@ Activation and definition handling: @@ -2917,13 +2912,18 @@ If COMPILE is nil then the result depends on the value of "Redefine FUNCTION with its advised definition from cache or scratch. The resulting FUNCTION will be compiled if `ad-should-compile' returns t. The current definition and its cache-id will be put into the cache." - (let ((verified-cached-definition - (if (ad-verify-cache-id function) - (ad-get-cache-definition function))) - (advicefunname (ad-get-advice-info-field function 'advicefunname))) + (let* ((verified-cached-definition + (if (ad-verify-cache-id function) + (ad-get-cache-definition function))) + (advicefunname (ad-get-advice-info-field function 'advicefunname)) + (old-ispec (interactive-form advicefunname))) (fset advicefunname (or verified-cached-definition (ad-make-advised-definition function))) + (unless (equal (interactive-form advicefunname) old-ispec) + ;; If the interactive-spec of advicefunname has changed, force nadvice to + ;; refresh its copy. + (advice-remove function advicefunname)) (advice-add function :around advicefunname) (if (ad-should-compile function compile) (ad-compile-function function)) diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index 6741094aa55..270badd53cb 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -295,6 +295,14 @@ Changes to files matching one of the regexps in this list are not listed.") "calc/INSTALL" "calc/Makefile" "vms-pp.trans" "_emacs" "batcomp.com" "notes/cpp" ; admin/ "emacsver.texi.in" + "vpath.sed" + "Cocoa/Emacs.base/Contents/Info.plist" + "Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings" + "GNUstep/Emacs.base/Resources/Info-gnustep.plist" + "GNUstep/Emacs.base/Resources/Emacs.desktop" + "Cocoa/Emacs.base/Contents/Resources/English.lproj" + ;; Only existed briefly, then deleted: + "coccinelle/overlay.cocci" "coccinelle/symbol.cocci" ;; MH-E stuff not in Emacs: "import-emacs" "release-utils" ;; Erc stuff not in Emacs: @@ -540,6 +548,7 @@ Changes to files in this list are not listed.") "makedist.bat" "makefile.def" "makefile.nt" + "ns.mk" "debug.bat.in" "emacs.bat.in" ".gdbinit-union" "alloca.s" @@ -553,15 +562,17 @@ Changes to files in this list are not listed.") "ymakefile" "permute-index" "index.perm" "ibmrs6000.inp" - "b2m.c" "b2m.1" "b2m.pl" + "b2m.c" "b2m.1" "b2m.pl" "rcs-checkin.1" "emacs.bash" "emacs.csh" "ms-kermit" "emacs.ico" "emacs21.ico" + "emacs.py" "emacs2.py" "emacs3.py" "BABYL" "LPF" "LEDIT" "OTHER.EMACSES" "emacs16_mac.png" "emacs24_mac.png" "emacs256_mac.png" "emacs32_mac.png" "emacs48_mac.png" "emacs512_mac.png" "revdiff" ; admin/ + "vcdiff" "rcs-checkin" "tindex.pl" "mainmake" "sed1.inp" "sed2.inp" "sed3.inp" ; msdos/ "mac-fix-env.m" ;; Deleted vms stuff: @@ -580,6 +591,7 @@ in the repository.") ("s/windowsnt.h" . "s/ms-w32.h") ("s/ms-w32.h" . "inc/ms-w32.h") ("winnt.el" . "w32-fns.el") + ("emacs.manifest" . "emacs-x86.manifest") ("config.emacs" . "configure") ("configure.in" . "configure.ac") ("config.h.dist" . "config.in") @@ -616,6 +628,8 @@ in the repository.") ("build-install" . "build-ins.in") ("build-install.in" . "build-ins.in") ("unidata/Makefile" . "unidata/Makefile.in") + ("move-if-change" . "build-aux/move-if-change") + ("update-subdirs" . "build-aux/update-subdirs") ;; Not renamed, but we only have the latter in the Emacs repo. ("trampver.texi.in" . "trampver.texi") ("e/eterm" . "e/eterm-color") diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index 5607c9b0698..f88cb0ef9bb 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -30,12 +30,12 @@ ;; a single prompt, optionally using completion. ;; Multiple strings are specified by separating each of the strings -;; with a prespecified separator character. For example, if the -;; separator character is a comma, the strings 'alice', 'bob', and +;; with a prespecified separator regexp. For example, if the +;; separator regexp is ",", the strings 'alice', 'bob', and ;; 'eve' would be specified as 'alice,bob,eve'. -;; The default value for the separator character is the value of -;; `crm-default-separator' (comma). The separator character may be +;; The default value for the separator regexp is the value of +;; `crm-default-separator' (comma). The separator regexp may be ;; changed by modifying the value of `crm-separator'. ;; Contiguous strings of non-separator-characters are referred to as @@ -96,14 +96,14 @@ ;; first revamped version ;;; Code: -(defconst crm-default-separator "," - "Default separator for `completing-read-multiple'.") +(defconst crm-default-separator "[ \t]*,[ \t]*" + "Default separator regexp for `completing-read-multiple'.") (defvar crm-separator crm-default-separator - "Separator used for separating strings in `completing-read-multiple'. -It should be a single character string that doesn't appear in the list of -completion candidates. Modify this value to make `completing-read-multiple' -use a separator other than `crm-default-separator'.") + "Separator regexp used for separating strings in `completing-read-multiple'. +It should be a regexp that does not match the list of completion candidates. +Modify this value to make `completing-read-multiple' use a separator other +than `crm-default-separator'.") (defvar crm-local-completion-map (let ((map (make-sparse-keymap))) @@ -173,13 +173,17 @@ Place an overlay on the element, with a `field' property, and return it." (overlay-put ol 'field (make-symbol "crm")) ol)) +(defmacro crm--completion-command (command) + "Make COMMAND a completion command for `completing-read-multiple'." + `(let ((ol (crm--select-current-element))) + (unwind-protect + ,command + (delete-overlay ol)))) + (defun crm-completion-help () "Display a list of possible completions of the current minibuffer element." (interactive) - (let ((ol (crm--select-current-element))) - (unwind-protect - (minibuffer-completion-help) - (delete-overlay ol))) + (crm--completion-command (minibuffer-completion-help)) nil) (defun crm-complete () @@ -188,19 +192,13 @@ If no characters can be completed, display a list of possible completions. Return t if the current element is now a valid match; otherwise return nil." (interactive) - (let ((ol (crm--select-current-element))) - (unwind-protect - (minibuffer-complete) - (delete-overlay ol)))) + (crm--completion-command (minibuffer-complete))) (defun crm-complete-word () "Complete the current element at most a single word. Like `minibuffer-complete-word' but for `completing-read-multiple'." (interactive) - (let ((ol (crm--select-current-element))) - (unwind-protect - (minibuffer-complete-word) - (delete-overlay ol)))) + (crm--completion-command (minibuffer-complete-word))) (defun crm-complete-and-exit () "If all of the minibuffer elements are valid completions then exit. @@ -222,9 +220,10 @@ This function is modeled after `minibuffer-complete-and-exit'." (setq doexit nil)) (goto-char (overlay-end ol)) (delete-overlay ol)) - (not (eobp)))) + (not (eobp))) + (looking-at crm-separator)) ;; Skip to the next element. - (forward-char 1)) + (goto-char (match-end 0))) (if doexit (exit-minibuffer)))) (defun crm--choose-completion-string (choice buffer base-position @@ -248,12 +247,12 @@ By using this functionality, a user may specify multiple strings at a single prompt, optionally using completion. Multiple strings are specified by separating each of the strings with -a prespecified separator character. For example, if the separator -character is a comma, the strings 'alice', 'bob', and 'eve' would be +a prespecified separator regexp. For example, if the separator +regexp is \",\", the strings 'alice', 'bob', and 'eve' would be specified as 'alice,bob,eve'. -The default value for the separator character is the value of -`crm-default-separator' (comma). The separator character may be +The default value for the separator regexp is the value of +`crm-default-separator' (comma). The separator regexp may be changed by modifying the value of `crm-separator'. Contiguous strings of non-separator-characters are referred to as @@ -282,8 +281,8 @@ INHERIT-INPUT-METHOD." (map (if require-match crm-local-must-match-map crm-local-completion-map)) - ;; If the user enters empty input, read-from-minibuffer returns - ;; the empty string, not DEF. + ;; If the user enters empty input, `read-from-minibuffer' + ;; returns the empty string, not DEF. (input (read-from-minibuffer prompt initial-input map nil hist def inherit-input-method))) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 378ba9db9f4..52e12013fd3 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -461,8 +461,8 @@ STREAM or the value of `standard-input' may be: This version, from Edebug, maybe instruments the expression. But the STREAM must be the current buffer to do so. Whether it instruments is -also dependent on the values of `edebug-all-defs' and -`edebug-all-forms'." +also dependent on the values of the option `edebug-all-defs' and +the option `edebug-all-forms'." (or stream (setq stream standard-input)) (if (eq stream (current-buffer)) (edebug-read-and-maybe-wrap-form) @@ -484,8 +484,8 @@ similarly. Reinitialize the face according to `defface' specification. With a prefix argument, instrument the code for Edebug. -Setting `edebug-all-defs' to a non-nil value reverses the meaning of -the prefix argument. Code is then instrumented when this function is +Setting option `edebug-all-defs' to a non-nil value reverses the meaning +of the prefix argument. Code is then instrumented when this function is invoked without a prefix argument If acting on a `defun' for FUNCTION, and the function was instrumented, diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 70d6a6a4a5f..dd849362228 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -937,7 +937,7 @@ Returns the result and stores it in ERT-TEST's `most-recent-result' slot." (cl-block error (let ((begin-marker (with-current-buffer (get-buffer-create "*Messages*") - (set-marker (make-marker) (point-max))))) + (point-max-marker)))) (unwind-protect (let ((info (make-ert--test-execution-info :test ert-test diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index b4d6fac92a2..b0711fed26c 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -167,20 +167,27 @@ WHERE is a symbol to select an entry in `advice--where-alist'." (setq definition (advice--cdr definition)))) found)) -;;;###autoload -(defun advice--remove-function (flist function) +(defun advice--tweak (flist tweaker) (if (not (advice--p flist)) - flist + (funcall tweaker nil flist nil) (let ((first (advice--car flist)) + (rest (advice--cdr flist)) (props (advice--props flist))) - (if (or (equal function first) - (equal function (cdr (assq 'name props)))) - (advice--cdr flist) - (let* ((rest (advice--cdr flist)) - (nrest (advice--remove-function rest function))) - (if (eq rest nrest) flist - (advice--make-1 (aref flist 1) (aref flist 3) - first nrest props))))))) + (let ((val (funcall tweaker first rest props))) + (if val (car val) + (let ((nrest (advice--tweak rest tweaker))) + (if (eq rest nrest) flist + (advice--make-1 (aref flist 1) (aref flist 3) + first nrest props)))))))) + +;;;###autoload +(defun advice--remove-function (flist function) + (advice--tweak flist + (lambda (first rest props) + (cond ((not first) rest) + ((or (equal function first) + (equal function (cdr (assq 'name props)))) + (list rest)))))) (defvar advice--buffer-local-function-sample nil) @@ -269,15 +276,8 @@ of the piece of advice." ;;;; Specific application of add-function to `symbol-function' for advice. (defun advice--subst-main (old new) - (if (not (advice--p old)) - new - (let* ((first (advice--car old)) - (rest (advice--cdr old)) - (props (advice--props old)) - (nrest (advice--subst-main rest new))) - (if (equal rest nrest) old - (advice--make-1 (aref old 1) (aref old 3) - first nrest props))))) + (advice--tweak old + (lambda (first _rest _props) (if (not first) new)))) (defun advice--normalize (symbol def) (cond diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 69834810d11..e000c343721 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -431,30 +431,31 @@ MATCH is the pattern that needs to be matched, of the form: (match ,symd . ,(pcase--upat (cdr qpat)))) :pcase--fail))) ;; A QPattern but not for a cons, can only go to the `else' side. - ((eq (car-safe pat) '\`) (cons :pcase--fail nil)) + ((eq (car-safe pat) '\`) '(:pcase--fail . nil)) ((and (eq (car-safe pat) 'pred) (or (member (cons 'consp (cadr pat)) pcase-mutually-exclusive-predicates) (member (cons (cadr pat) 'consp) pcase-mutually-exclusive-predicates))) - (cons :pcase--fail nil)))) + '(:pcase--fail . nil)))) (defun pcase--split-equal (elem pat) (cond ;; The same match will give the same result. ((and (eq (car-safe pat) '\`) (equal (cadr pat) elem)) - (cons :pcase--succeed :pcase--fail)) + '(:pcase--succeed . :pcase--fail)) ;; A different match will fail if this one succeeds. ((and (eq (car-safe pat) '\`) ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) ;; (consp (cadr pat))) ) - (cons :pcase--fail nil)) + '(:pcase--fail . nil)) ((and (eq (car-safe pat) 'pred) (symbolp (cadr pat)) - (get (cadr pat) 'side-effect-free) - (funcall (cadr pat) elem)) - (cons :pcase--succeed nil)))) + (get (cadr pat) 'side-effect-free)) + (if (funcall (cadr pat) elem) + '(:pcase--succeed . nil) + '(:pcase--fail . nil))))) (defun pcase--split-member (elems pat) ;; Based on pcase--split-equal. @@ -462,7 +463,7 @@ MATCH is the pattern that needs to be matched, of the form: ;; The same match (or a match of membership in a superset) will ;; give the same result, but we don't know how to check it. ;; (??? - ;; (cons :pcase--succeed nil)) + ;; '(:pcase--succeed . nil)) ;; A match for one of the elements may succeed or fail. ((and (eq (car-safe pat) '\`) (member (cadr pat) elems)) nil) @@ -471,7 +472,7 @@ MATCH is the pattern that needs to be matched, of the form: ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) ;; (consp (cadr pat))) ) - (cons :pcase--fail nil)) + '(:pcase--fail . nil)) ((and (eq (car-safe pat) 'pred) (symbolp (cadr pat)) (get (cadr pat) 'side-effect-free) @@ -479,21 +480,21 @@ MATCH is the pattern that needs to be matched, of the form: (dolist (elem elems) (unless (funcall p elem) (setq all nil))) all)) - (cons :pcase--succeed nil)))) + '(:pcase--succeed . nil)))) (defun pcase--split-pred (upat pat) ;; FIXME: For predicates like (pred (> a)), two such predicates may ;; actually refer to different variables `a'. (let (test) (cond - ((equal upat pat) (cons :pcase--succeed :pcase--fail)) + ((equal upat pat) '(:pcase--succeed . :pcase--fail)) ((and (eq 'pred (car upat)) (eq 'pred (car-safe pat)) (or (member (cons (cadr upat) (cadr pat)) pcase-mutually-exclusive-predicates) (member (cons (cadr pat) (cadr upat)) pcase-mutually-exclusive-predicates))) - (cons :pcase--fail nil)) + '(:pcase--fail . nil)) ((and (eq 'pred (car upat)) (eq '\` (car-safe pat)) (symbolp (cadr upat)) @@ -502,8 +503,8 @@ MATCH is the pattern that needs to be matched, of the form: (ignore-errors (setq test (list (funcall (cadr upat) (cadr pat)))))) (if (car test) - (cons nil :pcase--fail) - (cons :pcase--fail nil)))))) + '(nil . :pcase--fail) + '(:pcase--fail . nil)))))) (defun pcase--fgrep (vars sexp) "Check which of the symbols VARS appear in SEXP." diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 3eaacd24ec8..8b019d0a785 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -307,13 +307,13 @@ This function is called, by name, directly by the C code." ;; Run handler. ;; We do this after rescheduling so that the handler function ;; can cancel its own timer successfully with cancel-timer. - (condition-case nil + (condition-case-unless-debug err ;; Timer functions should not change the current buffer. ;; If they do, all kinds of nasty surprises can happen, ;; and it can be hellish to track down their source. (save-current-buffer (apply (timer--function timer) (timer--args timer))) - (error nil)) + (error (message "Error in timer: %S" err))) (if retrigger (setf (timer--triggered timer) nil))) (error "Bogus timer event")))) diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index d2566b8cb9f..fb1b995be2b 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -38,11 +38,6 @@ ;; generation of trace output won't interfere with what you are currently ;; doing. -;; Requirement: -;; ============ -;; trace.el needs advice.el version 2.0 or later which you can get from the -;; same place from where you got trace.el. - ;; Restrictions: ;; ============= ;; - Traced subrs when called interactively will always show nil as the @@ -55,17 +50,6 @@ ;; + Macros that were expanded during compilation ;; - All the restrictions that apply to advice.el -;; Installation: -;; ============= -;; Put this file together with advice.el (version 2.0 or later) somewhere -;; into your Emacs `load-path', byte-compile it/them for efficiency, and -;; put the following autoload declarations into your .emacs -;; -;; (autoload 'trace-function "trace" "Trace a function" t) -;; (autoload 'trace-function-background "trace" "Trace a function" t) -;; -;; or explicitly load it with (require 'trace) or (load "trace"). - ;; Usage: ;; ====== ;; - To trace a function say `M-x trace-function' which will ask you for the @@ -183,6 +167,8 @@ some global variables)." (mapconcat 'char-to-string (make-string (1- level) ?|) " ") (if (> level 1) " " "") level + ;; FIXME: Make it so we can click the function name to jump to its + ;; definition and/or untrace it. (cons function args) context))) @@ -282,21 +268,17 @@ and return values will be inserted into BUFFER. This function generates the trace advice for FUNCTION and activates it together with any other advice there might be!! The trace BUFFER will popup whenever FUNCTION is called. Do not use this to trace functions that switch buffers or do any other -display oriented stuff, use `trace-function-background' instead." +display oriented stuff, use `trace-function-background' instead. + +To untrace a function, use `untrace-function' or `untrace-all'." (interactive (trace--read-args "Trace function: ")) (trace-function-internal function buffer nil context)) ;;;###autoload (defun trace-function-background (function &optional buffer context) "Traces FUNCTION with trace output going quietly to BUFFER. -When this tracing is enabled, every call to FUNCTION writes -a Lisp-style trace message (showing the arguments and return value) -into BUFFER. This function generates advice to trace FUNCTION -and activates it together with any other advice there might be. -The trace output goes to BUFFER quietly, without changing -the window or buffer configuration. - -BUFFER defaults to `trace-buffer'." +Like `trace-function-foreground' but without popping up the trace BUFFER or +changing the window configuration." (interactive (trace--read-args "Trace function in background: ")) (trace-function-internal function buffer t context)) |