unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#2224: [PATCH] add-log.el: Modularize add-log-current-defun, new types supported
@ 2009-02-06 17:41 Jari Aalto
  2012-04-11 12:44 ` Lars Magne Ingebrigtsen
  0 siblings, 1 reply; 8+ messages in thread
From: Jari Aalto @ 2009-02-06 17:41 UTC (permalink / raw)
  To: submit, control

[-- Attachment #1: Type: text/plain, Size: 1535 bytes --]

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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Modularize-add-log-current-defun-.-New-file-types-s.patch --]
[-- Type: text/x-diff, Size: 14318 bytes --]

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


^ permalink raw reply related	[flat|nested] 8+ messages in thread
end of thread, other threads:[~2012-12-01  5:54 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2009-02-06 17:41 bug#2224: [PATCH] add-log.el: Modularize add-log-current-defun, new types supported Jari Aalto
2012-04-11 12:44 ` Lars Magne Ingebrigtsen
2012-04-11 13:49   ` Stefan Monnier
2012-04-12 16:03     ` Lars Magne Ingebrigtsen
2012-04-12 18:11       ` Stefan Monnier
2012-04-12 18:19         ` Lars Magne Ingebrigtsen
2012-04-12 20:38           ` Stefan Monnier
2012-12-01  5:54     ` Chong Yidong

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).