10 files changed, 157 insertions, 127 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 334efbc10e1..c7fb5cabe07 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,37 @@
 2012-12-01  Chong Yidong  <cyd@gnu.org>
 
+        Modularize add-log-current-defun (Bug#2224).
+        Suggested by Jari Aalto.
+
+        * vc/add-log.el (add-log-current-defun-function): Doc fix.
+        (add-log-current-defun): Move mode-specific code to other files.
+        (add-log-lisp-like-modes, add-log-c-like-modes)
+        (add-log-tex-like-modes): Variables deleted.
+
+        * emacs-lisp/lisp-mode.el (lisp-current-defun-name): New.
+        (lisp-mode-variables): Use it.
+
+        * progmodes/cc-mode.el (c-common-init):
+        * progmodes/cperl-mode.el (cperl-mode): Set a value for
+        add-log-current-defun-function.
+
+        * progmodes/m4-mode.el (m4-current-defun-name): New function.
+        (m4-mode): Use it.
+
+        * progmodes/perl-mode.el (perl-current-defun-name): New.
+        (perl-mode): Use it.
+
+        * progmodes/scheme.el (scheme-mode-variables, dsssl-mode): Use
+        lisp-current-defun-name.
+
+        * textmodes/tex-mode.el (tex-current-defun-name): New.
+        (tex-common-initialization): Use it.
+
+        * textmodes/texinfo.el (texinfo-current-defun-name): New.
+        (texinfo-mode): Use it.
+
+2012-12-01  Chong Yidong  <cyd@gnu.org>
+
         * emacs-lisp/lisp-mode.el (lisp-mode-variables, lisp-mode):
         * progmodes/autoconf.el (autoconf-mode):
         * progmodes/js.el (js-mode):
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 81adab53c93..11dd6dc6ee2 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -209,6 +209,7 @@ font-lock keywords will not be case sensitive."
   (setq-local indent-line-function 'lisp-indent-line)
   (setq-local outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")
   (setq-local outline-level 'lisp-outline-level)
+  (setq-local add-log-current-defun-function #'lisp-current-defun-name)
   (setq-local comment-start ";")
   ;; Look within the line for a ; following an even number of backslashes
   ;; after either a non-backslash or the line beginning.
@@ -237,6 +238,31 @@ font-lock keywords will not be case sensitive."
         1000
       len)))
 
+(defun lisp-current-defun-name ()
+  "Return the name of the defun at point, or nil."
+  (let ((location (point)))
+    ;; 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.
+    (when (and (looking-at "\\s(")
+               (progn (end-of-defun)
+                      (< location (point)))
+               (progn (forward-sexp -1)
+                      (>= location (point))))
+      (if (looking-at "\\s(")
+          (forward-char 1))
+      ;; Skip the defining construct name, typically "defun" or
+      ;; "defvar".
+      (forward-sexp 1)
+      ;; The second element is usually a symbol being defined.  If it
+      ;; is not, use the first symbol in it.
+      (skip-chars-forward " \t\n'(")
+      (buffer-substring-no-properties (point)
+                                      (progn (forward-sexp 1)
+                                             (point))))))
+
 (defvar lisp-mode-shared-map
   (let ((map (make-sparse-keymap)))
     (define-key map "\e\C-q" 'indent-sexp)
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 91866278e28..a904ffdb811 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -647,7 +647,9 @@ compatible with old code; callers should always specify it."
 
   (set (make-local-variable 'outline-regexp) "[^#\n\^M]")
   (set (make-local-variable 'outline-level) 'c-outline-level)
-
+  (set (make-local-variable 'add-log-current-defun-function)
+       (lambda ()
+         (or (c-cpp-define-name) (c-defun-name))))
   (let ((rfn (assq mode c-require-final-newline)))
     (when rfn
       (and (cdr rfn)
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index e1430b67e99..5b5097803c3 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1742,6 +1742,12 @@ or as help on variables `cperl-tips', `cperl-problems',
   (setq outline-regexp cperl-outline-regexp)
   (make-local-variable 'outline-level)
   (setq outline-level 'cperl-outline-level)
+  (make-local-variable 'add-log-current-defun-function)
+  (setq add-log-current-defun-function
+        (lambda ()
+          (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
+              (match-string-no-properties 1))))
+
   (make-local-variable 'paragraph-start)
   (setq paragraph-start (concat "^$\\|" page-delimiter))
   (make-local-variable 'paragraph-separate)
diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el
index 20f91ce2d9e..9cf98d979f6 100644
--- a/lisp/progmodes/m4-mode.el
+++ b/lisp/progmodes/m4-mode.el
@@ -141,13 +141,20 @@
    "*m4-output*" nil)
   (switch-to-buffer-other-window "*m4-output*"))
 
+(defun m4-current-defun-name ()
+  "Return the name of the M4 function at point, or nil."
+  (if (re-search-backward
+       "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t)
+      (match-string-no-properties 3)))
+
 ;;;###autoload
 (define-derived-mode m4-mode prog-mode "m4"
   "A major mode to edit m4 macro files."
   :abbrev-table m4-mode-abbrev-table
-  (set (make-local-variable 'comment-start) "#")
-  (set (make-local-variable 'parse-sexp-ignore-comments) t)
-  (set (make-local-variable 'font-lock-defaults) '(m4-font-lock-keywords nil)))
+  (setq-local comment-start "#")
+  (setq-local parse-sexp-ignore-comments t)
+  (setq-local add-log-current-defun-function #'m4-current-defun-name)
+  (setq font-lock-defaults '(m4-font-lock-keywords nil)))
 
 (provide 'm4-mode)
 ;;stuff to play with for debugging
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index f8ae0030cf0..82f742de274 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -578,6 +578,11 @@ create a new comment."
    ((looking-at "=head[0-9]") (- (char-before (match-end 0)) ?0))
    ((looking-at "=cut") 1)
    (t 3)))
+
+(defun perl-current-defun-name ()
+  "The `add-log-current-defun' function in Perl mode."
+  (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
+      (match-string-no-properties 1)))
 
 (defvar perl-mode-hook nil
   "Normal hook to run when entering Perl mode.")
@@ -660,7 +665,8 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
   (setq imenu-case-fold-search nil)
   ;; Setup outline-minor-mode.
   (setq-local outline-regexp perl-outline-regexp)
-  (setq-local outline-level 'perl-outline-level))
+  (setq-local outline-level 'perl-outline-level)
+  (setq-local add-log-current-defun-function #'perl-current-defun-name))
 
 ;; This is used by indent-for-comment
 ;; to decide how much to indent a comment in Perl code
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index 7cab07fe387..1a15f9eda3c 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -126,44 +126,44 @@
 (defun scheme-mode-variables ()
   (set-syntax-table scheme-mode-syntax-table)
   (setq local-abbrev-table scheme-mode-abbrev-table)
-  (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
-  (set (make-local-variable 'paragraph-separate) paragraph-start)
-  (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
-  (set (make-local-variable 'fill-paragraph-function) 'lisp-fill-paragraph)
+  (setq-local paragraph-start (concat "$\\|" page-delimiter))
+  (setq-local paragraph-separate paragraph-start)
+  (setq-local paragraph-ignore-fill-prefix t)
+  (setq-local fill-paragraph-function 'lisp-fill-paragraph)
   ;; Adaptive fill mode gets in the way of auto-fill,
   ;; and should make no difference for explicit fill
   ;; because lisp-fill-paragraph should do the job.
-  (set (make-local-variable 'adaptive-fill-mode) nil)
-  (set (make-local-variable 'indent-line-function) 'lisp-indent-line)
-  (set (make-local-variable 'parse-sexp-ignore-comments) t)
-  (set (make-local-variable 'outline-regexp) ";;; \\|(....")
-  (set (make-local-variable 'comment-start) ";")
-  (set (make-local-variable 'comment-add) 1)
+  (setq-local adaptive-fill-mode nil)
+  (setq-local indent-line-function 'lisp-indent-line)
+  (setq-local parse-sexp-ignore-comments t)
+  (setq-local outline-regexp ";;; \\|(....")
+  (setq-local add-log-current-defun-function #'lisp-current-defun-name)
+  (setq-local comment-start ";")
+  (setq-local comment-add 1)
   ;; Look within the line for a ; following an even number of backslashes
   ;; after either a non-backslash or the line beginning.
-  (set (make-local-variable 'comment-start-skip)
-       "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
-  (set (make-local-variable 'font-lock-comment-start-skip) ";+ *")
-  (set (make-local-variable 'comment-column) 40)
-  (set (make-local-variable 'parse-sexp-ignore-comments) t)
-  (set (make-local-variable 'lisp-indent-function) 'scheme-indent-function)
+  (setq-local comment-start-skip
+              "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
+  (setq-local font-lock-comment-start-skip ";+ *")
+  (setq-local comment-column 40)
+  (setq-local parse-sexp-ignore-comments t)
+  (setq-local lisp-indent-function 'scheme-indent-function)
   (setq mode-line-process '("" scheme-mode-line-process))
-  (set (make-local-variable 'imenu-case-fold-search) t)
+  (setq-local imenu-case-fold-search t)
   (setq imenu-generic-expression scheme-imenu-generic-expression)
-  (set (make-local-variable 'imenu-syntax-alist)
+  (setq-local imenu-syntax-alist
         '(("+-*/.<>=?!$%_&~^:" . "w")))
-  (set (make-local-variable 'font-lock-defaults)
-       '((scheme-font-lock-keywords
-          scheme-font-lock-keywords-1 scheme-font-lock-keywords-2)
-         nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14"))
-         beginning-of-defun
-         (font-lock-mark-block-function . mark-defun)
-         (font-lock-syntactic-face-function
-          . scheme-font-lock-syntactic-face-function)
-         (parse-sexp-lookup-properties . t)
-         (font-lock-extra-managed-props syntax-table)))
-  (set (make-local-variable 'lisp-doc-string-elt-property)
-       'scheme-doc-string-elt))
+  (setq font-lock-defaults
+        '((scheme-font-lock-keywords
+           scheme-font-lock-keywords-1 scheme-font-lock-keywords-2)
+          nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14"))
+          beginning-of-defun
+          (font-lock-mark-block-function . mark-defun)
+          (font-lock-syntactic-face-function
+           . scheme-font-lock-syntactic-face-function)
+          (parse-sexp-lookup-properties . t)
+          (font-lock-extra-managed-props syntax-table)))
+  (setq-local lisp-doc-string-elt-property 'scheme-doc-string-elt))
 
 (defvar scheme-mode-line-process "")
 
@@ -386,7 +386,7 @@ Blank lines separate paragraphs.  Semicolons start comments.
 Entering this mode runs the hooks `scheme-mode-hook' and then
 `dsssl-mode-hook' and inserts the value of `dsssl-sgml-declaration' if
 that variable's value is a string."
-  (set (make-local-variable 'page-delimiter) "^;;;") ; ^L not valid SGML char
+  (setq-local page-delimiter "^;;;") ; ^L not valid SGML char
   ;; Insert a suitable SGML declaration into an empty buffer.
   ;; FIXME: This should use `auto-insert-alist' instead.
   (and (zerop (buffer-size))
@@ -397,10 +397,10 @@ that variable's value is a string."
                              nil t (("+-*/.<>=?$%_&~^:" . "w"))
                              beginning-of-defun
                              (font-lock-mark-block-function . mark-defun)))
-  (set (make-local-variable 'imenu-case-fold-search) nil)
+  (setq-local add-log-current-defun-function #'lisp-current-defun-name)
+  (setq-local imenu-case-fold-search nil)
   (setq imenu-generic-expression dsssl-imenu-generic-expression)
-  (set (make-local-variable 'imenu-syntax-alist)
-       '(("+-*/.<>=?$%_&~^:" . "w"))))
+  (setq-local imenu-syntax-alist '(("+-*/.<>=?$%_&~^:" . "w"))))
 
 ;; Extra syntax for DSSSL.  This isn't separated from Scheme, but
 ;; shouldn't cause much trouble in scheme-mode.
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index c4fe0d629b4..966fa60e6de 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -421,6 +421,16 @@ An alternative value is \" . \", if you use a font with a narrow period."
   (if (looking-at latex-outline-regexp)
       (1+ (or (cdr (assoc (match-string 1) latex-section-alist)) -1))
     1000))
+
+(defun tex-current-defun-name ()
+  "Return the name of the TeX section/paragraph/chapter at point, or nil."
+  (when (re-search-backward
+         "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)"
+         nil t)
+    (goto-char (match-beginning 0))
+    (buffer-substring-no-properties
+     (1+ (point))       ; without initial backslash
+     (line-end-position))))
 
 ;;;;
 ;;;; Font-Lock support
@@ -1202,6 +1212,7 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
   ;; A line starting with $$ starts a paragraph,
   ;; but does not separate paragraphs if it has more stuff on it.
   (setq-local paragraph-separate "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$[ \t]*$")
+  (setq-local add-log-current-defun-function #'tex-current-defun-name)
   (setq-local comment-start "%")
   (setq-local comment-add 1)
   (setq-local comment-start-skip
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 91405ba0744..0e45b603c1a 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -511,6 +511,11 @@ Subexpression 1 is what goes into the corresponding `@end' statement.")
   (regexp-opt (texinfo-filter 2 texinfo-section-list))
   "Regular expression matching just the Texinfo chapter level headings.")
 
+(defun texinfo-current-defun-name ()
+  "Return the name of the Texinfo node at point, or nil."
+  (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
+      (match-string-no-properties 1)))
+
 ;;; Texinfo mode
 
 ;;;###autoload
@@ -587,8 +592,10 @@ value of `texinfo-mode-hook'."
   (setq-local require-final-newline mode-require-final-newline)
   (setq-local indent-tabs-mode nil)
   (setq-local paragraph-separate
-              (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-separate))
-  (setq-local paragraph-start (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-start))
+              (concat "\b\\|@[a-zA-Z]*[ \n]\\|"
+                      paragraph-separate))
+  (setq-local paragraph-start (concat "\b\\|@[a-zA-Z]*[ \n]\\|"
+                                      paragraph-start))
   (setq-local sentence-end-base "\\(@\\(end\\)?dots{}\\|[.?!]\\)[]\"'”)}]*")
   (setq-local fill-column 70)
   (setq-local comment-start "@c ")
@@ -600,6 +607,7 @@ value of `texinfo-mode-hook'."
         '(texinfo-font-lock-keywords nil nil nil backward-paragraph))
   (setq-local syntax-propertize-function texinfo-syntax-propertize-function)
   (setq-local parse-sexp-lookup-properties t)
+  (setq-local add-log-current-defun-function #'texinfo-current-defun-name)
 
   ;; Outline settings.
   (setq-local outline-heading-alist
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index 5a378df6513..0d2b82cb9a7 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -61,8 +61,9 @@
 ;;;###autoload
 (defcustom add-log-current-defun-function nil
   "If non-nil, function to guess name of surrounding function.
-It is used by `add-log-current-defun' in preference to built-in rules.
-Returns function's name as a string, or nil if outside a function."
+It is called by `add-log-current-defun' with no argument, and
+should return the function's name as a string, or nil if point is
+outside a function."
   :type '(choice (const nil) function)
   :group 'change-log)
 
@@ -1118,21 +1119,6 @@ parentheses."
   :type 'regexp
   :group 'change-log)
 
-;;;###autoload
-(defvar add-log-lisp-like-modes
-  '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode)
-  "Modes that look like Lisp to `add-log-current-defun'.")
-
-;;;###autoload
-(defvar add-log-c-like-modes
-  '(c-mode c++-mode c++-c-mode objc-mode)
-  "Modes that look like C to `add-log-current-defun'.")
-
-;;;###autoload
-(defvar add-log-tex-like-modes
-  '(TeX-mode plain-TeX-mode LaTeX-mode tex-mode)
-  "Modes that look like TeX to `add-log-current-defun'.")
-
 (declare-function c-cpp-define-name "cc-cmds" ())
 (declare-function c-defun-name      "cc-cmds" ())
 
@@ -1152,75 +1138,21 @@ identifiers followed by `:' or `='.  See variables
 Has a preference of looking backwards."
   (condition-case nil
       (save-excursion
-        (let ((location (point)))
-          (cond (add-log-current-defun-function
-                 (funcall add-log-current-defun-function))
-                ((apply 'derived-mode-p 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.
-                 (when (and (looking-at "\\s(")
-                            (progn (end-of-defun)
-                                   (< location (point)))
-                            (progn (forward-sexp -1)
-                                   (>= location (point))))
-                   (if (looking-at "\\s(")
-                       (forward-char 1))
-                   ;; Skip the defining construct name, typically "defun"
-                   ;; or "defvar".
-                   (forward-sexp 1)
-                   ;; The second element is usually a symbol being defined.
-                   ;; If it is not, use the first symbol in it.
-                   (skip-chars-forward " \t\n'(")
-                   (buffer-substring-no-properties (point)
-                                                   (progn (forward-sexp 1)
-                                                          (point)))))
-                ((apply 'derived-mode-p add-log-c-like-modes)
-                 (or (c-cpp-define-name)
-                     (c-defun-name)))
-                ((apply #'derived-mode-p add-log-tex-like-modes)
-                 (if (re-search-backward
-                      "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)"
-                      nil t)
-                     (progn
-                       (goto-char (match-beginning 0))
-                       (buffer-substring-no-properties
-                        (1+ (point))    ; without initial backslash
-                        (line-end-position)))))
-                ((derived-mode-p 'texinfo-mode)
-                 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
-                     (match-string-no-properties 1)))
-                ((derived-mode-p 'perl-mode 'cperl-mode)
-                 (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
-                     (match-string-no-properties 1)))
-                ;; Emacs's autoconf-mode installs its own
-                ;; `add-log-current-defun-function'.  This applies to
-                ;; a different mode apparently for editing .m4
-                ;; autoconf source.
-                ((derived-mode-p 'autoconf-mode)
-                 (if (re-search-backward
-                      "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t)
-                     (match-string-no-properties 3)))
-                (t
-                 ;; If all else fails, try heuristics
-                 (let (case-fold-search
-                       result)
-                   (end-of-line)
-                   (when (re-search-backward
-                          add-log-current-defun-header-regexp
-                          (- (point) 10000)
-                          t)
-                     (setq result (or (match-string-no-properties 1)
-                                      (match-string-no-properties 0)))
-                     ;; Strip whitespace away
-                     (when (string-match "\\([^ \t\n\r\f].*[^ \t\n\r\f]\\)"
-                                         result)
-                       (setq result (match-string-no-properties 1 result)))
-                     result))))))
+        (if add-log-current-defun-function
+            (funcall add-log-current-defun-function)
+          ;; If all else fails, try heuristics
+          (let (case-fold-search
+                result)
+            (end-of-line)
+            (when (re-search-backward add-log-current-defun-header-regexp
+                                      (- (point) 10000) t)
+              (setq result (or (match-string-no-properties 1)
+                               (match-string-no-properties 0)))
+              ;; Strip whitespace away
+              (when (string-match "\\([^ \t\n\r\f].*[^ \t\n\r\f]\\)"
+                                  result)
+                (setq result (match-string-no-properties 1 result)))
+              result))))
     (error nil)))
 
 (defvar change-log-get-method-definition-md)