bug#2224: [PATCH] add-log.el: Modularize add-log-current-defun, new types supported

[Jari Aalto]

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@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.

>From 8416fbfcff9cda0cf26d936e672db706948f0095 Mon Sep 17 00:00:00 2001
From: Jari Aalto <jari.aalto@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@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@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