aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog186
-rw-r--r--lisp/arc-mode.el2
-rw-r--r--lisp/cedet/ChangeLog21
-rw-r--r--lisp/cedet/semantic/bovine/c.el6
-rw-r--r--lisp/cedet/semantic/fw.el9
-rw-r--r--lisp/cedet/semantic/lex-spp.el6
-rw-r--r--lisp/cedet/semantic/symref.el2
-rw-r--r--lisp/cedet/semantic/symref/list.el2
-rw-r--r--lisp/cedet/semantic/util.el2
-rw-r--r--lisp/emacs-lisp/advice.el751
-rw-r--r--lisp/emacs-lisp/checkdoc.el2
-rw-r--r--lisp/emacs-lisp/cl-lib.el2
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el12
-rw-r--r--lisp/emacs-lisp/cl-macs.el18
-rw-r--r--lisp/emacs-lisp/eieio-datadebug.el2
-rw-r--r--lisp/emacs-lisp/gv.el2
-rw-r--r--lisp/emacs-lisp/nadvice.el104
-rw-r--r--lisp/erc/ChangeLog4
-rw-r--r--lisp/erc/erc.el4
-rw-r--r--lisp/eshell/em-cmpl.el11
-rw-r--r--lisp/eshell/em-unix.el3
-rw-r--r--lisp/faces.el58
-rw-r--r--lisp/filecache.el33
-rw-r--r--lisp/gnus/ChangeLog14
-rw-r--r--lisp/gnus/gnus-diary.el12
-rw-r--r--lisp/gnus/gnus-logic.el13
-rw-r--r--lisp/gnus/gnus-score.el17
-rw-r--r--lisp/gnus/pop3.el2
-rw-r--r--lisp/help-mode.el3
-rw-r--r--lisp/ibuffer.el25
-rw-r--r--lisp/imenu.el4
-rw-r--r--lisp/net/tramp-gvfs.el4
-rw-r--r--lisp/play/gamegrid.el2
-rw-r--r--lisp/progmodes/ruby-mode.el122
-rw-r--r--lisp/subr.el15
-rw-r--r--lisp/term.el15
-rw-r--r--lisp/term/w32-win.el2
-rw-r--r--lisp/window.el125
-rw-r--r--lisp/woman.el12
39 files changed, 860 insertions, 769 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5ef50e0548f..f26643ea5cf 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,189 @@
12012-11-17 Andreas Politz <politza@fh-trier.de>
2
3 * ibuffer.el (ibuffer-mark-forward, ibuffer-unmark-forward)
4 (ibuffer-unmark-backward, ibuffer-mark-interactive): Support plain
5 prefix and negative numeric prefix args (Bug#12795).
6
72012-11-17 Stephen Berman <stephen.berman@gmx.net>
8
9 * play/gamegrid.el (gamegrid-add-score-with-update-game-score-1):
10 Don't signal an error with a score that is too low to add to the
11 list of top scores. (Bug#12779)
12
132012-11-17 Chong Yidong <cyd@gnu.org>
14
15 * help-mode.el (help-xref-interned): End on point-min (Bug#12737).
16
17 * filecache.el (file-cache-add-file): Handle relative file name in
18 the argument (Bug#12694).
19
202012-11-16 Jürgen Hötzel <juergen@archlinux.org> (tiny change)
21
22 * eshell/em-unix.el (eshell/mkdir): Handle "--parents" (bug#12897).
23
242012-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
25
26 * emacs-lisp/advice.el (ad-make-advised-definition): Improve last fix.
27
28 * emacs-lisp/cl-lib.el: Set more meaningful version number.
29
302012-11-16 Martin Rudalics <rudalics@gmx.at>
31
32 * window.el (enlarge-window, shrink-window): Don't mention return
33 value in doc-string (Bug#12896).
34 (window--display-buffer): Don't resize frames - it won't work
35 with all window managers and defeat pop-up-frame-alist.
36 (display-buffer-alist): In doc-string explain that CONDITION can
37 be a function and which arguments are passed to it (Bug#12854).
38 (display-buffer-assq-regexp): New argument ACTION. Handle lambda
39 expressions (Bug#12854).
40 (display-buffer): Pass ACTION argument to
41 display-buffer-assq-regexp.
42
432012-11-16 Glenn Morris <rgm@gnu.org>
44
45 * window.el (fit-frame-to-buffer-bottom-margin)
46 (fit-frame-to-buffer, fit-window-to-buffer): Doc fixes.
47
48 * faces.el (face-underline-p): Use face-attribute-specified-or.
49
502012-11-16 Juanma Barranquero <lekktu@gmail.com>
51
52 * emacs-lisp/cl-macs.el (cl-loop, cl-do, cl-do*): Doc fixes.
53
542012-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
55
56 * emacs-lisp/cl-macs.el (cl-flet, cl-flet*): Fix docstring (bug#12895).
57
582012-11-16 Glenn Morris <rgm@gnu.org>
59
60 * eshell/em-cmpl.el (eshell-pcomplete): New command. (Bug#12838)
61 (eshell-cmpl-initialize): Bind eshell-pcomplete to TAB, C-i.
62
63 * faces.el (face-underline-p): Doc fix. Handle :underline being
64 things other than `t' (a string, a list).
65 (face-inverse-video-p): Doc fix.
66 (set-face-underline): Rename it back from set-face-underline-p.
67 Doc fix. Allow interactive input of values other than t.
68 (read-face-attribute): Apply formatting to :underline,
69 since like :box and :stipple it can take list values.
70
71 * term.el (ansi-term): Don't let C-x escape-char binding
72 clobber the more standard C-c binding. (Bug#12842)
73
74 * subr.el (set-temporary-overlay-map): Doc fix.
75
762012-11-16 Martin Rudalics <rudalics@gmx.at>
77
78 * window.el (record-window-buffer)
79 (display-buffer-record-window): When copying the markers to
80 window-point preserve window-point-insertion-type. (Bug#12588)
81
822012-11-16 Glenn Morris <rgm@gnu.org>
83
84 * emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke):
85 * net/tramp-gvfs.el (tramp-gvfs-dbus-event-error):
86 Use new names for hooks rather than obsolete aliases.
87
882012-11-15 Daniel Colascione <dancol@dancol.org>
89
90 * term/w32-win.el (w32-handle-dropped-file): Use a "file://"
91 prefix instead of "file:" so that when FILE-NAME begins with "//",
92 as it does when the target file is on a network share, url-handler
93 isn't confused.
94
952012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
96
97 * emacs-lisp/advice.el (ad-definition-type): Make sure we don't use
98 a preactivated advice from an old advice.el; they're not compatible!
99
1002012-11-15 Katsumi Yamaoka <yamaoka@jpl.org>
101
102 * emacs-lisp/nadvice.el (advice--make-interactive-form):
103 Fix string-spec case.
104
105 * emacs-lisp/advice.el (ad-make-advised-definition): Fix undefined case.
106
1072012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
108
109 * emacs-lisp/nadvice.el: Add buffer-local support to add-function.
110 (advice--buffer-local-function-sample): New var.
111 (advice--set-buffer-local, advice--buffer-local): New functions.
112 (add-function, remove-function): Use them.
113
1142012-11-15 Drew Adams <drew.adams@oracle.com>
115
116 * imenu.el (imenu--split-submenus): Use imenu--subalist-p (bug#12717).
117
1182012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
119
120 * emacs-lisp/cl-macs.el (cl--transform-lambda): Defend against
121 potential binding of print-gensym to t, and prettify (back)quotes in
122 case they appear in args's default values (bug#12884).
123
1242012-11-14 Stefan Monnier <monnier@iro.umontreal.ca>
125
126 * emacs-lisp/nadvice.el: Add around advice for interactive specs.
127 (advice-eval-interactive-spec): New function.
128 (advice--make-interactive-form): Support around advice (bug#12844).
129
1302012-11-14 Dmitry Gutov <dgutov@yandex.ru>
131
132 * progmodes/ruby-mode.el (ruby-expr-beg): Make heredoc detection
133 more strict. Add docstring.
134 (ruby-expression-expansion-re): Extract from
135 `ruby-match-expression-expansion'.
136 (ruby-syntax-propertize-function): After everything else, search
137 for expansions in string literals, mark their insides as
138 whitespace syntax and save match data for font-lock.
139 (ruby-font-lock-keywords): Use the 2nd group from expression
140 expansion matches.
141 (ruby-match-expression-expansion): Use the match data saved to the
142 text property in ruby-syntax-propertize-function.
143
1442012-11-14 Stefan Monnier <monnier@iro.umontreal.ca>
145
146 * emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments
147 (bug#12879).
148
1492012-11-13 Dmitry Gutov <dgutov@yandex.ru>
150
151 * progmodes/ruby-mode.el (ruby-move-to-block): Looks for a block
152 start/end keyword a bit harder. Works with different values of N.
153 Add more comments.
154 (ruby-end-of-block): Update accordingly.
155
1562012-11-13 Stefan Monnier <monnier@iro.umontreal.ca>
157
158 * woman.el (woman-file-name): Don't mess with unread-command-events
159 (bug#12861).
160
161 * emacs-lisp/advice.el: Layer on top of nadvice.el.
162 Remove out of date self-require hack.
163 (ad-do-advised-functions): Use simple `dolist'.
164 (ad-advice-name, ad-advice-protected, ad-advice-enabled)
165 (ad-advice-definition): Redefine as functions.
166 (ad-advice-classes): Move before first use.
167 (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition)
168 (ad-make-mapped-call, ad-make-advised-docstring,ad-make-plain-docstring)
169 (ad--defalias-fset): Remove functions.
170 (ad-make-advicefunname, ad-clear-advicefunname-definition): New funs.
171 (ad-get-orig-definition): Rewrite.
172 (ad-make-advised-definition-docstring): Change base docstring.
173 (ad-real-orig-definition): Rewrite.
174 (ad-map-arglists): Change name of called function.
175 (ad--make-advised-docstring): Redirect `function' from ad-Advice-...
176 (ad-make-advised-definition): Simplify.
177 (ad-assemble-advised-definition): Tweak for new calling context.
178 (ad-activate-advised-definition): Setup ad-Advice-* i.s.o ad-Orig-*.
179 (ad--defalias-fset): Rename from ad-handle-definition. Make it set the
180 function and call ad-activate if needed.
181 (ad-activate, ad-deactivate): Don't call ad-handle-definition any more.
182 (ad-recover): Clear ad-Advice-* instead of ad-Orig-*.
183 (ad-compile-function): Compile ad-Advice-*.
184 (ad-activate-on-top-level, ad-with-auto-activation-disabled): Remove.
185 (ad-start-advice, ad-stop-advice): Remove.
186
12012-11-13 Dmitry Gutov <dgutov@yandex.ru> 1872012-11-13 Dmitry Gutov <dgutov@yandex.ru>
2 188
3 * progmodes/ruby-mode.el (ruby-add-log-current-method): Print the 189 * progmodes/ruby-mode.el (ruby-add-log-current-method): Print the
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index cebd4302d0c..9fc91a242d2 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -96,7 +96,7 @@
96;; 96;;
97;; archive-mode-hook 97;; archive-mode-hook
98;; archive-foo-mode-hook 98;; archive-foo-mode-hook
99;; archive-extract-hooks 99;; archive-extract-hook
100 100
101;;; Code: 101;;; Code:
102 102
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog
index 755f4c8159b..a01ce4c30a3 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog
@@ -1,3 +1,24 @@
12012-11-16 David Engster <deng@randomsample.de>
2
3 * semantic/symref/list.el (semantic-symref-symbol): Use
4 `semantic-complete-read-tag-project' instead of
5 `semantic-complete-read-tag-buffer-deep', since the latter is not
6 working correctly.
7
8 * semantic/symref.el (semantic-symref-result-get-tags): Use
9 `find-buffer-visiting' to follow symbolic links.
10
11 * semantic/fw.el (semantic-find-file-noselect): Always set
12 `enable-local-variables' to `:safe' when loading files.
13
142012-11-16 Glenn Morris <rgm@gnu.org>
15
16 * semantic/lex-spp.el (semantic-lex-spp-lex-text-string):
17 * semantic/util.el (semantic-describe-buffer):
18 * semantic/bovine/c.el (semantic-c-parse-lexical-token)
19 (semantic-default-c-setup):
20 Use new names for hooks rather than obsolete aliases.
21
12012-11-13 Stefan Monnier <monnier@iro.umontreal.ca> 222012-11-13 Stefan Monnier <monnier@iro.umontreal.ca>
2 23
3 * semantic/mru-bookmark.el (semantic-mru-bookmark-mode): 24 * semantic/mru-bookmark.el (semantic-mru-bookmark-mode):
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index 02ad6e05d1a..a3d57108d1d 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -931,8 +931,8 @@ the regular parser."
931 (setq semantic-new-buffer-fcn-was-run t) 931 (setq semantic-new-buffer-fcn-was-run t)
932 (semantic-lex-init) 932 (semantic-lex-init)
933 (semantic-clear-toplevel-cache) 933 (semantic-clear-toplevel-cache)
934 (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook 934 (remove-hook 'semantic-lex-reset-functions
935 t) 935 'semantic-lex-spp-reset-hook t)
936 ) 936 )
937 ;; Get the macro symbol table right. 937 ;; Get the macro symbol table right.
938 (setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms) 938 (setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms)
@@ -2073,7 +2073,7 @@ actually in their parent which is not accessible.")
2073 ) 2073 )
2074 2074
2075 (setq semantic-lex-analyzer #'semantic-c-lexer) 2075 (setq semantic-lex-analyzer #'semantic-c-lexer)
2076 (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t) 2076 (add-hook 'semantic-lex-reset-functions 'semantic-lex-spp-reset-hook nil t)
2077 (when (eq major-mode 'c++-mode) 2077 (when (eq major-mode 'c++-mode)
2078 (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__cplusplus" . ""))) 2078 (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__cplusplus" . "")))
2079 ) 2079 )
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index 5a12047eb76..14ffc808c44 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -421,14 +421,7 @@ into `mode-local-init-hook'." file filename)
421 ;; Don't prompt to insert a template if we visit an empty file 421 ;; Don't prompt to insert a template if we visit an empty file
422 (auto-insert nil) 422 (auto-insert nil)
423 ;; We don't want emacs to query about unsafe local variables 423 ;; We don't want emacs to query about unsafe local variables
424 (enable-local-variables 424 (enable-local-variables :safe)
425 (if (featurep 'xemacs)
426 ;; XEmacs only has nil as an option?
427 nil
428 ;; Emacs 23 has the spiffy :safe option, nil otherwise.
429 (if (>= emacs-major-version 22)
430 nil
431 :safe)))
432 ;; ... or eval variables 425 ;; ... or eval variables
433 (enable-local-eval nil) 426 (enable-local-eval nil)
434 ) 427 )
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 406f2900563..ad366c2b94f 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -30,7 +30,7 @@
30;; If you use SPP in your language, be sure to specify this in your 30;; If you use SPP in your language, be sure to specify this in your
31;; semantic language setup function: 31;; semantic language setup function:
32;; 32;;
33;; (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t) 33;; (add-hook 'semantic-lex-reset-functions 'semantic-lex-spp-reset-hook nil t)
34;; 34;;
35;; 35;;
36;; Special Lexical Tokens: 36;; Special Lexical Tokens:
@@ -947,8 +947,8 @@ and variable state from the current buffer."
947 (setq semantic-new-buffer-fcn-was-run t) 947 (setq semantic-new-buffer-fcn-was-run t)
948 (semantic-lex-init) 948 (semantic-lex-init)
949 (semantic-clear-toplevel-cache) 949 (semantic-clear-toplevel-cache)
950 (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook 950 (remove-hook 'semantic-lex-reset-functions
951 t) 951 'semantic-lex-spp-reset-hook t)
952 )) 952 ))
953 953
954 ;; Second Cheat: copy key variables regarding macro state from the 954 ;; Second Cheat: copy key variables regarding macro state from the
diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el
index 540c766cc94..ad897680d7f 100644
--- a/lisp/cedet/semantic/symref.el
+++ b/lisp/cedet/semantic/symref.el
@@ -356,7 +356,7 @@ already."
356 (lambda (hit) 356 (lambda (hit)
357 (let* ((line (car hit)) 357 (let* ((line (car hit))
358 (file (cdr hit)) 358 (file (cdr hit))
359 (buff (get-file-buffer file)) 359 (buff (find-buffer-visiting file))
360 (tag nil) 360 (tag nil)
361 ) 361 )
362 (cond 362 (cond
diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el
index 55ccf1c103f..729bd8e153c 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -69,7 +69,7 @@ current project to find references to the input SYM. The
69references are organized by file and the name of the function 69references are organized by file and the name of the function
70they are used in. 70they are used in.
71Display the references in `semantic-symref-results-mode'." 71Display the references in `semantic-symref-results-mode'."
72 (interactive (list (semantic-tag-name (semantic-complete-read-tag-buffer-deep 72 (interactive (list (semantic-tag-name (semantic-complete-read-tag-project
73 "Symrefs for: ")))) 73 "Symrefs for: "))))
74 (semantic-fetch-tags) 74 (semantic-fetch-tags)
75 (let ((res nil) 75 (let ((res nil)
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index 65201c4fd12..f3d30f6af5c 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -280,7 +280,7 @@ If TAG is not specified, use the tag at point."
280 semantic-parser-name 280 semantic-parser-name
281 semantic-parse-tree-state 281 semantic-parse-tree-state
282 semantic-lex-analyzer 282 semantic-lex-analyzer
283 semantic-lex-reset-hooks 283 semantic-lex-reset-functions
284 semantic-lex-syntax-modifications 284 semantic-lex-syntax-modifications
285 ))) 285 )))
286 (dolist (V vars) 286 (dolist (V vars)
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index ecaf6861a6c..c2ebb3bbdc6 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -47,14 +47,12 @@
47;; @ Highlights: 47;; @ Highlights:
48;; ============= 48;; =============
49;; - Clean definition of multiple, named before/around/after advices 49;; - Clean definition of multiple, named before/around/after advices
50;; for functions, macros, subrs and special forms 50;; for functions and macros.
51;; - Full control over the arguments an advised function will receive, 51;; - Full control over the arguments an advised function will receive,
52;; the binding environment in which it will be executed, as well as the 52;; the binding environment in which it will be executed, as well as the
53;; value it will return. 53;; value it will return.
54;; - Allows re/definition of interactive behavior for functions and subrs 54;; - Allows re/definition of interactive behavior for commands.
55;; - Every piece of advice can have its documentation string which will be 55;; - Every piece of advice can have its documentation string.
56;; combined with the original documentation of the advised function at
57;; call-time of `documentation' for proper command-key substitution.
58;; - The execution of every piece of advice can be protected against error 56;; - The execution of every piece of advice can be protected against error
59;; and non-local exits in preceding code or advices. 57;; and non-local exits in preceding code or advices.
60;; - Simple argument access either by name, or, more portable but as 58;; - Simple argument access either by name, or, more portable but as
@@ -63,7 +61,7 @@
63;; version of a function. 61;; version of a function.
64;; - Advised functions can be byte-compiled either at file-compile time 62;; - Advised functions can be byte-compiled either at file-compile time
65;; (see preactivation) or activation time. 63;; (see preactivation) or activation time.
66;; - Separation of advice definition and activation 64;; - Separation of advice definition and activation.
67;; - Forward advice is possible, that is 65;; - Forward advice is possible, that is
68;; as yet undefined or autoload functions can be advised without having to 66;; as yet undefined or autoload functions can be advised without having to
69;; preload the file in which they are defined. 67;; preload the file in which they are defined.
@@ -77,7 +75,7 @@
77;; - En/disablement mechanism allows the use of different "views" of advised 75;; - En/disablement mechanism allows the use of different "views" of advised
78;; functions depending on what pieces of advice are currently en/disabled 76;; functions depending on what pieces of advice are currently en/disabled
79;; - Provides manipulation mechanisms for sets of advised functions via 77;; - Provides manipulation mechanisms for sets of advised functions via
80;; regular expressions that match advice names 78;; regular expressions that match advice names.
81 79
82;; @ Overview, or how to read this file: 80;; @ Overview, or how to read this file:
83;; ===================================== 81;; =====================================
@@ -113,23 +111,12 @@
113;; others come from the various Lisp advice mechanisms I've come across 111;; others come from the various Lisp advice mechanisms I've come across
114;; so far, and a few are simply mine. 112;; so far, and a few are simply mine.
115 113
116;; @ Comments, suggestions, bug reports:
117;; =====================================
118;; If you find any bugs, have suggestions for new advice features, find the
119;; documentation wrong, confusing, incomplete, or otherwise unsatisfactory,
120;; have any questions about Advice, or have otherwise enlightening
121;; comments feel free to send me email at <hans@cs.buffalo.edu>.
122
123;; @ Safety Rules and Emergency Exits: 114;; @ Safety Rules and Emergency Exits:
124;; =================================== 115;; ===================================
125;; Before we begin: CAUTION!! 116;; Before we begin: CAUTION!!
126;; Advice provides you with a lot of rope to hang yourself on very 117;; Advice provides you with a lot of rope to hang yourself on very
127;; easily accessible trees, so, here are a few important things you 118;; easily accessible trees, so, here are a few important things you
128;; should know: Once Advice has been started with `ad-start-advice' 119;; should know:
129;; (which happens automatically when you load this file), it
130;; generates an advised definition of the `documentation' function, and
131;; it will enable automatic advice activation when functions get defined.
132;; All of this can be undone at any time with `M-x ad-stop-advice'.
133;; 120;;
134;; If you experience any strange behavior/errors etc. that you attribute to 121;; If you experience any strange behavior/errors etc. that you attribute to
135;; Advice or to some ill-advised function do one of the following: 122;; Advice or to some ill-advised function do one of the following:
@@ -137,45 +124,37 @@
137;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what 124;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what
138;; function gives you problems) 125;; function gives you problems)
139;; - M-x ad-deactivate-all (if you don't have a clue what's going wrong) 126;; - M-x ad-deactivate-all (if you don't have a clue what's going wrong)
140;; - M-x ad-stop-advice (if you think the problem is related to the
141;; advised functions used by Advice itself)
142;; - M-x ad-recover-normality (for real emergencies) 127;; - M-x ad-recover-normality (for real emergencies)
143;; - If none of the above solves your Advice-related problem go to another 128;; - If none of the above solves your Advice-related problem go to another
144;; terminal, kill your Emacs process and send me some hate mail. 129;; terminal, kill your Emacs process and send me some hate mail.
145 130
146;; The first three measures have restarts, i.e., once you've figured out 131;; The first two measures have restarts, i.e., once you've figured out
147;; the problem you can reactivate advised functions with either `ad-activate', 132;; the problem you can reactivate advised functions with either `ad-activate',
148;; `ad-activate-all', or `ad-start-advice'. `ad-recover-normality' unadvises 133;; or `ad-activate-all'. `ad-recover-normality' unadvises
149;; everything so you won't be able to reactivate any advised functions, you'll 134;; everything so you won't be able to reactivate any advised functions, you'll
150;; have to stick with their standard incarnations for the rest of the session. 135;; have to stick with their standard incarnations for the rest of the session.
151 136
152;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before
153;; you byte-compile a file, because advised special forms and macros can lead
154;; to unwanted compilation results. When you are done compiling use
155;; `M-x ad-activate-all' to go back to the advised state of all your
156;; advised functions.
157
158;; RELAX: Advice is pretty safe even if you are oblivious to the above. 137;; RELAX: Advice is pretty safe even if you are oblivious to the above.
159;; I use it extensively and haven't run into any serious trouble in a long 138;; I use it extensively and haven't run into any serious trouble in a long
160;; time. Just wanted you to be warned. 139;; time. Just wanted you to be warned.
161 140
162;; @ Customization: 141;; @ Customization:
163;; ================ 142;; ================
164 143
165;; Look at the documentation of `ad-redefinition-action' for possible values 144;; Look at the documentation of `ad-redefinition-action' for possible values
166;; of this variable. Its default value is `warn' which will print a warning 145;; of this variable. Its default value is `warn' which will print a warning
167;; message when an already defined advised function gets redefined with a 146;; message when an already defined advised function gets redefined with a
168;; new original definition and de/activated. 147;; new original definition and de/activated.
169 148
170;; Look at the documentation of `ad-default-compilation-action' for possible 149;; Look at the documentation of `ad-default-compilation-action' for possible
171;; values of this variable. Its default value is `maybe' which will compile 150;; values of this variable. Its default value is `maybe' which will compile
172;; advised definitions during activation in case the byte-compiler is already 151;; advised definitions during activation in case the byte-compiler is already
173;; loaded. Otherwise, it will leave them uncompiled. 152;; loaded. Otherwise, it will leave them uncompiled.
174 153
175;; @ Motivation: 154;; @ Motivation:
176;; ============= 155;; =============
177;; Before I go on explaining how advice works, here are four simple examples 156;; Before I go on explaining how advice works, here are four simple examples
178;; how this package can be used. The first three are very useful, the last one 157;; how this package can be used. The first three are very useful, the last one
179;; is just a joke: 158;; is just a joke:
180 159
181;;(defadvice switch-to-buffer (before existing-buffers-only activate) 160;;(defadvice switch-to-buffer (before existing-buffers-only activate)
@@ -206,13 +185,12 @@
206 185
207;; @ Advice documentation: 186;; @ Advice documentation:
208;; ======================= 187;; =======================
209;; Below is general documentation of the various features of advice. For more 188;; Below is general documentation of the various features of advice. For more
210;; concrete examples check the corresponding sections in the tutorial part. 189;; concrete examples check the corresponding sections in the tutorial part.
211 190
212;; @@ Terminology: 191;; @@ Terminology:
213;; =============== 192;; ===============
214;; - Emacs: Emacs as released by the GNU Project 193;; - Emacs: Emacs as released by the GNU Project
215;; - jwz: Jamie Zawinski - creator of the byte-compiler used in v19s.
216;; - Advice: The name of this package. 194;; - Advice: The name of this package.
217;; - advices: Short for "pieces of advice". 195;; - advices: Short for "pieces of advice".
218 196
@@ -236,22 +214,22 @@
236;; <name> is the name of the advice which has to be a non-nil symbol. 214;; <name> is the name of the advice which has to be a non-nil symbol.
237;; Names uniquely identify a piece of advice in a certain advice class, 215;; Names uniquely identify a piece of advice in a certain advice class,
238;; hence, advices can be redefined by defining an advice with the same class 216;; hence, advices can be redefined by defining an advice with the same class
239;; and name. Advice names are global symbols, hence, the same name space 217;; and name. Advice names are global symbols, hence, the same name space
240;; conventions used for function names should be applied. 218;; conventions used for function names should be applied.
241 219
242;; An optional <position> specifies where in the current list of advices of 220;; An optional <position> specifies where in the current list of advices of
243;; the specified <class> this new advice will be placed. <position> has to 221;; the specified <class> this new advice will be placed. <position> has to
244;; be either `first', `last' or a number that specifies a zero-based 222;; be either `first', `last' or a number that specifies a zero-based
245;; position (`first' is equivalent to 0). If no position is specified 223;; position (`first' is equivalent to 0). If no position is specified
246;; `first' will be used as a default. If this call to `defadvice' redefines 224;; `first' will be used as a default. If this call to `defadvice' redefines
247;; an already existing advice (see above) then the position argument will 225;; an already existing advice (see above) then the position argument will
248;; be ignored and the position of the already existing advice will be used. 226;; be ignored and the position of the already existing advice will be used.
249 227
250;; An optional <arglist> which has to be a list can be used to define the 228;; An optional <arglist> which has to be a list can be used to define the
251;; argument list of the advised function. This argument list should of 229;; argument list of the advised function. This argument list should of
252;; course be compatible with the argument list of the original function, 230;; course be compatible with the argument list of the original function,
253;; otherwise functions that call the advised function with the original 231;; otherwise functions that call the advised function with the original
254;; argument list in mind will break. If more than one advice specify an 232;; argument list in mind will break. If more than one advice specify an
255;; argument list then the first one (the one with the smallest position) 233;; argument list then the first one (the one with the smallest position)
256;; found in the list of before/around/after advices will be used. 234;; found in the list of before/around/after advices will be used.
257 235
@@ -267,10 +245,10 @@
267;; `disable': Specifies that the defined advice should be disabled, hence, 245;; `disable': Specifies that the defined advice should be disabled, hence,
268;; it will not be used in an activation until somebody enables it. 246;; it will not be used in an activation until somebody enables it.
269;; `preactivate': Specifies that the advised function should get preactivated 247;; `preactivate': Specifies that the advised function should get preactivated
270;; at macro-expansion/compile time of this `defadvice'. This 248;; at macro-expansion/compile time of this `defadvice'. This
271;; generates a compiled advised definition according to the 249;; generates a compiled advised definition according to the
272;; current advice state which will be used during activation 250;; current advice state which will be used during activation
273;; if appropriate. Only use this if the `defadvice' gets 251;; if appropriate. Only use this if the `defadvice' gets
274;; actually compiled. 252;; actually compiled.
275 253
276;; An optional <documentation-string> can be supplied to document the advice. 254;; An optional <documentation-string> can be supplied to document the advice.
@@ -278,20 +256,20 @@
278;; documentation strings of the original function and other advices. 256;; documentation strings of the original function and other advices.
279 257
280;; An optional <interactive-form> form can be supplied to change/add 258;; An optional <interactive-form> form can be supplied to change/add
281;; interactive behavior of the original function. If more than one advice 259;; interactive behavior of the original function. If more than one advice
282;; has an `(interactive ...)' specification then the first one (the one 260;; has an `(interactive ...)' specification then the first one (the one
283;; with the smallest position) found in the list of before/around/after 261;; with the smallest position) found in the list of before/around/after
284;; advices will be used. 262;; advices will be used.
285 263
286;; A possibly empty list of <body-forms> specifies the body of the advice in 264;; A possibly empty list of <body-forms> specifies the body of the advice in
287;; an implicit progn. The body of an advice can access/change arguments, 265;; an implicit progn. The body of an advice can access/change arguments,
288;; the return value, the binding environment, and can have all sorts of 266;; the return value, the binding environment, and can have all sorts of
289;; other side effects. 267;; other side effects.
290 268
291;; @@ Assembling advised definitions: 269;; @@ Assembling advised definitions:
292;; ================================== 270;; ==================================
293;; Suppose a function/macro/subr/special-form has N pieces of before advice, 271;; Suppose a function/macro/subr/special-form has N pieces of before advice,
294;; M pieces of around advice and K pieces of after advice. Assuming none of 272;; M pieces of around advice and K pieces of after advice. Assuming none of
295;; the advices is protected, its advised definition will look like this 273;; the advices is protected, its advised definition will look like this
296;; (body-form indices correspond to the position of the respective advice in 274;; (body-form indices correspond to the position of the respective advice in
297;; that advice class): 275;; that advice class):
@@ -330,11 +308,11 @@
330;; be expanded into a proper documentation string upon call of `documentation'. 308;; be expanded into a proper documentation string upon call of `documentation'.
331 309
332;; (interactive ...) is an optional interactive form either taken from the 310;; (interactive ...) is an optional interactive form either taken from the
333;; original function or from a before/around/after advice. For advised 311;; original function or from a before/around/after advice. For advised
334;; interactive subrs that do not have an interactive form specified in any 312;; interactive subrs that do not have an interactive form specified in any
335;; advice we have to use (interactive) and then call the subr interactively 313;; advice we have to use (interactive) and then call the subr interactively
336;; if the advised function was called interactively, because the 314;; if the advised function was called interactively, because the
337;; interactive specification of subrs is not accessible. This is the only 315;; interactive specification of subrs is not accessible. This is the only
338;; case where changing the values of arguments will not have an affect 316;; case where changing the values of arguments will not have an affect
339;; because they will be reset by the interactive specification of the subr. 317;; because they will be reset by the interactive specification of the subr.
340;; If this is a problem one can always specify an interactive form in a 318;; If this is a problem one can always specify an interactive form in a
@@ -343,45 +321,44 @@
343;; 321;;
344;; Then the body forms of the various advices in the various classes of advice 322;; Then the body forms of the various advices in the various classes of advice
345;; are assembled in order. The forms of around advice L are normally part of 323;; are assembled in order. The forms of around advice L are normally part of
346;; one of the forms of around advice L-1. An around advice can specify where 324;; one of the forms of around advice L-1. An around advice can specify where
347;; the forms of the wrapped or surrounded forms should go with the special 325;; the forms of the wrapped or surrounded forms should go with the special
348;; keyword `ad-do-it', which will be substituted with a `progn' containing the 326;; keyword `ad-do-it', which will run the forms of the surrounded code.
349;; forms of the surrounded code.
350 327
351;; The innermost part of the around advice onion is 328;; The innermost part of the around advice onion is
352;; <apply original definition to <arglist>> 329;; <apply original definition to <arglist>>
353;; whose form depends on the type of the original function. The variable 330;; whose form depends on the type of the original function. The variable
354;; `ad-return-value' will be set to its result. This variable is visible to 331;; `ad-return-value' will be set to its result. This variable is visible to
355;; all pieces of advice which can access and modify it before it gets returned. 332;; all pieces of advice which can access and modify it before it gets returned.
356;; 333;;
357;; The semantic structure of advised functions that contain protected pieces 334;; The semantic structure of advised functions that contain protected pieces
358;; of advice is the same. The only difference is that `unwind-protect' forms 335;; of advice is the same. The only difference is that `unwind-protect' forms
359;; make sure that the protected advice gets executed even if some previous 336;; make sure that the protected advice gets executed even if some previous
360;; piece of advice had an error or a non-local exit. If any around advice is 337;; piece of advice had an error or a non-local exit. If any around advice is
361;; protected then the whole around advice onion will be protected. 338;; protected then the whole around advice onion will be protected.
362 339
363;; @@ Argument access in advised functions: 340;; @@ Argument access in advised functions:
364;; ======================================== 341;; ========================================
365;; As already mentioned, the simplest way to access the arguments of an 342;; As already mentioned, the simplest way to access the arguments of an
366;; advised function in the body of an advice is to refer to them by name. To 343;; advised function in the body of an advice is to refer to them by name.
367;; do that, the advice programmer needs to know either the names of the 344;; To do that, the advice programmer needs to know either the names of the
368;; argument variables of the original function, or the names used in the 345;; argument variables of the original function, or the names used in the
369;; argument list redefinition given in a piece of advice. While this simple 346;; argument list redefinition given in a piece of advice. While this simple
370;; method might be sufficient in many cases, it has the disadvantage that it 347;; method might be sufficient in many cases, it has the disadvantage that it
371;; is not very portable because it hardcodes the argument names into the 348;; is not very portable because it hardcodes the argument names into the
372;; advice. If the definition of the original function changes the advice 349;; advice. If the definition of the original function changes the advice
373;; might break even though the code might still be correct. Situations like 350;; might break even though the code might still be correct. Situations like
374;; that arise, for example, if one advises a subr like `eval-region' which 351;; that arise, for example, if one advises a subr like `eval-region' which
375;; gets redefined in a non-advice style into a function by the edebug 352;; gets redefined in a non-advice style into a function by the edebug
376;; package. If the advice assumes `eval-region' to be a subr it might break 353;; package. If the advice assumes `eval-region' to be a subr it might break
377;; once edebug is loaded. Similar situations arise when one wants to use the 354;; once edebug is loaded. Similar situations arise when one wants to use the
378;; same piece of advice across different versions of Emacs. 355;; same piece of advice across different versions of Emacs.
379 356
380;; As a solution to that advice provides argument list access macros that get 357;; As a solution to that advice provides argument list access macros that get
381;; translated into the proper access forms at activation time, i.e., when the 358;; translated into the proper access forms at activation time, i.e., when the
382;; advised definition gets constructed. Access macros access actual arguments 359;; advised definition gets constructed. Access macros access actual arguments
383;; by position regardless of how these actual argument get distributed onto 360;; by position regardless of how these actual argument get distributed onto
384;; the argument variables of a function. The rational behind this is that in 361;; the argument variables of a function. The rational behind this is that in
385;; Emacs Lisp the semantics of an argument is strictly determined by its 362;; Emacs Lisp the semantics of an argument is strictly determined by its
386;; position (there are no keyword arguments). 363;; position (there are no keyword arguments).
387 364
@@ -393,9 +370,9 @@
393;; 370;;
394;; (foo 0 1 2 3 4 5 6) 371;; (foo 0 1 2 3 4 5 6)
395 372
396;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that 373;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that
397;; the semantics of an actual argument is determined by its position. It is 374;; the semantics of an actual argument is determined by its position. It is
398;; this semantics that has to be known by the advice programmer. Then s/he 375;; this semantics that has to be known by the advice programmer. Then s/he
399;; can access these arguments in a piece of advice with some of the 376;; can access these arguments in a piece of advice with some of the
400;; following macros (the arrows indicate what value they will return): 377;; following macros (the arrows indicate what value they will return):
401 378
@@ -408,17 +385,17 @@
408 385
409;; `(ad-get-arg <position>)' will return the actual argument that was supplied 386;; `(ad-get-arg <position>)' will return the actual argument that was supplied
410;; at <position>, `(ad-get-args <position>)' will return the list of actual 387;; at <position>, `(ad-get-args <position>)' will return the list of actual
411;; arguments supplied starting at <position>. Note that these macros can be 388;; arguments supplied starting at <position>. Note that these macros can be
412;; used without any knowledge about the form of the actual argument list of 389;; used without any knowledge about the form of the actual argument list of
413;; the original function. 390;; the original function.
414 391
415;; Similarly, `(ad-set-arg <position> <value-form>)' can be used to set the 392;; Similarly, `(ad-set-arg <position> <value-form>)' can be used to set the
416;; value of the actual argument at <position> to <value-form>. For example, 393;; value of the actual argument at <position> to <value-form>. For example,
417;; 394;;
418;; (ad-set-arg 5 "five") 395;; (ad-set-arg 5 "five")
419;; 396;;
420;; will have the effect that R=(3 4 "five" 6) once the original function is 397;; will have the effect that R=(3 4 "five" 6) once the original function is
421;; called. `(ad-set-args <position> <value-list-form>)' can be used to set 398;; called. `(ad-set-args <position> <value-list-form>)' can be used to set
422;; the list of actual arguments starting at <position> to <value-list-form>. 399;; the list of actual arguments starting at <position> to <value-list-form>.
423;; For example, 400;; For example,
424;; 401;;
@@ -427,7 +404,7 @@
427;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original 404;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original
428;; function is called. 405;; function is called.
429 406
430;; All these access macros are text macros rather than real Lisp macros. When 407;; All these access macros are text macros rather than real Lisp macros. When
431;; the advised definition gets constructed they get replaced with actual access 408;; the advised definition gets constructed they get replaced with actual access
432;; forms depending on the argument list of the advised function, i.e., after 409;; forms depending on the argument list of the advised function, i.e., after
433;; that argument access is in most cases as efficient as using the argument 410;; that argument access is in most cases as efficient as using the argument
@@ -437,7 +414,7 @@
437;; ======================================================= 414;; =======================================================
438;; Some functions (such as `trace-function' defined in trace.el) need a 415;; Some functions (such as `trace-function' defined in trace.el) need a
439;; method of accessing the names and bindings of the arguments of an 416;; method of accessing the names and bindings of the arguments of an
440;; arbitrary advised function. To do that within an advice one can use the 417;; arbitrary advised function. To do that within an advice one can use the
441;; special keyword `ad-arg-bindings' which is a text macro that will be 418;; special keyword `ad-arg-bindings' which is a text macro that will be
442;; substituted with a form that will evaluate to a list of binding 419;; substituted with a form that will evaluate to a list of binding
443;; specifications, one for every argument variable. These binding 420;; specifications, one for every argument variable. These binding
@@ -463,7 +440,7 @@
463;; ========================== 440;; ==========================
464;; Because `defadvice' allows the specification of the argument list 441;; Because `defadvice' allows the specification of the argument list
465;; of the advised function we need a mapping mechanism that maps this 442;; of the advised function we need a mapping mechanism that maps this
466;; argument list onto that of the original function. Hence SYM and 443;; argument list onto that of the original function. Hence SYM and
467;; NEWDEF have to be properly mapped onto the &rest variable when the 444;; NEWDEF have to be properly mapped onto the &rest variable when the
468;; original definition is called. Advice automatically takes care of 445;; original definition is called. Advice automatically takes care of
469;; that mapping, hence, the advice programmer can specify an argument 446;; that mapping, hence, the advice programmer can specify an argument
@@ -474,11 +451,10 @@
474;; @@ Activation and deactivation: 451;; @@ Activation and deactivation:
475;; =============================== 452;; ===============================
476;; The definition of an advised function does not change until all its advice 453;; The definition of an advised function does not change until all its advice
477;; gets actually activated. Activation can either happen with the `activate' 454;; gets actually activated. Activation can either happen with the `activate'
478;; flag specified in the `defadvice', with an explicit call or interactive 455;; flag specified in the `defadvice', with an explicit call or interactive
479;; invocation of `ad-activate', or if forward advice is enabled (i.e., the 456;; invocation of `ad-activate', or at the time an already advised function
480;; value of `ad-activate-on-definition' is t) at the time an already advised 457;; gets defined.
481;; function gets defined.
482 458
483;; When a function gets first activated its original definition gets saved, 459;; When a function gets first activated its original definition gets saved,
484;; all defined and enabled pieces of advice will get combined with the 460;; all defined and enabled pieces of advice will get combined with the
@@ -496,7 +472,7 @@
496;; the file that contained the `defadvice' with the `preactivate' flag. 472;; the file that contained the `defadvice' with the `preactivate' flag.
497 473
498;; `ad-deactivate' can be used to back-define an advised function to its 474;; `ad-deactivate' can be used to back-define an advised function to its
499;; original definition. It can be called interactively or directly. Because 475;; original definition. It can be called interactively or directly. Because
500;; `ad-activate' caches the advised definition the function can be 476;; `ad-activate' caches the advised definition the function can be
501;; reactivated via `ad-activate' with only minor overhead (it is checked 477;; reactivated via `ad-activate' with only minor overhead (it is checked
502;; whether the current advice state is consistent with the cached 478;; whether the current advice state is consistent with the cached
@@ -504,12 +480,12 @@
504 480
505;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate 481;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate
506;; all currently advised function that have a piece of advice with a name that 482;; all currently advised function that have a piece of advice with a name that
507;; contains a match for a regular expression. These functions can be used to 483;; contains a match for a regular expression. These functions can be used to
508;; de/activate sets of functions depending on certain advice naming 484;; de/activate sets of functions depending on certain advice naming
509;; conventions. 485;; conventions.
510 486
511;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to 487;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to
512;; de/activate all currently advised functions. These are useful to 488;; de/activate all currently advised functions. These are useful to
513;; (temporarily) return to an un/advised state. 489;; (temporarily) return to an un/advised state.
514 490
515;; @@@ Reasons for the separation of advice definition and activation: 491;; @@@ Reasons for the separation of advice definition and activation:
@@ -521,26 +497,26 @@
521 497
522;; The advantage of this is that various pieces of advice can be defined 498;; The advantage of this is that various pieces of advice can be defined
523;; before they get combined into an advised definition which avoids 499;; before they get combined into an advised definition which avoids
524;; unnecessary constructions of intermediate advised definitions. The more 500;; unnecessary constructions of intermediate advised definitions. The more
525;; important advantage is that it allows the implementation of forward advice. 501;; important advantage is that it allows the implementation of forward advice.
526;; Advice information for a certain function accumulates as the value of the 502;; Advice information for a certain function accumulates as the value of the
527;; `advice-info' property of the function symbol. This accumulation is 503;; `advice-info' property of the function symbol. This accumulation is
528;; completely independent of the fact that that function might not yet be 504;; completely independent of the fact that that function might not yet be
529;; defined. The special forms `defun' and `defmacro' have been advised to 505;; defined. The macros `defun' and `defmacro' check whether the
530;; check whether the function/macro they defined had advice information 506;; function/macro they defined had advice information
531;; associated with it. If so and forward advice is enabled, the original 507;; associated with it. If so and forward advice is enabled, the original
532;; definition will be saved, and then the advice will be activated. 508;; definition will be saved, and then the advice will be activated.
533 509
534;; @@ Enabling/disabling pieces or sets of advice: 510;; @@ Enabling/disabling pieces or sets of advice:
535;; =============================================== 511;; ===============================================
536;; A major motivation for the development of this advice package was to bring 512;; A major motivation for the development of this advice package was to bring
537;; a little bit more structure into the function overloading chaos in Emacs 513;; a little bit more structure into the function overloading chaos in Emacs
538;; Lisp. Many packages achieve some of their functionality by adding a little 514;; Lisp. Many packages achieve some of their functionality by adding a little
539;; bit (or a lot) to the standard functionality of some Emacs Lisp function. 515;; bit (or a lot) to the standard functionality of some Emacs Lisp function.
540;; ange-ftp is a very popular package that achieves its magic by overloading 516;; ange-ftp is a very popular package that used to achieve its magic by
541;; most Emacs Lisp functions that deal with files. A popular function that's 517;; overloading most Emacs Lisp functions that deal with files. A popular
542;; overloaded by many packages is `expand-file-name'. The situation that one 518;; function that's overloaded by many packages is `expand-file-name'.
543;; function is multiply overloaded can arise easily. 519;; The situation that one function is multiply overloaded can arise easily.
544 520
545;; Once in a while it would be desirable to be able to disable some/all 521;; Once in a while it would be desirable to be able to disable some/all
546;; overloads of a particular package while keeping all the rest. Ideally - 522;; overloads of a particular package while keeping all the rest. Ideally -
@@ -548,7 +524,7 @@
548;; I know I am dreaming right now... In that ideal case the enable/disable 524;; I know I am dreaming right now... In that ideal case the enable/disable
549;; mechanism of advice could be used to achieve just that. 525;; mechanism of advice could be used to achieve just that.
550 526
551;; Every piece of advice is associated with an enablement flag. When the 527;; Every piece of advice is associated with an enablement flag. When the
552;; advised definition of a particular function gets constructed (e.g., during 528;; advised definition of a particular function gets constructed (e.g., during
553;; activation) only the currently enabled pieces of advice will be considered. 529;; activation) only the currently enabled pieces of advice will be considered.
554;; This mechanism allows one to have different "views" of an advised function 530;; This mechanism allows one to have different "views" of an advised function
@@ -556,17 +532,15 @@
556 532
557;; Another motivation for this mechanism is that it allows one to define a 533;; Another motivation for this mechanism is that it allows one to define a
558;; piece of advice for some function yet keep it dormant until a certain 534;; piece of advice for some function yet keep it dormant until a certain
559;; condition is met. Until then activation of the function will not make use 535;; condition is met. Until then activation of the function will not make use
560;; of that piece of advice. Once the condition is met the advice can be 536;; of that piece of advice. Once the condition is met the advice can be
561;; enabled and a reactivation of the function will add its functionality as 537;; enabled and a reactivation of the function will add its functionality as
562;; part of the new advised definition. For example, the advices of `defun' 538;; part of the new advised definition. Hence, if somebody
563;; etc. used by advice itself will stay disabled until `ad-start-advice' is
564;; called and some variables have the proper values. Hence, if somebody
565;; else advised these functions too and activates them the advices defined 539;; else advised these functions too and activates them the advices defined
566;; by advice will get used only if they are intended to be used. 540;; by advice will get used only if they are intended to be used.
567 541
568;; The main interface to this mechanism are the interactive functions 542;; The main interface to this mechanism are the interactive functions
569;; `ad-enable-advice' and `ad-disable-advice'. For example, the following 543;; `ad-enable-advice' and `ad-disable-advice'. For example, the following
570;; would disable a particular advice of the function `foo': 544;; would disable a particular advice of the function `foo':
571;; 545;;
572;; (ad-disable-advice 'foo 'before 'my-advice) 546;; (ad-disable-advice 'foo 'before 'my-advice)
@@ -576,28 +550,28 @@
576;; 550;;
577;; (ad-activate 'foo) 551;; (ad-activate 'foo)
578;; 552;;
579;; or interactively. To disable whole sets of advices one can use a regular 553;; or interactively. To disable whole sets of advices one can use a regular
580;; expression mechanism. For example, let us assume that ange-ftp actually 554;; expression mechanism. For example, let us assume that ange-ftp actually
581;; used advice to overload all its functions, and that it used the 555;; used advice to overload all its functions, and that it used the
582;; "ange-ftp-" prefix for all its advice names, then we could temporarily 556;; "ange-ftp-" prefix for all its advice names, then we could temporarily
583;; disable all its advices with 557;; disable all its advices with
584;; 558;;
585;; (ad-disable-regexp "^ange-ftp-") 559;; (ad-disable-regexp "\\`ange-ftp-")
586;; 560;;
587;; and the following call would put that actually into effect: 561;; and the following call would put that actually into effect:
588;; 562;;
589;; (ad-activate-regexp "^ange-ftp-") 563;; (ad-activate-regexp "\\`ange-ftp-")
590;; 564;;
591;; A safer way would have been to use 565;; A safer way would have been to use
592;; 566;;
593;; (ad-update-regexp "^ange-ftp-") 567;; (ad-update-regexp "\\`ange-ftp-")
594;; 568;;
595;; instead which would have only reactivated currently actively advised 569;; instead which would have only reactivated currently actively advised
596;; functions, but not functions that were currently inactive. All these 570;; functions, but not functions that were currently inactive. All these
597;; functions can also be called interactively. 571;; functions can also be called interactively.
598 572
599;; A certain piece of advice is considered a match if its name contains a 573;; A certain piece of advice is considered a match if its name contains a
600;; match for the regular expression. To enable ange-ftp again we would use 574;; match for the regular expression. To enable ange-ftp again we would use
601;; `ad-enable-regexp' and then activate or update again. 575;; `ad-enable-regexp' and then activate or update again.
602 576
603;; @@ Forward advice, automatic advice activation: 577;; @@ Forward advice, automatic advice activation:
@@ -616,7 +590,7 @@
616;; of advice definition and activation that makes it possible to accumulate 590;; of advice definition and activation that makes it possible to accumulate
617;; advice information without having the original function already defined, 591;; advice information without having the original function already defined,
618;; 2) special versions of the built-in functions `fset/defalias' which check 592;; 2) special versions of the built-in functions `fset/defalias' which check
619;; for advice information whenever they define a function. If advice 593;; for advice information whenever they define a function. If advice
620;; information was found then the advice will immediately get activated when 594;; information was found then the advice will immediately get activated when
621;; the function gets defined. 595;; the function gets defined.
622 596
@@ -625,16 +599,11 @@
625;; file, and the function has some advice-info stored with it then that 599;; file, and the function has some advice-info stored with it then that
626;; advice will get activated right away. 600;; advice will get activated right away.
627 601
628;; @@@ Enabling automatic advice activation:
629;; =========================================
630;; Automatic advice activation is enabled by default. It can be disabled with
631;; `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'.
632
633;; @@ Caching of advised definitions: 602;; @@ Caching of advised definitions:
634;; ================================== 603;; ==================================
635;; After an advised definition got constructed it gets cached as part of the 604;; After an advised definition got constructed it gets cached as part of the
636;; advised function's advice-info so it can be reused, for example, after an 605;; advised function's advice-info so it can be reused, for example, after an
637;; intermediate deactivation. Because the advice-info of a function might 606;; intermediate deactivation. Because the advice-info of a function might
638;; change between the time of caching and reuse a cached definition gets 607;; change between the time of caching and reuse a cached definition gets
639;; a cache-id associated with it so it can be verified whether the cached 608;; a cache-id associated with it so it can be verified whether the cached
640;; definition is still valid (the main application of this is preactivation 609;; definition is still valid (the main application of this is preactivation
@@ -642,19 +611,19 @@
642 611
643;; When an advised function gets activated and a verifiable cached definition 612;; When an advised function gets activated and a verifiable cached definition
644;; is available, then that definition will be used instead of creating a new 613;; is available, then that definition will be used instead of creating a new
645;; advised definition from scratch. If you want to make sure that a new 614;; advised definition from scratch. If you want to make sure that a new
646;; definition gets constructed then you should use `ad-clear-cache' before you 615;; definition gets constructed then you should use `ad-clear-cache' before you
647;; activate the advised function. 616;; activate the advised function.
648 617
649;; @@ Preactivation: 618;; @@ Preactivation:
650;; ================= 619;; =================
651;; Constructing an advised definition is moderately expensive. In a situation 620;; Constructing an advised definition is moderately expensive. In a situation
652;; where one package defines a lot of advised functions it might be 621;; where one package defines a lot of advised functions it might be
653;; prohibitively expensive to do all the advised definition construction at 622;; prohibitively expensive to do all the advised definition construction at
654;; runtime. Preactivation is a mechanism that allows compile-time construction 623;; runtime. Preactivation is a mechanism that allows compile-time construction
655;; of compiled advised definitions that can be activated cheaply during 624;; of compiled advised definitions that can be activated cheaply during
656;; runtime. Preactivation uses the caching mechanism to do that. Here's how it 625;; runtime. Preactivation uses the caching mechanism to do that. Here's how
657;; works: 626;; it works:
658 627
659;; When the byte-compiler compiles a `defadvice' that has the `preactivate' 628;; When the byte-compiler compiles a `defadvice' that has the `preactivate'
660;; flag specified, it uses the current original definition of the advised 629;; flag specified, it uses the current original definition of the advised
@@ -665,27 +634,27 @@
665;; byte-compiler. 634;; byte-compiler.
666;; When the file with the compiled, preactivating `defadvice' gets loaded the 635;; When the file with the compiled, preactivating `defadvice' gets loaded the
667;; precompiled advised definition will be cached on the advised function's 636;; precompiled advised definition will be cached on the advised function's
668;; advice-info. When it gets activated (can be immediately on execution of the 637;; advice-info. When it gets activated (can be immediately on execution of the
669;; `defadvice' or any time later) the cache-id gets checked against the 638;; `defadvice' or any time later) the cache-id gets checked against the
670;; current state of advice and if it is verified the precompiled definition 639;; current state of advice and if it is verified the precompiled definition
671;; will be used directly (the verification is pretty cheap). If it couldn't get 640;; will be used directly (the verification is pretty cheap). If it couldn't
672;; verified a new advised definition for that function will be built from 641;; get verified a new advised definition for that function will be built from
673;; scratch, hence, the efficiency added by the preactivation mechanism does 642;; scratch, hence, the efficiency added by the preactivation mechanism does not
674;; not at all impair the flexibility of the advice mechanism. 643;; at all impair the flexibility of the advice mechanism.
675 644
676;; MORAL: In order get all the efficiency out of preactivation the advice 645;; MORAL: In order get all the efficiency out of preactivation the advice
677;; state of an advised function at the time the file with the 646;; state of an advised function at the time the file with the
678;; preactivating `defadvice' gets byte-compiled should be exactly 647;; preactivating `defadvice' gets byte-compiled should be exactly
679;; the same as it will be when the advice of that function gets 648;; the same as it will be when the advice of that function gets
680;; actually activated. If it is not there is a high chance that the 649;; actually activated. If it is not there is a high chance that the
681;; cache-id will not match and hence a new advised definition will 650;; cache-id will not match and hence a new advised definition will
682;; have to be constructed at runtime. 651;; have to be constructed at runtime.
683 652
684;; Preactivation and forward advice do not contradict each other. It is 653;; Preactivation and forward advice do not contradict each other. It is
685;; perfectly ok to load a file with a preactivating `defadvice' before the 654;; perfectly ok to load a file with a preactivating `defadvice' before the
686;; original definition of the advised function is available. The constructed 655;; original definition of the advised function is available. The constructed
687;; advised definition will be used once the original function gets defined and 656;; advised definition will be used once the original function gets defined and
688;; its advice gets activated. The only constraint is that at the time the 657;; its advice gets activated. The only constraint is that at the time the
689;; file with the preactivating `defadvice' got compiled the original function 658;; file with the preactivating `defadvice' got compiled the original function
690;; definition was available. 659;; definition was available.
691 660
@@ -697,18 +666,18 @@
697;; - `byte-compile' is part of the `features' variable even though you 666;; - `byte-compile' is part of the `features' variable even though you
698;; did not use the byte-compiler 667;; did not use the byte-compiler
699;; Right now advice does not provide an elegant way to find out whether 668;; Right now advice does not provide an elegant way to find out whether
700;; and why a preactivation failed. What you can do is to trace the 669;; and why a preactivation failed. What you can do is to trace the
701;; function `ad-cache-id-verification-code' (with the function 670;; function `ad-cache-id-verification-code' (with the function
702;; `trace-function-background' defined in my trace.el package) before 671;; `trace-function-background' defined in my trace.el package) before
703;; any of your advised functions get activated. After they got 672;; any of your advised functions get activated. After they got
704;; activated check whether all calls to `ad-cache-id-verification-code' 673;; activated check whether all calls to `ad-cache-id-verification-code'
705;; returned `verified' as a result. Other values indicate why the 674;; returned `verified' as a result. Other values indicate why the
706;; verification failed which should give you enough information to 675;; verification failed which should give you enough information to
707;; fix your preactivation/compile/load/activation sequence. 676;; fix your preactivation/compile/load/activation sequence.
708 677
709;; IMPORTANT: There is one case (that I am aware of) that can make 678;; IMPORTANT: There is one case (that I am aware of) that can make
710;; preactivation fail, i.e., a preconstructed advised definition that does 679;; preactivation fail, i.e., a preconstructed advised definition that does
711;; NOT match the current state of advice gets used nevertheless. That case 680;; NOT match the current state of advice gets used nevertheless. That case
712;; arises if one package defines a certain piece of advice which gets used 681;; arises if one package defines a certain piece of advice which gets used
713;; during preactivation, and another package incompatibly redefines that 682;; during preactivation, and another package incompatibly redefines that
714;; very advice (i.e., same function/class/name), and it is the second advice 683;; very advice (i.e., same function/class/name), and it is the second advice
@@ -720,30 +689,20 @@
720;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with 689;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with
721;; George Walker Bush), and why would you redefine your own advice anyway? 690;; George Walker Bush), and why would you redefine your own advice anyway?
722;; Advice is a mechanism to facilitate function redefinition, not advice 691;; Advice is a mechanism to facilitate function redefinition, not advice
723;; redefinition (wait until I write Meta-Advice :-). If you really have 692;; redefinition (wait until I write Meta-Advice :-). If you really have
724;; to undo somebody else's advice try to write a "neutralizing" advice. 693;; to undo somebody else's advice, try to write a "neutralizing" advice.
725 694
726;; @@ Advising macros and special forms and other dangerous things: 695;; @@ Advising macros and other dangerous things:
727;; ================================================================ 696;; ==============================================
728;; Look at the corresponding tutorial sections for more information on 697;; Look at the corresponding tutorial sections for more information on
729;; these topics. Here it suffices to point out that the special treatment 698;; these topics. Here it suffices to point out that the special treatment
730;; of macros and special forms by the byte-compiler can lead to problems 699;; of macros can lead to problems when they get advised. Macros can create
731;; when they get advised. Macros can create problems because they get 700;; problems because they get expanded at compile or load time, hence, they
732;; expanded at compile time, hence, they might not have all the necessary 701;; might not have all the necessary runtime support and such advice cannot be
733;; runtime support and such advice cannot be de/activated or changed as 702;; de/activated or changed as it is possible for functions.
734;; it is possible for functions. Special forms create problems because they 703;; Special forms cannot be advised.
735;; have to be advised "into" macros, i.e., an advised special form is a 704;;
736;; implemented as a macro, hence, in most cases the byte-compiler will 705;; MORAL: - Only advise macros when you are absolutely sure what you are doing.
737;; not recognize it as a special form anymore which can lead to very strange
738;; results.
739;;
740;; MORAL: - Only advise macros or special forms when you are absolutely sure
741;; what you are doing.
742;; - As a safety measure, always do `ad-deactivate-all' before you
743;; byte-compile a file to make sure that even if some inconsiderate
744;; person advised some special forms you'll get proper compilation
745;; results. After compilation do `ad-activate-all' to get back to
746;; the previous state.
747 706
748;; @@ Adding a piece of advice with `ad-add-advice': 707;; @@ Adding a piece of advice with `ad-add-advice':
749;; ================================================= 708;; =================================================
@@ -754,10 +713,10 @@
754;; @@ Activation/deactivation advices, file load hooks: 713;; @@ Activation/deactivation advices, file load hooks:
755;; ==================================================== 714;; ====================================================
756;; There are two special classes of advice called `activation' and 715;; There are two special classes of advice called `activation' and
757;; `deactivation'. The body forms of these advices are not included into the 716;; `deactivation'. The body forms of these advices are not included into the
758;; advised definition of a function, rather they are assembled into a hook 717;; advised definition of a function, rather they are assembled into a hook
759;; form which will be evaluated whenever the advice-info of the advised 718;; form which will be evaluated whenever the advice-info of the advised
760;; function gets activated or deactivated. One application of this mechanism 719;; function gets activated or deactivated. One application of this mechanism
761;; is to define file load hooks for files that do not provide such hooks. 720;; is to define file load hooks for files that do not provide such hooks.
762;; For example, suppose you want to print a message whenever `file-x' gets 721;; For example, suppose you want to print a message whenever `file-x' gets
763;; loaded, and suppose the last function defined in `file-x' is 722;; loaded, and suppose the last function defined in `file-x' is
@@ -769,7 +728,7 @@
769;; 728;;
770;; This will constitute a forward advice for function `file-x-last-fn' which 729;; This will constitute a forward advice for function `file-x-last-fn' which
771;; will get activated when `file-x' is loaded (only if forward advice is 730;; will get activated when `file-x' is loaded (only if forward advice is
772;; enabled of course). Because there are no "real" pieces of advice 731;; enabled of course). Because there are no "real" pieces of advice
773;; available for it, its definition will not be changed, but the activation 732;; available for it, its definition will not be changed, but the activation
774;; advice will be run during its activation which is equivalent to having a 733;; advice will be run during its activation which is equivalent to having a
775;; file load hook for `file-x'. 734;; file load hook for `file-x'.
@@ -784,14 +743,14 @@
784;; enabled advices are considered during construction of an advised 743;; enabled advices are considered during construction of an advised
785;; definition. 744;; definition.
786;; - Activation: 745;; - Activation:
787;; Redefine an advised function with its advised definition. Constructs 746;; Redefine an advised function with its advised definition. Constructs
788;; an advised definition from scratch if no verifiable cached advised 747;; an advised definition from scratch if no verifiable cached advised
789;; definition is available and caches it. 748;; definition is available and caches it.
790;; - Deactivation: 749;; - Deactivation:
791;; Back-define an advised function to its original definition. 750;; Back-define an advised function to its original definition.
792;; - Update: 751;; - Update:
793;; Reactivate an advised function but only if its advice is currently 752;; Reactivate an advised function but only if its advice is currently
794;; active. This can be used to bring all currently advised function up 753;; active. This can be used to bring all currently advised function up
795;; to date with the current state of advice without also activating 754;; to date with the current state of advice without also activating
796;; currently inactive functions. 755;; currently inactive functions.
797;; - Caching: 756;; - Caching:
@@ -800,7 +759,7 @@
800;; - Preactivation: 759;; - Preactivation:
801;; Is the construction of an advised definition according to the current 760;; Is the construction of an advised definition according to the current
802;; state of advice during byte-compilation of a file with a preactivating 761;; state of advice during byte-compilation of a file with a preactivating
803;; `defadvice'. That advised definition can then rather cheaply be used 762;; `defadvice'. That advised definition can then rather cheaply be used
804;; during activation without having to construct an advised definition 763;; during activation without having to construct an advised definition
805;; from scratch at runtime. 764;; from scratch at runtime.
806 765
@@ -860,12 +819,8 @@
860 819
861;; @ Foo games: An advice tutorial 820;; @ Foo games: An advice tutorial
862;; =============================== 821;; ===============================
863;; The following tutorial was created in Emacs 18.59. Left-justified 822;; The following tutorial was created in Emacs 18.59. Left-justified
864;; s-expressions are input forms followed by one or more result forms. 823;; s-expressions are input forms followed by one or more result forms.
865;; First we have to start the advice magic:
866;;
867;; (ad-start-advice)
868;; nil
869;; 824;;
870;; We start by defining an innocent looking function `foo' that simply 825;; We start by defining an innocent looking function `foo' that simply
871;; adds 1 to its argument X: 826;; adds 1 to its argument X:
@@ -988,19 +943,6 @@
988;; (call-interactively 'foo) 943;; (call-interactively 'foo)
989;; 6 944;; 6
990;; 945;;
991;; Let's have a look at what the definition of `foo' looks like now
992;; (indentation added by hand for legibility):
993;;
994;; (symbol-function 'foo)
995;; (lambda (x)
996;; "$ad-doc: foo$"
997;; (interactive (list 5))
998;; (let (ad-return-value)
999;; (setq x (1- x))
1000;; (setq x (1+ x))
1001;; (setq ad-return-value (ad-Orig-foo x))
1002;; ad-return-value))
1003;;
1004;; @@ Around advices: 946;; @@ Around advices:
1005;; ================== 947;; ==================
1006;; Now we'll try some `around' advices. An around advice is a wrapper around 948;; Now we'll try some `around' advices. An around advice is a wrapper around
@@ -1038,20 +980,6 @@
1038;; (foo 3) 980;; (foo 3)
1039;; 8 981;; 8
1040;; 982;;
1041;; Again, let's see what the definition of `foo' looks like so far:
1042;;
1043;; (symbol-function 'foo)
1044;; (lambda (x)
1045;; "$ad-doc: foo$"
1046;; (interactive (list 5))
1047;; (let (ad-return-value)
1048;; (setq x (1- x))
1049;; (setq x (1+ x))
1050;; (let ((x (* x 2)))
1051;; (let ((x (1+ x)))
1052;; (setq ad-return-value (ad-Orig-foo x))))
1053;; ad-return-value))
1054;;
1055;; @@ Controlling advice activation: 983;; @@ Controlling advice activation:
1056;; ================================= 984;; =================================
1057;; In every `defadvice' so far we have used the flag `activate' to activate 985;; In every `defadvice' so far we have used the flag `activate' to activate
@@ -1071,9 +999,9 @@
1071;; 8 999;; 8
1072;; 1000;;
1073;; Now we define another advice and activate which will also activate the 1001;; Now we define another advice and activate which will also activate the
1074;; previous advice `fg-times-x'. Note the use of the special variable 1002;; previous advice `fg-times-x'. Note the use of the special variable
1075;; `ad-return-value' in the body of the advice which is set to the result of 1003;; `ad-return-value' in the body of the advice which is set to the result of
1076;; the original function. If we change its value then the value returned by 1004;; the original function. If we change its value then the value returned by
1077;; the advised function will be changed accordingly: 1005;; the advised function will be changed accordingly:
1078;; 1006;;
1079;; (defadvice foo (after fg-times-x-again act) 1007;; (defadvice foo (after fg-times-x-again act)
@@ -1121,24 +1049,6 @@
1121;; "Let's clean up now!" 1049;; "Let's clean up now!"
1122;; error-in-foo 1050;; error-in-foo
1123;; 1051;;
1124;; Again, let's see what `foo' looks like:
1125;;
1126;; (symbol-function 'foo)
1127;; (lambda (x)
1128;; "$ad-doc: foo$"
1129;; (interactive (list 5))
1130;; (let (ad-return-value)
1131;; (unwind-protect
1132;; (progn (setq x (1- x))
1133;; (setq x (1+ x))
1134;; (let ((x (* x 2)))
1135;; (let ((x (1+ x)))
1136;; (setq ad-return-value (ad-Orig-foo x))))
1137;; (setq ad-return-value (* ad-return-value x))
1138;; (setq ad-return-value (* ad-return-value x)))
1139;; (print "Let's clean up now!"))
1140;; ad-return-value))
1141;;
1142;; @@ Compilation of advised definitions: 1052;; @@ Compilation of advised definitions:
1143;; ====================================== 1053;; ======================================
1144;; Finally, we can specify the `compile' keyword in a `defadvice' to say 1054;; Finally, we can specify the `compile' keyword in a `defadvice' to say
@@ -1150,13 +1060,10 @@
1150;; (print "Let's clean up now!")) 1060;; (print "Let's clean up now!"))
1151;; foo 1061;; foo
1152;; 1062;;
1153;; Now `foo' is byte-compiled: 1063;; Now `foo's advice is byte-compiled:
1154;; 1064;;
1155;; (symbol-function 'foo) 1065;; (byte-code-function-p 'ad-Advice-foo)
1156;; (lambda (x) 1066;; t
1157;; "$ad-doc: foo$"
1158;; (interactive (byte-code "....." [5] 1))
1159;; (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6))
1160;; 1067;;
1161;; (foo 3) 1068;; (foo 3)
1162;; "Let's clean up now!" 1069;; "Let's clean up now!"
@@ -1262,7 +1169,7 @@
1262;; deactivate functions that have a piece of advice defined by a certain 1169;; deactivate functions that have a piece of advice defined by a certain
1263;; package (we save the old definition to check out caching): 1170;; package (we save the old definition to check out caching):
1264;; 1171;;
1265;; (setq old-definition (symbol-function 'foo)) 1172;; (setq old-definition (symbol-function 'ad-Advice-foo))
1266;; (lambda (x) ....) 1173;; (lambda (x) ....)
1267;; 1174;;
1268;; (ad-deactivate-regexp "^fg-") 1175;; (ad-deactivate-regexp "^fg-")
@@ -1274,7 +1181,7 @@
1274;; (ad-activate-regexp "^fg-") 1181;; (ad-activate-regexp "^fg-")
1275;; nil 1182;; nil
1276;; 1183;;
1277;; (eq old-definition (symbol-function 'foo)) 1184;; (eq old-definition (symbol-function 'ad-Advice-foo))
1278;; t 1185;; t
1279;; 1186;;
1280;; (foo 3) 1187;; (foo 3)
@@ -1283,14 +1190,6 @@
1283;; 1190;;
1284;; @@ Forward advice: 1191;; @@ Forward advice:
1285;; ================== 1192;; ==================
1286;; To enable automatic activation of forward advice we first have to set
1287;; `ad-activate-on-definition' to t and restart advice:
1288;;
1289;; (setq ad-activate-on-definition t)
1290;; t
1291;;
1292;; (ad-start-advice)
1293;; (ad-activate-defined-function)
1294;; 1193;;
1295;; Let's define a piece of advice for an undefined function: 1194;; Let's define a piece of advice for an undefined function:
1296;; 1195;;
@@ -1303,9 +1202,7 @@
1303;; (fboundp 'bar) 1202;; (fboundp 'bar)
1304;; nil 1203;; nil
1305;; 1204;;
1306;; Now we define it and the forward advice will get activated (only because 1205;; Now we define it and the forward advice will get activated:
1307;; `ad-activate-on-definition' was t when we started advice above with
1308;; `ad-start-advice'):
1309;; 1206;;
1310;; (defun bar (x) 1207;; (defun bar (x)
1311;; "Subtract 1 from X." 1208;; "Subtract 1 from X."
@@ -1357,7 +1254,7 @@
1357;; (ad-activate 'fie) 1254;; (ad-activate 'fie)
1358;; fie 1255;; fie
1359;; 1256;;
1360;; (eq cached-definition (symbol-function 'fie)) 1257;; (eq cached-definition (symbol-function 'ad-Advice-fie))
1361;; t 1258;; t
1362;; 1259;;
1363;; (fie 2) 1260;; (fie 2)
@@ -1365,7 +1262,7 @@
1365;; 1262;;
1366;; If you put a preactivating `defadvice' into a Lisp file that gets byte- 1263;; If you put a preactivating `defadvice' into a Lisp file that gets byte-
1367;; compiled then the constructed advised definition will get compiled by 1264;; compiled then the constructed advised definition will get compiled by
1368;; the byte-compiler. For that to occur in a v18 Emacs you had to put the 1265;; the byte-compiler. For that to occur in a v18 Emacs you had to put the
1369;; `defadvice' inside a `defun' because the v18 compiler did not compile 1266;; `defadvice' inside a `defun' because the v18 compiler did not compile
1370;; top-level forms other than `defun' or `defmacro', for example, 1267;; top-level forms other than `defun' or `defmacro', for example,
1371;; 1268;;
@@ -1407,18 +1304,16 @@
1407;; constructed during preactivation was used, even though we did not specify 1304;; constructed during preactivation was used, even though we did not specify
1408;; the `compile' flag: 1305;; the `compile' flag:
1409;; 1306;;
1410;; (symbol-function 'fum) 1307;; (byte-code-function-p 'ad-Advice-fum)
1411;; (lambda (x) 1308;; t
1412;; "$ad-doc: fum$"
1413;; (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4))
1414;; 1309;;
1415;; (fum 2) 1310;; (fum 2)
1416;; 8 1311;; 8
1417;; 1312;;
1418;; A preactivated definition will only be used if it matches the current 1313;; A preactivated definition will only be used if it matches the current
1419;; function definition and advice information. If it does not match it 1314;; function definition and advice information. If it does not match it
1420;; will simply be discarded and a new advised definition will be constructed 1315;; will simply be discarded and a new advised definition will be constructed
1421;; from scratch. For example, let's first remove all advice-info for `fum': 1316;; from scratch. For example, let's first remove all advice-info for `fum':
1422;; 1317;;
1423;; (ad-unadvise 'fum) 1318;; (ad-unadvise 'fum)
1424;; (("fie") ("bar") ("foo") ...) 1319;; (("fie") ("bar") ("foo") ...)
@@ -1431,7 +1326,7 @@
1431;; fum 1326;; fum
1432;; 1327;;
1433;; When we now try to use a preactivation it will not be used because the 1328;; When we now try to use a preactivation it will not be used because the
1434;; current advice state is different from the one at preactivation time. This 1329;; current advice state is different from the one at preactivation time. This
1435;; is no tragedy, everything will work as expected just not as efficient, 1330;; is no tragedy, everything will work as expected just not as efficient,
1436;; because a new advised definition has to be constructed from scratch: 1331;; because a new advised definition has to be constructed from scratch:
1437;; 1332;;
@@ -1440,7 +1335,7 @@
1440;; 1335;;
1441;; A new uncompiled advised definition got constructed: 1336;; A new uncompiled advised definition got constructed:
1442;; 1337;;
1443;; (ad-compiled-p (symbol-function 'fum)) 1338;; (byte-code-function-p 'ad-Advice-fum)
1444;; nil 1339;; nil
1445;; 1340;;
1446;; (fum 2) 1341;; (fum 2)
@@ -1448,7 +1343,7 @@
1448;; 1343;;
1449;; MORAL: To get all the efficiency out of preactivation the function 1344;; MORAL: To get all the efficiency out of preactivation the function
1450;; definition and advice state at preactivation time must be the same as the 1345;; definition and advice state at preactivation time must be the same as the
1451;; state at activation time. Preactivation does work with forward advice, all 1346;; state at activation time. Preactivation does work with forward advice, all
1452;; that's necessary is that the definition of the forward advised function is 1347;; that's necessary is that the definition of the forward advised function is
1453;; available when the `defadvice' with the preactivation gets compiled. 1348;; available when the `defadvice' with the preactivation gets compiled.
1454;; 1349;;
@@ -1702,15 +1597,9 @@
1702;; @@ Compilation idiosyncrasies: 1597;; @@ Compilation idiosyncrasies:
1703;; ============================== 1598;; ==============================
1704 1599
1705;; `defadvice' expansion needs quite a few advice functions and variables,
1706;; hence, I need to preload the file before it can be compiled. To avoid
1707;; interference of bogus compiled files I always preload the source file:
1708(provide 'advice-preload)
1709;; During a normal load this is a noop:
1710(require 'advice-preload "advice.el")
1711(require 'macroexp) 1600(require 'macroexp)
1712;; At run-time also, since ad-do-advised-functions returns code that uses it. 1601;; At run-time also, since ad-do-advised-functions returns code that uses it.
1713(require 'cl-lib) 1602(eval-when-compile (require 'cl-lib))
1714 1603
1715;; @@ Variable definitions: 1604;; @@ Variable definitions:
1716;; ======================== 1605;; ========================
@@ -1789,7 +1678,7 @@ generates a copy of TREE."
1789;; (after adv1 adv2 ...) 1678;; (after adv1 adv2 ...)
1790;; (activation adv1 adv2 ...) 1679;; (activation adv1 adv2 ...)
1791;; (deactivation adv1 adv2 ...) 1680;; (deactivation adv1 adv2 ...)
1792;; (origname . <symbol fbound to origdef>) 1681;; (advicefunname . <symbol fbound to assembled advice function>)
1793;; (cache . (<advised-definition> . <id>))) 1682;; (cache . (<advised-definition> . <id>)))
1794 1683
1795;; List of currently advised though not necessarily activated functions 1684;; List of currently advised though not necessarily activated functions
@@ -1816,7 +1705,7 @@ generates a copy of TREE."
1816On each iteration VAR will be bound to the name of an advised function 1705On each iteration VAR will be bound to the name of an advised function
1817\(a symbol)." 1706\(a symbol)."
1818 (declare (indent 1)) 1707 (declare (indent 1))
1819 `(cl-dolist (,(car varform) ad-advised-functions) 1708 `(dolist (,(car varform) ad-advised-functions)
1820 (setq ,(car varform) (intern (car ,(car varform)))) 1709 (setq ,(car varform) (intern (car ,(car varform))))
1821 ,@body)) 1710 ,@body))
1822 1711
@@ -1882,18 +1771,17 @@ either t or nil, and DEFINITION should be a list of the form
1882 1771
1883;; ad-find-advice uses the alist structure directly -> 1772;; ad-find-advice uses the alist structure directly ->
1884;; change if this data structure changes!! 1773;; change if this data structure changes!!
1885(defmacro ad-advice-name (advice) 1774(defsubst ad-advice-name (advice) (car advice))
1886 (list 'car advice)) 1775(defsubst ad-advice-protected (advice) (nth 1 advice))
1887(defmacro ad-advice-protected (advice) 1776(defsubst ad-advice-enabled (advice) (nth 2 advice))
1888 (list 'nth 1 advice)) 1777(defsubst ad-advice-definition (advice) (nth 3 advice))
1889(defmacro ad-advice-enabled (advice)
1890 (list 'nth 2 advice))
1891(defmacro ad-advice-definition (advice)
1892 (list 'nth 3 advice))
1893 1778
1894(defun ad-advice-set-enabled (advice flag) 1779(defun ad-advice-set-enabled (advice flag)
1895 (rplaca (cdr (cdr advice)) flag)) 1780 (rplaca (cdr (cdr advice)) flag))
1896 1781
1782(defvar ad-advice-classes '(before around after activation deactivation)
1783 "List of defined advice classes.")
1784
1897(defun ad-class-p (thing) 1785(defun ad-class-p (thing)
1898 (memq thing ad-advice-classes)) 1786 (memq thing ad-advice-classes))
1899(defun ad-name-p (thing) 1787(defun ad-name-p (thing)
@@ -1906,9 +1794,6 @@ either t or nil, and DEFINITION should be a list of the form
1906;; @@ Advice access functions: 1794;; @@ Advice access functions:
1907;; =========================== 1795;; ===========================
1908 1796
1909;; List of defined advice classes:
1910(defvar ad-advice-classes '(before around after activation deactivation))
1911
1912(defun ad-has-enabled-advice (function class) 1797(defun ad-has-enabled-advice (function class)
1913 "True if at least one of FUNCTION's advices in CLASS is enabled." 1798 "True if at least one of FUNCTION's advices in CLASS is enabled."
1914 (cl-dolist (advice (ad-get-advice-info-field function class)) 1799 (cl-dolist (advice (ad-get-advice-info-field function class))
@@ -1948,58 +1833,23 @@ Redefining advices affect the construction of an advised definition."
1948;; Whether advised definitions created by automatic activations will be 1833;; Whether advised definitions created by automatic activations will be
1949;; compiled depends on the value of `ad-default-compilation-action'. 1834;; compiled depends on the value of `ad-default-compilation-action'.
1950 1835
1951;; Since calling `ad-activate-internal' in the built-in definition of `fset' can 1836(defalias 'ad-activate-internal 'ad-activate)
1952;; create major disasters we have to be a bit careful. One precaution is
1953;; to provide a dummy definition for `ad-activate-internal' which can be used to
1954;; turn off automatic advice activation (e.g., when `ad-stop-advice' or
1955;; `ad-recover-normality' are called). Another is to avoid recursive calls
1956;; to `ad-activate' by using `ad-with-auto-activation-disabled' where
1957;; appropriate, especially in a safe version of `fset'.
1958
1959(defun ad--defalias-fset (fsetfun function definition)
1960 (funcall (or fsetfun #'fset) function definition)
1961 (ad-activate-internal function nil))
1962
1963;; For now define `ad-activate-internal' to the dummy definition:
1964(defun ad-activate-internal (_function &optional _compile)
1965 "Automatic advice activation is disabled. `ad-start-advice' enables it."
1966 nil)
1967
1968;; This is just a copy of the above:
1969(defun ad-activate-internal-off (_function &optional _compile)
1970 "Automatic advice activation is disabled. `ad-start-advice' enables it."
1971 nil)
1972
1973;; This will be t for top-level calls to `ad-activate-internal-on':
1974(defvar ad-activate-on-top-level t)
1975
1976(defmacro ad-with-auto-activation-disabled (&rest body)
1977 `(let ((ad-activate-on-top-level nil))
1978 ,@body))
1979
1980;; @@ Access functions for original definitions:
1981;; ============================================
1982;; The advice-info of an advised function contains its `origname' which is
1983;; a symbol that is fbound to the original definition available at the first
1984;; proper activation of the function after a valid re/definition. If the
1985;; original was defined via fcell indirection then `origname' will be defined
1986;; just so. Hence, to get hold of the actual original definition of a function
1987;; we need to use `ad-real-orig-definition'.
1988
1989(defun ad-make-origname (function)
1990 "Make name to be used to call the original FUNCTION."
1991 (intern (format "ad-Orig-%s" function)))
1992 1837
1993(defmacro ad-get-orig-definition (function) 1838(defun ad-make-advicefunname (function)
1994 `(let ((origname (ad-get-advice-info-field ,function 'origname))) 1839 "Make name to be used to call the assembled advice function."
1995 (if (fboundp origname) 1840 (intern (format "ad-Advice-%s" function)))
1996 (symbol-function origname))))
1997 1841
1998(defmacro ad-set-orig-definition (function definition) 1842(defun ad-get-orig-definition (function) ;FIXME: Rename to "-unadvised-".
1999 `(fset (ad-get-advice-info-field ,function 'origname) ,definition)) 1843 (if (symbolp function)
1844 (setq function (if (fboundp function)
1845 (advice--strip-macro (symbol-function function)))))
1846 (while (advice--p function) (setq function (advice--cdr function)))
1847 function)
2000 1848
2001(defmacro ad-clear-orig-definition (function) 1849(defun ad-clear-advicefunname-definition (function)
2002 `(fmakunbound (ad-get-advice-info-field ,function 'origname))) 1850 (let ((advicefunname (ad-get-advice-info-field function 'advicefunname)))
1851 (advice-remove function advicefunname)
1852 (fmakunbound advicefunname)))
2003 1853
2004 1854
2005;; @@ Interactive input functions: 1855;; @@ Interactive input functions:
@@ -2259,7 +2109,7 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
2259 (cond ((not (ad-is-advised function)) 2109 (cond ((not (ad-is-advised function))
2260 (ad-initialize-advice-info function) 2110 (ad-initialize-advice-info function)
2261 (ad-set-advice-info-field 2111 (ad-set-advice-info-field
2262 function 'origname (ad-make-origname function)))) 2112 function 'advicefunname (ad-make-advicefunname function))))
2263 (let* ((previous-position 2113 (let* ((previous-position
2264 (ad-advice-position function class (ad-advice-name advice))) 2114 (ad-advice-position function class (ad-advice-name advice)))
2265 (advices (ad-get-advice-info-field function class)) 2115 (advices (ad-get-advice-info-field function class))
@@ -2374,7 +2224,8 @@ the name of the advised function from the docstring. This is needed
2374to generate a proper advised docstring even if we are just given a 2224to generate a proper advised docstring even if we are just given a
2375definition (see the code for `documentation')." 2225definition (see the code for `documentation')."
2376 (eval-when-compile 2226 (eval-when-compile
2377 (propertize "Advice doc string" 'dynamic-docstring-function 2227 (propertize "Advice function assembled by advice.el."
2228 'dynamic-docstring-function
2378 #'ad--make-advised-docstring))) 2229 #'ad--make-advised-docstring)))
2379 2230
2380(defun ad-advised-definition-p (definition) 2231(defun ad-advised-definition-p (definition)
@@ -2388,16 +2239,15 @@ definition (see the code for `documentation')."
2388 2239
2389(defun ad-definition-type (definition) 2240(defun ad-definition-type (definition)
2390 "Return symbol that describes the type of DEFINITION." 2241 "Return symbol that describes the type of DEFINITION."
2242 ;; These symbols are only ever used to check a cache entry's validity.
2243 ;; The suffix `2' reflects the fact that we're using version 2 of advice
2244 ;; representations, so cache entries preactivated with version
2245 ;; 1 can't be used.
2391 (cond 2246 (cond
2392 ((ad-macro-p definition) 'macro) 2247 ((ad-macro-p definition) 'macro2)
2393 ((ad-subr-p definition) 2248 ((ad-subr-p definition) 'subr2)
2394 (if (special-form-p definition) 2249 ((or (ad-lambda-p definition) (ad-compiled-p definition)) 'fun2)
2395 'special-form 2250 ((ad-advice-p definition) 'advice2))) ;; FIXME: Can this ever happen?
2396 'subr))
2397 ((or (ad-lambda-p definition)
2398 (ad-compiled-p definition))
2399 'function)
2400 ((ad-advice-p definition) 'advice)))
2401 2251
2402(defun ad-has-proper-definition (function) 2252(defun ad-has-proper-definition (function)
2403 "True if FUNCTION is a symbol with a proper definition. 2253 "True if FUNCTION is a symbol with a proper definition.
@@ -2417,9 +2267,9 @@ For that it has to be fbound with a non-autoload definition."
2417 definition)))) 2267 definition))))
2418 2268
2419(defun ad-real-orig-definition (function) 2269(defun ad-real-orig-definition (function)
2420 "Find FUNCTION's real original definition starting from its `origname'." 2270 (let* ((fun1 (ad-get-orig-definition function))
2421 (if (ad-is-advised function) 2271 (fun2 (indirect-function fun1)))
2422 (ad-real-definition (ad-get-advice-info-field function 'origname)))) 2272 (unless (autoloadp fun2) fun2)))
2423 2273
2424(defun ad-is-compilable (function) 2274(defun ad-is-compilable (function)
2425 "True if FUNCTION has an interpreted definition that can be compiled." 2275 "True if FUNCTION has an interpreted definition that can be compiled."
@@ -2430,24 +2280,15 @@ For that it has to be fbound with a non-autoload definition."
2430 2280
2431(defvar warning-suppress-types) ;From warnings.el. 2281(defvar warning-suppress-types) ;From warnings.el.
2432(defun ad-compile-function (function) 2282(defun ad-compile-function (function)
2433 "Byte-compiles FUNCTION (or macro) if it is not yet compiled." 2283 "Byte-compile the assembled advice function."
2434 (interactive "aByte-compile function: ") 2284 (require 'bytecomp)
2435 (if (ad-is-compilable function) 2285 (require 'warnings) ;To define warning-suppress-types before we let-bind it.
2436 ;; Need to turn off auto-activation 2286 (let ((byte-compile-warnings byte-compile-warnings)
2437 ;; because `byte-compile' uses `fset': 2287 ;; Don't pop up windows showing byte-compiler warnings.
2438 (ad-with-auto-activation-disabled 2288 (warning-suppress-types '((bytecomp))))
2439 (require 'bytecomp) 2289 (if (featurep 'cl)
2440 (require 'warnings) ;To define warning-suppress-types 2290 (byte-compile-disable-warning 'cl-functions))
2441 ;before we let-bind it. 2291 (byte-compile (ad-get-advice-info-field function 'advicefunname))))
2442 (let ((symbol (make-symbol "advice-compilation"))
2443 (byte-compile-warnings byte-compile-warnings)
2444 ;; Don't pop up windows showing byte-compiler warnings.
2445 (warning-suppress-types '((bytecomp))))
2446 (if (featurep 'cl)
2447 (byte-compile-disable-warning 'cl-functions))
2448 (fset symbol (symbol-function function))
2449 (byte-compile symbol)
2450 (fset function (symbol-function symbol))))))
2451 2292
2452;; @@@ Accessing argument lists: 2293;; @@@ Accessing argument lists:
2453;; ============================= 2294;; =============================
@@ -2634,7 +2475,7 @@ Excess source arguments will be neglected, missing source arguments will be
2634supplied as nil. Returns a `funcall' or `apply' form with the second element 2475supplied as nil. Returns a `funcall' or `apply' form with the second element
2635being `function' which has to be replaced by an actual function argument. 2476being `function' which has to be replaced by an actual function argument.
2636Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return 2477Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
2637 `(funcall function a (car args) (car (cdr args)) (nth 2 args))'." 2478 `(funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))'."
2638 (let* ((parsed-source-arglist (ad-parse-arglist source-arglist)) 2479 (let* ((parsed-source-arglist (ad-parse-arglist source-arglist))
2639 (source-reqopt-args (append (nth 0 parsed-source-arglist) 2480 (source-reqopt-args (append (nth 0 parsed-source-arglist)
2640 (nth 1 parsed-source-arglist))) 2481 (nth 1 parsed-source-arglist)))
@@ -2648,7 +2489,7 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
2648 ;; This produces ``error-proof'' target function calls with the exception 2489 ;; This produces ``error-proof'' target function calls with the exception
2649 ;; of a case like (&rest a) mapped onto (x &rest y) where the actual args 2490 ;; of a case like (&rest a) mapped onto (x &rest y) where the actual args
2650 ;; supplied to A might not be enough to supply the required target arg X 2491 ;; supplied to A might not be enough to supply the required target arg X
2651 (append (list (if need-apply 'apply 'funcall) 'function) 2492 (append (list (if need-apply 'apply 'funcall) 'ad--addoit-function)
2652 (cond (need-apply 2493 (cond (need-apply
2653 ;; `apply' can take care of that directly: 2494 ;; `apply' can take care of that directly:
2654 (append source-reqopt-args (list source-rest-arg))) 2495 (append source-reqopt-args (list source-rest-arg)))
@@ -2663,13 +2504,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
2663 (nthcdr (length target-reqopt-args) 2504 (nthcdr (length target-reqopt-args)
2664 source-reqopt-args))))))))) 2505 source-reqopt-args)))))))))
2665 2506
2666(defun ad-make-mapped-call (source-arglist target-arglist target-function)
2667 "Make form to call TARGET-FUNCTION with args from SOURCE-ARGLIST."
2668 (let ((mapped-form (ad-map-arglists source-arglist target-arglist)))
2669 (if (eq (car mapped-form) 'funcall)
2670 (cons target-function (cdr (cdr mapped-form)))
2671 (prog1 mapped-form
2672 (setcar (cdr mapped-form) (list 'quote target-function))))))
2673 2507
2674;; @@@ Making an advised documentation string: 2508;; @@@ Making an advised documentation string:
2675;; =========================================== 2509;; ===========================================
@@ -2697,13 +2531,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
2697 2531
2698(require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage. 2532(require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage.
2699 2533
2700(defun ad-make-advised-docstring (function &optional style)
2701 (let* ((origdef (ad-real-orig-definition function))
2702 (origdoc
2703 ;; Retrieve raw doc, key substitution will be taken care of later:
2704 (documentation origdef t)))
2705 (ad--make-advised-docstring origdoc function style)))
2706
2707(defun ad--make-advised-docstring (origdoc function &optional style) 2534(defun ad--make-advised-docstring (origdoc function &optional style)
2708 "Construct a documentation string for the advised FUNCTION. 2535 "Construct a documentation string for the advised FUNCTION.
2709It concatenates the original documentation with the documentation 2536It concatenates the original documentation with the documentation
@@ -2712,14 +2539,14 @@ according to STYLE. STYLE can be `plain', everything else
2712will be interpreted as `default'. The order of the advice documentation 2539will be interpreted as `default'. The order of the advice documentation
2713strings corresponds to before/around/after and the individual ordering 2540strings corresponds to before/around/after and the individual ordering
2714in any of these classes." 2541in any of these classes."
2715 (let* ((origdef (ad-real-orig-definition function)) 2542 (if (and (symbolp function)
2716 (origtype (symbol-name (ad-definition-type origdef))) 2543 (string-match "\\`ad-+Advice-" (symbol-name function)))
2717 (usage (help-split-fundoc origdoc function)) 2544 (setq function
2545 (intern (substring (symbol-name function) (match-end 0)))))
2546 (let* ((usage (help-split-fundoc origdoc function))
2718 paragraphs advice-docstring) 2547 paragraphs advice-docstring)
2719 (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage))) 2548 (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
2720 (if origdoc (setq paragraphs (list origdoc))) 2549 (if origdoc (setq paragraphs (list origdoc)))
2721 (unless (eq style 'plain)
2722 (push (concat "This " origtype " is advised.") paragraphs))
2723 (dolist (class ad-advice-classes) 2550 (dolist (class ad-advice-classes)
2724 (dolist (advice (ad-get-enabled-advices function class)) 2551 (dolist (advice (ad-get-enabled-advices function class))
2725 (setq advice-docstring 2552 (setq advice-docstring
@@ -2735,8 +2562,6 @@ in any of these classes."
2735 #'ad--make-advised-docstring))) 2562 #'ad--make-advised-docstring)))
2736 (help-add-fundoc-usage origdoc usage))) 2563 (help-add-fundoc-usage origdoc usage)))
2737 2564
2738(defun ad-make-plain-docstring (function)
2739 (ad-make-advised-docstring function 'plain))
2740 2565
2741;; @@@ Accessing overriding arglists and interactive forms: 2566;; @@@ Accessing overriding arglists and interactive forms:
2742;; ======================================================== 2567;; ========================================================
@@ -2770,64 +2595,18 @@ in any of these classes."
2770 (if (and (ad-is-advised function) 2595 (if (and (ad-is-advised function)
2771 (ad-has-redefining-advice function)) 2596 (ad-has-redefining-advice function))
2772 (let* ((origdef (ad-real-orig-definition function)) 2597 (let* ((origdef (ad-real-orig-definition function))
2773 (origname (ad-get-advice-info-field function 'origname))
2774 (orig-interactive-p (commandp origdef))
2775 (orig-subr-p (ad-subr-p origdef))
2776 (orig-special-form-p (special-form-p origdef))
2777 (orig-macro-p (ad-macro-p origdef))
2778 ;; Construct the individual pieces that we need for assembly: 2598 ;; Construct the individual pieces that we need for assembly:
2779 (orig-arglist (ad-arglist origdef)) 2599 (orig-arglist (let ((args (ad-arglist origdef)))
2600 ;; The arglist may still be unknown.
2601 (if (listp args) args '(&rest args))))
2780 (advised-arglist (or (ad-advised-arglist function) 2602 (advised-arglist (or (ad-advised-arglist function)
2781 orig-arglist)) 2603 orig-arglist))
2782 (advised-interactive-form (ad-advised-interactive-form function)) 2604 (interactive-form (ad-advised-interactive-form function))
2783 (interactive-form
2784 (cond (orig-macro-p nil)
2785 (advised-interactive-form)
2786 ((interactive-form origdef)
2787 (interactive-form
2788 (if (and (symbolp function) (get function 'elp-info))
2789 (aref (get function 'elp-info) 2)
2790 origdef)))))
2791 (orig-form 2605 (orig-form
2792 (cond ((or orig-special-form-p orig-macro-p) 2606 (ad-map-arglists advised-arglist orig-arglist)))
2793 ;; Special forms and macros will be advised into macros.
2794 ;; The trick is to construct an expansion for the advised
2795 ;; macro that does the correct thing when it gets eval'ed.
2796 ;; For macros we'll just use the expansion of the original
2797 ;; macro and return that. This way compiled advised macros
2798 ;; will be expanded into something useful. Note that after
2799 ;; advices have full control over whether they want to
2800 ;; evaluate the expansion (the value of `ad-return-value')
2801 ;; at macro expansion time or not. For special forms there
2802 ;; is no solution that interacts reasonably with the
2803 ;; compiler, hence we just evaluate the original at macro
2804 ;; expansion time and return the result. The moral of that
2805 ;; is that one should always deactivate advised special
2806 ;; forms before one byte-compiles a file.
2807 `(,(if orig-macro-p 'macroexpand 'eval)
2808 (cons ',origname
2809 ,(ad-get-arguments advised-arglist 0))))
2810 ((and orig-subr-p
2811 orig-interactive-p
2812 (not interactive-form)
2813 (not advised-interactive-form))
2814 ;; Check whether we were called interactively
2815 ;; in order to do proper prompting:
2816 `(if (called-interactively-p 'any)
2817 (call-interactively ',origname)
2818 ,(ad-make-mapped-call advised-arglist
2819 orig-arglist
2820 origname)))
2821 ;; And now for normal functions and non-interactive subrs
2822 ;; (or subrs whose interactive behavior was advised):
2823 (t (ad-make-mapped-call
2824 advised-arglist orig-arglist origname)))))
2825 2607
2826 ;; Finally, build the sucker: 2608 ;; Finally, build the sucker:
2827 (ad-assemble-advised-definition 2609 (ad-assemble-advised-definition
2828 (cond (orig-macro-p 'macro)
2829 (orig-special-form-p 'special-form)
2830 (t 'function))
2831 advised-arglist 2610 advised-arglist
2832 (ad-make-advised-definition-docstring function) 2611 (ad-make-advised-definition-docstring function)
2833 interactive-form 2612 interactive-form
@@ -2837,13 +2616,11 @@ in any of these classes."
2837 (ad-get-enabled-advices function 'after))))) 2616 (ad-get-enabled-advices function 'after)))))
2838 2617
2839(defun ad-assemble-advised-definition 2618(defun ad-assemble-advised-definition
2840 (type args docstring interactive orig &optional befores arounds afters) 2619 (args docstring interactive orig &optional befores arounds afters)
2841 2620 "Assemble the advices into an overall advice function.
2842 "Assembles an original and its advices into an advised function. 2621ARGS is the argument list that has to be used,
2843It constructs a function or macro definition according to TYPE which has to 2622DOCSTRING if non-nil defines the documentation of the definition,
2844be either `macro', `function' or `special-form'. ARGS is the argument list 2623INTERACTIVE if non-nil is the interactive form to be used,
2845that has to be used, DOCSTRING if non-nil defines the documentation of the
2846definition, INTERACTIVE if non-nil is the interactive form to be used,
2847ORIG is a form that calls the body of the original unadvised function, 2624ORIG is a form that calls the body of the original unadvised function,
2848and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG 2625and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG
2849should be modified. The assembled function will be returned." 2626should be modified. The assembled function will be returned."
@@ -2894,16 +2671,12 @@ should be modified. The assembled function will be returned."
2894 (ad-body-forms (ad-advice-definition advice))))))) 2671 (ad-body-forms (ad-advice-definition advice)))))))
2895 2672
2896 (setq definition 2673 (setq definition
2897 `(,@(if (memq type '(macro special-form)) '(macro)) 2674 `(lambda (ad--addoit-function ,@args)
2898 lambda
2899 ,args
2900 ,@(if docstring (list docstring)) 2675 ,@(if docstring (list docstring))
2901 ,@(if interactive (list interactive)) 2676 ,@(if interactive (list interactive))
2902 (let (ad-return-value) 2677 (let (ad-return-value)
2903 ,@after-forms 2678 ,@after-forms
2904 ,(if (eq type 'special-form) 2679 ad-return-value)))
2905 '(list 'quote ad-return-value)
2906 'ad-return-value))))
2907 2680
2908 (ad-insert-argument-access-forms definition args))) 2681 (ad-insert-argument-access-forms definition args)))
2909 2682
@@ -3000,11 +2773,11 @@ advised definition from scratch."
3000 "Generate an identifying image of the current advices of FUNCTION." 2773 "Generate an identifying image of the current advices of FUNCTION."
3001 (let ((original-definition (ad-real-orig-definition function)) 2774 (let ((original-definition (ad-real-orig-definition function))
3002 (cached-definition (ad-get-cache-definition function))) 2775 (cached-definition (ad-get-cache-definition function)))
3003 (list (mapcar (function (lambda (advice) (ad-advice-name advice))) 2776 (list (mapcar #'ad-advice-name
3004 (ad-get-enabled-advices function 'before)) 2777 (ad-get-enabled-advices function 'before))
3005 (mapcar (function (lambda (advice) (ad-advice-name advice))) 2778 (mapcar #'ad-advice-name
3006 (ad-get-enabled-advices function 'around)) 2779 (ad-get-enabled-advices function 'around))
3007 (mapcar (function (lambda (advice) (ad-advice-name advice))) 2780 (mapcar #'ad-advice-name
3008 (ad-get-enabled-advices function 'after)) 2781 (ad-get-enabled-advices function 'after))
3009 (ad-definition-type original-definition) 2782 (ad-definition-type original-definition)
3010 (if (equal (ad-arglist original-definition) 2783 (if (equal (ad-arglist original-definition)
@@ -3147,25 +2920,32 @@ The resulting FUNCTION will be compiled if `ad-should-compile' returns t.
3147The current definition and its cache-id will be put into the cache." 2920The current definition and its cache-id will be put into the cache."
3148 (let ((verified-cached-definition 2921 (let ((verified-cached-definition
3149 (if (ad-verify-cache-id function) 2922 (if (ad-verify-cache-id function)
3150 (ad-get-cache-definition function)))) 2923 (ad-get-cache-definition function)))
3151 (fset function 2924 (advicefunname (ad-get-advice-info-field function 'advicefunname)))
3152 (or verified-cached-definition 2925 (fset advicefunname
3153 (ad-make-advised-definition function))) 2926 (or verified-cached-definition
2927 (ad-make-advised-definition function)))
2928 (advice-add function :around advicefunname)
3154 (if (ad-should-compile function compile) 2929 (if (ad-should-compile function compile)
3155 (ad-compile-function function)) 2930 (byte-compile advicefunname))
3156 (if verified-cached-definition 2931 (if verified-cached-definition
3157 (if (not (eq verified-cached-definition (symbol-function function))) 2932 (if (not (eq verified-cached-definition
2933 (symbol-function advicefunname)))
3158 ;; we must have compiled, cache the compiled definition: 2934 ;; we must have compiled, cache the compiled definition:
3159 (ad-set-cache 2935 (ad-set-cache function (symbol-function advicefunname)
3160 function (symbol-function function) (ad-get-cache-id function))) 2936 (ad-get-cache-id function)))
3161 ;; We created a new advised definition, cache it with a proper id: 2937 ;; We created a new advised definition, cache it with a proper id:
3162 (ad-clear-cache function) 2938 (ad-clear-cache function)
3163 ;; ad-make-cache-id needs the new cached definition: 2939 ;; ad-make-cache-id needs the new cached definition:
3164 (ad-set-cache function (symbol-function function) nil) 2940 (ad-set-cache function (symbol-function advicefunname) nil)
3165 (ad-set-cache 2941 (ad-set-cache
3166 function (symbol-function function) (ad-make-cache-id function))))) 2942 function (symbol-function advicefunname) (ad-make-cache-id function)))))
3167 2943
3168(defun ad-handle-definition (function) 2944(defun ad--defalias-fset (fsetfun function newdef)
2945 ;; Besides ad-redefinition-action we use this defalias-fset-function hook
2946 ;; for two other reasons:
2947 ;; - for `activation/deactivation' advices.
2948 ;; - to rebuild the ad-Advice-* function with the right argument names.
3169 "Handle re/definition of an advised FUNCTION during de/activation. 2949 "Handle re/definition of an advised FUNCTION during de/activation.
3170If FUNCTION does not have an original definition associated with it and 2950If FUNCTION does not have an original definition associated with it and
3171the current definition is usable, then it will be stored as FUNCTION's 2951the current definition is usable, then it will be stored as FUNCTION's
@@ -3177,33 +2957,27 @@ associated with it but got redefined with a new definition and then
3177de/activated. If you do not like the current redefinition action change 2957de/activated. If you do not like the current redefinition action change
3178the value of `ad-redefinition-action' and de/activate again." 2958the value of `ad-redefinition-action' and de/activate again."
3179 (let ((original-definition (ad-get-orig-definition function)) 2959 (let ((original-definition (ad-get-orig-definition function))
3180 (current-definition (if (ad-real-definition function) 2960 (current-definition (ad-get-orig-definition newdef)))
3181 (symbol-function function))))
3182 (if original-definition 2961 (if original-definition
3183 (if current-definition 2962 (if current-definition
3184 (if (and (not (eq current-definition original-definition)) 2963 (if (not (eq current-definition original-definition))
3185 ;; Redefinition with an advised definition from a 2964 ;; We have a redefinition:
3186 ;; different function won't count as such:
3187 (not (ad-advised-definition-p current-definition)))
3188 ;; we have a redefinition:
3189 (if (not (memq ad-redefinition-action '(accept discard warn))) 2965 (if (not (memq ad-redefinition-action '(accept discard warn)))
3190 (error "ad-handle-definition (see its doc): `%s' %s" 2966 (error "ad-redefinition-action: `%s' %s"
3191 function "invalidly redefined") 2967 function "invalidly redefined")
3192 (if (eq ad-redefinition-action 'discard) 2968 (if (eq ad-redefinition-action 'discard)
3193 (fset function original-definition) 2969 nil ;; Just drop it!
3194 (ad-set-orig-definition function current-definition) 2970 (funcall (or fsetfun #'fset) function newdef)
2971 (ad-activate-internal function)
3195 (if (eq ad-redefinition-action 'warn) 2972 (if (eq ad-redefinition-action 'warn)
3196 (message "ad-handle-definition: `%s' got redefined" 2973 (message "ad-handle-definition: `%s' got redefined"
3197 function)))) 2974 function))))
3198 ;; either advised def or correct original is in place: 2975 ;; either advised def or correct original is in place:
3199 nil) 2976 nil)
3200 ;; we have an undefinition, ignore it: 2977 ;; We have an undefinition, ignore it:
3201 nil) 2978 (funcall (or fsetfun #'fset) function newdef))
3202 (if current-definition 2979 (funcall (or fsetfun #'fset) function newdef)
3203 ;; we have a first definition, save it as original: 2980 (when current-definition (ad-activate-internal function)))))
3204 (ad-set-orig-definition function current-definition)
3205 ;; we don't have anything noteworthy:
3206 nil))))
3207 2981
3208 2982
3209;; @@ The top-level advice interface: 2983;; @@ The top-level advice interface:
@@ -3229,24 +3003,20 @@ definition will always be cached for later usage."
3229 (interactive 3003 (interactive
3230 (list (ad-read-advised-function "Activate advice of") 3004 (list (ad-read-advised-function "Activate advice of")
3231 current-prefix-arg)) 3005 current-prefix-arg))
3232 (if ad-activate-on-top-level 3006 (if (not (ad-is-advised function))
3233 ;; avoid recursive calls to `ad-activate': 3007 (error "ad-activate: `%s' is not advised" function)
3234 (ad-with-auto-activation-disabled 3008 ;; Just return for forward advised and not yet defined functions:
3235 (if (not (ad-is-advised function)) 3009 (if (ad-get-orig-definition function)
3236 (error "ad-activate: `%s' is not advised" function) 3010 (if (not (ad-has-any-advice function))
3237 (ad-handle-definition function) 3011 (ad-unadvise function)
3238 ;; Just return for forward advised and not yet defined functions: 3012 ;; Otherwise activate the advice:
3239 (if (ad-get-orig-definition function) 3013 (cond ((ad-has-redefining-advice function)
3240 (if (not (ad-has-any-advice function)) 3014 (ad-activate-advised-definition function compile)
3241 (ad-unadvise function) 3015 (ad-set-advice-info-field function 'active t)
3242 ;; Otherwise activate the advice: 3016 (eval (ad-make-hook-form function 'activation))
3243 (cond ((ad-has-redefining-advice function) 3017 function)
3244 (ad-activate-advised-definition function compile) 3018 ;; Here we are if we have all disabled advices:
3245 (ad-set-advice-info-field function 'active t) 3019 (t (ad-deactivate function)))))))
3246 (eval (ad-make-hook-form function 'activation))
3247 function)
3248 ;; Here we are if we have all disabled advices:
3249 (t (ad-deactivate function)))))))))
3250 3020
3251(defalias 'ad-activate-on 'ad-activate) 3021(defalias 'ad-activate-on 'ad-activate)
3252 3022
@@ -3261,11 +3031,10 @@ a call to `ad-activate'."
3261 (if (not (ad-is-advised function)) 3031 (if (not (ad-is-advised function))
3262 (error "ad-deactivate: `%s' is not advised" function) 3032 (error "ad-deactivate: `%s' is not advised" function)
3263 (cond ((ad-is-active function) 3033 (cond ((ad-is-active function)
3264 (ad-handle-definition function)
3265 (if (not (ad-get-orig-definition function)) 3034 (if (not (ad-get-orig-definition function))
3266 (error "ad-deactivate: `%s' has no original definition" 3035 (error "ad-deactivate: `%s' has no original definition"
3267 function) 3036 function)
3268 (fset function (ad-get-orig-definition function)) 3037 (ad-clear-advicefunname-definition function)
3269 (ad-set-advice-info-field function 'active nil) 3038 (ad-set-advice-info-field function 'active nil)
3270 (eval (ad-make-hook-form function 'deactivation)) 3039 (eval (ad-make-hook-form function 'deactivation))
3271 function))))) 3040 function)))))
@@ -3287,7 +3056,7 @@ If FUNCTION was not advised this will be a noop."
3287 (cond ((ad-is-advised function) 3056 (cond ((ad-is-advised function)
3288 (if (ad-is-active function) 3057 (if (ad-is-active function)
3289 (ad-deactivate function)) 3058 (ad-deactivate function))
3290 (ad-clear-orig-definition function) 3059 (ad-clear-advicefunname-definition function)
3291 (ad-set-advice-info function nil) 3060 (ad-set-advice-info function nil)
3292 (ad-pop-advised-function function)))) 3061 (ad-pop-advised-function function))))
3293 3062
@@ -3302,9 +3071,7 @@ Use in emergencies."
3302 (list (intern 3071 (list (intern
3303 (completing-read "Recover advised function: " obarray nil t)))) 3072 (completing-read "Recover advised function: " obarray nil t))))
3304 (cond ((ad-is-advised function) 3073 (cond ((ad-is-advised function)
3305 (cond ((ad-get-orig-definition function) 3074 (ad-clear-advicefunname-definition function)
3306 (fset function (ad-get-orig-definition function))
3307 (ad-clear-orig-definition function)))
3308 (ad-set-advice-info function nil) 3075 (ad-set-advice-info function nil)
3309 (ad-pop-advised-function function)))) 3076 (ad-pop-advised-function function))))
3310 3077
@@ -3544,35 +3311,15 @@ undone on exit of this macro."
3544;; @@ Starting, stopping and recovering from the advice package magic: 3311;; @@ Starting, stopping and recovering from the advice package magic:
3545;; =================================================================== 3312;; ===================================================================
3546 3313
3547(defun ad-start-advice ()
3548 "Start the automatic advice handling magic."
3549 (interactive)
3550 ;; Advising `ad-activate-internal' means death!!
3551 (ad-set-advice-info 'ad-activate-internal nil)
3552 (fset 'ad-activate-internal 'ad-activate))
3553
3554(defun ad-stop-advice ()
3555 "Stop the automatic advice handling magic.
3556You should only need this in case of Advice-related emergencies."
3557 (interactive)
3558 ;; Advising `ad-activate-internal' means death!!
3559 (ad-set-advice-info 'ad-activate-internal nil)
3560 (fset 'ad-activate-internal 'ad-activate-internal-off))
3561
3562(defun ad-recover-normality () 3314(defun ad-recover-normality ()
3563 "Undo all advice related redefinitions and unadvises everything. 3315 "Undo all advice related redefinitions and unadvises everything.
3564Use only in REAL emergencies." 3316Use only in REAL emergencies."
3565 (interactive) 3317 (interactive)
3566 ;; Advising `ad-activate-internal' means death!!
3567 (ad-set-advice-info 'ad-activate-internal nil)
3568 (fset 'ad-activate-internal 'ad-activate-internal-off)
3569 (ad-recover-all) 3318 (ad-recover-all)
3570 (ad-do-advised-functions (function) 3319 (ad-do-advised-functions (function)
3571 (message "Oops! Left over advised function %S" function) 3320 (message "Oops! Left over advised function %S" function)
3572 (ad-pop-advised-function function))) 3321 (ad-pop-advised-function function)))
3573 3322
3574(ad-start-advice)
3575
3576(provide 'advice) 3323(provide 'advice)
3577 3324
3578;;; advice.el ends here 3325;;; advice.el ends here
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index ffa42e97221..1cbed17cbab 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -124,7 +124,7 @@
124;; Adding your own checks: 124;; Adding your own checks:
125;; 125;;
126;; You can experiment with adding your own checks by setting the 126;; You can experiment with adding your own checks by setting the
127;; hooks `checkdoc-style-functions' and `checkdoc-comment-style-hooks'. 127;; hooks `checkdoc-style-functions' and `checkdoc-comment-style-functions'.
128;; Return a string which is the error you wish to report. The cursor 128;; Return a string which is the error you wish to report. The cursor
129;; position should be preserved. 129;; position should be preserved.
130;; 130;;
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index a9be08b1383..bfc63134985 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -3,7 +3,7 @@
3;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc. 3;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
4 4
5;; Author: Dave Gillespie <daveg@synaptics.com> 5;; Author: Dave Gillespie <daveg@synaptics.com>
6;; Version: 2.02 6;; Version: 1.0
7;; Keywords: extensions 7;; Keywords: extensions
8 8
9;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index eb58d17c02e..69882e36f22 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'.
267;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when 267;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
268;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp 268;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
269;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) 269;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
270;;;;;; "cl-macs" "cl-macs.el" "c7ad09a74a1d2969406e7e2aaf3812fc") 270;;;;;; "cl-macs" "cl-macs.el" "a7d9b56ea588b869813de8ed7ec1fbcd")
271;;; Generated autoloads from cl-macs.el 271;;; Generated autoloads from cl-macs.el
272 272
273(autoload 'cl--compiler-macro-list* "cl-macs" "\ 273(autoload 'cl--compiler-macro-list* "cl-macs" "\
@@ -416,7 +416,7 @@ This is compatible with Common Lisp, but note that `defun' and
416(put 'cl-return-from 'lisp-indent-function '1) 416(put 'cl-return-from 'lisp-indent-function '1)
417 417
418(autoload 'cl-loop "cl-macs" "\ 418(autoload 'cl-loop "cl-macs" "\
419The Common Lisp `cl-loop' macro. 419The Common Lisp `loop' macro.
420Valid clauses are: 420Valid clauses are:
421 for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, 421 for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
422 for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, 422 for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR,
@@ -432,14 +432,14 @@ Valid clauses are:
432\(fn CLAUSE...)" nil t) 432\(fn CLAUSE...)" nil t)
433 433
434(autoload 'cl-do "cl-macs" "\ 434(autoload 'cl-do "cl-macs" "\
435The Common Lisp `cl-do' loop. 435The Common Lisp `do' loop.
436 436
437\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t) 437\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t)
438 438
439(put 'cl-do 'lisp-indent-function '2) 439(put 'cl-do 'lisp-indent-function '2)
440 440
441(autoload 'cl-do* "cl-macs" "\ 441(autoload 'cl-do* "cl-macs" "\
442The Common Lisp `cl-do*' loop. 442The Common Lisp `do*' loop.
443 443
444\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t) 444\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t)
445 445
@@ -501,7 +501,7 @@ a `let' form, except that the list of symbols can be computed at run-time.
501(put 'cl-progv 'lisp-indent-function '2) 501(put 'cl-progv 'lisp-indent-function '2)
502 502
503(autoload 'cl-flet "cl-macs" "\ 503(autoload 'cl-flet "cl-macs" "\
504Make temporary function definitions. 504Make local function definitions.
505Like `cl-labels' but the definitions are not recursive. 505Like `cl-labels' but the definitions are not recursive.
506 506
507\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) 507\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
@@ -509,7 +509,7 @@ Like `cl-labels' but the definitions are not recursive.
509(put 'cl-flet 'lisp-indent-function '1) 509(put 'cl-flet 'lisp-indent-function '1)
510 510
511(autoload 'cl-flet* "cl-macs" "\ 511(autoload 'cl-flet* "cl-macs" "\
512Make temporary function definitions. 512Make local function definitions.
513Like `cl-flet' but the definitions can refer to previous ones. 513Like `cl-flet' but the definitions can refer to previous ones.
514 514
515\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) 515\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 3c46c40242d..918e992512c 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -260,9 +260,11 @@ The name is made by appending a number to PREFIX, default \"G\"."
260 (require 'help-fns) 260 (require 'help-fns)
261 (cons (help-add-fundoc-usage 261 (cons (help-add-fundoc-usage
262 (if (stringp (car hdr)) (pop hdr)) 262 (if (stringp (car hdr)) (pop hdr))
263 (format "%S" 263 ;; Be careful with make-symbol and (back)quote,
264 (cons 'fn 264 ;; see bug#12884.
265 (cl--make-usage-args orig-args)))) 265 (let ((print-gensym nil) (print-quoted t))
266 (format "%S" (cons 'fn (cl--make-usage-args
267 orig-args)))))
266 hdr))) 268 hdr)))
267 (list `(let* ,cl--bind-lets 269 (list `(let* ,cl--bind-lets
268 ,@(nreverse cl--bind-forms) 270 ,@(nreverse cl--bind-forms)
@@ -756,7 +758,7 @@ This is compatible with Common Lisp, but note that `defun' and
756 758
757;;;###autoload 759;;;###autoload
758(defmacro cl-loop (&rest loop-args) 760(defmacro cl-loop (&rest loop-args)
759 "The Common Lisp `cl-loop' macro. 761 "The Common Lisp `loop' macro.
760Valid clauses are: 762Valid clauses are:
761 for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, 763 for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
762 for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, 764 for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR,
@@ -1501,7 +1503,7 @@ such that COMBO is equivalent to (and . CLAUSES)."
1501 1503
1502;;;###autoload 1504;;;###autoload
1503(defmacro cl-do (steps endtest &rest body) 1505(defmacro cl-do (steps endtest &rest body)
1504 "The Common Lisp `cl-do' loop. 1506 "The Common Lisp `do' loop.
1505 1507
1506\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" 1508\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
1507 (declare (indent 2) 1509 (declare (indent 2)
@@ -1513,7 +1515,7 @@ such that COMBO is equivalent to (and . CLAUSES)."
1513 1515
1514;;;###autoload 1516;;;###autoload
1515(defmacro cl-do* (steps endtest &rest body) 1517(defmacro cl-do* (steps endtest &rest body)
1516 "The Common Lisp `cl-do*' loop. 1518 "The Common Lisp `do*' loop.
1517 1519
1518\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" 1520\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
1519 (declare (indent 2) (debug cl-do)) 1521 (declare (indent 2) (debug cl-do))
@@ -1648,7 +1650,7 @@ a `let' form, except that the list of symbols can be computed at run-time."
1648 1650
1649;;;###autoload 1651;;;###autoload
1650(defmacro cl-flet (bindings &rest body) 1652(defmacro cl-flet (bindings &rest body)
1651 "Make temporary function definitions. 1653 "Make local function definitions.
1652Like `cl-labels' but the definitions are not recursive. 1654Like `cl-labels' but the definitions are not recursive.
1653 1655
1654\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" 1656\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
@@ -1672,7 +1674,7 @@ Like `cl-labels' but the definitions are not recursive.
1672 1674
1673;;;###autoload 1675;;;###autoload
1674(defmacro cl-flet* (bindings &rest body) 1676(defmacro cl-flet* (bindings &rest body)
1675 "Make temporary function definitions. 1677 "Make local function definitions.
1676Like `cl-flet' but the definitions can refer to previous ones. 1678Like `cl-flet' but the definitions can refer to previous ones.
1677 1679
1678\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" 1680\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el
index ec470d21bf3..a1db1972b83 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -131,7 +131,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
131(defun eieio-debug-methodinvoke (method class) 131(defun eieio-debug-methodinvoke (method class)
132 "Show the method invocation order for METHOD with CLASS object." 132 "Show the method invocation order for METHOD with CLASS object."
133 (interactive "aMethod: \nXClass Expression: ") 133 (interactive "aMethod: \nXClass Expression: ")
134 (let* ((eieio-pre-method-execution-hooks 134 (let* ((eieio-pre-method-execution-functions
135 (lambda (l) (throw 'moose l) )) 135 (lambda (l) (throw 'moose l) ))
136 (data 136 (data
137 (catch 'moose (eieio-generic-call 137 (catch 'moose (eieio-generic-call
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 02eec08f96b..5488330a1a4 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -236,7 +236,7 @@ For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y).
236The return value is the last VAL in the list. 236The return value is the last VAL in the list.
237 237
238\(fn PLACE VAL PLACE VAL ...)" 238\(fn PLACE VAL PLACE VAL ...)"
239 (declare (debug (gv-place form))) 239 (declare (debug (&rest [gv-place form])))
240 (if (and args (null (cddr args))) 240 (if (and args (null (cddr args)))
241 (let ((place (pop args)) 241 (let ((place (pop args))
242 (val (car args))) 242 (val (car args)))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index ca1ebf3cad2..540e0166ec2 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -30,7 +30,7 @@
30;; holds a function. 30;; holds a function.
31;; This part provides mainly 2 macros: `add-function' and `remove-function'. 31;; This part provides mainly 2 macros: `add-function' and `remove-function'.
32;; 32;;
33;; - The second part provides `add-advice' and `remove-advice' which are 33;; - The second part provides `advice-add' and `advice-remove' which are
34;; refined version of the previous macros specially tailored for the case 34;; refined version of the previous macros specially tailored for the case
35;; where the place that we want to modify is a `symbol-function'. 35;; where the place that we want to modify is a `symbol-function'.
36 36
@@ -109,18 +109,33 @@ Each element has the form (WHERE BYTECODE STACK) where:
109 (propertize "Advised function" 109 (propertize "Advised function"
110 'dynamic-docstring-function #'advice--make-docstring)) ;; ) 110 'dynamic-docstring-function #'advice--make-docstring)) ;; )
111 111
112(defun advice-eval-interactive-spec (spec)
113 "Evaluate the interactive spec SPEC."
114 (cond
115 ((stringp spec)
116 ;; There's no direct access to the C code (in call-interactively) that
117 ;; processes those specs, but that shouldn't stop us, should it?
118 ;; FIXME: Despite appearances, this is not faithful: SPEC and
119 ;; (advice-eval-interactive-spec SPEC) will behave subtly differently w.r.t
120 ;; command-history (and maybe a few other details).
121 (call-interactively `(lambda (&rest args) (interactive ,spec) args)))
122 ;; ((functionp spec) (funcall spec))
123 (t (eval spec))))
124
112(defun advice--make-interactive-form (function main) 125(defun advice--make-interactive-form (function main)
113 ;; TODO: Make it possible to do around-like advising on the
114 ;; interactive forms (bug#12844).
115 ;; TODO: make it so that interactive spec can be a constant which 126 ;; TODO: make it so that interactive spec can be a constant which
116 ;; dynamically checks the advice--car/cdr to do its job. 127 ;; dynamically checks the advice--car/cdr to do its job.
117 ;; TODO: Implement interactive-read-args: 128 ;; For that, advice-eval-interactive-spec needs to be more faithful.
118 ;;(when (or (commandp function) (commandp main)) 129 ;; FIXME: The calls to interactive-form below load autoloaded functions
119 ;; `(interactive-read-args 130 ;; too eagerly.
120 ;; (cadr (or (interactive-form function) (interactive-form main))))) 131 (let ((fspec (cadr (interactive-form function))))
121 ;; FIXME: This loads autoloaded functions too eagerly. 132 (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda?
133 (setq fspec (nth 1 fspec)))
134 (if (functionp fspec)
135 `(funcall ',fspec
136 ',(cadr (interactive-form main)))
122 (cadr (or (interactive-form function) 137 (cadr (or (interactive-form function)
123 (interactive-form main)))) 138 (interactive-form main))))))
124 139
125(defsubst advice--make-1 (byte-code stack-depth function main props) 140(defsubst advice--make-1 (byte-code stack-depth function main props)
126 "Build a function value that adds FUNCTION to MAIN." 141 "Build a function value that adds FUNCTION to MAIN."
@@ -167,17 +182,31 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
167 (advice--make-1 (aref flist 1) (aref flist 3) 182 (advice--make-1 (aref flist 1) (aref flist 3)
168 first nrest props))))))) 183 first nrest props)))))))
169 184
185(defvar advice--buffer-local-function-sample nil)
186
187(defun advice--set-buffer-local (var val)
188 (if (function-equal val advice--buffer-local-function-sample)
189 (kill-local-variable var)
190 (set (make-local-variable var) val)))
191
192;;;###autoload
193(defun advice--buffer-local (var)
194 "Buffer-local value of VAR, presumed to contain a function."
195 (declare (gv-setter advice--set-buffer-local))
196 (if (local-variable-p var) (symbol-value var)
197 (setq advice--buffer-local-function-sample
198 (lambda (&rest args) (apply (default-value var) args)))))
199
170;;;###autoload 200;;;###autoload
171(defmacro add-function (where place function &optional props) 201(defmacro add-function (where place function &optional props)
172 ;; TODO: 202 ;; TODO:
173 ;; - provide something like `around' for interactive forms.
174 ;; - provide some kind of buffer-local functionality at least when `place'
175 ;; is a variable.
176 ;; - obsolete with-wrapper-hook (mostly requires buffer-local support). 203 ;; - obsolete with-wrapper-hook (mostly requires buffer-local support).
177 ;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP 204 ;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP
178 ;; and tracing want to stay first. 205 ;; and tracing want to stay first.
179 ;; - maybe also let `where' specify some kind of predicate and use it 206 ;; - maybe let `where' specify some kind of predicate and use it
180 ;; to implement things like mode-local or eieio-defmethod. 207 ;; to implement things like mode-local or eieio-defmethod.
208 ;; Of course, that only makes sense if the predicates of all advices can
209 ;; be combined and made more efficient.
181 ;; :before is like a normal add-hook on a normal hook. 210 ;; :before is like a normal add-hook on a normal hook.
182 ;; :before-while is like add-hook on run-hook-with-args-until-failure. 211 ;; :before-while is like add-hook on run-hook-with-args-until-failure.
183 ;; :before-until is like add-hook on run-hook-with-args-until-success. 212 ;; :before-until is like add-hook on run-hook-with-args-until-success.
@@ -197,8 +226,24 @@ call OLDFUN here:
197If FUNCTION was already added, do nothing. 226If FUNCTION was already added, do nothing.
198PROPS is an alist of additional properties, among which the following have 227PROPS is an alist of additional properties, among which the following have
199a special meaning: 228a special meaning:
200- `name': a string or symbol. It can be used to refer to this piece of advice." 229- `name': a string or symbol. It can be used to refer to this piece of advice.
230
231PLACE cannot be a simple variable. Instead it should either be
232\(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION
233should be applied to VAR buffer-locally or globally.
234
235If one of FUNCTION or OLDFUN is interactive, then the resulting function
236is also interactive. There are 3 cases:
237- FUNCTION is not interactive: the interactive spec of OLDFUN is used.
238- The interactive spec of FUNCTION is itself a function: it should take one
239 argument (the interactive spec of OLDFUN, which it can pass to
240 `advice-eval-interactive-spec') and return the list of arguments to use.
241- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN."
201 (declare (debug t)) ;;(indent 2) 242 (declare (debug t)) ;;(indent 2)
243 (cond ((eq 'local (car-safe place))
244 (setq place `(advice--buffer-local ,@(cdr place))))
245 ((symbolp place)
246 (error "Use (default-value '%S) or (local '%S)" place place)))
202 `(advice--add-function ,where (gv-ref ,place) ,function ,props)) 247 `(advice--add-function ,where (gv-ref ,place) ,function ,props))
203 248
204;;;###autoload 249;;;###autoload
@@ -213,6 +258,10 @@ If FUNCTION was not added to PLACE, do nothing.
213Instead of FUNCTION being the actual function, it can also be the `name' 258Instead of FUNCTION being the actual function, it can also be the `name'
214of the piece of advice." 259of the piece of advice."
215 (declare (debug t)) 260 (declare (debug t))
261 (cond ((eq 'local (car-safe place))
262 (setq place `(advice--buffer-local ,@(cdr place))))
263 ((symbolp place)
264 (error "Use (default-value '%S) or (local '%S)" place place)))
216 (gv-letplace (getter setter) place 265 (gv-letplace (getter setter) place
217 (macroexp-let2 nil new `(advice--remove-function ,getter ,function) 266 (macroexp-let2 nil new `(advice--remove-function ,getter ,function)
218 `(unless (eq ,new ,getter) ,(funcall setter new))))) 267 `(unless (eq ,new ,getter) ,(funcall setter new)))))
@@ -234,7 +283,7 @@ of the piece of advice."
234 (cond 283 (cond
235 ((special-form-p def) 284 ((special-form-p def)
236 ;; Not worth the trouble trying to handle this, I think. 285 ;; Not worth the trouble trying to handle this, I think.
237 (error "add-advice failure: %S is a special form" symbol)) 286 (error "advice-add failure: %S is a special form" symbol))
238 ((and (symbolp def) 287 ((and (symbolp def)
239 (eq 'macro (car-safe (ignore-errors (indirect-function def))))) 288 (eq 'macro (car-safe (ignore-errors (indirect-function def)))))
240 (let ((newval (cons 'macro (cdr (indirect-function def))))) 289 (let ((newval (cons 'macro (cdr (indirect-function def)))))
@@ -285,28 +334,21 @@ is defined as a macro, alias, command, ..."
285 ;; - change all defadvice in lisp/**/*.el. 334 ;; - change all defadvice in lisp/**/*.el.
286 ;; - rewrite advice.el on top of this. 335 ;; - rewrite advice.el on top of this.
287 ;; - obsolete advice.el. 336 ;; - obsolete advice.el.
288 ;; To make advice.el and nadvice.el interoperate properly I see 2 different
289 ;; ways:
290 ;; - keep them separate: complete the defalias-fset-function setter with
291 ;; a matching accessor which both nadvice.el and advice.el will have to use
292 ;; in place of symbol-function. This can probably be made to work, but
293 ;; they have to agree on a "protocol".
294 ;; - layer advice.el on top of nadvice.el. I prefer this approach. the
295 ;; simplest way is to make advice.el build one ad-Advice-foo function for
296 ;; each advised function which is advice-added/removed whenever ad-activate
297 ;; ad-deactivate is called.
298 (let* ((f (and (fboundp symbol) (symbol-function symbol))) 337 (let* ((f (and (fboundp symbol) (symbol-function symbol)))
299 (nf (advice--normalize symbol f))) 338 (nf (advice--normalize symbol f)))
300 (unless (eq f nf) ;; Most importantly, if nf == nil! 339 (unless (eq f nf) ;; Most importantly, if nf == nil!
301 (fset symbol nf)) 340 (fset symbol nf))
302 (add-function where (cond 341 (add-function where (cond
303 ((eq (car-safe nf) 'macro) (cdr nf)) 342 ((eq (car-safe nf) 'macro) (cdr nf))
304 ;; If the function is not yet defined, we can't yet 343 ;; Reasons to delay installation of the advice:
305 ;; install the advice. 344 ;; - If the function is not yet defined, installing
306 ;; FIXME: If it's an autoloaded command, we also 345 ;; the advice would affect `fboundp'ness.
307 ;; have a problem because we need to load the 346 ;; - If it's an autoloaded command,
308 ;; command to build the interactive-form. 347 ;; advice--make-interactive-form would end up
309 ((or (not nf) (and (autoloadp nf))) ;; (commandp nf) 348 ;; loading the command eagerly.
349 ;; - `autoload' does nothing if the function is
350 ;; not an autoload or undefined.
351 ((or (not nf) (autoloadp nf))
310 (get symbol 'advice--pending)) 352 (get symbol 'advice--pending))
311 (t (symbol-function symbol))) 353 (t (symbol-function symbol)))
312 function props) 354 function props)
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index 13dbba769a4..e0a88461dc9 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,7 @@
12012-11-16 Glenn Morris <rgm@gnu.org>
2
3 * erc.el (erc-modules): Add "notifications". Tweak "hecomplete" doc.
4
12012-10-28 Stefan Monnier <monnier@iro.umontreal.ca> 52012-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
2 6
3 * erc-backend.el: Only require `erc' during compilation (bug#12740). 7 * erc-backend.el: Only require `erc' during compilation (bug#12740).
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 2e97131b603..7cb6fbb595b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1843,7 +1843,7 @@ removed from the list will be disabled."
1843 capab-identify) 1843 capab-identify)
1844 (const :tag "completion: Complete nicknames and commands (programmable)" 1844 (const :tag "completion: Complete nicknames and commands (programmable)"
1845 completion) 1845 completion)
1846 (const :tag "hecomplete: Complete nicknames and commands (old)" hecomplete) 1846 (const :tag "hecomplete: Complete nicknames and commands (obsolete, use \"completion\")" hecomplete)
1847 (const :tag "dcc: Provide Direct Client-to-Client support" dcc) 1847 (const :tag "dcc: Provide Direct Client-to-Client support" dcc)
1848 (const :tag "fill: Wrap long lines" fill) 1848 (const :tag "fill: Wrap long lines" fill)
1849 (const :tag "identd: Launch an identd server on port 8113" identd) 1849 (const :tag "identd: Launch an identd server on port 8113" identd)
@@ -1863,6 +1863,8 @@ removed from the list will be disabled."
1863 (const :tag 1863 (const :tag
1864 "notify: Notify when the online status of certain users changes" 1864 "notify: Notify when the online status of certain users changes"
1865 notify) 1865 notify)
1866 (const :tag "notifications: Send notifications on PRIVMSG or nickname mentions"
1867 notifications)
1866 (const :tag "page: Process CTCP PAGE requests from IRC" page) 1868 (const :tag "page: Process CTCP PAGE requests from IRC" page)
1867 (const :tag "readonly: Make displayed lines read-only" readonly) 1869 (const :tag "readonly: Make displayed lines read-only" readonly)
1868 (const :tag "replace: Replace text in messages" replace) 1870 (const :tag "replace: Replace text in messages" replace)
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index a67861e83a9..aa8aae2d245 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -295,8 +295,8 @@ to writing a completion function."
295 'pcomplete-expand-and-complete) 295 'pcomplete-expand-and-complete)
296 (define-key eshell-command-map [space] 'pcomplete-expand) 296 (define-key eshell-command-map [space] 'pcomplete-expand)
297 (define-key eshell-command-map [? ] 'pcomplete-expand) 297 (define-key eshell-command-map [? ] 'pcomplete-expand)
298 (define-key eshell-mode-map [tab] 'pcomplete) 298 (define-key eshell-mode-map [tab] 'eshell-pcomplete)
299 (define-key eshell-mode-map [(control ?i)] 'pcomplete) 299 (define-key eshell-mode-map [(control ?i)] 'eshell-pcomplete)
300 ;; jww (1999-10-19): Will this work on anything but X? 300 ;; jww (1999-10-19): Will this work on anything but X?
301 (if (featurep 'xemacs) 301 (if (featurep 'xemacs)
302 (define-key eshell-mode-map [iso-left-tab] 'pcomplete-reverse) 302 (define-key eshell-mode-map [iso-left-tab] 'pcomplete-reverse)
@@ -449,6 +449,13 @@ to writing a completion function."
449 (all-completions filename obarray 'functionp)) 449 (all-completions filename obarray 'functionp))
450 completions))))))) 450 completions)))))))
451 451
452(defun eshell-pcomplete ()
453 "Eshell wrapper for `pcomplete'."
454 (interactive)
455 (if eshell-cmpl-ignore-case
456 (pcomplete-expand-and-complete) ; hack workaround for bug#12838
457 (pcomplete)))
458
452(provide 'em-cmpl) 459(provide 'em-cmpl)
453 460
454;; Local Variables: 461;; Local Variables:
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index d3ddab8af1b..32744c702a6 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -306,12 +306,13 @@ Remove (unlink) the FILE(s).")
306 (eshell-eval-using-options 306 (eshell-eval-using-options
307 "mkdir" args 307 "mkdir" args
308 '((?h "help" nil nil "show this usage screen") 308 '((?h "help" nil nil "show this usage screen")
309 (?p "parents" nil em-parents "make parent directories as needed")
309 :external "mkdir" 310 :external "mkdir"
310 :show-usage 311 :show-usage
311 :usage "[OPTION] DIRECTORY... 312 :usage "[OPTION] DIRECTORY...
312Create the DIRECTORY(ies), if they do not already exist.") 313Create the DIRECTORY(ies), if they do not already exist.")
313 (while args 314 (while args
314 (eshell-funcalln 'make-directory (car args)) 315 (eshell-funcalln 'make-directory (car args) em-parents)
315 (setq args (cdr args))) 316 (setq args (cdr args)))
316 nil)) 317 nil))
317 318
diff --git a/lisp/faces.el b/lisp/faces.el
index f5ef88d08b0..9e0ca962499 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -487,16 +487,21 @@ with the `default' face (which is always completely specified)."
487(defalias 'face-background-pixmap 'face-stipple) 487(defalias 'face-background-pixmap 'face-stipple)
488 488
489 489
490;; FIXME all of these -p functions ignore inheritance (cf face-stipple).
491;; Ie, a face that inherits from an underlined face but does not
492;; specify :underline will return nil.
493;; So these functions don't actually tell you anything about how the
494;; face will _appear_. So not very useful IMO.
490(defun face-underline-p (face &optional frame) 495(defun face-underline-p (face &optional frame)
491 "Return non-nil if FACE is underlined. 496 "Return non-nil if FACE specifies a non-nil underlining.
492If the optional argument FRAME is given, report on face FACE in that frame. 497If the optional argument FRAME is given, report on face FACE in that frame.
493If FRAME is t, report on the defaults for face FACE (for new frames). 498If FRAME is t, report on the defaults for face FACE (for new frames).
494If FRAME is omitted or nil, use the selected frame." 499If FRAME is omitted or nil, use the selected frame."
495 (eq (face-attribute face :underline frame) t)) 500 (face-attribute-specified-or (face-attribute face :underline frame) nil))
496 501
497 502
498(defun face-inverse-video-p (face &optional frame) 503(defun face-inverse-video-p (face &optional frame)
499 "Return non-nil if FACE is in inverse video on FRAME. 504 "Return non-nil if FACE specifies a non-nil inverse-video.
500If the optional argument FRAME is given, report on face FACE in that frame. 505If the optional argument FRAME is given, report on face FACE in that frame.
501If FRAME is t, report on the defaults for face FACE (for new frames). 506If FRAME is t, report on the defaults for face FACE (for new frames).
502If FRAME is omitted or nil, use the selected frame." 507If FRAME is omitted or nil, use the selected frame."
@@ -837,21 +842,24 @@ and DATA is a string, containing the raw bits of the bitmap."
837 (set-face-attribute face frame :stipple (or stipple 'unspecified))) 842 (set-face-attribute face frame :stipple (or stipple 'unspecified)))
838 843
839 844
840(defun set-face-underline-p (face underline &optional frame) 845(defun set-face-underline (face underline &optional frame)
841 "Specify whether face FACE is underlined. 846 "Specify whether face FACE is underlined.
842UNDERLINE nil means FACE explicitly doesn't underline. 847UNDERLINE nil means FACE explicitly doesn't underline.
843UNDERLINE non-nil means FACE explicitly does underlining 848UNDERLINE t means FACE underlines with its foreground color.
844with the same of the foreground color. 849If UNDERLINE is a string, underline with that color.
845If UNDERLINE is a string, underline with the color named UNDERLINE. 850
851UNDERLINE may also be a list of the form (:color COLOR :style STYLE),
852where COLOR is a string or `foreground-color', and STYLE is either
853`line' or `wave'. :color may be omitted, which means to use the
854foreground color. :style may be omitted, which means to use a line.
855
846FRAME nil or not specified means change face on all frames. 856FRAME nil or not specified means change face on all frames.
847Use `set-face-attribute' to ``unspecify'' underlining." 857Use `set-face-attribute' to ``unspecify'' underlining."
848 (interactive 858 (interactive (read-face-and-attribute :underline))
849 (let ((list (read-face-and-attribute :underline)))
850 (list (car list) (eq (car (cdr list)) t))))
851 (set-face-attribute face frame :underline underline)) 859 (set-face-attribute face frame :underline underline))
852 860
853(define-obsolete-function-alias 'set-face-underline 861(define-obsolete-function-alias 'set-face-underline-p
854 'set-face-underline-p "22.1") 862 'set-face-underline "24.3")
855 863
856 864
857(defun set-face-inverse-video-p (face inverse-video-p &optional frame) 865(defun set-face-inverse-video-p (face inverse-video-p &optional frame)
@@ -866,6 +874,9 @@ Use `set-face-attribute' to ``unspecify'' the inverse video attribute."
866 (set-face-attribute face frame :inverse-video inverse-video-p)) 874 (set-face-attribute face frame :inverse-video inverse-video-p))
867 875
868 876
877;; The -p suffix is a hostage to fortune. What if we want to extend
878;; this to allow more than boolean options? Exactly this happened
879;; to set-face-underline-p.
869(defun set-face-bold-p (face bold-p &optional frame) 880(defun set-face-bold-p (face bold-p &optional frame)
870 "Specify whether face FACE is bold. 881 "Specify whether face FACE is bold.
871BOLD-P non-nil means FACE should explicitly display bold. 882BOLD-P non-nil means FACE should explicitly display bold.
@@ -1114,6 +1125,9 @@ name of the attribute for prompting. Value is the new attribute value."
1114 (string-to-number new-value))))) 1125 (string-to-number new-value)))))
1115 1126
1116 1127
1128;; FIXME this does allow you to enter the list forms of :box,
1129;; :stipple, or :underline, because face-valid-attribute-values does
1130;; not return those forms.
1117(defun read-face-attribute (face attribute &optional frame) 1131(defun read-face-attribute (face attribute &optional frame)
1118 "Interactively read a new value for FACE's ATTRIBUTE. 1132 "Interactively read a new value for FACE's ATTRIBUTE.
1119Optional argument FRAME nil or unspecified means read an attribute value 1133Optional argument FRAME nil or unspecified means read an attribute value
@@ -1125,12 +1139,11 @@ of a global face. Value is the new attribute value."
1125 ;; Represent complex attribute values as strings by printing them 1139 ;; Represent complex attribute values as strings by printing them
1126 ;; out. Stipple can be a vector; (WIDTH HEIGHT DATA). Box can be 1140 ;; out. Stipple can be a vector; (WIDTH HEIGHT DATA). Box can be
1127 ;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow 1141 ;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow
1128 ;; SHADOW)'. 1142 ;; SHADOW)'. Underline can be `(:color COLOR :style STYLE)'.
1129 (when (and (or (eq attribute :stipple) 1143 (and (memq attribute '(:box :stipple :underline))
1130 (eq attribute :box)) 1144 (or (consp old-value)
1131 (or (consp old-value) 1145 (vectorp old-value))
1132 (vectorp old-value))) 1146 (setq old-value (prin1-to-string old-value)))
1133 (setq old-value (prin1-to-string old-value)))
1134 (cond ((listp valid) 1147 (cond ((listp valid)
1135 (let ((default 1148 (let ((default
1136 (or (car (rassoc old-value valid)) 1149 (or (car (rassoc old-value valid))
@@ -1160,11 +1173,10 @@ of a global face. Value is the new attribute value."
1160 ;; Convert stipple and box value text we read back to a list or 1173 ;; Convert stipple and box value text we read back to a list or
1161 ;; vector if it looks like one. This makes the assumption that a 1174 ;; vector if it looks like one. This makes the assumption that a
1162 ;; pixmap file name won't start with an open-paren. 1175 ;; pixmap file name won't start with an open-paren.
1163 (when (and (or (eq attribute :stipple) 1176 (and (memq attribute '(:stipple :box :underline))
1164 (eq attribute :box)) 1177 (stringp new-value)
1165 (stringp new-value) 1178 (string-match "^[[(]" new-value)
1166 (string-match "^[[(]" new-value)) 1179 (setq new-value (read new-value)))
1167 (setq new-value (read new-value)))
1168 new-value)) 1180 new-value))
1169 1181
1170(declare-function fontset-list "fontset.c" ()) 1182(declare-function fontset-list "fontset.c" ())
diff --git a/lisp/filecache.el b/lisp/filecache.el
index 2dd7c2673bf..23246c24c45 100644
--- a/lisp/filecache.el
+++ b/lisp/filecache.el
@@ -310,23 +310,22 @@ files in each directory, not to the directory list itself."
310(defun file-cache-add-file (file) 310(defun file-cache-add-file (file)
311 "Add FILE to the file cache." 311 "Add FILE to the file cache."
312 (interactive "fAdd File: ") 312 (interactive "fAdd File: ")
313 (if (not (file-exists-p file)) 313 (setq file (file-truename file))
314 (message "Filecache: file %s does not exist" file) 314 (unless (file-exists-p file)
315 (let* ((file-name (file-name-nondirectory file)) 315 (error "Filecache: file %s does not exist" file))
316 (dir-name (file-name-directory file)) 316 (let* ((file-name (file-name-nondirectory file))
317 (the-entry (assoc-string 317 (dir-name (file-name-directory file))
318 file-name file-cache-alist 318 (the-entry (assoc-string file-name file-cache-alist
319 file-cache-ignore-case))) 319 file-cache-ignore-case)))
320 ;; Does the entry exist already? 320 ;; Does the entry exist already?
321 (if the-entry 321 (if the-entry
322 (if (or (and (stringp (cdr the-entry)) 322 (unless (or (and (stringp (cdr the-entry))
323 (string= dir-name (cdr the-entry))) 323 (string= dir-name (cdr the-entry)))
324 (and (listp (cdr the-entry)) 324 (and (listp (cdr the-entry))
325 (member dir-name (cdr the-entry)))) 325 (member dir-name (cdr the-entry))))
326 nil 326 (setcdr the-entry (cons dir-name (cdr the-entry))))
327 (setcdr the-entry (cons dir-name (cdr the-entry)))) 327 ;; If not, add it to the cache
328 ;; If not, add it to the cache 328 (push (list file-name dir-name) file-cache-alist))))
329 (push (list file-name dir-name) file-cache-alist)))))
330 329
331;;;###autoload 330;;;###autoload
332(defun file-cache-add-directory-using-find (directory) 331(defun file-cache-add-directory-using-find (directory)
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 5f635e59cdf..dd493d383a3 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,17 @@
12012-11-16 Jan Tatarik <jan.tatarik@gmail.com>
2
3 * gnus-score.el (gnus-score-body):
4 * gnus-logic.el (gnus-advanced-body): Don't score by headers when
5 scoring by body.
6
72012-11-16 Glenn Morris <rgm@gnu.org>
8
9 * gnus-diary.el (nndiary-request-create-group-functions)
10 (nndiary-request-update-info-functions)
11 (gnus-subscribe-newsgroup-functions)
12 (nndiary-request-accept-article-functions):
13 Use new names for hooks rather than obsolete aliases.
14
12012-11-08 Katsumi Yamaoka <yamaoka@jpl.org> 152012-11-08 Katsumi Yamaoka <yamaoka@jpl.org>
2 16
3 * gnus-art.el (gnus-article-browse-html-parts): Always replace charset 17 * gnus-art.el (gnus-article-browse-html-parts): Always replace charset
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index 854af2f5d76..bca307b19b6 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -277,18 +277,18 @@ Optional prefix (or REVERSE argument) means sort in reverse order."
277 277
278;; Called when a group is subscribed. This is needed because groups created 278;; Called when a group is subscribed. This is needed because groups created
279;; because of mail splitting are *not* created with the back end function. 279;; because of mail splitting are *not* created with the back end function.
280;; Thus, `nndiary-request-create-group-hooks' is inoperative. 280;; Thus, `nndiary-request-create-group-functions' is inoperative.
281(defun gnus-diary-maybe-update-group-parameters (group) 281(defun gnus-diary-maybe-update-group-parameters (group)
282 (when (eq (car (gnus-find-method-for-group group)) 'nndiary) 282 (when (eq (car (gnus-find-method-for-group group)) 'nndiary)
283 (gnus-diary-update-group-parameters group))) 283 (gnus-diary-update-group-parameters group)))
284 284
285(add-hook 'nndiary-request-create-group-hooks 285(add-hook 'nndiary-request-create-group-functions
286 'gnus-diary-update-group-parameters) 286 'gnus-diary-update-group-parameters)
287;; Now that we have `gnus-subscribe-newsgroup-hooks', this is not needed 287;; Now that we have `gnus-subscribe-newsgroup-functions', this is not needed
288;; anymore. Maybe I should remove this completely. 288;; anymore. Maybe I should remove this completely.
289(add-hook 'nndiary-request-update-info-hooks 289(add-hook 'nndiary-request-update-info-functions
290 'gnus-diary-update-group-parameters) 290 'gnus-diary-update-group-parameters)
291(add-hook 'gnus-subscribe-newsgroup-hooks 291(add-hook 'gnus-subscribe-newsgroup-functions
292 'gnus-diary-maybe-update-group-parameters) 292 'gnus-diary-maybe-update-group-parameters)
293 293
294 294
@@ -384,7 +384,7 @@ If ARG (or prefix) is non-nil, force prompting for all fields."
384 nndiary-headers) 384 nndiary-headers)
385 )) 385 ))
386 386
387(add-hook 'nndiary-request-accept-article-hooks 387(add-hook 'nndiary-request-accept-article-functions
388 (lambda () (gnus-diary-check-message nil))) 388 (lambda () (gnus-diary-check-message nil)))
389 389
390(define-key message-mode-map "\C-c\C-fd" 'gnus-diary-check-message) 390(define-key message-mode-map "\C-c\C-fd" 'gnus-diary-check-message)
diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el
index a440b779930..60d7b31713b 100644
--- a/lisp/gnus/gnus-logic.el
+++ b/lisp/gnus/gnus-logic.el
@@ -181,17 +181,18 @@
181 (with-current-buffer nntp-server-buffer 181 (with-current-buffer nntp-server-buffer
182 (let* ((request-func (cond ((string= "head" header) 182 (let* ((request-func (cond ((string= "head" header)
183 'gnus-request-head) 183 'gnus-request-head)
184 ;; We need to peek at the headers to detect the
185 ;; content encoding
186 ((string= "body" header) 184 ((string= "body" header)
187 'gnus-request-article) 185 'gnus-request-body)
188 (t 'gnus-request-article))) 186 (t 'gnus-request-article)))
189 ofunc article handles) 187 ofunc article handles)
190 ;; Not all backends support partial fetching. In that case, we 188 ;; Not all backends support partial fetching. In that case, we
191 ;; just fetch the entire article. 189 ;; just fetch the entire article.
192 (unless (gnus-check-backend-function 190 ;; When scoring by body, we need to peek at the headers to detect the
193 (intern (concat "request-" header)) 191 ;; content encoding
194 gnus-newsgroup-name) 192 (unless (or (gnus-check-backend-function
193 (intern (concat "request-" header))
194 gnus-newsgroup-name)
195 (string= "body" header))
195 (setq ofunc request-func) 196 (setq ofunc request-func)
196 (setq request-func 'gnus-request-article)) 197 (setq request-func 'gnus-request-article))
197 (setq article (mail-header-number gnus-advanced-headers)) 198 (setq article (mail-header-number gnus-advanced-headers))
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index f215b845514..b7061960839 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1762,21 +1762,22 @@ score in `gnus-newsgroup-scored' by SCORE."
1762 (all-scores scores) 1762 (all-scores scores)
1763 (request-func (cond ((string= "head" header) 1763 (request-func (cond ((string= "head" header)
1764 'gnus-request-head) 1764 'gnus-request-head)
1765 ;; We need to peek at the headers to detect
1766 ;; the content encoding
1767 ((string= "body" header) 1765 ((string= "body" header)
1768 'gnus-request-article) 1766 'gnus-request-body)
1769 (t 'gnus-request-article))) 1767 (t 'gnus-request-article)))
1770 entries alist ofunc article last) 1768 entries alist ofunc article last)
1771 (when articles 1769 (when articles
1772 (setq last (mail-header-number (caar (last articles)))) 1770 (setq last (mail-header-number (caar (last articles))))
1773 ;; Not all backends support partial fetching. In that case, 1771 ;; Not all backends support partial fetching. In that case,
1774 ;; we just fetch the entire article. 1772 ;; we just fetch the entire article.
1775 (unless (gnus-check-backend-function 1773 ;; When scoring by body, we need to peek at the headers to detect
1776 (and (string-match "^gnus-" (symbol-name request-func)) 1774 ;; the content encoding
1777 (intern (substring (symbol-name request-func) 1775 (unless (or (gnus-check-backend-function
1778 (match-end 0)))) 1776 (and (string-match "^gnus-" (symbol-name request-func))
1779 gnus-newsgroup-name) 1777 (intern (substring (symbol-name request-func)
1778 (match-end 0))))
1779 gnus-newsgroup-name)
1780 (string= "body" header))
1780 (setq ofunc request-func) 1781 (setq ofunc request-func)
1781 (setq request-func 'gnus-request-article)) 1782 (setq request-func 'gnus-request-article))
1782 (while articles 1783 (while articles
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index f95bf26ad1d..801ed66ec2b 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -178,7 +178,7 @@ Shorter values mean quicker response, but are more CPU intensive.")
178 1000)))))) 178 1000))))))
179 179
180(defvar pop3-uidl) 180(defvar pop3-uidl)
181;; List of UIDLs of existing messages at pesent in the server: 181;; List of UIDLs of existing messages at present in the server:
182;; ("UIDL1" "UIDL2" "UIDL3"...) 182;; ("UIDL1" "UIDL2" "UIDL3"...)
183 183
184(defvar pop3-uidl-saved) 184(defvar pop3-uidl-saved)
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index c1ce5a521be..48c5849d301 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -677,7 +677,8 @@ help buffer."
677 " is also a " "face." "\n\n" facedoc)) 677 " is also a " "face." "\n\n" facedoc))
678 ;; Don't record the `describe-function' item in the stack. 678 ;; Don't record the `describe-function' item in the stack.
679 (setq help-xref-stack-item nil) 679 (setq help-xref-stack-item nil)
680 (help-setup-xref (list #'help-xref-interned symbol) nil))))))) 680 (help-setup-xref (list #'help-xref-interned symbol) nil))))
681 (goto-char (point-min)))))
681 682
682 683
683;; Navigation/hyperlinking with xrefs 684;; Navigation/hyperlinking with xrefs
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 72ca189e9d5..4e0ac1a4856 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -1362,24 +1362,27 @@ group."
1362(defun ibuffer-mark-forward (arg) 1362(defun ibuffer-mark-forward (arg)
1363 "Mark the buffer on this line, and move forward ARG lines. 1363 "Mark the buffer on this line, and move forward ARG lines.
1364If point is on a group name, this function operates on that group." 1364If point is on a group name, this function operates on that group."
1365 (interactive "P") 1365 (interactive "p")
1366 (ibuffer-mark-interactive arg ibuffer-marked-char 1)) 1366 (ibuffer-mark-interactive arg ibuffer-marked-char))
1367 1367
1368(defun ibuffer-unmark-forward (arg) 1368(defun ibuffer-unmark-forward (arg)
1369 "Unmark the buffer on this line, and move forward ARG lines. 1369 "Unmark the buffer on this line, and move forward ARG lines.
1370If point is on a group name, this function operates on that group." 1370If point is on a group name, this function operates on that group."
1371 (interactive "P") 1371 (interactive "p")
1372 (ibuffer-mark-interactive arg ?\s 1)) 1372 (ibuffer-mark-interactive arg ?\s))
1373 1373
1374(defun ibuffer-unmark-backward (arg) 1374(defun ibuffer-unmark-backward (arg)
1375 "Unmark the buffer on this line, and move backward ARG lines. 1375 "Unmark the buffer on this line, and move backward ARG lines.
1376If point is on a group name, this function operates on that group." 1376If point is on a group name, this function operates on that group."
1377 (interactive "P") 1377 (interactive "p")
1378 (ibuffer-mark-interactive arg ?\s -1)) 1378 (ibuffer-unmark-forward (- arg)))
1379 1379
1380(defun ibuffer-mark-interactive (arg mark movement) 1380(defun ibuffer-mark-interactive (arg mark &optional movement)
1381 (ibuffer-assert-ibuffer-mode) 1381 (ibuffer-assert-ibuffer-mode)
1382 (or arg (setq arg 1)) 1382 (or arg (setq arg 1))
1383 ;; deprecated movement argument
1384 (when (and movement (< movement 0))
1385 (setq arg (- arg)))
1383 (ibuffer-forward-line 0) 1386 (ibuffer-forward-line 0)
1384 (ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name) 1387 (ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name)
1385 (progn 1388 (progn
@@ -1389,8 +1392,12 @@ If point is on a group name, this function operates on that group."
1389 (let ((inhibit-read-only t)) 1392 (let ((inhibit-read-only t))
1390 (while (> arg 0) 1393 (while (> arg 0)
1391 (ibuffer-set-mark mark) 1394 (ibuffer-set-mark mark)
1392 (ibuffer-forward-line movement t) 1395 (ibuffer-forward-line 1 t)
1393 (setq arg (1- arg)))))) 1396 (setq arg (1- arg)))
1397 (while (< arg 0)
1398 (ibuffer-forward-line -1 t)
1399 (ibuffer-set-mark mark)
1400 (setq arg (1+ arg))))))
1394 1401
1395(defun ibuffer-set-mark (mark) 1402(defun ibuffer-set-mark (mark)
1396 (ibuffer-assert-ibuffer-mode) 1403 (ibuffer-assert-ibuffer-mode)
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 4686d1cf538..1d3da2db15b 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -546,9 +546,7 @@ The returned alist DOES NOT share structure with MENULIST."
546Return a split and sorted copy of ALIST. The returned alist DOES 546Return a split and sorted copy of ALIST. The returned alist DOES
547NOT share structure with ALIST." 547NOT share structure with ALIST."
548 (mapcar (lambda (elt) 548 (mapcar (lambda (elt)
549 (if (and (consp elt) 549 (if (imenu--subalist-p elt)
550 (stringp (car elt))
551 (listp (cdr elt)))
552 (imenu--split-menu (cdr elt) (car elt)) 550 (imenu--split-menu (cdr elt) (car elt))
553 elt)) 551 elt))
554 alist)) 552 alist))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 60b39606d86..0aa1b8957ac 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -521,12 +521,12 @@ It is needed when D-Bus signals or errors arrive, because there
521is no information where to trace the message.") 521is no information where to trace the message.")
522 522
523(defun tramp-gvfs-dbus-event-error (event err) 523(defun tramp-gvfs-dbus-event-error (event err)
524 "Called when a D-Bus error message arrives, see `dbus-event-error-hooks'." 524 "Called when a D-Bus error message arrives, see `dbus-event-error-functions'."
525 (when tramp-gvfs-dbus-event-vector 525 (when tramp-gvfs-dbus-event-vector
526 (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event) 526 (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event)
527 (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err)))) 527 (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
528 528
529(add-hook 'dbus-event-error-hooks 'tramp-gvfs-dbus-event-error) 529(add-hook 'dbus-event-error-functions 'tramp-gvfs-dbus-event-error)
530 530
531 531
532;; File name primitives. 532;; File name primitives.
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index f3e277e338c..a3ea4af4651 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -560,7 +560,7 @@ FILE is created there."
560 (goto-char (point-min)) 560 (goto-char (point-min))
561 (search-forward (concat (int-to-string score) 561 (search-forward (concat (int-to-string score)
562 " " (user-login-name) " " 562 " " (user-login-name) " "
563 marker-string)) 563 marker-string) nil t)
564 (beginning-of-line))))) 564 (beginning-of-line)))))
565 565
566(defun gamegrid-add-score-insecure (file score &optional directory) 566(defun gamegrid-add-score-insecure (file score &optional directory)
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 7c72b73a879..9d78b20ba4c 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -105,7 +105,10 @@
105(eval-and-compile 105(eval-and-compile
106 (defconst ruby-here-doc-beg-re 106 (defconst ruby-here-doc-beg-re
107 "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)" 107 "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)"
108 "Regexp to match the beginning of a heredoc.")) 108 "Regexp to match the beginning of a heredoc.")
109
110 (defconst ruby-expression-expansion-re
111 "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)"))
109 112
110(defun ruby-here-doc-end-match () 113(defun ruby-here-doc-end-match ()
111 "Return a regexp to find the end of a heredoc. 114 "Return a regexp to find the end of a heredoc.
@@ -384,7 +387,9 @@ and `\\' when preceded by `?'."
384 (looking-at "class\\s *<<")))) 387 (looking-at "class\\s *<<"))))
385 388
386(defun ruby-expr-beg (&optional option) 389(defun ruby-expr-beg (&optional option)
387 "TODO: document." 390 "Check if point is possibly at the beginning of an expression.
391OPTION specifies the type of the expression.
392Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
388 (save-excursion 393 (save-excursion
389 (store-match-data nil) 394 (store-match-data nil)
390 (let ((space (skip-chars-backward " \t")) 395 (let ((space (skip-chars-backward " \t"))
@@ -397,10 +402,10 @@ and `\\' when preceded by `?'."
397 (or (eq (char-syntax (char-before (point))) ?w) 402 (or (eq (char-syntax (char-before (point))) ?w)
398 (ruby-special-char-p)))) 403 (ruby-special-char-p))))
399 nil) 404 nil)
400 ((and (eq option 'heredoc) (< space 0)) 405 ((looking-at ruby-operator-re))
401 (not (progn (goto-char start) (ruby-singleton-class-p)))) 406 ((eq option 'heredoc)
402 ((or (looking-at ruby-operator-re) 407 (and (< space 0) (not (ruby-singleton-class-p start))))
403 (looking-at "[\\[({,;]") 408 ((or (looking-at "[\\[({,;]")
404 (and (looking-at "[!?]") 409 (and (looking-at "[!?]")
405 (or (not (eq option 'modifier)) 410 (or (not (eq option 'modifier))
406 (bolp) 411 (bolp)
@@ -865,39 +870,54 @@ calculating indentation on the lines after it."
865 (beginning-of-line))))) 870 (beginning-of-line)))))
866 871
867(defun ruby-move-to-block (n) 872(defun ruby-move-to-block (n)
868 "Move to the beginning (N < 0) or the end (N > 0) of the current block 873 "Move to the beginning (N < 0) or the end (N > 0) of the
869or blocks containing the current block." 874current block, a sibling block, or an outer block. Do that (abs N) times."
870 ;; TODO: Make this work for n > 1,
871 ;; make it not loop for n = 0,
872 ;; document body
873 (let ((orig (point)) 875 (let ((orig (point))
874 (start (ruby-calculate-indent)) 876 (start (ruby-calculate-indent))
875 (down (looking-at (if (< n 0) ruby-block-end-re 877 (signum (if (> n 0) 1 -1))
876 (concat "\\<\\(" ruby-block-beg-re "\\)\\>")))) 878 (backward (< n 0))
877 pos done) 879 down pos done)
878 (while (and (not done) (not (if (< n 0) (bobp) (eobp)))) 880 (dotimes (_ (abs n))
879 (forward-line n) 881 (setq done nil)
880 (cond 882 (setq down (save-excursion
881 ((looking-at "^\\s *$")) 883 (back-to-indentation)
882 ((looking-at "^\\s *#")) 884 ;; There is a block start or block end keyword on this
883 ((and (> n 0) (looking-at "^=begin\\>")) 885 ;; line, don't need to look for another block.
884 (re-search-forward "^=end\\>")) 886 (and (re-search-forward
885 ((and (< n 0) (looking-at "^=end\\>")) 887 (if backward ruby-block-end-re
886 (re-search-backward "^=begin\\>")) 888 (concat "\\_<\\(" ruby-block-beg-re "\\)\\_>"))
887 (t 889 (line-end-position) t)
888 (setq pos (current-indentation)) 890 (not (nth 8 (syntax-ppss))))))
891 (while (and (not done) (not (if backward (bobp) (eobp))))
892 (forward-line signum)
889 (cond 893 (cond
890 ((< start pos) 894 ;; Skip empty and commented out lines.
891 (setq down t)) 895 ((looking-at "^\\s *$"))
892 ((and down (= pos start)) 896 ((looking-at "^\\s *#"))
893 (setq done t)) 897 ;; Skip block comments;
894 ((> start pos) 898 ((and (not backward) (looking-at "^=begin\\>"))
895 (setq done t))))) 899 (re-search-forward "^=end\\>"))
896 (if done 900 ((and backward (looking-at "^=end\\>"))
897 (save-excursion 901 (re-search-backward "^=begin\\>"))
898 (back-to-indentation) 902 (t
899 (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>")) 903 (setq pos (current-indentation))
900 (setq done nil))))) 904 (cond
905 ;; Deeper indentation, we found a block.
906 ;; FIXME: We can't recognize empty blocks this way.
907 ((< start pos)
908 (setq down t))
909 ;; Block found, and same indentation as when started, stop.
910 ((and down (= pos start))
911 (setq done t))
912 ;; Shallower indentation, means outer block, can stop now.
913 ((> start pos)
914 (setq done t)))))
915 (if done
916 (save-excursion
917 (back-to-indentation)
918 ;; Not really at the first or last line of the block, move on.
919 (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>"))
920 (setq done nil))))))
901 (back-to-indentation))) 921 (back-to-indentation)))
902 922
903(defun ruby-beginning-of-block (&optional arg) 923(defun ruby-beginning-of-block (&optional arg)
@@ -909,8 +929,7 @@ With ARG, move up multiple blocks."
909(defun ruby-end-of-block (&optional arg) 929(defun ruby-end-of-block (&optional arg)
910 "Move forward to the end of the current block. 930 "Move forward to the end of the current block.
911With ARG, move out of multiple blocks." 931With ARG, move out of multiple blocks."
912 ;; Passing a value > 1 to ruby-move-to-block currently doesn't work. 932 (interactive "p")
913 (interactive)
914 (ruby-move-to-block (or arg 1))) 933 (ruby-move-to-block (or arg 1)))
915 934
916(defun ruby-forward-sexp (&optional arg) 935(defun ruby-forward-sexp (&optional arg)
@@ -1233,7 +1252,19 @@ It will be properly highlighted even when the call omits parens."))
1233 ;; Handle percent literals: %w(), %q{}, etc. 1252 ;; Handle percent literals: %w(), %q{}, etc.
1234 ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re) 1253 ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re)
1235 (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end))))) 1254 (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end)))))
1236 (point) end)) 1255 (point) end)
1256 (remove-text-properties start end '(ruby-expansion-match-data))
1257 (goto-char start)
1258 ;; Find all expression expansions and
1259 ;; - set the syntax of all text inside to whitespace,
1260 ;; - save the match data to a text property, for font-locking later.
1261 (while (re-search-forward ruby-expression-expansion-re end 'move)
1262 (when (ruby-in-ppss-context-p 'string)
1263 (put-text-property (match-beginning 2) (match-end 2)
1264 'syntax-table (string-to-syntax "-"))
1265 (put-text-property (match-beginning 2) (1+ (match-beginning 2))
1266 'ruby-expansion-match-data
1267 (match-data)))))
1237 1268
1238 (defun ruby-syntax-propertize-heredoc (limit) 1269 (defun ruby-syntax-propertize-heredoc (limit)
1239 (let ((ppss (syntax-ppss)) 1270 (let ((ppss (syntax-ppss))
@@ -1566,7 +1597,7 @@ See `font-lock-syntax-table'.")
1566 '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face) 1597 '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face)
1567 ;; expression expansion 1598 ;; expression expansion
1568 '(ruby-match-expression-expansion 1599 '(ruby-match-expression-expansion
1569 0 font-lock-variable-name-face t) 1600 2 font-lock-variable-name-face t)
1570 ;; warn lower camel case 1601 ;; warn lower camel case
1571 ;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)" 1602 ;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)"
1572 ; 0 font-lock-warning-face) 1603 ; 0 font-lock-warning-face)
@@ -1574,9 +1605,14 @@ See `font-lock-syntax-table'.")
1574 "Additional expressions to highlight in Ruby mode.") 1605 "Additional expressions to highlight in Ruby mode.")
1575 1606
1576(defun ruby-match-expression-expansion (limit) 1607(defun ruby-match-expression-expansion (limit)
1577 (when (re-search-forward "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)" limit 'move) 1608 (let ((prop 'ruby-expansion-match-data) pos value)
1578 (or (ruby-in-ppss-context-p 'string) 1609 (when (and (setq pos (next-single-char-property-change (point) prop
1579 (ruby-match-expression-expansion limit)))) 1610 nil limit))
1611 (> pos (point)))
1612 (goto-char pos)
1613 (or (and (setq value (get-text-property pos prop))
1614 (progn (set-match-data value) t))
1615 (ruby-match-expression-expansion limit)))))
1580 1616
1581;;;###autoload 1617;;;###autoload
1582(define-derived-mode ruby-mode prog-mode "Ruby" 1618(define-derived-mode ruby-mode prog-mode "Ruby"
diff --git a/lisp/subr.el b/lisp/subr.el
index 48d208235dd..1a850b1eabf 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3972,11 +3972,16 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
3972 (put symbol 'hookvar (or hookvar 'mail-send-hook))) 3972 (put symbol 'hookvar (or hookvar 'mail-send-hook)))
3973 3973
3974(defun set-temporary-overlay-map (map &optional keep-pred) 3974(defun set-temporary-overlay-map (map &optional keep-pred)
3975 "Set MAP as a temporary overlay map. 3975 "Set MAP as a temporary keymap taking precedence over most other keymaps.
3976When KEEP-PRED is `t', using a key from the temporary keymap 3976Note that this does NOT take precedence over the \"overriding\" maps
3977leaves this keymap activated. KEEP-PRED can also be a function, 3977`overriding-terminal-local-map' and `overriding-local-map' (or the
3978which will have the same effect when it returns `t'. 3978`keymap' text property). Unlike those maps, if no match for a key is
3979When KEEP-PRED is nil, the temporary keymap is used only once." 3979found in MAP, the normal key lookup sequence then continues.
3980
3981Normally, MAP is used only once. If the optional argument
3982KEEP-PRED is t, MAP stays active if a key from MAP is used.
3983KEEP-PRED can also be a function of no arguments: if it returns
3984non-nil then MAP stays active."
3980 (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map")) 3985 (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
3981 (overlaysym (make-symbol "t")) 3986 (overlaysym (make-symbol "t"))
3982 (alist (list (cons overlaysym map))) 3987 (alist (list (cons overlaysym map)))
diff --git a/lisp/term.el b/lisp/term.el
index e6466b8fa95..d6acaef1ae9 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -4178,11 +4178,16 @@ the process. Any more args are arguments to PROGRAM."
4178 (term-mode) 4178 (term-mode)
4179 (term-char-mode) 4179 (term-char-mode)
4180 4180
4181 ;; I wanna have find-file on C-x C-f -mm 4181 ;; Historical baggage. A call to term-set-escape-char used to not
4182 ;; your mileage may definitely vary, maybe it's better to put this in your 4182 ;; undo any previous call to t-s-e-c. Because of this, ansi-term
4183 ;; .emacs ... 4183 ;; ended up with both C-x and C-c as escape chars. Who knows what
4184 4184 ;; the original intention was, but people could have become used to
4185 (term-set-escape-char ?\C-x) 4185 ;; either. (Bug#12842)
4186 (let (term-escape-char)
4187 ;; I wanna have find-file on C-x C-f -mm
4188 ;; your mileage may definitely vary, maybe it's better to put this in your
4189 ;; .emacs ...
4190 (term-set-escape-char ?\C-x))
4186 4191
4187 (switch-to-buffer term-ansi-buffer-name)) 4192 (switch-to-buffer term-ansi-buffer-name))
4188 4193
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index ad6e1125027..224fb7c1442 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -116,7 +116,7 @@
116 "/") 116 "/")
117 "/"))) 117 "/")))
118 (dnd-handle-one-url window 'private 118 (dnd-handle-one-url window 'private
119 (concat "file:" file-name))) 119 (concat "file://" file-name)))
120 120
121(defun w32-drag-n-drop (event &optional new-frame) 121(defun w32-drag-n-drop (event &optional new-frame)
122 "Edit the files listed in the drag-n-drop EVENT. 122 "Edit the files listed in the drag-n-drop EVENT.
diff --git a/lisp/window.el b/lisp/window.el
index 30ee622cfe6..9ac3a4ecda0 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -2571,8 +2571,7 @@ move it as far as possible in the desired direction."
2571Interactively, if no argument is given, make the selected window 2571Interactively, if no argument is given, make the selected window
2572one line taller. If optional argument HORIZONTAL is non-nil, 2572one line taller. If optional argument HORIZONTAL is non-nil,
2573make selected window wider by DELTA columns. If DELTA is 2573make selected window wider by DELTA columns. If DELTA is
2574negative, shrink selected window by -DELTA lines or columns. 2574negative, shrink selected window by -DELTA lines or columns."
2575Return nil."
2576 (interactive "p") 2575 (interactive "p")
2577 (let ((minibuffer-window (minibuffer-window))) 2576 (let ((minibuffer-window (minibuffer-window)))
2578 (cond 2577 (cond
@@ -2605,8 +2604,7 @@ Interactively, if no argument is given, make the selected window
2605one line smaller. If optional argument HORIZONTAL is non-nil, 2604one line smaller. If optional argument HORIZONTAL is non-nil,
2606make selected window narrower by DELTA columns. If DELTA is 2605make selected window narrower by DELTA columns. If DELTA is
2607negative, enlarge selected window by -DELTA lines or columns. 2606negative, enlarge selected window by -DELTA lines or columns.
2608Also see the `window-min-height' variable. 2607Also see the `window-min-height' variable."
2609Return nil."
2610 (interactive "p") 2608 (interactive "p")
2611 (let ((minibuffer-window (minibuffer-window))) 2609 (let ((minibuffer-window (minibuffer-window)))
2612 (cond 2610 (cond
@@ -3049,8 +3047,10 @@ WINDOW must be a live window and defaults to the selected one."
3049 (set-marker (nth 2 entry) point)) 3047 (set-marker (nth 2 entry) point))
3050 ;; Make new markers. 3048 ;; Make new markers.
3051 (list (copy-marker start) 3049 (list (copy-marker start)
3052 (copy-marker point))))) 3050 (copy-marker
3053 3051 ;; Preserve window-point-insertion-type
3052 ;; (Bug#12588).
3053 point window-point-insertion-type)))))
3054 (set-window-prev-buffers 3054 (set-window-prev-buffers
3055 window (cons entry (window-prev-buffers window)))))))) 3055 window (cons entry (window-prev-buffers window))))))))
3056 3056
@@ -4555,13 +4555,17 @@ element is BUFFER."
4555 ;; If WINDOW has a quit-restore parameter, reset its car. 4555 ;; If WINDOW has a quit-restore parameter, reset its car.
4556 (setcar (window-parameter window 'quit-restore) 'same)) 4556 (setcar (window-parameter window 'quit-restore) 'same))
4557 ;; WINDOW shows another buffer. 4557 ;; WINDOW shows another buffer.
4558 (set-window-parameter 4558 (with-current-buffer (window-buffer window)
4559 window 'quit-restore 4559 (set-window-parameter
4560 (list 'other 4560 window 'quit-restore
4561 ;; A quadruple of WINDOW's buffer, start, point and height. 4561 (list 'other
4562 (list (window-buffer window) (window-start window) 4562 ;; A quadruple of WINDOW's buffer, start, point and height.
4563 (window-point window) (window-total-size window)) 4563 (list (current-buffer) (window-start window)
4564 (selected-window) buffer)))) 4564 ;; Preserve window-point-insertion-type (Bug#12588).
4565 (copy-marker
4566 (window-point window) window-point-insertion-type)
4567 (window-total-size window))
4568 (selected-window) buffer)))))
4565 ((eq type 'window) 4569 ((eq type 'window)
4566 ;; WINDOW has been created on an existing frame. 4570 ;; WINDOW has been created on an existing frame.
4567 (set-window-parameter 4571 (set-window-parameter
@@ -5170,11 +5174,12 @@ is higher than WINDOW."
5170 (error nil)))) 5174 (error nil))))
5171 5175
5172(defun window--display-buffer (buffer window type &optional alist dedicated) 5176(defun window--display-buffer (buffer window type &optional alist dedicated)
5173 "Display BUFFER in WINDOW and make its frame visible. 5177 "Display BUFFER in WINDOW.
5174TYPE must be one of the symbols `reuse', `window' or `frame' and 5178TYPE must be one of the symbols `reuse', `window' or `frame' and
5175is passed unaltered to `display-buffer-record-window'. Set 5179is passed unaltered to `display-buffer-record-window'. ALIST is
5176`window-dedicated-p' to DEDICATED if non-nil. Return WINDOW if 5180the alist argument of `display-buffer'. Set `window-dedicated-p'
5177BUFFER and WINDOW are live." 5181to DEDICATED if non-nil. Return WINDOW if BUFFER and WINDOW are
5182live."
5178 (when (and (buffer-live-p buffer) (window-live-p window)) 5183 (when (and (buffer-live-p buffer) (window-live-p window))
5179 (display-buffer-record-window type window buffer) 5184 (display-buffer-record-window type window buffer)
5180 (unless (eq buffer (window-buffer window)) 5185 (unless (eq buffer (window-buffer window))
@@ -5187,10 +5192,10 @@ BUFFER and WINDOW are live."
5187 (let ((parameter (window-parameter window 'quit-restore)) 5192 (let ((parameter (window-parameter window 'quit-restore))
5188 (height (cdr (assq 'window-height alist))) 5193 (height (cdr (assq 'window-height alist)))
5189 (width (cdr (assq 'window-width alist)))) 5194 (width (cdr (assq 'window-width alist))))
5190 (when (or (memq type '(window frame)) 5195 (when (or (eq type 'window)
5191 (and (eq (car parameter) 'same) 5196 (and (eq (car parameter) 'same)
5192 (memq (nth 1 parameter) '(window frame)))) 5197 (eq (nth 1 parameter) 'window)))
5193 ;; Adjust height of new window or frame. 5198 ;; Adjust height of window if asked for.
5194 (cond 5199 (cond
5195 ((not height)) 5200 ((not height))
5196 ((numberp height) 5201 ((numberp height)
@@ -5201,19 +5206,12 @@ BUFFER and WINDOW are live."
5201 (* (window-total-size (frame-root-window window)) 5206 (* (window-total-size (frame-root-window window))
5202 height)))) 5207 height))))
5203 (delta (- new-height (window-total-size window)))) 5208 (delta (- new-height (window-total-size window))))
5204 (cond 5209 (when (and (window--resizable-p window delta nil 'safe)
5205 ((and (window--resizable-p window delta nil 'safe) 5210 (window-combined-p window))
5206 (window-combined-p window)) 5211 (window-resize window delta nil 'safe))))
5207 (window-resize window delta nil 'safe))
5208 ((or (eq type 'frame)
5209 (and (eq (car parameter) 'same)
5210 (eq (nth 1 parameter) 'frame)))
5211 (set-frame-height
5212 (window-frame window)
5213 (+ (frame-height (window-frame window)) delta))))))
5214 ((functionp height) 5212 ((functionp height)
5215 (ignore-errors (funcall height window)))) 5213 (ignore-errors (funcall height window))))
5216 ;; Adjust width of a window or frame. 5214 ;; Adjust width of window if asked for.
5217 (cond 5215 (cond
5218 ((not width)) 5216 ((not width))
5219 ((numberp width) 5217 ((numberp width)
@@ -5224,18 +5222,12 @@ BUFFER and WINDOW are live."
5224 (* (window-total-size (frame-root-window window) t) 5222 (* (window-total-size (frame-root-window window) t)
5225 width)))) 5223 width))))
5226 (delta (- new-width (window-total-size window t)))) 5224 (delta (- new-width (window-total-size window t))))
5227 (cond 5225 (when (and (window--resizable-p window delta t 'safe)
5228 ((and (window--resizable-p window delta t 'safe) 5226 (window-combined-p window t))
5229 (window-combined-p window t)) 5227 (window-resize window delta t 'safe))))
5230 (window-resize window delta t 'safe))
5231 ((or (eq type 'frame)
5232 (and (eq (car parameter) 'same)
5233 (eq (nth 1 parameter) 'frame)))
5234 (set-frame-width
5235 (window-frame window)
5236 (+ (frame-width (window-frame window)) delta))))))
5237 ((functionp width) 5228 ((functionp width)
5238 (ignore-errors (funcall width window)))))) 5229 (ignore-errors (funcall width window))))))
5230
5239 window)) 5231 window))
5240 5232
5241(defun window--maybe-raise-frame (frame) 5233(defun window--maybe-raise-frame (frame)
@@ -5295,13 +5287,19 @@ See `display-buffer' for details.")
5295 "Alist of conditional actions for `display-buffer'. 5287 "Alist of conditional actions for `display-buffer'.
5296This is a list of elements (CONDITION . ACTION), where: 5288This is a list of elements (CONDITION . ACTION), where:
5297 5289
5298 CONDITION is either a regexp matching buffer names, or a function 5290 CONDITION is either a regexp matching buffer names, or a
5299 that takes a buffer and returns a boolean. 5291 function that takes two arguments - a buffer name and the
5292 ACTION argument of `display-buffer' - and returns a boolean.
5300 5293
5301 ACTION is a cons cell (FUNCTION . ALIST), where FUNCTION is a 5294 ACTION is a cons cell (FUNCTION . ALIST), where FUNCTION is a
5302 function or a list of functions. Each such function should 5295 function or a list of functions. Each such function should
5303 accept two arguments: a buffer to display and an alist of the 5296 accept two arguments: a buffer to display and an alist of the
5304 same form as ALIST. See `display-buffer' for details." 5297 same form as ALIST. See `display-buffer' for details.
5298
5299`display-buffer' scans this alist until it either finds a
5300matching regular expression or the function specified by a
5301condition returns non-nil. In any of these cases, it adds the
5302associated action to the list of actions it will try."
5305 :type `(alist :key-type 5303 :type `(alist :key-type
5306 (choice :tag "Condition" 5304 (choice :tag "Condition"
5307 regexp 5305 regexp
@@ -5335,15 +5333,16 @@ specified, e.g. by the user options `display-buffer-alist' or
5335`display-buffer-base-action'. See `display-buffer'.") 5333`display-buffer-base-action'. See `display-buffer'.")
5336(put 'display-buffer-fallback-action 'risky-local-variable t) 5334(put 'display-buffer-fallback-action 'risky-local-variable t)
5337 5335
5338(defun display-buffer-assq-regexp (buffer-name alist) 5336(defun display-buffer-assq-regexp (buffer-name alist action)
5339 "Retrieve ALIST entry corresponding to BUFFER-NAME." 5337 "Retrieve ALIST entry corresponding to BUFFER-NAME.
5338ACTION is the action argument passed to `display-buffer'."
5340 (catch 'match 5339 (catch 'match
5341 (dolist (entry alist) 5340 (dolist (entry alist)
5342 (let ((key (car entry))) 5341 (let ((key (car entry)))
5343 (when (or (and (stringp key) 5342 (when (or (and (stringp key)
5344 (string-match-p key buffer-name)) 5343 (string-match-p key buffer-name))
5345 (and (symbolp key) (functionp key) 5344 (and (functionp key)
5346 (funcall key buffer-name alist))) 5345 (funcall key buffer-name action)))
5347 (throw 'match (cdr entry))))))) 5346 (throw 'match (cdr entry)))))))
5348 5347
5349(defvar display-buffer--same-window-action 5348(defvar display-buffer--same-window-action
@@ -5453,8 +5452,8 @@ argument, ACTION is t."
5453 (funcall display-buffer-function buffer inhibit-same-window) 5452 (funcall display-buffer-function buffer inhibit-same-window)
5454 ;; Otherwise, use the defined actions. 5453 ;; Otherwise, use the defined actions.
5455 (let* ((user-action 5454 (let* ((user-action
5456 (display-buffer-assq-regexp (buffer-name buffer) 5455 (display-buffer-assq-regexp
5457 display-buffer-alist)) 5456 (buffer-name buffer) display-buffer-alist action))
5458 (special-action (display-buffer--special-action buffer)) 5457 (special-action (display-buffer--special-action buffer))
5459 ;; Extra actions from the arguments to this function: 5458 ;; Extra actions from the arguments to this function:
5460 (extra-action 5459 (extra-action
@@ -6068,22 +6067,26 @@ of `fit-frame-to-buffer-max-height' and `window-min-height'."
6068 :group 'help) 6067 :group 'help)
6069 6068
6070(defcustom fit-frame-to-buffer-bottom-margin 4 6069(defcustom fit-frame-to-buffer-bottom-margin 4
6071 "Bottom margin for `fit-frame-to-buffer'. 6070 "Bottom margin for the command `fit-frame-to-buffer'.
6072This is the number of lines `fit-frame-to-buffer' leaves free at the 6071This is the number of lines that function leaves free at the bottom of
6073bottom of the display in order to not obscure the system task bar." 6072the display, in order to not obscure any system task bar or panel.
6073If you do not have one (or if it is vertical) you might want to
6074reduce this. If it is thicker, you might want to increase this."
6075 ;; If you set this too small, fit-frame-to-buffer can shift the
6076 ;; frame up to avoid the panel.
6074 :type 'integer 6077 :type 'integer
6075 :version "24.3" 6078 :version "24.3"
6076 :group 'windows) 6079 :group 'windows)
6077 6080
6078(defun fit-frame-to-buffer (&optional frame max-height min-height) 6081(defun fit-frame-to-buffer (&optional frame max-height min-height)
6079 "Adjust height of FRAME to display its buffer's contents exactly. 6082 "Adjust height of FRAME to display its buffer contents exactly.
6080FRAME can be any live frame and defaults to the selected one. 6083FRAME can be any live frame and defaults to the selected one.
6081 6084
6082Optional argument MAX-HEIGHT specifies the maximum height of 6085Optional argument MAX-HEIGHT specifies the maximum height of FRAME.
6083FRAME and defaults to the height of the display below the current 6086It defaults to the height of the display below the current
6084top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN. 6087top line of FRAME, minus `fit-frame-to-buffer-bottom-margin'.
6085Optional argument MIN-HEIGHT specifies the minimum height of 6088Optional argument MIN-HEIGHT specifies the minimum height of FRAME.
6086FRAME." 6089The default corresponds to `window-min-height'."
6087 (interactive) 6090 (interactive)
6088 (setq frame (window-normalize-frame frame)) 6091 (setq frame (window-normalize-frame frame))
6089 (let* ((root (frame-root-window frame)) 6092 (let* ((root (frame-root-window frame))
@@ -6160,6 +6163,10 @@ defaults to `window-min-height'. Both MAX-HEIGHT and MIN-HEIGHT
6160are specified in lines and include the mode line and header line, 6163are specified in lines and include the mode line and header line,
6161if any. 6164if any.
6162 6165
6166If WINDOW is a full height window, then if the option
6167`fit-frame-to-buffer' is non-nil, this calls the function
6168`fit-frame-to-buffer' to adjust the frame height.
6169
6163Return the number of lines by which WINDOW was enlarged or 6170Return the number of lines by which WINDOW was enlarged or
6164shrunk. If an error occurs during resizing, return nil but don't 6171shrunk. If an error occurs during resizing, return nil but don't
6165signal an error. 6172signal an error.
diff --git a/lisp/woman.el b/lisp/woman.el
index 974a7d72465..46b6b680440 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1303,12 +1303,12 @@ cache to be re-read."
1303 ((null (cdr files)) (car (car files))) ; only 1 file for topic. 1303 ((null (cdr files)) (car (car files))) ; only 1 file for topic.
1304 (t 1304 (t
1305 ;; Multiple files for topic, so must select 1. 1305 ;; Multiple files for topic, so must select 1.
1306 ;; Unread the command event (TAB = ?\t = 9) that runs the command 1306 ;; Run the command `minibuffer-complete' in order to automatically
1307 ;; `minibuffer-complete' in order to automatically complete the 1307 ;; complete the minibuffer contents as far as possible.
1308 ;; minibuffer contents as far as possible. 1308 (minibuffer-with-setup-hook
1309 (setq unread-command-events '(9)) ; and delete any type-ahead! 1309 (lambda () (let ((this-command this-command)) (minibuffer-complete)))
1310 (completing-read "Manual file: " files nil 1 1310 (completing-read "Manual file: " files nil 1
1311 (try-completion "" files) 'woman-file-history)))))) 1311 (try-completion "" files) 'woman-file-history)))))))
1312 1312
1313(defun woman-select (predicate list) 1313(defun woman-select (predicate list)
1314 "Select unique elements for which PREDICATE is true in LIST. 1314 "Select unique elements for which PREDICATE is true in LIST.