Package: emacs;
Reported by: Jari Aalto <jari.aalto <at> cante.net>
Date: Fri, 6 Feb 2009 17:50:03 UTC
Severity: wishlist
Tags: patch
Done: Chong Yidong <cyd <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Jari Aalto <jari.aalto <at> cante.net> To: submit <at> debbugs.gnu.org, control <at> debbugs.gnu.org Subject: bug#2224: [PATCH] add-log.el: Modularize add-log-current-defun, new types supported Date: Fri, 06 Feb 2009 19:41:26 +0200
[Message part 1 (text/plain, inline)]
tags: patch
severity: wishlish
The following patch breaks down monolithic `add-log-current-defun' into
separate testing functions. Support for New buffer types is also
provided. The patch is against version control as of 2009-02-06.
Jari
[1] http://www.methods.co.nz/asciidoc/
2009-02-06 Jari Aalto <jari.aalto <at> cante.net>
* add-log.el (add-log-current-defun): Split function into
separate parts: add-log-current-defun-type-*. Add support
for new types: python, ruby, Bourne Shell, Makefile,
X?HTML, CSS, PHP, Javascript, Asciidoc.
(add-log-current-defun-type-c-like): New function.
(add-log-current-defun-type-tex-like): New function.
(add-log-current-defun-type-texinfo-like): New function.
(add-log-current-defun-type-perl-like): New function.
(add-log-current-defun-type-python-like): New function.
(add-log-current-defun-type-shell-ruby-like): New function.
(add-log-current-defun-type-autoconf-like): New function.
(add-log-current-defun-type-html-like): New function.
(add-log-current-defun-type-css-like): New function.
(add-log-current-defun-type-php-like): New function.
(add-log-current-defun-type-javascript-like): New function.
(add-log-current-defun-type-shell-bourne-like): New function.
(add-log-current-defun-type-makefile-like): New function.
(add-log-current-defun-type-text-asciidoc-like): New function.
(add-log-current-defun-type-default): New function.
[0001-Modularize-add-log-current-defun-.-New-file-types-s.patch (text/x-diff, inline)]
From 8416fbfcff9cda0cf26d936e672db706948f0095 Mon Sep 17 00:00:00 2001
From: Jari Aalto <jari.aalto <at> cante.net>
Date: Fri, 6 Feb 2009 19:00:24 +0200
Subject: [PATCH] Modularize `add-log-current-defun'. New file types supported.
2009-02-06 Jari Aalto <jari.aalto <at> cante.net>
* add-log.el (add-log-current-defun): Split function into
separate parts: add-log-current-defun-type-*. Add support
for new types: python, ruby, Bourne Shell, Makefile,
X?HTML, CSS, PHP, Javascript, Asciidoc.
(add-log-current-defun-type-c-like): New function.
(add-log-current-defun-type-tex-like): New function.
(add-log-current-defun-type-texinfo-like): New function.
(add-log-current-defun-type-perl-like): New function.
(add-log-current-defun-type-python-like): New function.
(add-log-current-defun-type-shell-ruby-like): New function.
(add-log-current-defun-type-autoconf-like): New function.
(add-log-current-defun-type-html-like): New function.
(add-log-current-defun-type-css-like): New function.
(add-log-current-defun-type-php-like): New function.
(add-log-current-defun-type-javascript-like): New function.
(add-log-current-defun-type-shell-bourne-like): New function.
(add-log-current-defun-type-makefile-like): New function.
(add-log-current-defun-type-text-asciidoc-like): New function.
(add-log-current-defun-type-default): New function.
Signed-off-by: Jari Aalto <jari.aalto <at> cante.net>
---
lisp/add-log.el | 316 +++++++++++++++++++++++++++++++++++++++++++------------
1 files changed, 247 insertions(+), 69 deletions(-)
diff --git a/lisp/add-log.el b/lisp/add-log.el
index 00e3172..b4cd1b7 100644
--- a/lisp/add-log.el
+++ b/lisp/add-log.el
@@ -1114,9 +1114,216 @@ Prefix arg means justify as well."
'(TeX-mode plain-TeX-mode LaTeX-mode tex-mode)
"*Modes that look like TeX to `add-log-current-defun'.")
+(defun add-log-current-defun-type-lisp-like ()
+ "Return name of function definition point for 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.
+ (let ((location (point)))
+ (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))))))
+
(declare-function c-cpp-define-name "cc-cmds" ())
(declare-function c-defun-name "cc-cmds" ())
+(defun add-log-current-defun-type-c-like ()
+ "Return name of function definition point for C like buffers."
+ (or (c-cpp-define-name)
+ (c-defun-name)))
+
+(defun add-log-current-defun-type-tex-like ()
+ "Return name of function definition point for TeX like buffers."
+ (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)))))
+
+(defun add-log-current-defun-type-texinfo-like ()
+ "Return name of function definition point for Texinfo buffers."
+ (if (re-search-backward
+ "^@node[ \t]+\\([^,\r\n]+\\)" nil t)
+ (match-string-no-properties 1)))
+
+(defun add-log-current-defun-type-perl-like ()
+ "Return name of function definition point for Perl like buffers."
+ (if (re-search-backward
+ "^\\(?:sub\\|package\\)[ \t]+\\([^({ \t\r\n]+\\)" nil t)
+ (match-string-no-properties 1)))
+
+(defun add-log-current-defun-type-python-like ()
+ "Return name of function definition point for Python like buffers."
+ (if (re-search-backward
+ "^\\(?:def\\|class\\)[ \t]+\\([^({ \t\r\n]+\\)" nil t)
+ (match-string-no-properties 1)))
+
+(defun add-log-current-defun-type-shell-ruby-like ()
+ "Return name of function definition point for Ruby buffers."
+ (if (re-search-backward
+ "^\\(?:def\\|class\\)[ \t]+\\([^({ \t\r\n]+\\)" nil t)
+ (match-string-no-properties 1)))
+
+(defun add-log-current-defun-type-autoconf-like ()
+ "Return name of function definition point for Autoconf like buffers."
+ ;; Emacs's autoconf-mode installs its own
+ ;; `add-log-current-defun-function'. This applies to
+ ;; a different mode apparently for editing .m4
+ ;; autoconf source.
+ (if (re-search-backward
+ "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t)
+ (match-string-no-properties 3)))
+
+(defun add-log-current-defun-type-html-like ()
+ "Return name of function definition point for HTML like buffers."
+ ;; <h1 id=123 >...</h1>
+ ;; <title>...</title>
+ (if (re-search-backward
+ (concat
+ "<[ \t\r\n]*"
+ "\\(?:[hH][0-6]\\|title\\|TITLE\\|Title\\)"
+ "[^>]*>"
+ "[ \t\r\n]*"
+ "\\([^<\r\n]*[^ <\t\r\n]+\\)")
+ nil t)
+ (match-string-no-properties 1)))
+
+(defun add-log-current-defun-type-css-like ()
+ "Return name of function definition point for CSS like buffers."
+ ;; * {
+ ;; ul#id {
+ ;; #id <token> {
+ ;; h1 p {
+ (let ((max (max (point-min) (- (point 20 * 80))))) ;; approx 20 lines back
+ (when (search-backward "{" max t)
+ (skip-chars-backward " \t\r\n")
+ (beginning-of-line)
+ (if (looking-at "^[ \t]*\\([^{\r\n]*[^ {\t\r\n]\\)")
+ (match-string-no-properties 1)))))
+
+(defun add-log-current-defun-type-php-like (&optional no-dollar-var)
+ "Return name of function definition point for PHP like buffers.
+
+Optional NO-DOLLAR-VAR suppresses checking that variable starts
+with dollar sign. The makes it possible to use this function for
+e.g. Javascript:
+
+ public $name = value; // PHP class variable.
+ var name = value; // Javascript function variable."
+ ;; function name ()
+ ;; class name
+ (if (or (re-search-backward
+ ;; function and method level
+ (concat
+ "^[ \t]*"
+ "\\(?:public\\|private\\|static\\)?[ \t]*"
+ "function[ \t]+\\([^ ({\t\r\n]+\\)") nil t)
+ ;; Class level variable
+ (save-excursion
+ (goto-char (line-beginning-position))
+ (looking-at
+ (concat
+ "^[ \t]*\\(?:var\\|public\\|private\\|static\\)"
+ "[ \t]+\\("
+ (if no-dollar-var
+ ""
+ "[$]?")
+ "[^ ;\t\r\n]+\\)")))
+ ;; Class top level
+ (re-search-backward
+ "^\\(class[ \t]+[^ ({\t\r\n]+\\)" nil t))
+ (match-string-no-properties 1)))
+
+(defun add-log-current-defun-type-javascript-like ()
+ "Return name of function definition point for Javascript like buffers."
+ (add-log-current-defun-type-php-like 'no-dollar-variables))
+
+(defun add-log-current-defun-type-shell-bourne-like ()
+ "Return name of function definition point for Bourne-Shell like buffers."
+ ;; function name ()
+ ;; name()
+ (if (re-search-backward
+ "^\\(?:function[ \t]+\\)?[ \t]*\\([^ {(\t\r\n]+\\).*()" nil t)
+ (match-string-no-properties 1)))
+
+(defun add-log-current-defun-type-makefile-like ()
+ "Return name of function definition point for Makefile like buffers."
+ ;; target-name:
+ ;; VARIABLE = ....
+ (if (or (re-search-backward "^\\([a-z][^ :\t\rn]+\\):" nil t)
+ (re-search-backward "^[ \t]*[[:upper]_]+" nil t))
+ (match-string-no-properties 1)))
+
+(defun add-log-current-defun-type-text-asciidoc-like ()
+ "Return name of function definition point for Asciidoc like buffers."
+ ;; Heading
+ ;; =======
+ ;; -------
+ ;; ^^^^^^^
+ ;; ~~~~~~~
+ (let ((point (point))
+ (distance (point-max))
+ re
+ chars
+ ret)
+ ;; Minimum of 3-character heading, like "FAQ"
+ (dolist (str '("^^^" "~~~" "---" "==="))
+ (setq re (concat
+ "[[:lower:][:upper:]0-9][ \t]*\r?\n"
+ (regexp-quote str)
+ "*$"))
+ (save-excursion
+ (if (and (re-search-backward re nil t)
+ (< (setq chars (- point (point))) distance))
+ ;; Read closest heading to the original point
+ (setq distance chars
+ ret (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position))))))
+ ret))
+
+(defun add-log-current-defun-type-default ()
+ "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 variables
+`add-log-current-defun-header-regexp' and
+`add-log-current-defun-function'."
+ (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)))
+
;;;###autoload
(defun add-log-current-defun ()
"Return name of function definition point is in, or nil.
@@ -1133,75 +1340,46 @@ 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)))
- ((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-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))))))
+ (cond (add-log-current-defun-function
+ (funcall add-log-current-defun-function))
+ ((apply 'derived-mode-p add-log-lisp-like-modes)
+ (add-log-current-defun-type-lisp-like))
+ ((apply 'derived-mode-p add-log-c-like-modes)
+ (add-log-current-defun-type-c-like))
+ ((memq major-mode add-log-tex-like-modes)
+ (add-log-current-defun-type-tex-like))
+ ((derived-mode-p 'texinfo-mode)
+ (add-log-current-defun-type-texinfo-like))
+ ((derived-mode-p 'perl-mode 'cperl-mode)
+ (add-log-current-defun-type-perl-like))
+ ((derived-mode-p 'python-mode)
+ (add-log-current-defun-type-python-like))
+ ((derived-mode-p 'ruby-mode)
+ (add-log-current-defun-type-ruby-like))
+ ((derived-mode-p 'autoconf-mode)
+ (add-log-current-defun-type-autoconf-like))
+ ((derived-mode-p 'sh-mode)
+ (add-log-current-defun-type-shell-bourne-like))
+ ((apply 'derived-mode-p '(makefile-mode makefile-gmake-mode))
+ (add-log-current-defun-type-makefile-like))
+ ((or (apply 'derived-mode-p '(html-mode 'html-helper-mode))
+ (string-match "\\.x?html$" (buffer-name)))
+ (add-log-current-defun-type-html-like))
+ ((or (derived-mode-p 'php-mode)
+ (string-match "\\.php$" (buffer-name)))
+ (add-log-current-defun-type-php-like))
+ ((or (derived-mode-p 'css-mode)
+ (string-match "\\.css$" (buffer-name)))
+ (add-log-current-defun-type-css-like))
+ ((or (derived-mode-p 'javascript-mode)
+ (string-match "\\.js$" (buffer-name)))
+ (add-log-current-defun-type-javascript-like))
+ ;; Fall through to `t' case if no asciidoc detected
+ ((and (or (derived-mode-p 'text-mode)
+ (string-match "asciidoc" (buffer-name)))
+ (add-log-current-defun-type-text-asciidoc-like)))
+ (t
+ (add-log-current-defun-type-default))))
(error nil)))
(defvar change-log-get-method-definition-md)
--
1.5.6.5
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.