1. xemacs
  2. xemacs-base


steve  committed 1fe9a3a


  • Participants
  • Branches default
  • Tags xemacs

Comments (0)

Files changed (39)

File ChangeLog

View file
+1998-01-11  SL Baur  <steve@altair.xemacs.org>
+	* Makefile (VERSION): Updated package build procedure.
+1998-01-09  Karl M. Hegbloom  <karlheg@bittersweet.inetarena.com>
+	* annotations.el (annotations-in-region): Rewrote the
+	`map-extents' call to use the newer interface.
+1998-01-05  Karl M. Hegbloom  <karlheg@bittersweet.inetarena.com>
+	* ring.el (ring-remove): Optimize by moveing duplicated function
+	call out of the loop into a let.  Varref is faster than a function
+	call, thus the codepath is reduced and the loop will execute more
+	quickly.
+1998-01-01  SL Baur  <steve@altair.xemacs.org>
+	* Makefile: Added skeleton.el.
+1997-12-24  SL Baur  <steve@altair.xemacs.org>
+	* Makefile: Add comint-xemacs.el and shell.el.
+1997-12-23  SL Baur  <steve@altair.xemacs.org>
+	* Makefile: Added ebuff-menu.el, echistory.el, ehelp.el,
+	electrict.el and helper.el.
+	Also added chistory.el, iso-syntax.el and time-stamp.el.
+	* xemacs-base 1.01 is released.
+	* add-log.el (change-log): Remove `(require 'fortran)'.
+	* imenu.el: New file.
+	* annotations.el: Commentary changes.
+	* assoc.el: Ditto.
+	* comint.el: Ditto.
+	* compile.el: Ditto.
+	* debug.el: Ditto.
+	* enriched.el: Ditto.
+	* env.el: Ditto.
+	* facemenu.el: Ditto.
+	* macros.el: Ditto.
+	* novice.el: Ditto.
+	* outline.el: Ditto.
+	* passwd.el: Ditto.
+	* pp.el: Ditto.
+	* regi.el: Ditto.
+	* ring.el: Ditto.
+	* sort.el: Ditto.
+	* thing.el: Ditto.
+	* timezone.el: Ditto.
+	* xbm-button.el: Ditto.
+	* Makefile: Add in:  add-log.el, compile.el, imenu.el, outline.el
+1997-12-20  SL Baur  <steve@altair.xemacs.org>
+	* Makefile: Created.

File Makefile

View file
+# Makefile for XEmacs base lisp code
+# This file is part of XEmacs.
+# XEmacs is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any
+# later version.
+# XEmacs is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+# for more details.
+# You should have received a copy of the GNU General Public License
+# along with XEmacs; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+VERSION = 1.07
+PACKAGE = xemacs-base
+PKG_TYPE = regular
+CATEGORY = libs
+ELCS = add-log.elc advice.elc annotations.elc assoc.elc case-table.elc \
+	chistory.elc comint.elc comint-xemacs.elc compile.elc debug.elc \
+	ebuff-menu.elc echistory.elc ehelp.elc edmacro.elc electric.elc \
+	enriched.elc env.elc facemenu.elc helper.elc imenu.elc \
+	iso-syntax.elc macros.elc novice.elc outline.elc passwd.elc pp.elc \
+	regi.elc ring.elc shell.elc skeleton.elc sort.elc thing.elc \
+	time-stamp.elc timezone.elc xbm-button.elc xpm-button.elc
+include ../../XEmacs.rules
+all:: $(ELCS) auto-autoloads.elc custom-load.elc
+srckit: srckit-std
+binkit: binkit-sourceonly

File add-log.el

View file
+;;; add-log.el --- change log maintenance commands for Emacs
+;; Copyright (C) 1985, 86, 88, 93, 94, 1997 Free Software Foundation, Inc.
+;; Keywords: maint
+;; This file is part of XEmacs.
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; General Public License for more details.
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;; Synched up with: Emacs 20.0.
+;;; Commentary:
+;; This facility is documented in the Emacs Manual.
+;;; Code:
+(defgroup change-log nil
+  "Change log maintenance"
+  :group 'tools
+  :group 'maint
+  :prefix "change-log-"
+  :prefix "add-log-")
+(defcustom change-log-default-name nil
+  "*Name of a change log file for \\[add-change-log-entry]."
+  :type '(choice (const :tag "default" nil)
+		 string)
+  :group 'change-log)
+(defcustom add-log-current-defun-function nil
+  "\
+*If non-nil, function to guess name of current function from surrounding text.
+\\[add-change-log-entry] calls this function (if nil, `add-log-current-defun'
+instead) with no arguments.  It returns a string or nil if it cannot guess."
+  :type 'boolean
+  :group 'change-log)
+(defcustom add-log-full-name nil
+  "*Full name of user, for inclusion in ChangeLog daily headers.
+This defaults to the value returned by the `user-full-name' function."
+  :type '(choice (const :tag "Default" nil)
+		 string)
+  :group 'change-log)
+(defcustom add-log-mailing-address nil
+  "*Electronic mail address of user, for inclusion in ChangeLog daily headers.
+This defaults to the value of `user-mail-address'."
+  :type '(choice (const :tag "Default" nil)
+		 string)
+  :group 'change-log)
+(defcustom add-log-time-format 'iso8601-time-string
+  "*Function that defines the time format.
+For example, `iso8601-time-string' (time in international ISO 8601 format)
+and `current-time-string' are valid values."
+  :type '(radio (const :tag "International ISO 8601 format" iso8601-time-string)
+		(const :tag "Old format, as returned by `current-time-string'"
+		       current-time-string)
+		(function :tag "Other"))
+  :group 'change-log)
+(defvar change-log-font-lock-keywords
+  '(;;
+    ;; Date lines, new and old styles.
+    ("^\\sw.........[0-9: ]*"
+     (0 font-lock-string-face)
+     ("\\([^<]+\\)<\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)>" nil nil
+      (1 font-lock-reference-face)
+      (2 font-lock-variable-name-face)))
+    ;;
+    ;; File names.
+    ("^\t\\* \\([^ ,:([\n]+\\)"
+     (1 font-lock-function-name-face)
+     ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 font-lock-function-name-face)))
+    ;;
+    ;; Function or variable names.
+    ("(\\([^ ,:)\n]+\\)"
+     (1 font-lock-keyword-face)
+     ("\\=, \\([^ ,:\n]+\\)" nil nil (1 font-lock-keyword-face)))
+    ;;
+    ;; Conditionals.
+    ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 font-lock-variable-name-face))
+    ;;
+    ;; Acknowledgments.
+    ("^\t\\(From\\|Reported by\\)" 1 font-lock-comment-face)
+    )
+  "Additional expressions to highlight in Change Log mode.")
+(put 'change-log-mode 'font-lock-defaults
+     '(change-log-font-lock-keywords t))
+(defvar change-log-mode-map nil
+  "Keymap for Change Log major mode.")
+(if change-log-mode-map
+    nil
+  (setq change-log-mode-map (make-sparse-keymap))
+  (define-key change-log-mode-map "\C-c\C-c" 'change-log-exit)
+  (define-key change-log-mode-map "\C-c\C-k" 'change-log-cancel))
+(defvar change-log-time-zone-rule nil
+  "Time zone used for calculating change log time stamps.
+It takes the same format as the TZ argument of `set-time-zone-rule'.
+If nil, use local time.")
+(defun iso8601-time-zone (time)
+  (let* ((utc-offset (or (car (current-time-zone time)) 0))
+	 (sign (if (< utc-offset 0) ?- ?+))
+	 (sec (abs utc-offset))
+	 (ss (% sec 60))
+	 (min (/ sec 60))
+	 (mm (% min 60))
+	 (hh (/ min 60)))
+    (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
+		  ((not (zerop mm)) "%c%02d:%02d")
+		  (t "%c%02d"))
+	    sign hh mm ss)))
+(defun iso8601-time-string ()
+  (if change-log-time-zone-rule
+      (let ((tz (getenv "TZ"))
+	    (now (current-time)))
+	(unwind-protect
+	    (progn
+	      (set-time-zone-rule
+	       change-log-time-zone-rule)
+	      (concat
+	       (format-time-string "%Y-%m-%d " now)
+	       (iso8601-time-zone now)))
+	  (set-time-zone-rule tz)))
+    (format-time-string "%Y-%m-%d")))
+(defun change-log-name ()
+  (or change-log-default-name
+      (if (eq system-type 'vax-vms) 
+	"ChangeLog")))
+(defun prompt-for-change-log-name ()
+  "Prompt for a change log name."
+  (let* ((default (change-log-name))
+	 (name (expand-file-name
+		(read-file-name (format "Log file (default %s): " default)
+				nil default))))
+    ;; Handle something that is syntactically a directory name.
+    ;; Look for ChangeLog or whatever in that directory.
+    (if (string= (file-name-nondirectory name) "")
+	(expand-file-name (file-name-nondirectory default)
+			  name)
+      ;; Handle specifying a file that is a directory.
+      (if (file-directory-p name)
+	  (expand-file-name (file-name-nondirectory default)
+			    (file-name-as-directory name))
+	name))))
+(defun find-change-log (&optional file-name)
+  "Find a change log file for \\[add-change-log-entry] and return the name.
+Optional arg FILE-NAME specifies the file to use.
+If FILE-NAME is nil, use the value of `change-log-default-name'.
+If 'change-log-default-name' is nil, behave as though it were 'ChangeLog'
+\(or whatever we use on this operating system).
+If 'change-log-default-name' contains a leading directory component, then
+simply find it in the current directory.  Otherwise, search in the current 
+directory and its successive parents for a file so named.
+Once a file is found, `change-log-default-name' is set locally in the
+current buffer to the complete file name."
+  ;; If user specified a file name or if this buffer knows which one to use,
+  ;; just use that.
+  (or file-name
+      (setq file-name (and change-log-default-name
+			   (file-name-directory change-log-default-name)
+			   change-log-default-name))
+      (progn
+	;; Chase links in the source file
+	;; and use the change log in the dir where it points.
+	(setq file-name (or (and buffer-file-name
+				 (file-name-directory
+				  (file-chase-links buffer-file-name)))
+			    default-directory))
+	(if (file-directory-p file-name)
+	    (setq file-name (expand-file-name (change-log-name) file-name)))
+	;; Chase links before visiting the file.
+	;; This makes it easier to use a single change log file
+	;; for several related directories.
+	(setq file-name (file-chase-links file-name))
+	(setq file-name (expand-file-name file-name))
+	;; Move up in the dir hierarchy till we find a change log file.
+	(let ((file1 file-name)
+	      parent-dir)
+	  (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
+		      (progn (setq parent-dir
+				   (file-name-directory
+				    (directory-file-name
+				     (file-name-directory file1))))
+			     ;; Give up if we are already at the root dir.
+			     (not (string= (file-name-directory file1)
+					   parent-dir))))
+	    ;; Move up to the parent dir and try again.
+	    (setq file1 (expand-file-name 
+			 (file-name-nondirectory (change-log-name))
+			 parent-dir)))
+	  ;; If we found a change log in a parent, use that.
+	  (if (or (get-file-buffer file1) (file-exists-p file1))
+	      (setq file-name file1)))))
+  ;; Make a local variable in this buffer so we needn't search again.
+  (set (make-local-variable 'change-log-default-name) file-name)
+  file-name)
+(defun add-change-log-entry (&optional whoami file-name other-window new-entry)
+  "Find change log file and add an entry for today.
+Optional arg (interactive prefix) non-nil means prompt for user name and site.
+Second arg is file name of change log.  If nil, uses `change-log-default-name'.
+Third arg OTHER-WINDOW non-nil means visit in other window.
+Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
+never append to an existing entry.  Today's date is calculated according to
+`change-log-time-zone-rule' if non-nil, otherwise in local time."
+  (interactive (list current-prefix-arg
+		     (prompt-for-change-log-name)))
+  (or add-log-full-name
+      (setq add-log-full-name (user-full-name)))
+  (or add-log-mailing-address
+      (setq add-log-mailing-address (user-mail-address)))
+  (if whoami
+      (progn
+        (setq add-log-full-name (read-string "Full name: " add-log-full-name))
+	;; Note that some sites have room and phone number fields in
+	;; full name which look silly when inserted.  Rather than do
+	;; anything about that here, let user give prefix argument so that
+	;; s/he can edit the full name field in prompter if s/he wants.
+	(setq add-log-mailing-address
+	      (read-string "Mailing address: " add-log-mailing-address))))
+  (let ((defun (funcall (or add-log-current-defun-function
+			    'add-log-current-defun)))
+	paragraph-end entry)
+    (setq file-name (expand-file-name (find-change-log file-name)))
+    ;; Set ENTRY to the file name to use in the new entry.
+    (and buffer-file-name
+	 ;; Never want to add a change log entry for the ChangeLog file itself.
+	 (not (string= buffer-file-name file-name))
+	 (setq entry (if (string-match
+			  (concat "^" (regexp-quote (file-name-directory
+						     file-name)))
+			  buffer-file-name)
+			 (substring buffer-file-name (match-end 0))
+		       (file-name-nondirectory buffer-file-name))))
+    (push-window-configuration)
+    (if (and other-window (not (equal file-name buffer-file-name)))
+	(find-file-other-window file-name)
+      (find-file file-name))
+    (or (eq major-mode 'change-log-mode)
+	(change-log-mode))
+    (undo-boundary)
+    (goto-char (point-min))
+    (let ((new-entry (concat (funcall add-log-time-format)
+			     "  " add-log-full-name
+			     "  <" add-log-mailing-address ">")))
+      (if (looking-at (regexp-quote new-entry))
+	  (forward-line 1)
+	(insert new-entry "\n\n")))
+    ;; Search only within the first paragraph.
+    (if (looking-at "\n*[^\n* \t]")
+	(skip-chars-forward "\n")
+      (forward-paragraph 1))
+    (setq paragraph-end (point))
+    (goto-char (point-min))
+    ;; Now insert the new line for this entry.
+    (cond ((re-search-forward "^\\s *\\*\\s *$" paragraph-end t)
+	   ;; Put this file name into the existing empty entry.
+	   (if entry
+	       (insert entry)))
+	  ((and (not new-entry)
+		(let (case-fold-search)
+		  (re-search-forward
+		   (concat (regexp-quote (concat "* " entry))
+			   ;; Don't accept `foo.bar' when
+			   ;; looking for `foo':
+			   "\\(\\s \\|[(),:]\\)")
+		   paragraph-end t)))
+	   ;; Add to the existing entry for the same file.
+	   (re-search-forward "^\\s *$\\|^\\s \\*")
+	   (goto-char (match-beginning 0))
+	   ;; Delete excess empty lines; make just 2.
+	   (while (and (not (eobp)) (looking-at "^\\s *$"))
+	     (delete-region (point) (save-excursion (forward-line 1) (point))))
+	   (insert "\n\n")
+	   (forward-line -2)
+	   (indent-relative-maybe))
+	  (t
+	   ;; Make a new entry.
+	   (forward-line 1)
+	   (while (looking-at "\\sW")
+	     (forward-line 1))
+	   (while (and (not (eobp)) (looking-at "^\\s *$"))
+	     (delete-region (point) (save-excursion (forward-line 1) (point))))
+	   (insert "\n\n\n")
+	   (forward-line -2)
+	   (indent-to left-margin)
+	   (insert "* " (or entry ""))))
+    ;; Now insert the function name, if we have one.
+    ;; Point is at the entry for this file,
+    ;; either at the end of the line or at the first blank line.
+    (if defun
+	(progn
+	  ;; Make it easy to get rid of the function name.
+	  (undo-boundary)
+	  (insert (if (save-excursion
+			(beginning-of-line 1)
+			(looking-at "\\s *$")) 
+		      ""
+		    " ")
+		  "(" defun "): "))
+      ;; No function name, so put in a colon unless we have just a star.
+      (if (not (save-excursion
+		 (beginning-of-line 1)
+		 (looking-at "\\s *\\(\\*\\s *\\)?$")))
+	  (insert ": ")))))
+(defun add-change-log-entry-other-window (&optional whoami file-name)
+  "Find change log file in other window and add an entry for today.
+Optional arg (interactive prefix) non-nil means prompt for user name and site.
+Second arg is file name of change log.  \
+If nil, uses `change-log-default-name'."
+  (interactive (if current-prefix-arg
+		   (list current-prefix-arg
+			 (prompt-for-change-log-name))))
+  (add-change-log-entry whoami file-name t))
+;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
+(defun change-log-mode ()
+  "Major mode for editing change logs; like Indented Text Mode.
+Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
+New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
+Each entry behaves as a paragraph, and the entries for one day as a page.
+Runs `change-log-mode-hook'."
+  (interactive)
+  (kill-all-local-variables)
+  (indented-text-mode)
+  (setq major-mode 'change-log-mode
+	mode-name "Change Log"
+	left-margin 8
+	fill-column 74
+	indent-tabs-mode t
+	tab-width 8)
+  (use-local-map change-log-mode-map)
+  (set (make-local-variable 'fill-paragraph-function)
+       'change-log-fill-paragraph)
+  ;; Let each entry behave as one paragraph:
+  ;; We really do want "^" in paragraph-start below: it is only the lines that
+  ;; begin at column 0 (despite the left-margin of 8) that we are looking for.
+  (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<")
+  (set (make-local-variable 'paragraph-separate) "\\s *$\\|\f\\|^\\<")
+  ;; Let all entries for one day behave as one page.
+  ;; Match null string on the date-line so that the date-line
+  ;; is grouped with what follows.
+  (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
+  (set (make-local-variable 'version-control) 'never)
+  (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
+  ;;(set (make-local-variable 'font-lock-defaults)
+       ;;'(change-log-font-lock-keywords t))
+  (when (boundp 'filladapt-mode)
+    ;; Filladapt works badly with ChangeLogs.  Still, we disable it
+    ;; before change-log-mode-hook, so the users can override this
+    ;; choice.
+    (setq filladapt-mode nil))
+  (run-hooks 'change-log-mode-hook))
+(defun change-log-exit ()
+  "Save the change-log buffer, and restores the old window configuration.
+Buries the buffer."
+  (interactive)
+  (save-buffer)
+  (let ((buf (current-buffer)))
+    (pop-window-configuration)
+    (bury-buffer buf)))
+(defun change-log-cancel ()
+  "Cancel the changes to change-log buffer.
+This kills the buffer without saving, and restores the old window
+ configuration."
+  (interactive)
+  (kill-buffer (current-buffer))
+  (pop-window-configuration))
+;; It might be nice to have a general feature to replace this.  The idea I
+;; have is a variable giving a regexp matching text which should not be
+;; moved from bol by filling.  change-log-mode would set this to "^\\s *\\s(".
+;; But I don't feel up to implementing that today.
+(defun change-log-fill-paragraph (&optional justify)
+  "Fill the paragraph, but preserve open parentheses at beginning of lines.
+Prefix arg means justify as well."
+  (interactive "P")
+  (let ((end (progn (forward-paragraph) (point)))
+	(beg (progn (backward-paragraph) (point)))
+	(paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
+    (fill-region beg end justify)
+    t))
+(defcustom add-log-current-defun-header-regexp
+  "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ \t]*[:=]"
+  "*Heuristic regexp used by `add-log-current-defun' for unknown major modes."
+  :type 'regexp
+  :group 'change-log)
+(defvar add-log-lisp-like-modes
+    '(emacs-lisp-mode lisp-mode scheme-mode lisp-interaction-mode)
+  "*Modes that look like Lisp to `add-log-current-defun'.")
+(defvar add-log-c-like-modes
+    '(c-mode c++-mode c++-c-mode objc-mode java-mode)
+  "*Modes that look like C to `add-log-current-defun'.")
+(defvar add-log-tex-like-modes
+    '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode)
+  "*Modes that look like TeX to `add-log-current-defun'.")
+(defun add-log-current-defun ()
+  "Return name of function definition point is in, or nil.
+Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
+Texinfo (@node titles), Perl, and Fortran.
+Other modes are handled by a heuristic that looks in the 10K before
+point for uppercase headings starting in the first column or
+identifiers followed by `:' or `=', see variable
+Has a preference of looking backwards."
+  (condition-case nil
+      (save-excursion
+	(let ((location (point)))
+	  (cond ((memq major-mode add-log-lisp-like-modes)
+		 ;; If we are now precisely at the beginning of a defun,
+		 ;; make sure beginning-of-defun finds that one
+		 ;; rather than the previous one.
+		 (or (eobp) (forward-char 1))
+		 (beginning-of-defun)
+		 ;; Make sure we are really inside the defun found, not after it.
+		 (if (and (looking-at "\\s(")
+			  (progn (end-of-defun)
+				 (< location (point)))
+			  (progn (forward-sexp -1)
+				 (>= location (point))))
+		     (progn
+		       (if (looking-at "\\s(")
+			   (forward-char 1))
+		       (forward-sexp 1)
+		       (skip-chars-forward " '")
+		       (buffer-substring (point)
+					 (progn (forward-sexp 1) (point))))))
+		((and (memq major-mode add-log-c-like-modes)
+		      (save-excursion
+			(beginning-of-line)
+			;; Use eq instead of = here to avoid
+			;; error when at bob and char-after
+			;; returns nil.
+			(while (eq (char-after (- (point) 2)) ?\\)
+			  (forward-line -1))
+			(looking-at "[ \t]*#[ \t]*define[ \t]")))
+		 ;; Handle a C macro definition.
+		 (beginning-of-line)
+		 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
+		   (forward-line -1))
+		 (search-forward "define")
+		 (skip-chars-forward " \t")
+		 (buffer-substring (point)
+				   (progn (forward-sexp 1) (point))))
+		((memq major-mode add-log-c-like-modes)
+		 (beginning-of-line)
+		 ;; See if we are in the beginning part of a function,
+		 ;; before the open brace.  If so, advance forward.
+		 (while (not (looking-at "{\\|\\(\\s *$\\)"))
+		   (forward-line 1))
+		 (or (eobp)
+		     (forward-char 1))
+		 (beginning-of-defun)
+		 (if (progn (end-of-defun)
+			    (< location (point)))
+		     (progn
+		       (backward-sexp 1)
+		       (let (beg tem)
+			 (forward-line -1)
+			 ;; Skip back over typedefs of arglist.
+			 (while (and (not (bobp))
+				     (looking-at "[ \t\n]"))
+			   (forward-line -1))
+			 ;; See if this is using the DEFUN macro used in Emacs,
+			 ;; or the DEFUN macro used by the C library.
+			 (if (condition-case nil
+				 (and (save-excursion
+					(end-of-line)
+					(while (= (preceding-char) ?\\)
+					  (end-of-line 2))
+					(backward-sexp 1)
+					(beginning-of-line)
+					(setq tem (point))
+					(looking-at "DEFUN\\b"))
+				      (>= location tem))
+			       (error nil))
+			     (progn
+			       (goto-char tem)
+			       (down-list 1)
+			       (if (= (char-after (point)) ?\")
+				   (progn
+				     (forward-sexp 1)
+				     (skip-chars-forward " ,")))
+			       (buffer-substring (point)
+						 (progn (forward-sexp 1) (point))))
+                           (if (looking-at "^[+-]")
+                               (get-method-definition)
+                             ;; Ordinary C function syntax.
+                             (setq beg (point))
+                             (if (and (condition-case nil
+					  ;; Protect against "Unbalanced parens" error.
+					  (progn
+					    (down-list 1) ; into arglist
+					    (backward-up-list 1)
+					    (skip-chars-backward " \t")
+					    t)
+					(error nil))
+				      ;; Verify initial pos was after
+				      ;; real start of function.
+				      (save-excursion
+					(goto-char beg)
+					;; For this purpose, include the line
+					;; that has the decl keywords.  This
+					;; may also include some of the
+					;; comments before the function.
+					(while (and (not (bobp))
+						    (save-excursion
+						      (forward-line -1)
+						      (looking-at "[^\n\f]")))
+					  (forward-line -1))
+					(>= location (point)))
+                                          ;; Consistency check: going down and up
+                                          ;; shouldn't take us back before BEG.
+                                          (> (point) beg))
+				 (let (end middle)
+				   ;; Don't include any final newline
+				   ;; in the name we use.
+				   (if (= (preceding-char) ?\n)
+				       (forward-char -1))
+				   (setq end (point))
+				   (backward-sexp 1)
+				   ;; Now find the right beginning of the name.
+				   ;; Include certain keywords if they
+				   ;; precede the name.
+				   (setq middle (point))
+				   (forward-word -1)
+				   ;; Ignore these subparts of a class decl
+				   ;; and move back to the class name itself.
+				   (while (looking-at "public \\|private ")
+				     (skip-chars-backward " \t:")
+				     (setq end (point))
+				     (backward-sexp 1)
+				     (setq middle (point))
+				     (forward-word -1))
+				   (and (bolp)
+					(looking-at "struct \\|union \\|class ")
+					(setq middle (point)))
+				   (buffer-substring middle end)))))))))
+		((memq major-mode add-log-tex-like-modes)
+		 (if (re-search-backward
+		      "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
+		     (progn
+		       (goto-char (match-beginning 0))
+		       (buffer-substring (1+ (point));; without initial backslash
+					 (progn
+					   (end-of-line)
+					   (point))))))
+		((eq major-mode 'texinfo-mode)
+		 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
+		     (buffer-substring (match-beginning 1)
+				       (match-end 1))))
+		((eq major-mode 'perl-mode)
+		 (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t)
+		     (buffer-substring (match-beginning 1)
+				       (match-end 1))))
+                ((eq major-mode 'fortran-mode)
+                 ;; must be inside function body for this to work
+                 (beginning-of-fortran-subprogram)
+                 (let ((case-fold-search t)) ; case-insensitive
+                   ;; search for fortran subprogram start
+                   (if (re-search-forward
+			 "^[ \t]*\\(program\\|subroutine\\|function\
+\\|[ \ta-z0-9*]*[ \t]+function\\)"
+			 nil t)
+                       (progn
+                         ;; move to EOL or before first left paren
+                         (if (re-search-forward "[(\n]" nil t)
+			     (progn (forward-char -1)
+				    (skip-chars-backward " \t"))
+			   (end-of-line))
+			 ;; Use the name preceding that.
+                         (buffer-substring (point)
+                                           (progn (forward-sexp -1)
+                                                  (point)))))))
+		(t
+		 ;; If all else fails, try heuristics
+		 (let (case-fold-search)
+		   (end-of-line)
+		   (if (re-search-backward add-log-current-defun-header-regexp
+					   (- (point) 10000)
+					   t)
+		       (buffer-substring (match-beginning 1)
+					 (match-end 1))))))))
+    (error nil)))
+(defvar get-method-definition-md)
+;; Subroutine used within get-method-definition.
+;; Add the last match in the buffer to the end of `md',
+;; followed by the string END; move to the end of that match.
+(defun get-method-definition-1 (end)
+  (setq get-method-definition-md
+	(concat get-method-definition-md 
+		(buffer-substring (match-beginning 1) (match-end 1))
+		end))
+  (goto-char (match-end 0)))
+;; For objective C, return the method name if we are in a method.
+(defun get-method-definition ()
+  (let ((get-method-definition-md "["))
+    (save-excursion
+      (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t)
+	  (get-method-definition-1 " ")))
+    (save-excursion
+      (cond
+       ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t)
+	(get-method-definition-1 "")
+	(while (not (looking-at "[{;]"))
+	  (looking-at
+	   "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
+	  (get-method-definition-1 ""))
+	(concat get-method-definition-md "]"))))))
+(provide 'add-log)
+;;; add-log.el ends here

File advice.el

View file
+;;; advice.el --- an overloading mechanism for Emacs Lisp functions
+;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
+;; Created: 12 Dec 1992
+;; Version: advice.el,v 2.14 1994/08/05 03:42:04 hans Exp
+;; Keywords: extensions, lisp, tools
+;; This file is part of XEmacs.
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; General Public License for more details.
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+;; LCD Archive Entry:
+;; advice|Hans Chalupsky|hans@cs.buffalo.edu|
+;; Overloading mechanism for Emacs Lisp functions|
+;; 1994/08/05 03:42:04|2.14|~/packages/advice.el.Z|
+;;; Synched up with: FSF 19.34 (In a fashion.  Many comments are dated).
+;;; Commentary:
+;; NOTE: This documentation is slightly out of date. In particular, all the
+;; references to Emacs-18 are obsolete now, because it is not any longer
+;; supported by this version of Advice. An up-to-date version will soon be
+;; available as an info file (thanks to the kind help of Jack Vinson and
+;; David M. Smith).
+;; @ Introduction:
+;; ===============
+;; This package implements a full-fledged Lisp-style advice mechanism
+;; for Emacs Lisp. Advice is a clean and efficient way to modify the 
+;; behavior of Emacs Lisp functions without having to keep  personal
+;; modified copies of such functions around. A great number of such 
+;; modifications can be achieved by treating the original function as a 
+;; black box and specifying a different execution environment for it 
+;; with a piece of advice. Think of a piece of advice as a kind of fancy
+;; hook that you can attach to any function/macro/subr.
+;; @ Highlights:
+;; =============
+;; - Clean definition of multiple, named before/around/after advices
+;;   for functions, macros, subrs and special forms
+;; - Full control over the arguments an advised function will receive,
+;;   the binding environment in which it will be executed, as well as the
+;;   value it will return.
+;; - Allows re/definition of interactive behavior for functions and subrs
+;; - Every piece of advice can have its documentation string which will be 
+;;   combined with the original documentation of the advised function at
+;;   call-time of `documentation' for proper command-key substitution.
+;; - The execution of every piece of advice can be protected against error
+;;   and non-local exits in preceding code or advices.
+;; - Simple argument access either by name, or, more portable but as
+;;   efficient, via access macros
+;; - Allows the specification of a different argument list for the advised
+;;   version of a function.
+;; - Advised functions can be byte-compiled either at file-compile time
+;;   (see preactivation) or activation time.
+;; - Separation of advice definition and activation
+;; - Forward advice is possible, that is
+;;   as yet undefined or autoload functions can be advised without having to
+;;   preload the file in which they are defined. 
+;; - Forward redefinition is possible because around advice can be used to
+;;   completely redefine a function.
+;; - A caching mechanism for advised definition provides for cheap deactivation
+;;   and reactivation of advised functions.
+;; - Preactivation allows efficient construction and compilation of advised
+;;   definitions at file compile time without giving up the flexibility of
+;;   the advice mechanism.
+;; - En/disablement mechanism allows the use of  different "views" of advised
+;;   functions depending on what pieces of advice are currently en/disabled
+;; - Provides manipulation mechanisms for sets of advised functions via 
+;;   regular expressions that match advice names
+;; @ How to get Advice for Emacs-18:
+;; =================================
+;; `advice18.el', a version of Advice that also works in Emacs-18 is available
+;; either via anonymous ftp from `ftp.cs.buffalo.edu (' with 
+;; pathname `/pub/Emacs/advice18.el', or from one of the Emacs Lisp archive
+;; sites, or send email to <hans@cs.buffalo.edu> and I'll mail it to you.
+;; @ Overview, or how to read this file:
+;; =====================================
+;; NOTE: This documentation is slightly out of date. In particular, all the
+;; references to Emacs-18 are obsolete now, because it is not any longer
+;; supported by this version of Advice. An up-to-date version will soon be
+;; available as an info file (thanks to the kind help of Jack Vinson and
+;; David M. Smith). Until then you can use `outline-mode' to help you read
+;; this documentation (set `outline-regexp' to `";; @+"').
+;; The four major sections of this file are:
+;;   @ This initial information       ...installation, customization etc.
+;;   @ Advice documentation:          ...general documentation
+;;   @ Foo games: An advice tutorial  ...teaches about Advice by example
+;;   @ Advice implementation:         ...actual code, yeah!!
+;; The latter three are actual headings which you can search for
+;; directly in case `outline-mode' doesn't work for you.
+;; @ Restrictions:
+;; ===============
+;; - Only works with Emacs 19.26 or later and XEmacs 19.12 or later.
+;; - Advised functions/macros/subrs will only exhibit their advised behavior
+;;   when they are invoked via their function cell. This means that advice will
+;;   not work for the following:
+;;   + advised subrs that are called directly from other subrs or C-code 
+;;   + advised subrs that got replaced with their byte-code during 
+;;     byte-compilation (e.g., car)
+;;   + advised macros which were expanded during byte-compilation before
+;;     their advice was activated.
+;; @ Credits:
+;; ==========
+;; This package is an extension and generalization of packages such as
+;; insert-hooks.el written by Noah S. Friedman, and advise.el written by
+;; Raul J. Acevedo. Some ideas used in here come from these packages,
+;; others come from the various Lisp advice mechanisms I've come across
+;; so far, and a few are simply mine.
+;; @ Comments, suggestions, bug reports:
+;; =====================================
+;; If you find any bugs, have suggestions for new advice features, find the
+;; documentation wrong, confusing, incomplete, or otherwise unsatisfactory,
+;; have any questions about Advice, or have otherwise enlightening
+;; comments feel free to send me email at <hans@cs.buffalo.edu>.
+;; @ Safety Rules and Emergency Exits:
+;; ===================================
+;; Before we begin: CAUTION!!
+;; Advice provides you with a lot of rope to hang yourself on very
+;; easily accessible trees, so, here are a few important things you
+;; should know: Once Advice has been started with `ad-start-advice'
+;; (which happens automatically when you load this file), it
+;; generates an advised definition of the `documentation' function, and
+;; it will enable automatic advice activation when functions get defined.
+;; All of this can be undone at any time with `M-x ad-stop-advice'.
+;; If you experience any strange behavior/errors etc. that you attribute to
+;; Advice or to some ill-advised function do one of the following:
+;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what
+;;                               function gives you problems)
+;; - M-x ad-deactivate-all      (if you don't have a clue what's going wrong)
+;; - M-x ad-stop-advice         (if you think the problem is related to the
+;;                               advised functions used by Advice itself)
+;; - M-x ad-recover-normality   (for real emergencies)
+;; - If none of the above solves your Advice-related problem go to another
+;;   terminal, kill your Emacs process and send me some hate mail.
+;; The first three measures have restarts, i.e., once you've figured out
+;; the problem you can reactivate advised functions with either `ad-activate',
+;; `ad-activate-all', or `ad-start-advice'. `ad-recover-normality' unadvises
+;; everything so you won't be able to reactivate any advised functions, you'll
+;; have to stick with their standard incarnations for the rest of the session.
+;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before
+;; you byte-compile a file, because advised special forms and macros can lead
+;; to unwanted compilation results. When you are done compiling use
+;; `M-x ad-activate-all' to go back to the advised state of all your 
+;; advised functions.
+;; RELAX: Advice is pretty safe even if you are oblivious to the above.
+;; I use it extensively and haven't run into any serious trouble in a long
+;; time. Just wanted you to be warned.
+;; @ Customization:
+;; ================
+;; Look at the documentation of `ad-redefinition-action' for possible values
+;; of this variable. Its default value is `warn' which will print a warning
+;; message when an already defined advised function gets redefined with a
+;; new original definition and de/activated.
+;; Look at the documentation of `ad-default-compilation-action' for possible
+;; values of this variable. Its default value is `maybe' which will compile
+;; advised definitions during activation in case the byte-compiler is already
+;; loaded. Otherwise, it will leave them uncompiled.
+;; @ Motivation:
+;; =============
+;; Before I go on explaining how advice works, here are four simple examples
+;; how this package can be used. The first three are very useful, the last one
+;; is just a joke:
+;;(defadvice switch-to-buffer (before existing-buffers-only activate)
+;;  "When called interactively switch to existing buffers only, unless 
+;;when called with a prefix argument."
+;;  (interactive 
+;;   (list (read-buffer "Switch to buffer: " (other-buffer) 
+;;                      (null current-prefix-arg)))))
+;;(defadvice switch-to-buffer (around confirm-non-existing-buffers activate)
+;;  "Switch to non-existing buffers only upon confirmation."
+;;  (interactive "BSwitch to buffer: ")
+;;  (if (or (get-buffer (ad-get-arg 0))
+;;          (y-or-n-p (format "`%s' does not exist, create? " (ad-get-arg 0))))
+;;      ad-do-it))
+;;(defadvice find-file (before existing-files-only activate)
+;;  "Find existing files only"
+;;  (interactive "fFind file: "))
+;;(defadvice car (around interactive activate)
+;;  "Make `car' an interactive function."
+;;   (interactive "xCar of list: ")
+;;   ad-do-it
+;;   (if (interactive-p)
+;;       (message "%s" ad-return-value)))
+;; @ Advice documentation:
+;; =======================
+;; Below is general documentation of the various features of advice. For more
+;; concrete examples check the corresponding sections in the tutorial part.
+;; @@ Terminology:
+;; ===============
+;; - Emacs, Emacs-19: FSF's version of Emacs with major version 19
+;; - Lemacs: Lucid's version of Emacs with major version 19
+;; - XEmacs: New name of Lucid Emacs starting with 19.11
+;; - v18: Any Emacs with major version 18 or built as an extension to that
+;;        (such as Epoch)
+;; - v19: Any Emacs with major version 19
+;; - jwz: Jamie Zawinski - former keeper of Lemacs and creator of the
+;;        optimizing byte-compiler used in v19s.
+;; - Advice: The name of this package.
+;; - advices: Short for "pieces of advice".
+;; @@ Defining a piece of advice with `defadvice':
+;; ===============================================
+;; The main means of defining a piece of advice is the macro `defadvice',
+;; there is no interactive way of specifying a piece of advice.  A call to
+;; `defadvice' has the following syntax which is similar to the syntax of
+;; `defun/defmacro':
+;; (defadvice <function> (<class> <name> [<position>] [<arglist>] {<flags>}*)
+;;   [ [<documentation-string>] [<interactive-form>] ]
+;;   {<body-form>}* )
+;; <function> is the name of the function/macro/subr to be advised.
+;; <class> is the class of the advice which has to be one of `before',
+;; `around', `after', `activation' or `deactivation' (the last two allow
+;; definition of special act/deactivation hooks).
+;; <name> is the name of the advice which has to be a non-nil symbol.
+;; Names uniquely identify a piece of advice in a certain advice class,
+;; hence, advices can be redefined by defining an advice with the same class
+;; and name. Advice names are global symbols, hence, the same name space
+;; conventions used for function names should be applied.
+;; An optional <position> specifies where in the current list of advices of
+;; the specified <class> this new advice will be placed. <position> has to
+;; be either `first', `last' or a number that specifies a zero-based
+;; position (`first' is equivalent to 0). If no position is specified
+;; `first' will be used as a default. If this call to `defadvice' redefines
+;; an already existing advice (see above) then the position argument will
+;; be ignored and the position of the already existing advice will be used.
+;; An optional <arglist> which has to be a list can be used to define the
+;; argument list of the advised function. This argument list should of
+;; course be compatible with the argument list of the original function,
+;; otherwise functions that call the advised function with the original
+;; argument list in mind will break. If more than one advice specify an
+;; argument list then the first one (the one with the smallest position)
+;; found in the list of before/around/after advices will be used.
+;; <flags> is a list of symbols that specify further information about the
+;; advice. All flags can be specified with unambiguous initial substrings.
+;;   `activate': Specifies that the advice information of the advised
+;;              function should be activated right after this advice has been
+;;              defined. In forward advices `activate' will be ignored. 
+;;   `protect': Specifies that this advice should be protected against
+;;              non-local exits and errors in preceding code/advices.
+;;   `compile': Specifies that the advised function should be byte-compiled.
+;;              This flag will be ignored unless `activate' is also specified.
+;;   `disable': Specifies that the defined advice should be disabled, hence,
+;;              it will not be used in an activation until somebody enables it.
+;;   `preactivate': Specifies that the advised function should get preactivated
+;;              at macro-expansion/compile time of this `defadvice'. This
+;;              generates a compiled advised definition according to the
+;;              current advice state which will be used during activation
+;;              if appropriate. Only use this if the `defadvice' gets
+;;              actually compiled (with a v18 byte-compiler put the `defadvice'
+;;              into the body of a `defun' to accomplish proper compilation).
+;; An optional <documentation-string> can be supplied to document the advice.
+;; On call of the `documentation' function it will be combined with the
+;; documentation strings of the original function and other advices.
+;; An optional <interactive-form> form can be supplied to change/add
+;; interactive behavior of the original function. If more than one advice
+;; has an `(interactive ...)' specification then the first one (the one
+;; with the smallest position) found in the list of before/around/after
+;; advices will be used.
+;; A possibly empty list of <body-forms> specifies the body of the advice in
+;; an implicit progn. The body of an advice can access/change arguments,
+;; the return value, the binding environment, and can have all sorts of 
+;; other side effects.
+;; @@ Assembling advised definitions:
+;; ==================================
+;; Suppose a function/macro/subr/special-form has N pieces of before advice,
+;; M pieces of around advice and K pieces of after advice. Assuming none of
+;; the advices is protected, its advised definition will look like this
+;; (body-form indices correspond to the position of the respective advice in
+;; that advice class):
+;;    ([macro] lambda <arglist>
+;;       [ [<advised-docstring>] [(interactive ...)] ]
+;;       (let (ad-return-value)
+;;         {<before-0-body-form>}*
+;;               ....
+;;         {<before-N-1-body-form>}*
+;;         {<around-0-body-form>}*
+;;            {<around-1-body-form>}*
+;;                  ....
+;;               {<around-M-1-body-form>}*
+;;                  (setq ad-return-value
+;;                        <apply original definition to <arglist>>)
+;;               {<other-around-M-1-body-form>}*
+;;                  ....
+;;            {<other-around-1-body-form>}*
+;;         {<other-around-0-body-form>}*
+;;         {<after-0-body-form>}*
+;;               ....
+;;         {<after-K-1-body-form>}*
+;;         ad-return-value))
+;; Macros and special forms will be redefined as macros, hence the optional
+;; [macro] in the beginning of the definition.
+;; <arglist> is either the argument list of the original function or the
+;; first argument list defined in the list of before/around/after advices.
+;; The values of <arglist> variables can be accessed/changed in the body of
+;; an advice by simply referring to them by their original name, however,
+;; more portable argument access macros are also provided (see below).  For
+;; subrs/special-forms for which neither explicit argument list definitions
+;; are available, nor their documentation strings contain such definitions
+;; (as they do v19s), `(&rest ad-subr-args)' will be used.
+;; <advised-docstring> is an optional, special documentation string which will
+;; be expanded into a proper documentation string upon call of `documentation'.
+;; (interactive ...) is an optional interactive form either taken from the
+;; original function or from a before/around/after advice. For advised
+;; interactive subrs that do not have an interactive form specified in any
+;; advice we have to use (interactive) and then call the subr interactively
+;; if the advised function was called interactively, because the
+;; interactive specification of subrs is not accessible. This is the only
+;; case where changing the values of arguments will not have an affect
+;; because they will be reset by the interactive specification of the subr.
+;; If this is a problem one can always specify an interactive form in a
+;; before/around/after advice to gain control over argument values that
+;; were supplied interactively.
+;; Then the body forms of the various advices in the various classes of advice
+;; are assembled in order.  The forms of around advice L are normally part of
+;; one of the forms of around advice L-1. An around advice can specify where
+;; the forms of the wrapped or surrounded forms should go with the special
+;; keyword `ad-do-it', which will be substituted with a `progn' containing the
+;; forms of the surrounded code.
+;; The innermost part of the around advice onion is 
+;;      <apply original definition to <arglist>>
+;; whose form depends on the type of the original function. The variable
+;; `ad-return-value' will be set to its result. This variable is visible to
+;; all pieces of advice which can access and modify it before it gets returned.
+;; The semantic structure of advised functions that contain protected pieces
+;; of advice is the same. The only difference is that `unwind-protect' forms
+;; make sure that the protected advice gets executed even if some previous
+;; piece of advice had an error or a non-local exit. If any around advice is
+;; protected then the whole around advice onion will be protected.
+;; @@ Argument access in advised functions:
+;; ========================================
+;; As already mentioned, the simplest way to access the arguments of an
+;; advised function in the body of an advice is to refer to them by name. To
+;; do that, the advice programmer needs to know either the names of the
+;; argument variables of the original function, or the names used in the
+;; argument list redefinition given in a piece of advice. While this simple
+;; method might be sufficient in many cases, it has the disadvantage that it
+;; is not very portable because it hardcodes the argument names into the
+;; advice. If the definition of the original function changes the advice
+;; might break even though the code might still be correct. Situations like
+;; that arise, for example, if one advises a subr like `eval-region' which
+;; gets redefined in a non-advice style into a function by the edebug
+;; package. If the advice assumes `eval-region' to be a subr it might break
+;; once edebug is loaded. Similar situations arise when one wants to use the
+;; same piece of advice across different versions of Emacs. Some subrs in a
+;; v18 Emacs are functions in v19 and vice versa, but for the most part the
+;; semantics remain the same, hence, the same piece of advice might be usable
+;; in both Emacs versions.
+;; As a solution to that advice provides argument list access macros that get
+;; translated into the proper access forms at activation time, i.e., when the
+;; advised definition gets constructed. Access macros access actual arguments
+;; by position regardless of how these actual argument get distributed onto
+;; the argument variables of a function. The rational behind this is that in
+;; Emacs Lisp the semantics of an argument is strictly determined by its
+;; position (there are no keyword arguments).
+;; Suppose the function `foo' is defined as
+;;    (defun foo (x y &optional z &rest r) ....)
+;; and is then called with
+;;    (foo 0 1 2 3 4 5 6)
+;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that
+;; the semantics of an actual argument is determined by its position. It is
+;; this semantics that has to be known by the advice programmer. Then s/he
+;; can access these arguments in a piece of advice with some of the
+;; following macros (the arrows indicate what value they will return):
+;;    (ad-get-arg 0) -> 0
+;;    (ad-get-arg 1) -> 1
+;;    (ad-get-arg 2) -> 2
+;;    (ad-get-arg 3) -> 3
+;;    (ad-get-args 2) -> (2 3 4 5 6)
+;;    (ad-get-args 4) -> (4 5 6)
+;; `(ad-get-arg <position>)' will return the actual argument that was supplied
+;; at <position>, `(ad-get-args <position>)' will return the list of actual
+;; arguments supplied starting at <position>. Note that these macros can be
+;; used without any knowledge about the form of the actual argument list of
+;; the original function.
+;; Similarly, `(ad-set-arg <position> <value-form>)' can be used to set the
+;; value of the actual argument at <position> to <value-form>. For example,
+;;   (ad-set-arg 5 "five")
+;; will have the effect that R=(3 4 "five" 6) once the original function is
+;; called. `(ad-set-args <position> <value-list-form>)' can be used to set
+;; the list of actual arguments starting at <position> to <value-list-form>.
+;; For example,
+;;   (ad-set-args 0 '(5 4 3 2 1 0))
+;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original
+;; function is called.
+;; All these access macros are text macros rather than real Lisp macros. When
+;; the advised definition gets constructed they get replaced with actual access
+;; forms depending on the argument list of the advised function, i.e., after
+;; that argument access is in most cases as efficient as using the argument
+;; variable names directly.
+;; @@@ Accessing argument bindings of arbitrary functions:
+;; =======================================================
+;; Some functions (such as `trace-function' defined in trace.el) need a
+;; method of accessing the names and bindings of the arguments of an
+;; arbitrary advised function. To do that within an advice one can use the
+;; special keyword `ad-arg-bindings' which is a text macro that will be
+;; substituted with a form that will evaluate to a list of binding
+;; specifications, one for every argument variable.  These binding
+;; specifications can then be examined in the body of the advice.  For
+;; example, somewhere in an advice we could do this:
+;;   (let* ((bindings ad-arg-bindings)
+;;          (firstarg (car bindings))
+;;          (secondarg (car (cdr bindings))))
+;;     ;; Print info about first argument
+;;     (print (format "%s=%s (%s)"
+;;                    (ad-arg-binding-field firstarg 'name)
+;;                    (ad-arg-binding-field firstarg 'value)
+;;                    (ad-arg-binding-field firstarg 'type)))
+;;     ....)
+;; The `type' of an argument is either `required', `optional' or `rest'.
+;; Wherever `ad-arg-bindings' appears a form will be inserted that evaluates
+;; to the list of bindings, hence, in order to avoid multiple unnecessary
+;; evaluations one should always bind it to some variable.
+;; @@@ Argument list mapping:
+;; ==========================
+;; Because `defadvice' allows the specification of the argument list of the
+;; advised function we need a mapping mechanism that maps this argument list
+;; onto that of the original function. For example, somebody might specify
+;; `(sym newdef)' as the argument list of `fset', while advice might use
+;; `(&rest ad-subr-args)' as the argument list of the original function
+;; (depending on what Emacs version is used). Hence SYM and NEWDEF have to
+;; be properly mapped onto the &rest variable when the original definition is
+;; called. Advice automatically takes care of that mapping, hence, the advice 
+;; programmer can specify an argument list without having to know about the
+;; exact structure of the original argument list as long as the new argument
+;; list takes a compatible number/magnitude of actual arguments.
+;; @@@ Definition of subr argument lists:
+;; ======================================
+;; When advice constructs the advised definition of a function it has to
+;; know the argument list of the original function. For functions and macros
+;; the argument list can be determined from the actual definition, however,
+;; for subrs there is no such direct access available. In XEmacs and for some
+;; subrs in Emacs-19 the argument list of a subr can be determined from
+;; its documentation string, in a v18 Emacs even that is not possible. If
+;; advice cannot at all determine the argument list of a subr it uses
+;; `(&rest ad-subr-args)' which will always work but is inefficient because
+;; it conses up arguments. The macro `ad-define-subr-args' can be used by
+;; the advice programmer to explicitly tell advice about the argument list
+;; of a certain subr, for example,
+;;    (ad-define-subr-args 'fset '(sym newdef))
+;; is used by advice itself to tell a v18 Emacs about the arguments of `fset'.
+;; The following can be used to undo such a definition:
+;;    (ad-undefine-subr-args 'fset)
+;; The argument list definition is stored on the property list of the subr
+;; name symbol. When an argument list could be determined from the
+;; documentation string it will be cached under that property. The general
+;; mechanism for looking up the argument list of a subr is the following:
+;; 1) look for a definition stored on the property list
+;; 2) if that failed try to infer it from the documentation string and
+;;    if successful cache it on the property list
+;; 3) otherwise use `(&rest ad-subr-args)'
+;; @@ Activation and deactivation:
+;; ===============================
+;; The definition of an advised function does not change until all its advice
+;; gets actually activated. Activation can either happen with the `activate'
+;; flag specified in the `defadvice', with an explicit call or interactive
+;; invocation of `ad-activate', or if forward advice is enabled (i.e., the
+;; value of `ad-activate-on-definition' is t) at the time an already advised
+;; function gets defined.
+;; When a function gets first activated its original definition gets saved,
+;; all defined and enabled pieces of advice will get combined with the
+;; original definition, the resulting definition might get compiled depending
+;; on some conditions described below, and then the function will get
+;; redefined with the advised definition.  This also means that undefined
+;; functions cannot get activated even though they might be already advised.
+;; The advised definition will get compiled either if `ad-activate' was called
+;; interactively with a prefix argument, or called explicitly with its second
+;; argument as t, or, if `ad-default-compilation-action' justifies it according
+;; to the current system state. If the advised definition was
+;; constructed during "preactivation" (see below) then that definition will
+;; be already compiled because it was constructed during byte-compilation of
+;; the file that contained the `defadvice' with the `preactivate' flag.
+;; `ad-deactivate' can be used to back-define an advised function to its
+;; original definition. It can be called interactively or directly. Because
+;; `ad-activate' caches the advised definition the function can be
+;; reactivated via `ad-activate' with only minor overhead (it is checked
+;; whether the current advice state is consistent with the cached
+;; definition, see the section on caching below).
+;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate
+;; all currently advised function that have a piece of advice with a name that
+;; contains a match for a regular expression. These functions can be used to
+;; de/activate sets of functions depending on certain advice naming
+;; conventions.
+;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to
+;; de/activate all currently advised functions. These are useful to
+;; (temporarily) return to an un/advised state.
+;; @@@ Reasons for the separation of advice definition and activation:
+;; ===================================================================
+;; As already mentioned, advising happens in two stages:
+;;   1) definition of various pieces of advice
+;;   2) activation of all advice currently defined and enabled
+;; The advantage of this is that various pieces of advice can be defined
+;; before they get combined into an advised definition which avoids
+;; unnecessary constructions of intermediate advised definitions. The more
+;; important advantage is that it allows the implementation of forward advice.
+;; Advice information for a certain function accumulates as the value of the
+;; `advice-info' property of the function symbol. This accumulation is
+;; completely independent of the fact that that function might not yet be
+;; defined. The special forms `defun' and `defmacro' have been advised to
+;; check whether the function/macro they defined had advice information
+;; associated with it. If so and forward advice is enabled, the original
+;; definition will be saved, and then the advice will be activated. When a
+;; file is loaded in a v18 Emacs the functions/macros it defines are also
+;; defined with calls to `defun/defmacro'.  Hence, we can forward advise
+;; functions/macros which will be defined later during a load/autoload of some
+;; file (for compiled files generated by jwz's byte-compiler in a v19 Emacs
+;; this is slightly more complicated but the basic idea is the same).
+;; @@ Enabling/disabling pieces or sets of advice:
+;; ===============================================
+;; A major motivation for the development of this advice package was to bring
+;; a little bit more structure into the function overloading chaos in Emacs
+;; Lisp. Many packages achieve some of their functionality by adding a little
+;; bit (or a lot) to the standard functionality of some Emacs Lisp function.
+;; ange-ftp is a very popular package that achieves its magic by overloading
+;; most Emacs Lisp functions that deal with files. A popular function that's
+;; overloaded by many packages is `expand-file-name'. The situation that one
+;; function is multiply overloaded can arise easily.
+;; Once in a while it would be desirable to be able to disable some/all
+;; overloads of a particular package while keeping all the rest.  Ideally -
+;; at least in my opinion - these overloads would all be done with advice,
+;; I know I am dreaming right now... In that ideal case the enable/disable
+;; mechanism of advice could be used to achieve just that.
+;; Every piece of advice is associated with an enablement flag. When the
+;; advised definition of a particular function gets constructed (e.g., during
+;; activation) only the currently enabled pieces of advice will be considered.
+;; This mechanism allows one to have different "views" of an advised function
+;; dependent on what pieces of advice are currently enabled.
+;; Another motivation for this mechanism is that it allows one to define a
+;; piece of advice for some function yet keep it dormant until a certain
+;; condition is met. Until then activation of the function will not make use
+;; of that piece of advice. Once the condition is met the advice can be
+;; enabled and a reactivation of the function will add its functionality as
+;; part of the new advised definition. For example, the advices of `defun'
+;; etc. used by advice itself will stay disabled until `ad-start-advice' is
+;; called and some variables have the proper values.  Hence, if somebody
+;; else advised these functions too and activates them the advices defined
+;; by advice will get used only if they are intended to be used.
+;; The main interface to this mechanism are the interactive functions
+;; `ad-enable-advice' and `ad-disable-advice'. For example, the following
+;; would disable a particular advice of the function `foo':
+;;    (ad-disable-advice 'foo 'before 'my-advice)
+;; This call by itself only changes the flag, to get the proper effect in
+;; the advised definition too one has to activate `foo' with
+;;    (ad-activate 'foo)
+;; or interactively. To disable whole sets of advices one can use a regular
+;; expression mechanism. For example, let us assume that ange-ftp actually
+;; used advice to overload all its functions, and that it used the
+;; "ange-ftp-" prefix for all its advice names, then we could temporarily
+;; disable all its advices with
+;;    (ad-disable-regexp "^ange-ftp-")
+;; and the following call would put that actually into effect:
+;;    (ad-activate-regexp "^ange-ftp-")
+;; A saver way would have been to use
+;;    (ad-update-regexp "^ange-ftp-")
+;; instead which would have only reactivated currently actively advised
+;; functions, but not functions that were currently deactivated. All these
+;; functions can also be called interactively.
+;; A certain piece of advice is considered a match if its name contains a
+;; match for the regular expression. To enable ange-ftp again we would use
+;; `ad-enable-regexp' and then activate or update again.
+;; @@ Forward advice, automatic advice activation:
+;; ===============================================
+;; Because most Emacs Lisp packages are loaded on demand via an autoload
+;; mechanism it is essential to be able to "forward advise" functions.
+;; Otherwise, proper advice definition and activation would make it necessary
+;; to preload every file that defines a certain function before it can be
+;; advised, which would partly defeat the purpose of the advice mechanism.
+;; In the following, "forward advice" always implies its automatic activation
+;; once a function gets defined, and not just the accumulation of advice
+;; information for a possibly undefined function.
+;; Advice implements forward advice mainly via the following: 1) Separation
+;; of advice definition and activation that makes it possible to accumulate
+;; advice information without having the original function already defined,
+;; 2) special versions of the built-in functions `fset/defalias' which check
+;; for advice information whenever they define a function. If advice
+;; information was found then the advice will immediately get activated when
+;; the function gets defined.
+;; Automatic advice activation means, that whenever a function gets defined
+;; with either `defun', `defmacro', `fset' or by loading a byte-compiled
+;; file, and the function has some advice-info stored with it then that
+;; advice will get activated right away.
+;; @@@ Enabling automatic advice activation:
+;; =========================================
+;; Automatic advice activation is enabled by default. It can be disabled by
+;; doint `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'.
+;; @@ Caching of advised definitions:
+;; ==================================
+;; After an advised definition got constructed it gets cached as part of the
+;; advised function's advice-info so it can be reused, for example, after an
+;; intermediate deactivation. Because the advice-info of a function might
+;; change between the time of caching and reuse a cached definition gets
+;; a cache-id associated with it so it can be verified whether the cached
+;; definition is still valid (the main application of this is preactivation
+;; - see below).
+;; When an advised function gets activated and a verifiable cached definition
+;; is available, then that definition will be used instead of creating a new
+;; advised definition from scratch. If you want to make sure that a new
+;; definition gets constructed then you should use `ad-clear-cache' before you
+;; activate the advised function.
+;; @@ Preactivation:
+;; =================
+;; Constructing an advised definition is moderately expensive. In a situation
+;; where one package defines a lot of advised functions it might be
+;; prohibitively expensive to do all the advised definition construction at
+;; runtime. Preactivation is a mechanism that allows compile-time construction
+;; of compiled advised definitions that can be activated cheaply during
+;; runtime. Preactivation uses the caching mechanism to do that. Here's how it
+;; works:
+;; When the byte-compiler compiles a `defadvice' that has the `preactivate'
+;; flag specified, it uses the current original definition of the advised
+;; function plus the advice specified in this `defadvice' (even if it is
+;; specified as disabled) and all other currently enabled pieces of advice to
+;; construct an advised definition and an identifying cache-id and makes them
+;; part of the `defadvice' expansion which will then be compiled by the
+;; byte-compiler (to ensure that in a v18 emacs you have to put the
+;; `defadvice' inside a `defun' to get it compiled and then you have to call
+;; that compiled `defun' in order to actually execute the `defadvice'). When
+;; the file with the compiled, preactivating `defadvice' gets loaded the
+;; precompiled advised definition will be cached on the advised function's
+;; advice-info. When it gets activated (can be immediately on execution of the
+;; `defadvice' or any time later) the cache-id gets checked against the
+;; current state of advice and if it is verified the precompiled definition
+;; will be used directly (the verification is pretty cheap). If it couldn't get
+;; verified a new advised definition for that function will be built from
+;; scratch, hence, the efficiency added by the preactivation mechanism does
+;; not at all impair the flexibility of the advice mechanism.
+;; MORAL: In order get all the efficiency out of preactivation the advice
+;;        state of an advised function at the time the file with the
+;;        preactivating `defadvice' gets byte-compiled should be exactly
+;;        the same as it will be when the advice of that function gets
+;;        actually activated. If it is not there is a high chance that the
+;;        cache-id will not match and hence a new advised definition will
+;;        have to be constructed at runtime.
+;; Preactivation and forward advice do not contradict each other. It is
+;; perfectly ok to load a file with a preactivating `defadvice' before the
+;; original definition of the advised function is available. The constructed
+;; advised definition will be used once the original function gets defined and
+;; its advice gets activated. The only constraint is that at the time the
+;; file with the preactivating `defadvice' got compiled the original function
+;; definition was available.
+;; TIPS: Here are some indications that a preactivation did not work the way
+;;       you intended it to work:
+;;       - Activation of the advised function takes longer than usual/expected
+;;       - The byte-compiler gets loaded while an advised function gets
+;;         activated
+;;       - `byte-compile' is part of the `features' variable even though you
+;;         did not use the byte-compiler
+;;       Right now advice does not provide an elegant way to find out whether
+;;       and why a preactivation failed. What you can do is to trace the
+;;       function `ad-cache-id-verification-code' (with the function
+;;       `trace-function-background' defined in my trace.el package) before
+;;       any of your advised functions get activated. After they got
+;;       activated check whether all calls to `ad-cache-id-verification-code'
+;;       returned `verified' as a result. Other values indicate why the
+;;       verification failed which should give you enough information to
+;;       fix your preactivation/compile/load/activation sequence.
+;; IMPORTANT: There is one case (that I am aware of) that can make 
+;; preactivation fail, i.e., a preconstructed advised definition that does
+;; NOT match the current state of advice gets used nevertheless. That case
+;; arises if one package defines a certain piece of advice which gets used
+;; during preactivation, and another package incompatibly redefines that 
+;; very advice (i.e., same function/class/name), and it is the second advice
+;; that is available when the preconstructed definition gets activated, and
+;; that was the only definition of that advice so far (`ad-add-advice' 
+;; catches advice redefinitions and clears the cache in such a case). 
+;; Catching that would make the cache verification too expensive.
+;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with
+;; George Walker Bush), and why would you redefine your own advice anyway?
+;; Advice is a mechanism to facilitate function redefinition, not advice
+;; redefinition (wait until I write Meta-Advice :-). If you really have
+;; to undo somebody else's advice try to write a "neutralizing" advice.
+;; @@ Advising macros and special forms and other dangerous things:
+;; ================================================================
+;; Look at the corresponding tutorial sections for more information on
+;; these topics. Here it suffices to point out that the special treatment
+;; of macros and special forms by the byte-compiler can lead to problems
+;; when they get advised. Macros can create problems because they get
+;; expanded at compile time, hence, they might not have all the necessary
+;; runtime support and such advice cannot be de/activated or changed as
+;; it is possible for functions. Special forms create problems because they
+;; have to be advised "into" macros, i.e., an advised special form is a
+;; implemented as a macro, hence, in most cases the byte-compiler will
+;; not recognize it as a special form anymore which can lead to very strange
+;; results.
+;; MORAL: - Only advise macros or special forms when you are absolutely sure
+;;          what you are doing.
+;;        - As a safety measure, always do `ad-deactivate-all' before you
+;;          byte-compile a file to make sure that even if some inconsiderate
+;;          person advised some special forms you'll get proper compilation
+;;          results. After compilation do `ad-activate-all' to get back to
+;;          the previous state.
+;; @@ Adding a piece of advice with `ad-add-advice':
+;; =================================================
+;; The non-interactive function `ad-add-advice' can be used to add a piece of
+;; advice to some function without using `defadvice'. This is useful if advice
+;; has to be added somewhere by a function (also look at `ad-make-advice').
+;; @@ Activation/deactivation advices, file load hooks:
+;; ====================================================
+;; There are two special classes of advice called `activation' and
+;; `deactivation'. The body forms of these advices are not included into the
+;; advised definition of a function, rather they are assembled into a hook
+;; form which will be evaluated whenever the advice-info of the advised
+;; function gets activated or deactivated. One application of this mechanism
+;; is to define file load hooks for files that do not provide such hooks
+;; (v19s already come with a general file-load-hook mechanism, v18s don't).
+;; For example, suppose you want to print a message whenever `file-x' gets
+;; loaded, and suppose the last function defined in `file-x' is
+;; `file-x-last-fn'.  Then we can define the following advice:
+;;   (defadvice file-x-last-fn (activation file-x-load-hook)
+;;      "Executed whenever file-x is loaded"
+;;      (if load-in-progress (message "Loaded file-x")))
+;; This will constitute a forward advice for function `file-x-last-fn' which
+;; will get activated when `file-x' is loaded (only if forward advice is
+;; enabled of course). Because there are no "real" pieces of advice
+;; available for it, its definition will not be changed, but the activation
+;; advice will be run during its activation which is equivalent to having a
+;; file load hook for `file-x'.
+;; @@ Summary of main advice concepts:
+;; ===================================
+;; - Definition:
+;;     A piece of advice gets defined with `defadvice' and added to the
+;;     `advice-info' property of a function.
+;; - Enablement:
+;;     Every piece of advice has an enablement flag associated with it. Only
+;;     enabled advices are considered during construction of an advised
+;;     definition.
+;; - Activation:
+;;     Redefine an advised function with its advised definition. Constructs
+;;     an advised definition from scratch if no verifiable cached advised
+;;     definition is available and caches it.
+;; - Deactivation:
+;;     Back-define an advised function to its original definition.
+;; - Update:
+;;     Reactivate an advised function but only if its advice is currently 
+;;     active. This can be used to bring all currently advised function up
+;;     to date with the current state of advice without also activating
+;;     currently deactivated functions.
+;; - Caching:
+;;     Is the saving of an advised definition and an identifying cache-id so
+;;     it can be reused, for example, for activation after deactivation.
+;; - Preactivation:
+;;     Is the construction of an advised definition according to the current
+;;     state of advice during byte-compilation of a file with a preactivating
+;;     `defadvice'. That advised definition can then rather cheaply be used
+;;     during activation without having to construct an advised definition
+;;     from scratch at runtime.
+;; @@ Summary of interactive advice manipulation functions:
+;; ========================================================
+;; The following interactive functions can be used to manipulate the state
+;; of advised functions (all of them support completion on function names,
+;; advice classes and advice names):
+;; - ad-activate to activate the advice of a FUNCTION
+;; - ad-deactivate to deactivate the advice of a FUNCTION
+;; - ad-update   to activate the advice of a FUNCTION unless it was not
+;;               yet activated or is currently deactivated.
+;; - ad-unadvise deactivates a FUNCTION and removes all of its advice 
+;;               information, hence, it cannot be activated again
+;; - ad-recover  tries to redefine a FUNCTION to its original definition and
+;;               discards all advice information (a low-level `ad-unadvise').
+;;               Use only in emergencies.
+;; - ad-remove-advice removes a particular piece of advice of a FUNCTION.
+;;               You still have to do call `ad-activate' or `ad-update' to
+;;               activate the new state of advice.
+;; - ad-enable-advice enables a particular piece of advice of a FUNCTION.
+;; - ad-disable-advice disables a particular piece of advice of a FUNCTION.
+;; - ad-enable-regexp maps over all currently advised functions and enables
+;;               every advice whose name contains a match for a regular
+;;               expression.
+;; - ad-disable-regexp disables matching advices.
+;; - ad-activate-regexp   activates all advised function with a matching advice
+;; - ad-deactivate-regexp deactivates all advised function with matching advice
+;; - ad-update-regexp     updates all advised function with a matching advice
+;; - ad-activate-all      activates all advised functions
+;; - ad-deactivate-all    deactivates all advised functions
+;; - ad-update-all        updates all advised functions
+;; - ad-unadvise-all      unadvises all advised functions
+;; - ad-recover-all       recovers all advised functions
+;; - ad-compile byte-compiles a function/macro if it is compilable.
+;; @@ Summary of forms with special meanings when used within an advice:
+;; =====================================================================
+;;   ad-return-value   name of the return value variable (get/settable)
+;;   ad-subr-args      name of &rest argument variable used for advised
+;;                     subrs whose actual argument list cannot be
+;;                     determined (get/settable)
+;;   (ad-get-arg <pos>), (ad-get-args <pos>),
+;;   (ad-set-arg <pos> <value>), (ad-set-args <pos> <value-list>)
+;;                     argument access text macros to get/set the values of
+;;                     actual arguments at a certain position
+;;   ad-arg-bindings   text macro that returns the actual names, values
+;;                     and types of the arguments as a list of bindings. The
+;;                     order of the bindings corresponds to the order of the
+;;                     arguments. The individual fields of every binding (name,
+;;                     value and type) can be accessed with the function
+;;                     `ad-arg-binding-field' (see example above).
+;;   ad-do-it          text macro that identifies the place where the original
+;;                     or wrapped definition should go in an around advice
+;; @ Foo games: An advice tutorial
+;; ===============================
+;; The following tutorial was created in Emacs 18.59. Left-justified
+;; s-expressions are input forms followed by one or more result forms.
+;; First we have to start the advice magic:
+;; (ad-start-advice)
+;; nil
+;; We start by defining an innocent looking function `foo' that simply
+;; adds 1 to its argument X:
+;; (defun foo (x)
+;;   "Add 1 to X."
+;;   (1+ x))
+;; foo
+;; (foo 3)
+;; 4
+;; @@ Defining a simple piece of advice:
+;; =====================================
+;; Now let's define the first piece of advice for `foo'.  To do that we
+;; use the macro `defadvice' which takes a function name, a list of advice
+;; specifiers and a list of body forms as arguments.  The first element of
+;; the advice specifiers is the class of the advice, the second is its name,
+;; the third its position and the rest are some flags. The class of our
+;; first advice is `before', its name is `fg-add2', its position among the
+;; currently defined before advices (none so far) is `first', and the advice
+;; will be `activate'ed immediately. Advice names are global symbols, hence,
+;; the name space conventions used for function names should be applied. All
+;; advice names in this tutorial will be prefixed with `fg' for `Foo Games'
+;; (because everybody has the right to be inconsistent all the function names
+;; used in this tutorial do NOT follow this convention).
+;; In the body of an advice we can refer to the argument variables of the
+;; original function by name. Here we add 1 to X so the effect of calling
+;; `foo' will be to actually add 2. All of the advice definitions below only
+;; have one body form for simplicity, but there is no restriction to that
+;; extent. Every piece of advice can have a documentation string which will
+;; be combined with the documentation of the original function.
+;; (defadvice foo (before fg-add2 first activate)
+;;   "Add 2 to X."
+;;   (setq x (1+ x)))
+;; foo
+;; (foo 3)
+;; 5
+;; @@ Specifying the position of an advice:
+;; ========================================
+;; Now we define the second before advice which will cancel the effect of
+;; the previous advice. This time we specify the position as 0 which is
+;; equivalent to `first'. A number can be used to specify the zero-based
+;; position of an advice among the list of advices in the same class. This
+;; time we already have one before advice hence the position specification
+;; actually has an effect. So, after the following definition the position
+;; of the previous advice will be 1 even though we specified it with `first'
+;; above, the reason for this is that the position argument is relative to
+;; the currently defined pieces of advice which by now has changed.
+;; (defadvice foo (before fg-cancel-add2 0 activate)
+;;   "Again only add 1 to X."
+;;   (setq x (1- x)))
+;; foo
+;; (foo 3)
+;; 4
+;; @@ Redefining a piece of advice:
+;; ================================
+;; Now we define an advice with the same class and same name but with a
+;; different position. Defining an advice in a class in which an advice with
+;; that name already exists is interpreted as a redefinition of that
+;; particular advice, in which case the position argument will be ignored
+;; and the previous position of the redefined piece of advice is used.
+;; Advice flags can be specified with non-ambiguous initial substrings, hence,
+;; from now on we'll use `act' instead of the verbose `activate'.
+;; (defadvice foo (before fg-cancel-add2 last act)
+;;   "Again only add 1 to X."
+;;   (setq x (1- x)))
+;; foo
+;; @@ Assembly of advised documentation:
+;; =====================================
+;; The documentation strings of the various pieces of advice are assembled
+;; in order which shows that advice `fg-cancel-add2' is still the first
+;; `before' advice even though we specified position `last' above:
+;; (documentation 'foo)
+;; "Add 1 to X.
+;; This function is advised with the following advice(s):
+;; fg-cancel-add2 (before):
+;; Again only add 1 to X.
+;; fg-add2 (before):
+;; Add 2 to X."
+;; @@ Advising interactive behavior:
+;; =================================
+;; We can make a function interactive (or change its interactive behavior)
+;; by specifying an interactive form in one of the before or around
+;; advices (there could also be body forms in this advice). The particular
+;; definition always assigns 5 as an argument to X which gives us 6 as a
+;; result when we call foo interactively:
+;; (defadvice foo (before fg-inter last act)
+;;   "Use 5 as argument when called interactively."
+;;   (interactive (list 5)))
+;; foo
+;; (call-interactively 'foo)
+;; 6
+;; If more than one advice have an interactive declaration, then the one of
+;; the advice with the smallest position will be used (before advices go
+;; before around and after advices), hence, the declaration below does
+;; not have any effect:
+;; (defadvice foo (before fg-inter2 last act)
+;;   (interactive (list 6)))
+;; foo
+;; (call-interactively 'foo)
+;; 6
+;; Let's have a look at what the definition of `foo' looks like now 
+;; (indentation added by hand for legibility):
+;; (symbol-function 'foo)
+;; (lambda (x)
+;;   "$ad-doc: foo$"
+;;   (interactive (list 5))
+;;   (let (ad-return-value) 
+;;     (setq x (1- x)) 
+;;     (setq x (1+ x)) 
+;;     (setq ad-return-value (ad-Orig-foo x)) 
+;;     ad-return-value))
+;; @@ Around advices:
+;; ==================
+;; Now we'll try some `around' advices. An around advice is a wrapper around
+;; the original definition. It can shadow or establish bindings for the
+;; original definition, and it can look at and manipulate the value returned
+;; by the original function. The position of the special keyword `ad-do-it'
+;; specifies where the code of the original function will be executed. The
+;; keyword can appear multiple times which will result in multiple calls of
+;; the original function in the resulting advised code. Note, that if we don't
+;; specify a position argument (i.e., `first', `last' or a number), then 
+;; `first' (or 0) is the default):
+;; (defadvice foo (around fg-times-2 act)
+;;   "First double X."
+;;   (let ((x (* x 2)))
+;;     ad-do-it))
+;; foo
+;; (foo 3)
+;; 7
+;; Around advices are assembled like onion skins where the around advice
+;; with position 0 is the outermost skin and the advice at the last position
+;; is the innermost skin which is directly wrapped around the call of the
+;; original definition of the function. Hence, after the next `defadvice' we
+;; will first multiply X by 2 then add 1 and then call the original
+;; definition (i.e., add 1 again):
+;; (defadvice foo (around fg-add-1 last act)
+;;   "Add 1 to X."
+;;   (let ((x (1+ x)))
+;;     ad-do-it))
+;; foo
+;; (foo 3)
+;; 8
+;; Again, let's see what the definition of `foo' looks like so far:
+;; (symbol-function 'foo)
+;; (lambda (x) 
+;;   "$ad-doc: foo$"
+;;   (interactive (list 5)) 
+;;   (let (ad-return-value) 
+;;     (setq x (1- x)) 
+;;     (setq x (1+ x)) 
+;;     (let ((x (* x 2))) 
+;;       (let ((x (1+ x))) 
+;;         (setq ad-return-value (ad-Orig-foo x)))) 
+;;     ad-return-value))
+;; @@ Controlling advice activation:
+;; =================================
+;; In every `defadvice' so far we have used the flag `activate' to activate
+;; the advice immediately after its definition, and that's what we want in
+;; most cases. However, if we define multiple pieces of advice for a single
+;; function then activating every advice immediately is inefficient. A
+;; better way to do this is to only activate the last defined advice.
+;; For example:
+;; (defadvice foo (after fg-times-x)
+;;   "Multiply the result with X."
+;;   (setq ad-return-value (* ad-return-value x)))
+;; foo
+;; This still yields the same result as before:
+;; (foo 3)
+;; 8
+;; Now we define another advice and activate which will also activate the
+;; previous advice `fg-times-x'. Note the use of the special variable
+;; `ad-return-value' in the body of the advice which is set to the result of
+;; the original function. If we change its value then the value returned by
+;; the advised function will be changed accordingly:
+;; (defadvice foo (after fg-times-x-again act)
+;;   "Again multiply the result with X."
+;;   (setq ad-return-value (* ad-return-value x)))
+;; foo
+;; Now the advices have an effect:
+;; (foo 3)
+;; 72
+;; @@ Protecting advice execution:
+;; ===============================
+;; Once in a while we define an advice to perform some cleanup action, 
+;; for example:
+;; (defadvice foo (after fg-cleanup last act)
+;;   "Do some cleanup."
+;;   (print "Let's clean up now!"))
+;; foo
+;; However, in case of an error the cleanup won't be performed:
+;; (condition-case error
+;;     (foo t)
+;;   (error 'error-in-foo))
+;; error-in-foo
+;; To make sure a certain piece of advice gets executed even if some error or
+;; non-local exit occurred in any preceding code, we can protect it by using
+;; the `protect' keyword. (if any of the around advices is protected then the
+;; whole around advice onion will be protected):
+;; (defadvice foo (after fg-cleanup prot act)
+;;   "Do some protected cleanup."
+;;   (print "Let's clean up now!"))
+;; foo
+;; Now the cleanup form will be executed even in case of an error:
+;; (condition-case error
+;;     (foo t)
+;;   (error 'error-in-foo))
+;; "Let's clean up now!"
+;; error-in-foo
+;; Again, let's see what `foo' looks like:
+;; (symbol-function 'foo)
+;; (lambda (x) 
+;;   "$ad-doc: foo$"
+;;   (interactive (list 5)) 
+;;   (let (ad-return-value) 
+;;     (unwind-protect 
+;;         (progn (setq x (1- x)) 
+;;                (setq x (1+ x)) 
+;;                (let ((x (* x 2))) 
+;;                  (let ((x (1+ x))) 
+;;                    (setq ad-return-value (ad-Orig-foo x)))) 
+;;                (setq ad-return-value (* ad-return-value x)) 
+;;                (setq ad-return-value (* ad-return-value x))) 
+;;       (print "Let's clean up now!")) 
+;;     ad-return-value))
+;; @@ Compilation of advised definitions:
+;; ======================================
+;; Finally, we can specify the `compile' keyword in a `defadvice' to say
+;; that we want the resulting advised function to be byte-compiled
+;; (`compile' will be ignored unless we also specified `activate'):
+;; (defadvice foo (after fg-cleanup prot act comp)
+;;   "Do some protected cleanup."
+;;   (print "Let's clean up now!"))
+;; foo
+;; Now `foo' is byte-compiled:
+;; (symbol-function 'foo)
+;; (lambda (x) 
+;;   "$ad-doc: foo$"
+;;   (interactive (byte-code "....." [5] 1)) 
+;;   (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6))
+;; (foo 3)
+;; "Let's clean up now!"
+;; 72
+;; @@ Enabling and disabling pieces of advice:
+;; ===========================================
+;; Once in a while it is desirable to temporarily disable a piece of advice
+;; so that it won't be considered during activation, for example, if two
+;; different packages advise the same function and one wants to temporarily
+;; neutralize the effect of the advice of one of the packages.
+;; The following disables the after advice `fg-times-x' in the function `foo'.
+;; All that does is to change a flag for this particular advice. All the
+;; other information defining it will be left unchanged (e.g., its relative
+;; position in this advice class, etc.).
+;; (ad-disable-advice 'foo 'after 'fg-times-x)
+;; nil
+;; For this to have an effect we have to activate `foo':
+;; (ad-activate 'foo)
+;; foo
+;; (foo 3)
+;; "Let's clean up now!"
+;; 24
+;; If we want to disable all multiplication advices in `foo' we can use a
+;; regular expression that matches the names of such advices. Actually, any
+;; advice name that contains a match for the regular expression will be
+;; called a match. A special advice class `any' can be used to consider
+;; all advice classes:
+;; (ad-disable-advice 'foo 'any "^fg-.*times")
+;; nil
+;; (ad-activate 'foo)
+;; foo
+;; (foo 3)
+;; "Let's clean up now!"
+;; 5
+;; To enable the disabled advice we could use either `ad-enable-advice'
+;; similar to `ad-disable-advice', or as an alternative `ad-enable-regexp'
+;; which will enable matching advices in ALL currently advised functions.
+;; Hence, this can be used to dis/enable advices made by a particular
+;; package to a set of functions as long as that package obeys standard
+;; advice name conventions.  We prefixed all advice names with `fg-', hence
+;; the following will do the trick (`ad-enable-regexp' returns the number
+;; of matched advices):
+;; (ad-enable-regexp "^fg-")
+;; 9
+;; The following will activate all currently active advised functions that
+;; contain some advice matched by the regular expression. This is a save
+;; way to update the activation of advised functions whose advice changed
+;; in some way or other without accidentally also activating currently
+;; deactivated functions:
+;; (ad-update-regexp "^fg-")
+;; nil
+;; (foo 3)
+;; "Let's clean up now!"
+;; 72
+;; Another use for the dis/enablement mechanism is to define a piece of advice
+;; and keep it "dormant" until a particular condition is satisfied, i.e., until
+;; then the advice will not be used during activation. The `disable' flag lets
+;; one do that with `defadvice':
+;; (defadvice foo (before fg-1-more dis)
+;;   "Add yet 1 more."
+;;   (setq x (1+ x)))
+;; foo
+;; (ad-activate 'foo)
+;; foo
+;; (foo 3)
+;; "Let's clean up now!"
+;; 72
+;; (ad-enable-advice 'foo 'before 'fg-1-more)
+;; nil
+;; (ad-activate 'foo)
+;; foo
+;; (foo 3)
+;; "Let's clean up now!"
+;; 160
+;; @@ Caching:
+;; ===========
+;; Advised definitions get cached to allow efficient activation/deactivation
+;; without having to reconstruct them if nothing in the advice-info of a
+;; function has changed. The following idiom can be used to temporarily
+;; deactivate functions that have a piece of advice defined by a certain
+;; package (we save the old definition to check out caching):
+;; (setq old-definition (symbol-function 'foo))
+;; (lambda (x) ....)
+;; (ad-deactivate-regexp "^fg-")
+;; nil
+;; (foo 3)
+;; 4
+;; (ad-activate-regexp "^fg-")
+;; nil
+;; (eq old-definition (symbol-function 'foo))
+;; t
+;; (foo 3)
+;; "Let's clean up now!"
+;; 160
+;; @@ Forward advice:
+;; ==================
+;; To enable automatic activation of forward advice we first have to set
+;; `ad-activate-on-definition' to t and restart advice:
+;; (setq ad-activate-on-definition t)
+;; t
+;; (ad-start-advice)
+;; (ad-activate-defined-function)
+;; Let's define a piece of advice for an undefined function:
+;; (defadvice bar (before fg-sub-1-more act)
+;;   "Subtract one more from X."
+;;   (setq x (1- x)))
+;; bar
+;; `bar' is not yet defined:
+;; (fboundp 'bar)
+;; nil
+;; Now we define it and the forward advice will get activated (only because
+;; `ad-activate-on-definition' was t when we started advice above with
+;; `ad-start-advice'):
+;; (defun bar (x)
+;;   "Subtract 1 from X."
+;;   (1- x))
+;; bar
+;; (bar 4)
+;; 2
+;; Redefinition will activate any available advice if the value of
+;; `ad-redefinition-action' is either `warn', `accept' or `discard':
+;; (defun bar (x)
+;;   "Subtract 2 from X."
+;;   (- x 2))
+;; bar
+;; (bar 4)
+;; 1
+;; @@ Preactivation:
+;; =================
+;; Constructing advised definitions is moderately expensive, hence, it is
+;; desirable to have a way to construct them at byte-compile time.
+;; Preactivation is a mechanism that allows one to do that.
+;; (defun fie (x)
+;;   "Multiply X