* bug#14285: 24.3; New octave feature: octave-update-function-file-comment
@ 2013-04-27 8:14 Leo Liu
2013-04-27 13:19 ` Stefan Monnier
0 siblings, 1 reply; 5+ messages in thread
From: Leo Liu @ 2013-04-27 8:14 UTC (permalink / raw)
To: 14285; +Cc: John Eaton, Jordi Gutiérrez Hermoso
[-- Attachment #1: Type: text/plain, Size: 471 bytes --]
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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch.diff --]
[-- Type: text/x-patch, Size: 6543 bytes --]
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)))))
\f
;;; 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)
\f
;;; Communication with the inferior Octave process
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#14285: 24.3; New octave feature: octave-update-function-file-comment
2013-04-27 8:14 bug#14285: 24.3; New octave feature: octave-update-function-file-comment Leo Liu
@ 2013-04-27 13:19 ` Stefan Monnier
2013-04-27 13:35 ` Leo Liu
0 siblings, 1 reply; 5+ messages in thread
From: Stefan Monnier @ 2013-04-27 13:19 UTC (permalink / raw)
To: Leo Liu; +Cc: John Eaton, Jordi Gutiérrez Hermoso, 14285
[ 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
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#14285: 24.3; New octave feature: octave-update-function-file-comment
2013-04-27 13:19 ` Stefan Monnier
@ 2013-04-27 13:35 ` Leo Liu
2013-04-27 17:50 ` Leo Liu
0 siblings, 1 reply; 5+ messages in thread
From: Leo Liu @ 2013-04-27 13:35 UTC (permalink / raw)
To: Stefan Monnier; +Cc: John Eaton, Jordi Gutiérrez Hermoso, 14285
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)))))
\f
;;; 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)
\f
;;; Communication with the inferior Octave process
--
1.8.2
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#14285: 24.3; New octave feature: octave-update-function-file-comment
2013-04-27 13:35 ` Leo Liu
@ 2013-04-27 17:50 ` Leo Liu
2013-05-02 7:20 ` Leo Liu
0 siblings, 1 reply; 5+ messages in thread
From: Leo Liu @ 2013-04-27 17:50 UTC (permalink / raw)
To: 14285; +Cc: John Eaton, Jordi Gutiérrez Hermoso
Installed in trunk.
I'll leave this bug open for a few more days.
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#14285: 24.3; New octave feature: octave-update-function-file-comment
2013-04-27 17:50 ` Leo Liu
@ 2013-05-02 7:20 ` Leo Liu
0 siblings, 0 replies; 5+ messages in thread
From: Leo Liu @ 2013-05-02 7:20 UTC (permalink / raw)
To: 14285-done
Fixed in trunk.
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2013-05-02 7:20 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-04-27 8:14 bug#14285: 24.3; New octave feature: octave-update-function-file-comment Leo Liu
2013-04-27 13:19 ` Stefan Monnier
2013-04-27 13:35 ` Leo Liu
2013-04-27 17:50 ` Leo Liu
2013-05-02 7:20 ` Leo Liu
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).