From ba03d0d932888f687ae9c9fb12e20908c6b0620f Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 1 Dec 2012 12:57:07 +0800 Subject: [PATCH] Modularize add-log-current-defun. Suggested by Jari Aalto. * lisp/emacs-lisp/lisp-mode.el (lisp-current-defun-name): New. (lisp-mode-variables): Use it. * lisp/progmodes/cc-mode.el (c-common-init): * lisp/progmodes/cperl-mode.el (cperl-mode): Set a value for add-log-current-defun-function. * lisp/progmodes/m4-mode.el (m4-current-defun-name): New function. (m4-mode): Use it. * lisp/progmodes/perl-mode.el (perl-current-defun-name): New. (perl-mode): Use it. * lisp/progmodes/scheme.el (scheme-mode-variables, dsssl-mode): Use lisp-current-defun-name. * lisp/textmodes/tex-mode.el (tex-current-defun-name): New. (tex-common-initialization): Use it. * lisp/textmodes/texinfo.el (texinfo-current-defun-name): New. (texinfo-mode): Use it. * lisp/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. Fixes: debbugs:2224 --- lisp/ChangeLog | 32 +++++++++++++ lisp/emacs-lisp/lisp-mode.el | 26 +++++++++++ lisp/progmodes/cc-mode.el | 4 +- lisp/progmodes/cperl-mode.el | 6 +++ lisp/progmodes/m4-mode.el | 13 ++++-- lisp/progmodes/perl-mode.el | 8 +++- lisp/progmodes/scheme.el | 68 ++++++++++++++-------------- lisp/textmodes/tex-mode.el | 11 +++++ lisp/textmodes/texinfo.el | 12 ++++- lisp/vc/add-log.el | 104 ++++++++----------------------------------- 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 + 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 + * 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) -- 2.11.4.GIT