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

[Leo Liu]

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