GNU bug report logs - #14285
24.3; New octave feature: octave-update-function-file-comment

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 14285 in the body.
You can then email your comments to 14285 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Leo Liu <sdl.web <at> gmail.com>
To: bug-gnu-emacs <at> gnu.org
Subject: 24.3; New octave feature: octave-update-function-file-comment
Date: Sat, 27 Apr 2013 16:14:26 +0800

[Message part 1 (text/plain, inline)]

Hello Stefan, JordiGH and John,

Based on our discussion on #octave and email, I have made a patch for
review. For convenience octave.el with the patch applied is available
from http://bpaste.net/raw/94528/. Note Emacs 24.3 is required.

The new command octave-update-function-file-comment let users update the
doc-string/doc-comment (per octave's definition) to the function name. I
am only just beginning octave. So please help test and review the patch.

Thanks.
Leo

[patch.diff (text/x-patch, inline)]

diff --git a/lisp/files.el b/lisp/files.el
index 80166961..59eef757 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4451,7 +4451,8 @@ (defvar auto-save-hook nil
   "Normal hook run just before auto-saving.")
 
 (defcustom before-save-hook nil
-  "Normal hook that is run before a buffer is saved to its file."
+  "Normal hook that is run before a buffer is saved to its file.
+Any error from the hook prevents saving the buffer."
   :options '(copyright-update time-stamp)
   :type 'hook
   :group 'files)
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index f8b9e4f6..8a8a6616 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -32,6 +32,7 @@
 ;; information on usage and customization.
 
 ;;; Code:
+(eval-when-compile (require 'cl-lib))
 (require 'comint)
 
 (defgroup octave nil
@@ -1010,25 +1011,103 @@ (defun octave-maybe-insert-continuation-string ()
     (delete-horizontal-space)
     (insert (concat " " octave-continuation-string))))
 
+(defun octave-function-file-p ()
+  "Return non-nil if the first token is \"function\".
+The value is (START END NAME-START NAME-END) of the function."
+  (save-excursion
+    (goto-char (point-min))
+    (when (equal (funcall smie-forward-token-function) "function")
+      (forward-word -1)
+      (let* ((start (point))
+             (end (progn (forward-sexp 1) (point)))
+             (name (when (progn
+                           (goto-char start)
+                           (re-search-forward octave-function-header-regexp
+                                              end t))
+                     (list (match-beginning 3) (match-end 3)))))
+        (cons start (cons end name))))))
+
+;; Like forward-comment but stop at non-comment blank
+(defun octave-skip-comment-forward (limit)
+  (and (comment-beginning)
+       (goto-char (comment-beginning)))
+  (goto-char (or (comment-search-forward limit t) (point)))
+  (while (and (< (point) limit) (looking-at-p "\\s<"))
+    (forward-comment 1)))
+
+;;; First non-copyright comment block
+(defun octave-function-file-comment ()
+  "Beginnning and end positions of the function file comment."
+  (save-excursion
+    (goto-char (point-min))
+    (let ((bound (progn (forward-comment (point-max)) (point))))
+      (goto-char (point-min))
+      ;; Copyright block: octave/libinterp/parse-tree/lex.ll around line 1634
+      (when (save-excursion
+              (comment-search-forward bound t)
+              (when (eq (char-after) ?\{) ; case of block comment
+                (forward-char 1))
+              (skip-syntax-forward "-")
+              (let ((case-fold-search t))
+                (looking-at-p "\\(?:copyright\\|author\\)\\_>")))
+        (octave-skip-comment-forward bound))
+      (let ((beg (comment-search-forward bound t)))
+        (when beg
+          (goto-char beg)
+          (octave-skip-comment-forward bound)
+          (list beg (point)))))))
+
 (defun octave-sync-function-file-names ()
   "Ensure function name agree with function file name.
 See Info node `(octave)Function Files'."
   (interactive)
+  (when buffer-file-name
+    (with-demoted-errors
+      (cl-destructuring-bind (&optional start _end name-start name-end)
+          (octave-function-file-p)
+        (when (and start name-start)
+          (let ((func (buffer-substring name-start name-end))
+                (file (file-name-sans-extension
+                       (file-name-nondirectory buffer-file-name))))
+            (save-excursion
+              (when (and (not (equal file func))
+                         (progn
+                           (goto-char name-start)
+                           (yes-or-no-p
+                            "Function name different from file name. Fix? ")))
+                (delete-region name-start name-end)
+                (insert file)))))))))
+
+(defun octave-update-function-file-comment (beg end &optional no-query)
+  "Update function file comment between BEG and END."
+  (interactive
+   (progn
+     (barf-if-buffer-read-only)
+     (if (use-region-p)
+         (list (region-beginning) (region-end) current-prefix-arg)
+       (append (or (octave-function-file-comment)
+                   (error "No function file comment found"))
+               (list current-prefix-arg)))))
   (save-excursion
-    (when (and buffer-file-name
-               (prog2
-                   (goto-char (point-min))
-                   (equal (funcall smie-forward-token-function) "function")
-                 (forward-word -1)))
-      (let ((file (file-name-sans-extension
-                   (file-name-nondirectory buffer-file-name)))
-            (func (and (re-search-forward octave-function-header-regexp nil t)
-                       (match-string 3))))
-        (when (and func
-                   (not (equal file func))
-                   (yes-or-no-p
-                    "Function name different from file name. Fix? "))
-          (replace-match file nil nil nil 3))))))
+    (let* ((bounds (or (octave-function-file-p)
+                       (error "Not in a function file buffer")))
+           (func (if (cddr bounds)
+                     (apply #'buffer-substring (cddr bounds))
+                   (error "Function name not found")))
+           (old-func (progn
+                       (goto-char beg)
+                       (when (and (re-search-forward "usage:\\|@deftypefn" end t)
+                                  (re-search-forward
+                                   "[=}]\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*("
+                                   (line-end-position) t))
+                         (match-string 1))))
+           (old-func (read-string
+                      (format (if old-func "From (default %s): " "From: ")
+                              old-func)
+                      nil nil old-func)))
+      (when (and func old-func (not (equal func old-func)))
+        (perform-replace old-func func
+                         (not no-query) nil 'delimited nil nil beg end)))))
 
 
 ;;; Indentation
@@ -1356,10 +1435,11 @@ (define-skeleton octave-insert-defun
              (t (concat vals " = ")))
             name
             args))
-  \n "function " > str \n \n
-  octave-block-comment-start "usage: " str \n
-  octave-block-comment-start \n octave-block-comment-start
-  \n _ \n
+  \n octave-block-comment-start "usage: " str \n
+  octave-block-comment-start \n
+  octave-block-comment-start \n
+  "function " > str \n
+  _ \n
   "endfunction" > \n)
 
 ;;; Communication with the inferior Octave process

Message #8 received at 14285 <at> debbugs.gnu.org (full text, mbox):

From: Stefan Monnier <monnier <at> iro.umontreal.ca>
To: Leo Liu <sdl.web <at> gmail.com>
Cc: John Eaton <jwe <at> octave.org>,
	Jordi Gutiérrez Hermoso <jordigh <at> octave.org>,
	14285 <at> debbugs.gnu.org
Subject: Re: bug#14285: 24.3;
	New octave feature: octave-update-function-file-comment
Date: Sat, 27 Apr 2013 09:19:30 -0400

[ FWIW, I use neither Octave nor Matlab and so I never use octave-mode.
  I just chose it as a kind of test for SMIE.  So I don't have any
  opinion on the feature you suggest.  ]

> -  "Normal hook that is run before a buffer is saved to its file."
> +  "Normal hook that is run before a buffer is saved to its file.
> +Any error from the hook prevents saving the buffer."

Maybe rather than fix the doc, we should fix the code and wrap the
run-hook with a with-demote-errors?

> +      (cl-destructuring-bind (&optional start _end name-start name-end)
> +          (octave-function-file-p)

I recommend you try

 (pcase-let ((`(,start ,_end ,name-start ,name-end) (octave-function-file-p)))

instead.


        Stefan

Message #11 received at 14285 <at> debbugs.gnu.org (full text, mbox):

From: Leo Liu <sdl.web <at> gmail.com>
To: Stefan Monnier <monnier <at> iro.umontreal.ca>
Cc: John Eaton <jwe <at> octave.org>,
	Jordi Gutiérrez Hermoso <jordigh <at> octave.org>,
	14285 <at> debbugs.gnu.org
Subject: Re: bug#14285: 24.3;
	New octave feature: octave-update-function-file-comment
Date: Sat, 27 Apr 2013 21:35:57 +0800

Thank you, Stefan, for the comments. Patch updated.

 lisp/files.el            |   3 +-
 lisp/progmodes/octave.el | 115 +++++++++++++++++++++++++++++++++++++++--------
 2 files changed, 99 insertions(+), 19 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index 80166961..3af27bde 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4540,7 +4540,8 @@ (defun basic-save-buffer ()
 		     (insert ?\n))))
 	    ;; Support VC version backups.
 	    (vc-before-save)
-	    (run-hooks 'before-save-hook)
+	    ;; Don't let errors prevent saving the buffer.
+	    (with-demoted-errors (run-hooks 'before-save-hook))
 	    (or (run-hook-with-args-until-success 'write-contents-functions)
 		(run-hook-with-args-until-success 'local-write-file-hooks)
 		(run-hook-with-args-until-success 'write-file-functions)
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index f8b9e4f6..ebdcb8b1 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -1010,25 +1010,103 @@ (defun octave-maybe-insert-continuation-string ()
     (delete-horizontal-space)
     (insert (concat " " octave-continuation-string))))
 
+(defun octave-function-file-p ()
+  "Return non-nil if the first token is \"function\".
+The value is (START END NAME-START NAME-END) of the function."
+  (save-excursion
+    (goto-char (point-min))
+    (when (equal (funcall smie-forward-token-function) "function")
+      (forward-word -1)
+      (let* ((start (point))
+             (end (progn (forward-sexp 1) (point)))
+             (name (when (progn
+                           (goto-char start)
+                           (re-search-forward octave-function-header-regexp
+                                              end t))
+                     (list (match-beginning 3) (match-end 3)))))
+        (cons start (cons end name))))))
+
+;; Like forward-comment but stop at non-comment blank
+(defun octave-skip-comment-forward (limit)
+  (let ((ppss (syntax-ppss)))
+    (if (nth 4 ppss)
+        (goto-char (nth 8 ppss))
+      (goto-char (or (comment-search-forward limit t) (point)))))
+  (while (and (< (point) limit) (looking-at-p "\\s<"))
+    (forward-comment 1)))
+
+;;; First non-copyright comment block
+(defun octave-function-file-comment ()
+  "Beginnning and end positions of the function file comment."
+  (save-excursion
+    (goto-char (point-min))
+    (let ((bound (progn (forward-comment (point-max)) (point))))
+      (goto-char (point-min))
+      ;; Copyright block: octave/libinterp/parse-tree/lex.ll around line 1634
+      (when (save-excursion
+              (comment-search-forward bound t)
+              (when (eq (char-after) ?\{) ; case of block comment
+                (forward-char 1))
+              (skip-syntax-forward "-")
+              (let ((case-fold-search t))
+                (looking-at-p "\\(?:copyright\\|author\\)\\_>")))
+        (octave-skip-comment-forward bound))
+      (let ((beg (comment-search-forward bound t)))
+        (when beg
+          (goto-char beg)
+          (octave-skip-comment-forward bound)
+          (list beg (point)))))))
+
 (defun octave-sync-function-file-names ()
   "Ensure function name agree with function file name.
 See Info node `(octave)Function Files'."
   (interactive)
+  (when buffer-file-name
+    (pcase-let ((`(,start ,_end ,name-start ,name-end)
+                 (octave-function-file-p)))
+      (when (and start name-start)
+        (let ((func (buffer-substring name-start name-end))
+              (file (file-name-sans-extension
+                     (file-name-nondirectory buffer-file-name))))
+          (save-excursion
+            (when (and (not (equal file func))
+                       (progn
+                         (goto-char name-start)
+                         (yes-or-no-p
+                          "Function name different from file name. Fix? ")))
+              (delete-region name-start name-end)
+              (insert file))))))))
+
+(defun octave-update-function-file-comment (beg end &optional no-query)
+  "Update function file comment between BEG and END."
+  (interactive
+   (progn
+     (barf-if-buffer-read-only)
+     (if (use-region-p)
+         (list (region-beginning) (region-end) current-prefix-arg)
+       (append (or (octave-function-file-comment)
+                   (error "No function file comment found"))
+               (list current-prefix-arg)))))
   (save-excursion
-    (when (and buffer-file-name
-               (prog2
-                   (goto-char (point-min))
-                   (equal (funcall smie-forward-token-function) "function")
-                 (forward-word -1)))
-      (let ((file (file-name-sans-extension
-                   (file-name-nondirectory buffer-file-name)))
-            (func (and (re-search-forward octave-function-header-regexp nil t)
-                       (match-string 3))))
-        (when (and func
-                   (not (equal file func))
-                   (yes-or-no-p
-                    "Function name different from file name. Fix? "))
-          (replace-match file nil nil nil 3))))))
+    (let* ((bounds (or (octave-function-file-p)
+                       (error "Not in a function file buffer")))
+           (func (if (cddr bounds)
+                     (apply #'buffer-substring (cddr bounds))
+                   (error "Function name not found")))
+           (old-func (progn
+                       (goto-char beg)
+                       (when (and (re-search-forward "usage:\\|@deftypefn" end t)
+                                  (re-search-forward
+                                   "[=}]\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*("
+                                   (line-end-position) t))
+                         (match-string 1))))
+           (old-func (read-string
+                      (format (if old-func "From (default %s): " "From: ")
+                              old-func)
+                      nil nil old-func)))
+      (when (and func old-func (not (equal func old-func)))
+        (perform-replace old-func func
+                         (not no-query) nil 'delimited nil nil beg end)))))
 
 
 ;;; Indentation
@@ -1356,10 +1434,11 @@ (define-skeleton octave-insert-defun
              (t (concat vals " = ")))
             name
             args))
-  \n "function " > str \n \n
-  octave-block-comment-start "usage: " str \n
-  octave-block-comment-start \n octave-block-comment-start
-  \n _ \n
+  \n octave-block-comment-start "usage: " str \n
+  octave-block-comment-start \n
+  octave-block-comment-start \n
+  "function " > str \n
+  _ \n
   "endfunction" > \n)
 
 ;;; Communication with the inferior Octave process
-- 
1.8.2

Message #14 received at 14285 <at> debbugs.gnu.org (full text, mbox):

From: Leo Liu <sdl.web <at> gmail.com>
To: 14285 <at> debbugs.gnu.org
Cc: John Eaton <jwe <at> octave.org>,
	Jordi Gutiérrez Hermoso <jordigh <at> octave.org>
Subject: Re: bug#14285: 24.3;
	New octave feature: octave-update-function-file-comment
Date: Sun, 28 Apr 2013 01:50:11 +0800

Installed in trunk.

I'll leave this bug open for a few more days.

Message #19 received at 14285-done <at> debbugs.gnu.org (full text, mbox):

From: Leo Liu <sdl.web <at> gmail.com>
To: 14285-done <at> debbugs.gnu.org
Subject: Re: bug#14285: 24.3;
	New octave feature: octave-update-function-file-comment
Date: Thu, 02 May 2013 15:20:07 +0800

Fixed in trunk.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.