From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Jari Aalto Newsgroups: gmane.emacs.bugs 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-ID: <87bptf5upl.fsf@jondo.cante.net> Reply-To: Jari Aalto , 2224@emacsbugs.donarmstrong.com NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1233943596 13309 80.91.229.12 (6 Feb 2009 18:06:36 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 6 Feb 2009 18:06:36 +0000 (UTC) To: submit@emacsbugs.donarmstrong.com, control@emacsbugs.donarmstrong.com Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Feb 06 19:07:47 2009 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1LVV71-0003b1-Lv for geb-bug-gnu-emacs@m.gmane.org; Fri, 06 Feb 2009 19:07:36 +0100 Original-Received: from localhost ([127.0.0.1]:54188 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1LVV5i-0002Ev-H3 for geb-bug-gnu-emacs@m.gmane.org; Fri, 06 Feb 2009 13:06:14 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1LVV3C-0007Em-Ht for bug-gnu-emacs@gnu.org; Fri, 06 Feb 2009 13:03:38 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1LVV3A-0007Cx-VP for bug-gnu-emacs@gnu.org; Fri, 06 Feb 2009 13:03:37 -0500 Original-Received: from [199.232.76.173] (port=51048 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1LVV3A-0007Cg-LW for bug-gnu-emacs@gnu.org; Fri, 06 Feb 2009 13:03:36 -0500 Original-Received: from rzlab.ucr.edu ([138.23.92.77]:34879) by monty-python.gnu.org with esmtps (TLS-1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1LVV39-0006Vf-MY for bug-gnu-emacs@gnu.org; Fri, 06 Feb 2009 13:03:36 -0500 Original-Received: from rzlab.ucr.edu (rzlab.ucr.edu [127.0.0.1]) by rzlab.ucr.edu (8.13.8/8.13.8/Debian-3) with ESMTP id n16I3WDd008267; Fri, 6 Feb 2009 10:03:33 -0800 Original-Received: (from debbugs@localhost) by rzlab.ucr.edu (8.13.8/8.13.8/Submit) id n16Ho338004794; Fri, 6 Feb 2009 09:50:03 -0800 X-Loop: owner@emacsbugs.donarmstrong.com Resent-From: Jari Aalto Resent-To: bug-submit-list@donarmstrong.com Resent-CC: Emacs Bugs Resent-Date: Fri, 06 Feb 2009 17:50:03 +0000 Resent-Message-ID: Resent-Sender: owner@emacsbugs.donarmstrong.com X-Emacs-PR-Message: report 2224 X-Emacs-PR-Package: emacs X-Emacs-PR-Keywords: patch Original-Received: via spool by submit@emacsbugs.donarmstrong.com id=B.12339421093364 (code B ref -1); Fri, 06 Feb 2009 17:50:03 +0000 Original-Received: (at submit) by emacsbugs.donarmstrong.com; 6 Feb 2009 17:41:49 +0000 X-Spam-Bayes: score:0.5 Bayes not run. spammytokens:Tokens not available. hammytokens:Tokens not available. Original-Received: from emh01.mail.saunalahti.fi (emh01.mail.saunalahti.fi [62.142.5.107]) by rzlab.ucr.edu (8.13.8/8.13.8/Debian-3) with ESMTP id n16HfXmM003356; Fri, 6 Feb 2009 09:41:34 -0800 Original-Received: from saunalahti-vams (vs3-12.mail.saunalahti.fi [62.142.5.96]) by emh01-2.mail.saunalahti.fi (Postfix) with SMTP id 76A7B8C150; Fri, 6 Feb 2009 19:41:31 +0200 (EET) Original-Received: from emh07.mail.saunalahti.fi ([62.142.5.117]) by vs3-12.mail.saunalahti.fi ([62.142.5.96]) with SMTP (gateway) id A04AD559AFF; Fri, 06 Feb 2009 19:41:31 +0200 Original-Received: from picasso.cante.net (a91-155-187-216.elisa-laajakaista.fi [91.155.187.216]) by emh07.mail.saunalahti.fi (Postfix) with ESMTP id 2C95F1C6388; Fri, 6 Feb 2009 19:41:26 +0200 (EET) Original-Received: from [192.168.1.7] (helo=jondo.cante.net) by picasso.cante.net with esmtp (Exim 4.69) (envelope-from ) id 1LVUhh-0004F6-0C; Fri, 06 Feb 2009 19:41:25 +0200 Original-Received: from jaalto by jondo.cante.net with local (Exim 4.69) (envelope-from ) id 1LVUhi-00027N-8r; Fri, 06 Feb 2009 19:41:26 +0200 X-SA-Exim-Connect-IP: 192.168.1.7 X-SA-Exim-Mail-From: jari.aalto@cante.net X-SA-Exim-Scanned: No (on picasso.cante.net); SAEximRunCond expanded to false X-Antivirus: VAMS X-CrossAssassin-Score: 2 X-detected-operating-system: by monty-python.gnu.org: GNU/Linux 2.6 (newer, 3) Resent-Date: Fri, 06 Feb 2009 13:03:37 -0500 X-BeenThere: bug-gnu-emacs@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:25003 Archived-At: --=-=-= 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 * 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. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Modularize-add-log-current-defun-.-New-file-types-s.patch >From 8416fbfcff9cda0cf26d936e672db706948f0095 Mon Sep 17 00:00:00 2001 From: Jari Aalto 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 * 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 --- 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." + ;;

...

+ ;; ... + (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 { + ;; 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 --=-=-=--