1;;; octave.el --- editing octave source files under emacs  -*- lexical-binding: t; -*-
2
3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
4
5;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>
6;;	   John Eaton <jwe@octave.org>
7;; Maintainer: emacs-devel@gnu.org
8;; Keywords: languages
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; This package provides Emacs support for Octave.  It defines a major
28;; mode for editing Octave code and contains code for interacting with
29;; an inferior Octave process using comint.
30
31;; See the documentation of `octave-mode' and `run-octave' for further
32;; information on usage and customization.
33
34;;; Code:
35(require 'comint)
36
37(defgroup octave nil
38  "Editing Octave code."
39  :link '(custom-manual "(octave-mode)Top")
40  :link '(url-link "https://www.gnu.org/s/octave")
41  :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
42  :group 'languages)
43
44(define-obsolete-function-alias 'octave-submit-bug-report
45  'report-emacs-bug "24.4")
46
47(define-abbrev-table 'octave-abbrev-table nil
48  "Abbrev table for Octave's reserved words.
49Used in `octave-mode' and `inferior-octave-mode' buffers.")
50
51(defvar octave-comment-char ?#
52  "Character to start an Octave comment.")
53
54(defvar octave-comment-start (char-to-string octave-comment-char)
55  "Octave-specific `comment-start' (which see).")
56
57(defvar octave-comment-start-skip "\\(^\\|\\S<\\)\\(?:%!\\|\\s<+\\)\\s-*"
58  "Octave-specific `comment-start-skip' (which see).")
59
60(defvar octave-function-header-regexp
61  (concat "^\\s-*\\_<\\(function\\)\\_>"
62	  "\\([^=;(\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>")
63  "Regexp to match an Octave function header.
64The string `function' and its name are given by the first and third
65parenthetical grouping.")
66
67
68(defvar octave-mode-map
69  (let ((map (make-sparse-keymap)))
70    (define-key map "\M-."     'octave-find-definition)
71    (define-key map "\M-\C-j"  'octave-indent-new-comment-line)
72    (define-key map "\C-c\C-p" 'octave-previous-code-line)
73    (define-key map "\C-c\C-n" 'octave-next-code-line)
74    (define-key map "\C-c\C-a" 'octave-beginning-of-line)
75    (define-key map "\C-c\C-e" 'octave-end-of-line)
76    (define-key map [remap down-list] 'smie-down-list)
77    (define-key map "\C-c\M-\C-h" 'octave-mark-block)
78    (define-key map "\C-c]" 'smie-close-block)
79    (define-key map "\C-c/" 'smie-close-block)
80    (define-key map "\C-c;" 'octave-update-function-file-comment)
81    (define-key map "\C-hd" 'octave-help)
82    (define-key map "\C-ha" 'octave-lookfor)
83    (define-key map "\C-c\C-l" 'octave-source-file)
84    (define-key map "\C-c\C-f" 'octave-insert-defun)
85    (define-key map "\C-c\C-il" 'octave-send-line)
86    (define-key map "\C-c\C-ib" 'octave-send-block)
87    (define-key map "\C-c\C-if" 'octave-send-defun)
88    (define-key map "\C-c\C-ir" 'octave-send-region)
89    (define-key map "\C-c\C-ia" 'octave-send-buffer)
90    (define-key map "\C-c\C-is" 'octave-show-process-buffer)
91    (define-key map "\C-c\C-iq" 'octave-hide-process-buffer)
92    (define-key map "\C-c\C-ik" 'octave-kill-process)
93    (define-key map "\C-c\C-i\C-l" 'octave-send-line)
94    (define-key map "\C-c\C-i\C-b" 'octave-send-block)
95    (define-key map "\C-c\C-i\C-f" 'octave-send-defun)
96    (define-key map "\C-c\C-i\C-r" 'octave-send-region)
97    (define-key map "\C-c\C-i\C-a" 'octave-send-buffer)
98    (define-key map "\C-c\C-i\C-s" 'octave-show-process-buffer)
99    (define-key map "\C-c\C-i\C-q" 'octave-hide-process-buffer)
100    (define-key map "\C-c\C-i\C-k" 'octave-kill-process)
101    map)
102  "Keymap used in Octave mode.")
103
104
105
106(easy-menu-define octave-mode-menu octave-mode-map
107  "Menu for Octave mode."
108  '("Octave"
109    ["Split Line at Point"          octave-indent-new-comment-line t]
110    ["Previous Code Line"           octave-previous-code-line t]
111    ["Next Code Line"               octave-next-code-line t]
112    ["Begin of Line"                octave-beginning-of-line t]
113    ["End of Line"                  octave-end-of-line t]
114    ["Mark Block"                   octave-mark-block t]
115    ["Close Block"                  smie-close-block t]
116    "---"
117    ["Start Octave Process"         run-octave t]
118    ["Documentation Lookup"         info-lookup-symbol t]
119    ["Help on Function"             octave-help t]
120    ["Search help"                  octave-lookfor t]
121    ["Find Function Definition"     octave-find-definition t]
122    ["Insert Function"              octave-insert-defun t]
123    ["Update Function File Comment" octave-update-function-file-comment t]
124    "---"
125    ["Function Syntax Hints" (eldoc-mode 'toggle)
126     :style toggle :selected (bound-and-true-p eldoc-mode)
127     :help "Display function signatures after typing `SPC' or `('"]
128    ["Delimiter Matching"           show-paren-mode
129     :style toggle :selected show-paren-mode
130     :help "Highlight matched pairs such as `if ... end'"
131     :visible (fboundp 'smie--matching-block-data)]
132    ["Auto Fill"                    auto-fill-mode
133     :style toggle :selected auto-fill-function
134     :help "Automatic line breaking"]
135    ["Electric Layout"              electric-layout-mode
136     :style toggle :selected electric-layout-mode
137     :help "Automatically insert newlines around some chars"]
138    "---"
139    ("Debug"
140     ["Send Current Line"       octave-send-line t]
141     ["Send Current Block"      octave-send-block t]
142     ["Send Current Function"   octave-send-defun t]
143     ["Send Region"             octave-send-region t]
144     ["Send Buffer"             octave-send-buffer t]
145     ["Source Current File"     octave-source-file t]
146     ["Show Process Buffer"     octave-show-process-buffer t]
147     ["Hide Process Buffer"     octave-hide-process-buffer t]
148     ["Kill Process"            octave-kill-process t])
149    "---"
150    ["Octave Mode Manual"       (info "(octave-mode)Top") t]
151    ["Customize Octave"         (customize-group 'octave) t]
152    ["Submit Bug Report"        report-emacs-bug t]))
153
154(defvar octave-mode-syntax-table
155  (let ((table (make-syntax-table)))
156    (modify-syntax-entry ?\r " "  table)
157    (modify-syntax-entry ?+ "."   table)
158    (modify-syntax-entry ?- "."   table)
159    (modify-syntax-entry ?= "."   table)
160    (modify-syntax-entry ?* "."   table)
161    (modify-syntax-entry ?/ "."   table)
162    (modify-syntax-entry ?> "."   table)
163    (modify-syntax-entry ?< "."   table)
164    (modify-syntax-entry ?& "."   table)
165    (modify-syntax-entry ?| "."   table)
166    (modify-syntax-entry ?! "."   table)
167    (modify-syntax-entry ?\\ "."  table)
168    (modify-syntax-entry ?\' "."  table)
169    (modify-syntax-entry ?\` "."  table)
170    (modify-syntax-entry ?. "."   table)
171    (modify-syntax-entry ?\" "\"" table)
172    (modify-syntax-entry ?_ "_"   table)
173    ;; The "b" flag only applies to the second letter of the comstart and
174    ;; the first letter of the comend, i.e. a "4b" below would be ineffective.
175    ;; If we try to put `b' on the single-line comments, we get a similar
176    ;; problem where the % and # chars appear as first chars of the 2-char
177    ;; comend, so the multi-line ender is also turned into style-b.
178    ;; So we need the new "c" comment style.
179    (modify-syntax-entry ?\% "< 13"  table)
180    (modify-syntax-entry ?\# "< 13"  table)
181    (modify-syntax-entry ?\{ "(} 2c"  table)
182    (modify-syntax-entry ?\} "){ 4c"  table)
183    (modify-syntax-entry ?\n ">"  table)
184    table)
185  "Syntax table in use in `octave-mode' buffers.")
186
187(defcustom octave-font-lock-texinfo-comment t
188  "Control whether to highlight the texinfo comment block."
189  :type 'boolean
190  :version "24.4")
191
192(defcustom octave-blink-matching-block t
193  "Control the blinking of matching Octave block keywords.
194Non-nil means show matching begin of block when inserting a space,
195newline or semicolon after an else or end keyword."
196  :type 'boolean)
197
198(defcustom octave-block-offset 2
199  "Extra indentation applied to statements in Octave block structures."
200  :type 'integer)
201(put 'octave-block-offset 'safe-local-variable 'integerp)
202
203(defvar octave-block-comment-start
204  (concat (make-string 2 octave-comment-char) " ")
205  "String to insert to start a new Octave comment on an empty line.")
206
207(defcustom octave-continuation-offset 4
208  "Extra indentation applied to Octave continuation lines."
209  :type 'integer)
210
211(eval-and-compile
212  (defconst octave-continuation-marker-regexp "\\\\\\|\\.\\.\\."))
213
214(defvar octave-continuation-regexp
215  (concat "[^#%\n]*\\(" octave-continuation-marker-regexp
216          "\\)\\s-*\\(\\s<.*\\)?$"))
217
218;; Char \ is considered a bad decision for continuing a line.
219(defconst octave-continuation-string "..."
220  "Character string used for Octave continuation lines.")
221
222(defvar octave-mode-imenu-generic-expression
223  (list
224   ;; Functions
225   (list nil octave-function-header-regexp 3))
226  "Imenu expression for Octave mode.  See `imenu-generic-expression'.")
227
228(defcustom octave-mode-hook nil
229  "Hook to be run when Octave mode is started."
230  :type 'hook)
231
232(defcustom octave-send-show-buffer t
233  "Non-nil means display `inferior-octave-buffer' after sending to it."
234  :type 'boolean)
235
236(defcustom octave-send-line-auto-forward t
237  "Control auto-forward after sending to the inferior Octave process.
238Non-nil means always go to the next Octave code line after sending."
239  :type 'boolean)
240
241(defcustom octave-send-echo-input t
242  "Non-nil means echo input sent to the inferior Octave process."
243  :type 'boolean)
244
245
246;;; SMIE indentation
247
248(require 'smie)
249
250(let-when-compile
251    ((operator-table
252      ;; Use '__operators__' in Octave REPL to get a full list?
253      '((assoc ";" "\n") (assoc ",") ;The doc says they have equal precedence!?
254        (right "=" "+=" "-=" "*=" "/=")
255        (assoc "&&") (assoc "||") ; The doc claims they have equal precedence!?
256        (assoc "&") (assoc "|") ; The doc claims they have equal precedence!?
257        (nonassoc "<" "<=" "==" ">=" ">" "!=" "~=")
258        (nonassoc ":")                  ;No idea what this is.
259        (assoc "+" "-")
260        (assoc "*" "/" "\\" ".\\" ".*" "./")
261        (nonassoc "'" ".'")
262        (nonassoc "++" "--" "!" "~")    ;And unary "+" and "-".
263        (right "^" "**" ".^" ".**")
264        ;; It's not really an operator, but for indentation purposes it
265        ;; could be convenient to treat it as one.
266        (assoc "...")))
267
268     (matchedrules
269      ;; We can't distinguish the first element in a sequence with
270      ;; precedence grammars, so we can't distinguish the condition
271      ;; of the `if' from the subsequent body, for example.
272      ;; This has to be done later in the indentation rules.
273      '(("try" exp "catch" exp "end_try_catch")
274        ("unwind_protect" exp
275         "unwind_protect_cleanup" exp "end_unwind_protect")
276        ("for" exp "endfor")
277        ("parfor" exp "endparfor")
278        ("while" exp "endwhile")
279        ("if" exp "endif")
280        ("if" exp "else" exp "endif")
281        ("if" exp "elseif" exp "else" exp "endif")
282        ("if" exp "elseif" exp "elseif" exp "else" exp "endif")
283        ("switch" exp "case" exp "endswitch")
284        ("switch" exp "case" exp "otherwise" exp "endswitch")
285        ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch")
286        ("function" exp "endfunction")
287        ("enumeration" exp "endenumeration")
288        ("events" exp "endevents")
289        ("methods" exp "endmethods")
290        ("properties" exp "endproperties")
291        ("classdef" exp "endclassdef")
292        ("spmd" exp "endspmd")
293        ))
294
295     (bnf-table
296      `((atom)
297        ;; FIXME: We don't parse these declarations correctly since
298        ;; SMIE *really* likes to parse "a b = 2 c" as "(a b) = (2 c)".
299        ;; IOW to do it right, we'd need to change octave-smie-*ward-token
300        ;; so that the spaces between vars in var-decls are lexed as
301        ;; something like ",".
302        ;; Doesn't seem worth the trouble/slowdown for now.
303        ;; We could hack smie-rules so as to work around the bad parse,
304        ;; but even that doesn't seem worth the trouble.
305        (var-decls (atom "=" atom)) ;; (var-decls "," var-decls)
306        (single-exp (atom "=" atom))
307        (exp (exp "\n" exp)
308             ;; We need to mention at least one of the operators in this part
309             ;; of the grammar: if the BNF and the operator table have
310             ;; no overlap, SMIE can't know how they relate.
311             (exp ";" exp)
312             ("do" exp "until" single-exp)
313             ,@matchedrules
314           ;; For every rule that ends in "endfoo", add a corresponding
315           ;; rule which uses "end" instead.
316           ,@(mapcar (lambda (rule) (nconc (butlast rule) '("end")))
317                     matchedrules)
318           ("global" var-decls) ("persistent" var-decls)
319           ;; These aren't super-important, but having them here
320           ;; makes it easier to extract all keywords.
321           ("break") ("continue") ("return")
322           ;; The following rules do not correspond to valid code AFAIK,
323           ;; but they lead to a grammar that degrades more gracefully
324           ;; on incomplete/incorrect code.  It also helps us in
325           ;; computing octave--block-offset-keywords.
326           ("try" exp "end") ("unwind_protect" exp "end")
327           )
328      ;; (fundesc (atom "=" atom))
329      )))
330
331(defconst octave-smie-grammar
332  (eval-when-compile
333    (smie-prec2->grammar
334     (smie-merge-prec2s
335      (smie-bnf->prec2 bnf-table '((assoc "\n" ";")))
336      (smie-precs->prec2 operator-table)))))
337
338(defconst octave-operator-regexp
339  (eval-when-compile
340    (regexp-opt (remove "\n" (apply #'append
341                                    (mapcar #'cdr operator-table)))))))
342
343;; Tokenizing needs to be refined so that ";;" is treated as two
344;; tokens and also so as to recognize the \n separator (and
345;; corresponding continuation lines).
346
347(defun octave-smie--funcall-p ()
348  "Return non-nil if we're in an expression context.  Moves point."
349  (looking-at "[ \t]*("))
350
351(defun octave-smie--end-index-p ()
352  (let ((ppss (syntax-ppss)))
353    (and (nth 1 ppss)
354         (memq (char-after (nth 1 ppss)) '(?\( ?\[ ?\{)))))
355
356(defun octave-smie--in-parens-p ()
357  (let ((ppss (syntax-ppss)))
358    (and (nth 1 ppss)
359         (eq ?\( (char-after (nth 1 ppss))))))
360
361(defun octave-smie-backward-token ()
362  (let ((pos (point)))
363    (forward-comment (- (point)))
364    (cond
365     ((and (not (eq (char-before) ?\;)) ;Coalesce ";" and "\n".
366           (> pos (line-end-position))
367           (if (looking-back octave-continuation-marker-regexp (- (point) 3))
368               (progn
369                 (goto-char (match-beginning 0))
370                 (forward-comment (- (point)))
371                 nil)
372             t)
373           (not (octave-smie--in-parens-p)))
374      (skip-chars-forward " \t")
375      ;; Why bother distinguishing \n and ;?
376      ";") ;;"\n"
377     ((and (looking-back octave-operator-regexp (- (point) 3) 'greedy)
378           ;; Don't mistake a string quote for a transpose.
379           (not (looking-back "\\s\"" (1- (point)))))
380      (goto-char (match-beginning 0))
381      (match-string-no-properties 0))
382     (t
383      (let ((tok (smie-default-backward-token)))
384        (cond
385         ((equal tok "enumeration")
386          (if (save-excursion (smie-default-forward-token)
387                              (octave-smie--funcall-p))
388              "enumeration (function)"
389            tok))
390         ((equal tok "end") (if (octave-smie--end-index-p) "end (index)" tok))
391         (t tok)))))))
392
393(defun octave-smie-forward-token ()
394  (skip-chars-forward " \t")
395  (when (looking-at (eval-when-compile
396                      (concat "\\(" octave-continuation-marker-regexp
397                              "\\)[ \t]*\\($\\|[%#]\\)")))
398    (goto-char (match-end 1))
399    (forward-comment 1))
400  (cond
401   ((and (looking-at "[%#\n]")
402         (not (or (save-excursion (skip-chars-backward " \t")
403                                  ;; Only add implicit ; when needed.
404                                  (or (bolp) (eq (char-before) ?\;)))
405                  (octave-smie--in-parens-p))))
406    (if (eolp) (forward-char 1) (forward-comment 1))
407    ;; Why bother distinguishing \n and ;?
408    ";") ;;"\n"
409   ((progn (forward-comment (point-max)) nil))
410   ((looking-at ";[ \t]*\\($\\|[%#]\\)")
411    ;; Combine the ; with the subsequent \n.
412    (goto-char (match-beginning 1))
413    (forward-comment 1)
414    ";")
415   ((and (looking-at octave-operator-regexp)
416         ;; Don't mistake a string quote for a transpose.
417         (not (looking-at "\\s\"")))
418    (goto-char (match-end 0))
419    (match-string-no-properties 0))
420   (t
421    (let ((tok (smie-default-forward-token)))
422      (cond
423       ((equal tok "enumeration")
424        (if (octave-smie--funcall-p)
425            "enumeration (function)"
426          tok))
427       ((equal tok "end") (if (octave-smie--end-index-p) "end (index)" tok))
428       (t tok))))))
429
430(defconst octave--block-offset-keywords
431  (let* ((end-prec (nth 1 (assoc "end" octave-smie-grammar)))
432         (end-matchers
433          (delq nil
434                (mapcar (lambda (x) (if (eq end-prec (nth 2 x)) (car x)))
435                        octave-smie-grammar))))
436    ;; Not sure if it would harm to keep "switch", but the previous code
437    ;; excluded it, presumably because there shouldn't be any code on
438    ;; the lines between "switch" and "case".
439    (delete "switch" end-matchers)))
440
441(defun octave-smie-rules (kind token)
442  (pcase (cons kind token)
443    ;; We could set smie-indent-basic instead, but that would have two
444    ;; disadvantages:
445    ;; - changes to octave-block-offset wouldn't take effect immediately.
446    ;; - edebug wouldn't show the use of this variable.
447    ('(:elem . basic) octave-block-offset)
448    (`(:list-intro . ,(or "global" "persistent")) t)
449    ;; Since "case" is in the same BNF rules as switch..end, SMIE by default
450    ;; aligns it with "switch".
451    ('(:before . "case") (if (not (smie-rule-sibling-p)) octave-block-offset))
452    ('(:after . ";")
453     (if (apply #'smie-rule-parent-p octave--block-offset-keywords)
454         (smie-rule-parent octave-block-offset)
455       ;; For (invalid) code between switch and case.
456       ;; (if (smie-rule-parent-p "switch") 4)
457       nil))))
458
459(defun octave-indent-comment ()
460  "A function for `smie-indent-functions' (which see)."
461  (save-excursion
462    (back-to-indentation)
463    (cond
464     ((octave-in-string-or-comment-p) nil)
465     ((looking-at-p "\\(\\s<\\)\\1\\{2,\\}")
466      0)
467     ;; Exclude %{, %} and %!.
468     ((and (looking-at-p "\\s<\\(?:[^{}!]\\|$\\)")
469           (not (looking-at-p "\\(\\s<\\)\\1")))
470      (comment-choose-indent)))))
471
472
473(defvar octave-reserved-words
474  (delq nil
475        (mapcar (lambda (x)
476                  (setq x (car x))
477                  (and (stringp x) (string-match "\\`[[:alpha:]]" x) x))
478                octave-smie-grammar))
479  "Reserved words in Octave.")
480
481(defvar octave-font-lock-keywords
482  (list
483   ;; Fontify all builtin keywords.
484   (cons (concat "\\_<" (regexp-opt octave-reserved-words) "\\_>")
485         'font-lock-keyword-face)
486   ;; Note: 'end' also serves as the last index in an indexing expression,
487   ;; and 'enumerate' is also a function.
488   ;; Ref: http://www.mathworks.com/help/matlab/ref/end.html
489   ;; Ref: http://www.mathworks.com/help/matlab/ref/enumeration.html
490   (list (lambda (limit)
491           (while (re-search-forward "\\_<en\\(?:d\\|umeratio\\(n\\)\\)\\_>"
492                                     limit 'move)
493             (let ((beg (match-beginning 0))
494                   (end (match-end 0)))
495               (unless (octave-in-string-or-comment-p)
496                 (when (if (match-end 1)
497                           (octave-smie--funcall-p)
498                         (octave-smie--end-index-p))
499                   (put-text-property beg end 'face nil)))))
500           nil))
501   ;; Fontify all operators.
502   (cons octave-operator-regexp 'font-lock-builtin-face)
503   ;; Fontify all function declarations.
504   (list octave-function-header-regexp
505         '(1 font-lock-keyword-face)
506         '(3 font-lock-function-name-face nil t)))
507  "Additional Octave expressions to highlight.")
508
509(defun octave-syntax-propertize-function (start end)
510  (goto-char start)
511  (octave-syntax-propertize-sqs end)
512  (funcall (syntax-propertize-rules
513            ("\\\\" (0 (when (eq (nth 3 (save-excursion
514                                          (syntax-ppss (match-beginning 0))))
515                                 ?\")
516                         (string-to-syntax "\\"))))
517            ;; Try to distinguish the string-quotes from the transpose-quotes.
518            ("\\(?:^\\|[[({,; ]\\)\\('\\)"
519             (1 (prog1 "\"'" (octave-syntax-propertize-sqs end)))))
520           (point) end))
521
522(defun octave-syntax-propertize-sqs (end)
523  "Propertize the content/end of single-quote strings."
524  (when (eq (nth 3 (syntax-ppss)) ?\')
525    ;; A '..' string.
526    (when (re-search-forward
527           "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move)
528      (goto-char (match-beginning 2))
529      (when (eq (char-before (match-beginning 1)) ?\\)
530        ;; Backslash cannot escape a single quote.
531        (put-text-property (1- (match-beginning 1)) (match-beginning 1)
532                           'syntax-table (string-to-syntax ".")))
533      (put-text-property (match-beginning 1) (match-end 1)
534                         'syntax-table (string-to-syntax "\"'")))))
535
536(defvar electric-layout-rules)
537
538;; FIXME: cc-mode.el also adds an entry for .m files, mapping them to
539;; objc-mode.  We here rely on the fact that loaddefs.el is filled in
540;; alphabetical order, so cc-mode.el comes before octave-mode.el, which lets
541;; our entry come first!
542;;;###autoload (add-to-list 'auto-mode-alist '("\\.m\\'" . octave-maybe-mode))
543
544;;;###autoload
545(defun octave-maybe-mode ()
546  "Select `octave-mode' if the current buffer seems to hold Octave code."
547  (if (save-excursion
548        (with-syntax-table octave-mode-syntax-table
549          (goto-char (point-min))
550          (forward-comment (point-max))
551          ;; FIXME: What about Octave files which don't start with "function"?
552          (looking-at "function")))
553      (octave-mode)
554    (let ((x (rassq 'octave-maybe-mode auto-mode-alist)))
555      (when x
556        (let ((auto-mode-alist (remove x auto-mode-alist)))
557          (set-auto-mode))))))
558
559;;;###autoload
560(define-derived-mode octave-mode prog-mode "Octave"
561  "Major mode for editing Octave code.
562
563Octave is a high-level language, primarily intended for numerical
564computations.  It provides a convenient command line interface
565for solving linear and nonlinear problems numerically.  Function
566definitions can also be stored in files and used in batch mode.
567
568See Info node `(octave-mode) Using Octave Mode' for more details.
569
570Key bindings:
571\\{octave-mode-map}"
572  :abbrev-table octave-abbrev-table
573  :group 'octave
574
575  (smie-setup octave-smie-grammar #'octave-smie-rules
576              :forward-token  #'octave-smie-forward-token
577              :backward-token #'octave-smie-backward-token)
578  (setq-local smie-indent-basic 'octave-block-offset)
579  (add-hook 'smie-indent-functions #'octave-indent-comment nil t)
580
581  (setq-local smie-blink-matching-triggers
582              (cons ?\; smie-blink-matching-triggers))
583  (unless octave-blink-matching-block
584    (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local))
585
586  (setq-local electric-indent-chars
587              (cons ?\; electric-indent-chars))
588  ;; IIUC matlab-mode takes the opposite approach: it makes RET insert
589  ;; a ";" at those places where it's correct (i.e. outside of parens).
590  (setq-local electric-layout-rules '((?\; . after)))
591
592  (setq-local comment-use-syntax t)
593  (setq-local comment-start octave-comment-start)
594  (setq-local comment-end "")
595  (setq-local comment-start-skip octave-comment-start-skip)
596  (setq-local comment-add 1)
597
598  (setq-local parse-sexp-ignore-comments t)
599  (setq-local paragraph-start (concat "\\s-*$\\|" page-delimiter))
600  (setq-local paragraph-separate paragraph-start)
601  (setq-local paragraph-ignore-fill-prefix t)
602  (setq-local fill-paragraph-function 'octave-fill-paragraph)
603
604  (setq-local fill-nobreak-predicate
605              (lambda () (eq (octave-in-string-p) ?')))
606  (add-function :around (local 'comment-line-break-function)
607                #'octave--indent-new-comment-line)
608
609  (setq font-lock-defaults '(octave-font-lock-keywords))
610
611  (setq-local syntax-propertize-function #'octave-syntax-propertize-function)
612
613  (setq-local imenu-generic-expression octave-mode-imenu-generic-expression)
614  (setq-local imenu-case-fold-search nil)
615
616  (setq-local add-log-current-defun-function #'octave-add-log-current-defun)
617
618  (add-hook 'completion-at-point-functions 'octave-completion-at-point nil t)
619  (add-hook 'before-save-hook 'octave-sync-function-file-names nil t)
620  (setq-local beginning-of-defun-function 'octave-beginning-of-defun)
621  (and octave-font-lock-texinfo-comment (octave-font-lock-texinfo-comment))
622  (add-function :before-until (local 'eldoc-documentation-function)
623                'octave-eldoc-function)
624
625  (easy-menu-add octave-mode-menu))
626
627
628(defcustom inferior-octave-program "octave"
629  "Program invoked by `inferior-octave'."
630  :type 'string)
631
632(defcustom inferior-octave-buffer "*Inferior Octave*"
633  "Name of buffer for running an inferior Octave process."
634  :type 'string)
635
636(defcustom inferior-octave-prompt
637  ;; For Octave >= 3.8, default is always 'octave', see
638  ;; https://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50
639  "\\(?:^octave\\(?:.bin\\|.exe\\)?\\(?:-[.0-9]+\\)?\\(?::[0-9]+\\)?\\|^debug\\|^\\)>+ "
640  "Regexp to match prompts for the inferior Octave process."
641  :type 'regexp)
642
643(defcustom inferior-octave-prompt-read-only comint-prompt-read-only
644  "If non-nil, the Octave prompt is read only.
645See `comint-prompt-read-only' for details."
646  :type 'boolean
647  :version "24.4")
648
649(defcustom inferior-octave-startup-file
650  (let ((n (file-name-nondirectory inferior-octave-program)))
651    (locate-user-emacs-file (format "init_%s.m" n) (format ".emacs-%s" n)))
652  "Name of the inferior Octave startup file.
653The contents of this file are sent to the inferior Octave process on
654startup."
655  :type '(choice (const :tag "None" nil) file)
656  :version "24.4")
657
658(defcustom inferior-octave-startup-args '("-i" "--no-line-editing")
659  "List of command line arguments for the inferior Octave process.
660For example, for suppressing the startup message and using `traditional'
661mode, include \"-q\" and \"--traditional\"."
662  :type '(repeat string)
663  :version "24.4")
664
665(define-obsolete-variable-alias 'inferior-octave-startup-hook
666  'inferior-octave-mode-hook "24.4")
667
668(defcustom inferior-octave-mode-hook nil
669  "Hook to be run when Inferior Octave mode is started."
670  :type 'hook)
671
672(defcustom inferior-octave-error-regexp-alist
673  '(("error:\\s-*\\(.*?\\) at line \\([0-9]+\\), column \\([0-9]+\\)"
674     1 2 3 2 1)
675    ("warning:\\s-*\\([^:\n]+\\):.*at line \\([0-9]+\\), column \\([0-9]+\\)"
676     1 2 3 1 1))
677  "Value for `compilation-error-regexp-alist' in inferior octave."
678  :version "24.4"
679  :type '(repeat (choice (symbol :tag "Predefined symbol")
680                         (sexp :tag "Error specification"))))
681
682(defvar inferior-octave-compilation-font-lock-keywords
683  '(("\\_<PASS\\_>" . compilation-info-face)
684    ("\\_<FAIL\\_>" . compilation-error-face)
685    ("\\_<\\(warning\\):" 1 compilation-warning-face)
686    ("\\_<\\(error\\):" 1 compilation-error-face)
687    ("^\\s-*!!!!!.*\\|^.*failed$" . compilation-error-face))
688  "Value for `compilation-mode-font-lock-keywords' in inferior octave.")
689
690(defvar inferior-octave-process nil)
691
692(defvar inferior-octave-mode-map
693  (let ((map (make-sparse-keymap)))
694    (set-keymap-parent map comint-mode-map)
695    (define-key map "\M-." 'octave-find-definition)
696    (define-key map "\t" 'completion-at-point)
697    (define-key map "\C-hd" 'octave-help)
698    (define-key map "\C-ha" 'octave-lookfor)
699    ;; Same as in `shell-mode'.
700    (define-key map "\M-?" 'comint-dynamic-list-filename-completions)
701    (define-key map "\C-c\C-l" 'inferior-octave-dynamic-list-input-ring)
702    (define-key map [menu-bar inout list-history]
703      '("List Input History" . inferior-octave-dynamic-list-input-ring))
704    map)
705  "Keymap used in Inferior Octave mode.")
706
707(defvar inferior-octave-mode-syntax-table
708  (let ((table (make-syntax-table octave-mode-syntax-table)))
709    table)
710  "Syntax table in use in `inferior-octave-mode' buffers.")
711
712(defvar inferior-octave-font-lock-keywords
713  (list
714   (cons inferior-octave-prompt 'font-lock-type-face))
715  ;; Could certainly do more font locking in inferior Octave ...
716  "Additional expressions to highlight in Inferior Octave mode.")
717
718(defvar inferior-octave-output-list nil)
719(defvar inferior-octave-output-string nil)
720(defvar inferior-octave-receive-in-progress nil)
721
722(defvar inferior-octave-dynamic-complete-functions
723  '(inferior-octave-completion-at-point comint-filename-completion)
724  "List of functions called to perform completion for inferior Octave.
725This variable is used to initialize `comint-dynamic-complete-functions'
726in the Inferior Octave buffer.")
727
728(defvar info-lookup-mode)
729(defvar compilation-error-regexp-alist)
730(defvar compilation-mode-font-lock-keywords)
731
732(declare-function compilation-forget-errors "compile" ())
733
734(defun inferior-octave-process-live-p ()
735  (process-live-p inferior-octave-process))
736
737(define-derived-mode inferior-octave-mode comint-mode "Inferior Octave"
738  "Major mode for interacting with an inferior Octave process.
739
740See Info node `(octave-mode) Running Octave from Within Emacs' for more
741details.
742
743Key bindings:
744\\{inferior-octave-mode-map}"
745  :abbrev-table octave-abbrev-table
746  :group 'octave
747
748  (setq comint-prompt-regexp inferior-octave-prompt)
749
750  (setq-local comment-use-syntax t)
751  (setq-local comment-start octave-comment-start)
752  (setq-local comment-end "")
753  (setq comment-column 32)
754  (setq-local comment-start-skip octave-comment-start-skip)
755
756  (setq font-lock-defaults '(inferior-octave-font-lock-keywords nil nil))
757
758  (setq-local info-lookup-mode 'octave-mode)
759  (setq-local eldoc-documentation-function 'octave-eldoc-function)
760
761  (setq-local comint-input-ring-file-name
762              (or (getenv "OCTAVE_HISTFILE") "~/.octave_hist"))
763  (setq-local comint-input-ring-size
764              (string-to-number (or (getenv "OCTAVE_HISTSIZE") "1024")))
765  (comint-read-input-ring t)
766  (setq-local comint-dynamic-complete-functions
767              inferior-octave-dynamic-complete-functions)
768  (setq-local comint-prompt-read-only inferior-octave-prompt-read-only)
769  (add-hook 'comint-input-filter-functions
770            'inferior-octave-directory-tracker nil t)
771  ;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572
772  (add-hook 'window-configuration-change-hook
773            'inferior-octave-track-window-width-change nil t)
774  (setq-local compilation-error-regexp-alist inferior-octave-error-regexp-alist)
775  (setq-local compilation-mode-font-lock-keywords
776              inferior-octave-compilation-font-lock-keywords)
777  (compilation-shell-minor-mode 1)
778  (compilation-forget-errors))
779
780;;;###autoload
781(defun inferior-octave (&optional arg)
782  "Run an inferior Octave process, I/O via `inferior-octave-buffer'.
783This buffer is put in Inferior Octave mode.  See `inferior-octave-mode'.
784
785Unless ARG is non-nil, switches to this buffer.
786
787The elements of the list `inferior-octave-startup-args' are sent as
788command line arguments to the inferior Octave process on startup.
789
790Additional commands to be executed on startup can be provided either in
791the file specified by `inferior-octave-startup-file' or by the default
792startup file, `~/.emacs-octave'."
793  (interactive "P")
794  (let ((buffer (get-buffer-create inferior-octave-buffer)))
795    (unless arg
796      (pop-to-buffer buffer))
797    (unless (comint-check-proc buffer)
798      (with-current-buffer buffer
799        (inferior-octave-startup)
800        (inferior-octave-mode)))
801    buffer))
802
803;;;###autoload
804(defalias 'run-octave 'inferior-octave)
805
806(defun inferior-octave-startup ()
807  "Start an inferior Octave process."
808  (let ((proc (comint-exec-1
809               (substring inferior-octave-buffer 1 -1)
810               inferior-octave-buffer
811               inferior-octave-program
812               (append
813                inferior-octave-startup-args
814                ;; --no-gui is introduced in Octave > 3.7
815                (and (not (member "--no-gui" inferior-octave-startup-args))
816                     (zerop (process-file inferior-octave-program
817                                          nil nil nil "--no-gui" "--help"))
818                     '("--no-gui"))))))
819    (set-process-filter proc 'inferior-octave-output-digest)
820    (setq inferior-octave-process proc
821          inferior-octave-output-list nil
822          inferior-octave-output-string nil
823          inferior-octave-receive-in-progress t)
824
825    ;; This may look complicated ... However, we need to make sure that
826    ;; we additional startup code only AFTER Octave is ready (otherwise,
827    ;; output may be mixed up).  Hence, we need to digest the Octave
828    ;; output to see when it issues a prompt.
829    (while inferior-octave-receive-in-progress
830      (unless (inferior-octave-process-live-p)
831        ;; Spit out the error messages.
832        (when inferior-octave-output-list
833          (princ (concat (mapconcat 'identity inferior-octave-output-list "\n")
834                         "\n")
835                 (process-mark inferior-octave-process)))
836        (error "Process `%s' died" inferior-octave-process))
837      (accept-process-output inferior-octave-process))
838    (goto-char (point-max))
839    (set-marker (process-mark proc) (point))
840    (insert-before-markers
841     (concat
842      (if (not (bobp)) "\n")
843      (if inferior-octave-output-list
844          (concat (mapconcat
845                   'identity inferior-octave-output-list "\n")
846                  "\n"))))
847
848    ;; An empty secondary prompt, as e.g. obtained by '--braindead',
849    ;; means trouble.
850    (inferior-octave-send-list-and-digest (list "PS2\n"))
851    (when (string-match "\\(PS2\\|ans\\) = *$"
852                        (car inferior-octave-output-list))
853      (inferior-octave-send-list-and-digest (list "PS2 ('> ');\n")))
854
855    (inferior-octave-send-list-and-digest
856     (list "disp (getenv ('OCTAVE_SRCDIR'))\n"))
857    (process-put proc 'octave-srcdir
858                 (unless (equal (car inferior-octave-output-list) "")
859                   (car inferior-octave-output-list)))
860
861    ;; O.K., now we are ready for the Inferior Octave startup commands.
862    (inferior-octave-send-list-and-digest
863     (list "more off;\n"
864           (unless (equal inferior-octave-output-string ">> ")
865             ;; See https://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50
866             "PS1 ('octave> ');\n")
867           (when (and inferior-octave-startup-file
868                      (file-exists-p inferior-octave-startup-file))
869             (format "source ('%s');\n" inferior-octave-startup-file))))
870    (when inferior-octave-output-list
871      (insert-before-markers
872       (mapconcat 'identity inferior-octave-output-list "\n")))
873
874    ;; And finally, everything is back to normal.
875    (set-process-filter proc 'comint-output-filter)
876    ;; Just in case, to be sure a cd in the startup file won't have
877    ;; detrimental effects.
878    (with-demoted-errors (inferior-octave-resync-dirs))
879    ;; Generate a proper prompt, which is critical to
880    ;; `comint-history-isearch-backward-regexp'.  Bug#14433.
881    (comint-send-string proc "\n")))
882
883(defun inferior-octave-completion-table ()
884  (completion-table-with-cache
885   (lambda (command)
886     (inferior-octave-send-list-and-digest
887      (list (format "completion_matches ('%s');\n" command)))
888     (delete-consecutive-dups
889      (sort inferior-octave-output-list 'string-lessp)))))
890
891(defun inferior-octave-completion-at-point ()
892  "Return the data to complete the Octave symbol at point."
893  ;; https://debbugs.gnu.org/14300
894  (unless (string-match-p "/" (or (comint--match-partial-filename) ""))
895    (let ((beg (save-excursion
896                 (skip-syntax-backward "w_" (comint-line-beginning-position))
897                 (point)))
898          (end (point)))
899      (when (and beg (> end beg))
900        (list beg end (completion-table-in-turn
901                       (inferior-octave-completion-table)
902                       'comint-completion-file-name-table))))))
903
904(defun inferior-octave-dynamic-list-input-ring ()
905  "List the buffer's input history in a help buffer."
906  ;; We cannot use `comint-dynamic-list-input-ring', because it replaces
907  ;; "completion" by "history reference" ...
908  (interactive)
909  (if (or (not (ring-p comint-input-ring))
910          (ring-empty-p comint-input-ring))
911      (message "No history")
912    (let ((history nil)
913          (history-buffer " *Input History*")
914          (index (1- (ring-length comint-input-ring)))
915          (conf (current-window-configuration)))
916      ;; We have to build up a list ourselves from the ring vector.
917      (while (>= index 0)
918        (setq history (cons (ring-ref comint-input-ring index) history)
919              index (1- index)))
920      ;; Change "completion" to "history reference"
921      ;; to make the display accurate.
922      (with-output-to-temp-buffer history-buffer
923        (display-completion-list history)
924        (set-buffer history-buffer))
925      (message "Hit space to flush")
926      (let ((ch (read-event)))
927        (if (eq ch ?\ )
928            (set-window-configuration conf)
929          (push ch unread-command-events))))))
930
931(defun inferior-octave-output-digest (_proc string)
932  "Special output filter for the inferior Octave process.
933Save all output between newlines into `inferior-octave-output-list', and
934the rest to `inferior-octave-output-string'."
935  (setq string (concat inferior-octave-output-string string))
936  (while (string-match "\n" string)
937    (setq inferior-octave-output-list
938	  (append inferior-octave-output-list
939		  (list (substring string 0 (match-beginning 0))))
940	  string (substring string (match-end 0))))
941  (if (string-match inferior-octave-prompt string)
942      (setq inferior-octave-receive-in-progress nil))
943  (setq inferior-octave-output-string string))
944
945(defun inferior-octave-check-process ()
946  (or (inferior-octave-process-live-p)
947      (error (substitute-command-keys
948              "No inferior octave process running. Type \\[run-octave]"))))
949
950(defun inferior-octave-send-list-and-digest (list)
951  "Send LIST to the inferior Octave process and digest the output.
952The elements of LIST have to be strings and are sent one by one.  All
953output is passed to the filter `inferior-octave-output-digest'."
954  (inferior-octave-check-process)
955  (let* ((proc inferior-octave-process)
956	 (filter (process-filter proc))
957	 string)
958    (set-process-filter proc 'inferior-octave-output-digest)
959    (setq inferior-octave-output-list nil)
960    (unwind-protect
961	(while (setq string (car list))
962	  (setq inferior-octave-output-string nil
963		inferior-octave-receive-in-progress t)
964	  (comint-send-string proc string)
965	  (while inferior-octave-receive-in-progress
966	    (accept-process-output proc))
967	  (setq list (cdr list)))
968      (set-process-filter proc filter))))
969
970(defvar inferior-octave-directory-tracker-resync nil)
971(make-variable-buffer-local 'inferior-octave-directory-tracker-resync)
972
973(defun inferior-octave-directory-tracker (string)
974  "Tracks `cd' commands issued to the inferior Octave process.
975Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused."
976  (when inferior-octave-directory-tracker-resync
977    (or (inferior-octave-resync-dirs 'noerror)
978        (setq inferior-octave-directory-tracker-resync nil)))
979  (cond
980   ((string-match "^[ \t]*cd[ \t;]*$" string)
981    (cd "~"))
982   ((string-match "^[ \t]*cd[ \t]+\\([^ \t\n;]*\\)[ \t\n;]*" string)
983    (condition-case err
984        (cd (match-string 1 string))
985      (error (setq inferior-octave-directory-tracker-resync t)
986             (message "%s: `%s'"
987                      (error-message-string err)
988                      (match-string 1 string)))))))
989
990(defun inferior-octave-resync-dirs (&optional noerror)
991  "Resync the buffer's idea of the current directory.
992This command queries the inferior Octave process about its current
993directory and makes this the current buffer's default directory."
994  (interactive)
995  (inferior-octave-send-list-and-digest '("disp (pwd ())\n"))
996  (condition-case err
997      (progn
998        (cd (car inferior-octave-output-list))
999        t)
1000    (error (unless noerror (signal (car err) (cdr err))))))
1001
1002(defcustom inferior-octave-minimal-columns 80
1003  "The minimal column width for the inferior Octave process."
1004  :type 'integer
1005  :version "24.4")
1006
1007(defvar inferior-octave-last-column-width nil)
1008
1009(defun inferior-octave-track-window-width-change ()
1010  ;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572
1011  (let ((width (max inferior-octave-minimal-columns (window-width))))
1012    (unless (eq inferior-octave-last-column-width width)
1013      (setq-local inferior-octave-last-column-width width)
1014      (when (inferior-octave-process-live-p)
1015        (inferior-octave-send-list-and-digest
1016         (list (format "putenv ('COLUMNS', '%s');\n" width)))))))
1017
1018
1019;;; Miscellaneous useful functions
1020
1021(defun octave-in-comment-p ()
1022  "Return non-nil if point is inside an Octave comment."
1023  (nth 4 (syntax-ppss)))
1024
1025(defun octave-in-string-p ()
1026  "Return non-nil if point is inside an Octave string."
1027  (nth 3 (syntax-ppss)))
1028
1029(defun octave-in-string-or-comment-p ()
1030  "Return non-nil if point is inside an Octave string or comment."
1031  (nth 8 (syntax-ppss)))
1032
1033(defun octave-looking-at-kw (regexp)
1034  "Like `looking-at', but sets `case-fold-search' nil."
1035  (let ((case-fold-search nil))
1036    (looking-at regexp)))
1037
1038(defun octave-maybe-insert-continuation-string ()
1039  (if (or (octave-in-comment-p)
1040	  (save-excursion
1041	    (beginning-of-line)
1042	    (looking-at octave-continuation-regexp)))
1043      nil
1044    (delete-horizontal-space)
1045    (insert (concat " " octave-continuation-string))))
1046
1047(defun octave-completing-read ()
1048  (let ((def (or (thing-at-point 'symbol)
1049                 (save-excursion
1050                   (skip-syntax-backward "-(")
1051                   (thing-at-point 'symbol)))))
1052    (completing-read
1053     (format (if def "Function (default %s): " "Function: ") def)
1054     (inferior-octave-completion-table)
1055     nil nil nil nil def)))
1056
1057(defun octave-goto-function-definition (fn)
1058  "Go to the function definition of FN in current buffer."
1059  (let ((search
1060         (lambda (re sub)
1061           (let ((orig (point)) found)
1062             (goto-char (point-min))
1063             (while (and (not found) (re-search-forward re nil t))
1064               (when (and (equal (match-string sub) fn)
1065                          (not (nth 8 (syntax-ppss))))
1066                 (setq found t)))
1067             (unless found (goto-char orig))
1068             found))))
1069    (pcase (and buffer-file-name (file-name-extension buffer-file-name))
1070      ("cc" (funcall search
1071                     "\\_<DEFUN\\(?:_DLD\\)?\\s-*(\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)" 1))
1072      (_ (funcall search octave-function-header-regexp 3)))))
1073
1074(defun octave-function-file-p ()
1075  "Return non-nil if the first token is \"function\".
1076The value is (START END NAME-START NAME-END) of the function."
1077  (save-excursion
1078    (goto-char (point-min))
1079    (when (equal (funcall smie-forward-token-function) "function")
1080      (forward-word-strictly -1)
1081      (let* ((start (point))
1082             (end (progn (forward-sexp 1) (point)))
1083             (name (when (progn
1084                           (goto-char start)
1085                           (re-search-forward octave-function-header-regexp
1086                                              end t))
1087                     (list (match-beginning 3) (match-end 3)))))
1088        (cons start (cons end name))))))
1089
1090;; Like forward-comment but stop at non-comment blank
1091(defun octave-skip-comment-forward (limit)
1092  (let ((ppss (syntax-ppss)))
1093    (if (nth 4 ppss)
1094        (goto-char (nth 8 ppss))
1095      (goto-char (or (comment-search-forward limit t) (point)))))
1096  (while (and (< (point) limit) (looking-at-p "\\s<"))
1097    (forward-comment 1)))
1098
1099;;; First non-copyright comment block
1100(defun octave-function-file-comment ()
1101  "Beginning and end positions of the function file comment."
1102  (save-excursion
1103    (goto-char (point-min))
1104    ;; Copyright block: octave/libinterp/parse-tree/lex.ll around line 1634
1105    (while (save-excursion
1106             (when (comment-search-forward (point-max) t)
1107               (when (eq (char-after) ?\{) ; case of block comment
1108                 (forward-char 1))
1109               (skip-syntax-forward "-")
1110               (let ((case-fold-search t))
1111                 (looking-at-p "\\(?:copyright\\|author\\)\\_>"))))
1112      (octave-skip-comment-forward (point-max)))
1113    (let ((beg (comment-search-forward (point-max) t)))
1114      (when beg
1115        (goto-char beg)
1116        (octave-skip-comment-forward (point-max))
1117        (list beg (point))))))
1118
1119(defun octave-sync-function-file-names ()
1120  "Ensure function name agree with function file name.
1121See Info node `(octave)Function Files'."
1122  (interactive)
1123  (when buffer-file-name
1124    (pcase-let ((`(,start ,_end ,name-start ,name-end)
1125                 (octave-function-file-p)))
1126      (when (and start name-start)
1127        (let* ((func (buffer-substring name-start name-end))
1128               (file (file-name-sans-extension
1129                      (file-name-nondirectory buffer-file-name)))
1130               (help-form (format-message "\
1131a: Use function name `%s'
1132b: Use file name `%s'
1133q: Don't fix\n" func file))
1134               (c (unless (equal file func)
1135                    (save-window-excursion
1136                      (help-form-show)
1137                      (read-char-choice
1138                       "Which name to use? (a/b/q) " '(?a ?b ?q))))))
1139          (pcase c
1140            (?a (let ((newname (expand-file-name
1141                                (concat func (file-name-extension
1142                                              buffer-file-name t)))))
1143                  (when (or (not (file-exists-p newname))
1144                            (yes-or-no-p
1145                             (format "Target file %s exists; proceed? " newname)))
1146                    (when (file-exists-p buffer-file-name)
1147                      (rename-file buffer-file-name newname t))
1148                    (set-visited-file-name newname))))
1149            (?b (save-excursion
1150                  (goto-char name-start)
1151                  (delete-region name-start name-end)
1152                  (insert file)))))))))
1153
1154(defun octave-update-function-file-comment (beg end)
1155  "Query replace function names in function file comment."
1156  (interactive
1157   (progn
1158     (barf-if-buffer-read-only)
1159     (if (use-region-p)
1160         (list (region-beginning) (region-end))
1161       (or (octave-function-file-comment)
1162           (error "No function file comment found")))))
1163  (save-excursion
1164    (let* ((bounds (or (octave-function-file-p)
1165                       (error "Not in a function file buffer")))
1166           (func (if (cddr bounds)
1167                     (apply #'buffer-substring (cddr bounds))
1168                   (error "Function name not found")))
1169           (old-func (progn
1170                       (goto-char beg)
1171                       (when (re-search-forward
1172                              "[=}]\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>"
1173                              (min (line-end-position 4) end)
1174                              t)
1175                         (match-string 1))))
1176           (old-func (read-string (format (if old-func
1177                                              "Name to replace (default %s): "
1178                                            "Name to replace: ")
1179                                          old-func)
1180                                  nil nil old-func)))
1181      (if (and func old-func (not (equal func old-func)))
1182          (perform-replace old-func func 'query
1183                           nil 'delimited nil nil beg end)
1184        (message "Function names match")))))
1185
1186(defface octave-function-comment-block
1187  '((t (:inherit font-lock-doc-face)))
1188  "Face used to highlight function comment block.")
1189
1190(eval-when-compile (require 'texinfo))
1191;; Undo the effects of texinfo loading tex-mode loading compile.
1192(declare-function compilation-forget-errors "compile" ())
1193
1194(defun octave-font-lock-texinfo-comment ()
1195  (let ((kws
1196         (eval-when-compile
1197           (delq nil (mapcar
1198                      (lambda (kw)
1199                        (if (numberp (nth 1 kw))
1200                            `(,(nth 0 kw) ,(nth 1 kw) ,(nth 2 kw) prepend)
1201                          (message "Ignoring Texinfo highlight: %S" kw)))
1202                      texinfo-font-lock-keywords)))))
1203    (font-lock-add-keywords
1204     nil
1205     `((,(lambda (limit)
1206           (while (and (< (point) limit)
1207                       (search-forward "-*- texinfo -*-" limit t)
1208                       (octave-in-comment-p))
1209             (let ((beg (nth 8 (syntax-ppss)))
1210                   (end (progn
1211                          (octave-skip-comment-forward (point-max))
1212                          (point))))
1213               (put-text-property beg end 'font-lock-multiline t)
1214               (font-lock-prepend-text-property
1215                beg end 'face 'octave-function-comment-block)
1216               (dolist (kw kws)
1217                 (goto-char beg)
1218                 (while (re-search-forward (car kw) end 'move)
1219                   (font-lock-apply-highlight (cdr kw))))))
1220           nil)))
1221     'append)))
1222
1223
1224;;; Indentation
1225
1226(defun octave-indent-new-comment-line (&optional soft)
1227  "Break Octave line at point, continuing comment if within one.
1228Insert `octave-continuation-string' before breaking the line
1229unless inside a list.  Signal an error if within a single-quoted
1230string."
1231  (interactive)
1232  (funcall comment-line-break-function soft))
1233
1234(defun octave--indent-new-comment-line (orig &rest args)
1235  (cond
1236   ((octave-in-comment-p) nil)
1237   ((eq (octave-in-string-p) ?')
1238    (error "Cannot split a single-quoted string"))
1239   ((eq (octave-in-string-p) ?\")
1240    (insert octave-continuation-string))
1241   (t
1242    (delete-horizontal-space)
1243    (unless (and (cadr (syntax-ppss))
1244                 (eq (char-after (cadr (syntax-ppss))) ?\())
1245      (insert " " octave-continuation-string))))
1246  (apply orig args)
1247  (indent-according-to-mode))
1248
1249(define-obsolete-function-alias
1250  'octave-indent-defun 'prog-indent-sexp "24.4")
1251
1252
1253;;; Motion
1254(defun octave-next-code-line (&optional arg)
1255  "Move ARG lines of Octave code forward (backward if ARG is negative).
1256Skips past all empty and comment lines.  Default for ARG is 1.
1257
1258On success, return 0.  Otherwise, go as far as possible and return -1."
1259  (interactive "p")
1260  (or arg (setq arg 1))
1261  (beginning-of-line)
1262  (let ((n 0)
1263	(inc (if (> arg 0) 1 -1)))
1264    (while (and (/= arg 0) (= n 0))
1265      (setq n (forward-line inc))
1266      (while (and (= n 0)
1267		  (looking-at "\\s-*\\($\\|\\s<\\)"))
1268	(setq n (forward-line inc)))
1269      (setq arg (- arg inc)))
1270    n))
1271
1272(defun octave-previous-code-line (&optional arg)
1273  "Move ARG lines of Octave code backward (forward if ARG is negative).
1274Skips past all empty and comment lines.  Default for ARG is 1.
1275
1276On success, return 0.  Otherwise, go as far as possible and return -1."
1277  (interactive "p")
1278  (or arg (setq arg 1))
1279  (octave-next-code-line (- arg)))
1280
1281(defun octave-beginning-of-line ()
1282  "Move point to beginning of current Octave line.
1283If on an empty or comment line, go to the beginning of that line.
1284Otherwise, move backward to the beginning of the first Octave code line
1285which is not inside a continuation statement, i.e., which does not
1286follow a code line ending with `...' or is inside an open
1287parenthesis list."
1288  (interactive)
1289  (beginning-of-line)
1290  (unless (looking-at "\\s-*\\($\\|\\s<\\)")
1291    (while (or (when (cadr (syntax-ppss))
1292                 (goto-char (cadr (syntax-ppss)))
1293                 (beginning-of-line)
1294                 t)
1295               (and (or (looking-at "\\s-*\\($\\|\\s<\\)")
1296                        (save-excursion
1297                          (if (zerop (octave-previous-code-line))
1298                              (looking-at octave-continuation-regexp))))
1299                    (zerop (forward-line -1)))))))
1300
1301(defun octave-end-of-line ()
1302  "Move point to end of current Octave line.
1303If on an empty or comment line, go to the end of that line.
1304Otherwise, move forward to the end of the first Octave code line which
1305does not end with `...' or is inside an open parenthesis list."
1306  (interactive)
1307  (end-of-line)
1308  (unless (save-excursion
1309            (beginning-of-line)
1310            (looking-at "\\s-*\\($\\|\\s<\\)"))
1311    (while (or (when (cadr (syntax-ppss))
1312                 (condition-case nil
1313                     (progn
1314                       (up-list 1)
1315                       (end-of-line)
1316                       t)
1317                   (error nil)))
1318               (and (save-excursion
1319                      (beginning-of-line)
1320                      (or (looking-at "\\s-*\\($\\|\\s<\\)")
1321                          (looking-at octave-continuation-regexp)))
1322                    (zerop (forward-line 1)))))
1323    (end-of-line)))
1324
1325(defun octave-mark-block ()
1326  "Put point at the beginning of this Octave block, mark at the end.
1327The block marked is the one that contains point or follows point."
1328  (interactive)
1329  (if (and (looking-at "\\sw\\|\\s_")
1330           (looking-back "\\sw\\|\\s_" (1- (point))))
1331      (skip-syntax-forward "w_"))
1332  (unless (or (looking-at "\\s(")
1333              (save-excursion
1334                (let* ((token (funcall smie-forward-token-function))
1335                       (level (assoc token smie-grammar)))
1336                  (and level (not (numberp (cadr level)))))))
1337    (backward-up-list 1))
1338  (mark-sexp))
1339
1340(defun octave-beginning-of-defun (&optional arg)
1341  "Octave-specific `beginning-of-defun-function' (which see)."
1342  (or arg (setq arg 1))
1343  ;; Move out of strings or comments.
1344  (when (octave-in-string-or-comment-p)
1345    (goto-char (octave-in-string-or-comment-p)))
1346  (letrec ((orig (point))
1347           (toplevel (lambda (pos)
1348                       (condition-case nil
1349                           (progn
1350                             (backward-up-list 1)
1351                             (funcall toplevel (point)))
1352                         (scan-error pos)))))
1353    (goto-char (funcall toplevel (point)))
1354    (when (and (> arg 0) (/= orig (point)))
1355      (setq arg (1- arg)))
1356    (forward-sexp (- arg))
1357    (and (< arg 0) (forward-sexp -1))
1358    (/= orig (point))))
1359
1360(defun octave-fill-paragraph (&optional _arg)
1361  "Fill paragraph of Octave code, handling Octave comments."
1362  ;; FIXME: difference with generic fill-paragraph:
1363  ;; - code lines are only split, never joined.
1364  ;; - \n that end comments are never removed.
1365  ;; - insert continuation marker when splitting code lines.
1366  (interactive "P")
1367  (save-excursion
1368    (let ((end (progn (forward-paragraph) (copy-marker (point) t)))
1369          (beg (progn
1370                 (forward-paragraph -1)
1371                 (skip-chars-forward " \t\n")
1372                 (beginning-of-line)
1373                 (point)))
1374          (cfc (current-fill-column))
1375          comment-prefix)
1376      (goto-char beg)
1377      (while (< (point) end)
1378        (condition-case nil
1379            (indent-according-to-mode)
1380          (error nil))
1381        (move-to-column cfc)
1382        ;; First check whether we need to combine non-empty comment lines
1383        (if (and (< (current-column) cfc)
1384                 (octave-in-comment-p)
1385                 (not (save-excursion
1386                        (beginning-of-line)
1387                        (looking-at "^\\s-*\\s<+\\s-*$"))))
1388            ;; This is a nonempty comment line which does not extend
1389            ;; past the fill column.  If it is followed by a nonempty
1390            ;; comment line with the same comment prefix, try to
1391            ;; combine them, and repeat this until either we reach the
1392            ;; fill-column or there is nothing more to combine.
1393            (progn
1394              ;; Get the comment prefix
1395              (save-excursion
1396                (beginning-of-line)
1397                (while (and (re-search-forward "\\s<+")
1398                            (not (octave-in-comment-p))))
1399                (setq comment-prefix (match-string 0)))
1400              ;; And keep combining ...
1401              (while (and (< (current-column) cfc)
1402                          (save-excursion
1403                            (forward-line 1)
1404                            (and (looking-at
1405                                  (concat "^\\s-*"
1406                                          comment-prefix
1407                                          "\\S<"))
1408                                 (not (looking-at
1409                                       (concat "^\\s-*"
1410                                               comment-prefix
1411                                               "\\s-*$"))))))
1412                (delete-char 1)
1413                (re-search-forward comment-prefix)
1414                (delete-region (match-beginning 0) (match-end 0))
1415                (fixup-whitespace)
1416                (move-to-column cfc))))
1417        ;; We might also try to combine continued code lines>  Perhaps
1418        ;; some other time ...
1419        (skip-chars-forward "^ \t\n")
1420        (delete-horizontal-space)
1421        (if (or (< (current-column) cfc)
1422                (and (= (current-column) cfc) (eolp)))
1423            (forward-line 1)
1424          (if (not (eolp)) (insert " "))
1425          (or (funcall normal-auto-fill-function)
1426              (forward-line 1))))
1427      t)))
1428
1429(defun octave-completion-at-point ()
1430  "Find the text to complete and the corresponding table."
1431  (let* ((beg (save-excursion (skip-syntax-backward "w_") (point)))
1432         (end (point)))
1433    (if (< beg (point))
1434        ;; Extend region past point, if applicable.
1435        (save-excursion (skip-syntax-forward "w_")
1436                        (setq end (point))))
1437    (when (> end beg)
1438      (list beg end (or (and (inferior-octave-process-live-p)
1439                             (inferior-octave-completion-table))
1440                        octave-reserved-words)))))
1441
1442(defun octave-add-log-current-defun ()
1443  "A function for `add-log-current-defun-function' (which see)."
1444  (save-excursion
1445    (end-of-line)
1446    (and (beginning-of-defun)
1447         (re-search-forward octave-function-header-regexp
1448                            (line-end-position) t)
1449         (match-string 3))))
1450
1451
1452;;; Electric characters && friends
1453(define-skeleton octave-insert-defun
1454  "Insert an Octave function skeleton.
1455Prompt for the function's name, arguments and return values (to be
1456entered without parens)."
1457  (let* ((defname (file-name-sans-extension (buffer-name)))
1458         (name (read-string (format "Function name (default %s): " defname)
1459                            nil nil defname))
1460         (args (read-string "Arguments: "))
1461         (vals (read-string "Return values: ")))
1462    (format "%s%s (%s)"
1463            (cond
1464             ((string-equal vals "") vals)
1465             ((string-match "[ ,]" vals) (concat "[" vals "] = "))
1466             (t (concat vals " = ")))
1467            name
1468            args))
1469  \n octave-block-comment-start "usage: " str \n
1470  octave-block-comment-start '(delete-horizontal-space) \n
1471  octave-block-comment-start '(delete-horizontal-space) \n
1472  "function " > str \n
1473  _ \n
1474  "endfunction" > \n)
1475
1476;;; Communication with the inferior Octave process
1477(defun octave-kill-process ()
1478  "Kill inferior Octave process and its buffer."
1479  (interactive)
1480  (when (and (buffer-live-p (get-buffer inferior-octave-buffer))
1481             (or (yes-or-no-p (format "Kill %S and its buffer? "
1482                                      inferior-octave-process))
1483                 (user-error "Aborted")))
1484    (when (inferior-octave-process-live-p)
1485      (set-process-query-on-exit-flag inferior-octave-process nil)
1486      (process-send-string inferior-octave-process "quit;\n")
1487      (accept-process-output inferior-octave-process))
1488    (kill-buffer inferior-octave-buffer)))
1489
1490(defun octave-show-process-buffer ()
1491  "Make sure that `inferior-octave-buffer' is displayed."
1492  (interactive)
1493  (if (get-buffer inferior-octave-buffer)
1494      (display-buffer inferior-octave-buffer)
1495    (message "No buffer named %s" inferior-octave-buffer)))
1496
1497(defun octave-hide-process-buffer ()
1498  "Delete all windows that display `inferior-octave-buffer'."
1499  (interactive)
1500  (if (get-buffer inferior-octave-buffer)
1501      (delete-windows-on inferior-octave-buffer)
1502    (message "No buffer named %s" inferior-octave-buffer)))
1503
1504(defun octave-source-file (file)
1505  "Execute FILE in the inferior Octave process.
1506This is done using Octave's source function.  FILE defaults to
1507current buffer file unless called with a prefix arg \\[universal-argument]."
1508  (interactive (list (or (and (not current-prefix-arg) buffer-file-name)
1509                         (read-file-name "File: " nil nil t))))
1510  (or (stringp file)
1511      (signal 'wrong-type-argument (list 'stringp file)))
1512  (inferior-octave t)
1513  (with-current-buffer inferior-octave-buffer
1514    (comint-send-string inferior-octave-process
1515                        (format "source '%s'\n" file))))
1516
1517(defun octave-send-region (beg end)
1518  "Send current region to the inferior Octave process."
1519  (interactive "r")
1520  (inferior-octave t)
1521  (let ((proc inferior-octave-process)
1522        (string (buffer-substring-no-properties beg end))
1523        line)
1524    (with-current-buffer inferior-octave-buffer
1525      ;; https://lists.gnu.org/r/emacs-devel/2013-10/msg00095.html
1526      (compilation-forget-errors)
1527      (setq inferior-octave-output-list nil)
1528      (while (not (string-equal string ""))
1529        (if (string-match "\n" string)
1530            (setq line (substring string 0 (match-beginning 0))
1531                  string (substring string (match-end 0)))
1532          (setq line string string ""))
1533        (setq inferior-octave-receive-in-progress t)
1534        (inferior-octave-send-list-and-digest (list (concat line "\n")))
1535        (while inferior-octave-receive-in-progress
1536          (accept-process-output proc))
1537        (insert-before-markers
1538         (mapconcat 'identity
1539                    (append
1540                     (if octave-send-echo-input (list line) (list ""))
1541                     inferior-octave-output-list
1542                     (list inferior-octave-output-string))
1543                    "\n")))))
1544  (if octave-send-show-buffer
1545      (display-buffer inferior-octave-buffer)))
1546
1547(defun octave-send-buffer ()
1548  "Send current buffer to the inferior Octave process."
1549  (interactive)
1550  (octave-send-region (point-min) (point-max)))
1551
1552(defun octave-send-block ()
1553  "Send current Octave block to the inferior Octave process."
1554  (interactive)
1555  (save-excursion
1556    (octave-mark-block)
1557    (octave-send-region (point) (mark))))
1558
1559(defun octave-send-defun ()
1560  "Send current Octave function to the inferior Octave process."
1561  (interactive)
1562  (save-excursion
1563    (mark-defun)
1564    (octave-send-region (point) (mark))))
1565
1566(defun octave-send-line (&optional arg)
1567  "Send current Octave code line to the inferior Octave process.
1568With positive prefix ARG, send that many lines.
1569If `octave-send-line-auto-forward' is non-nil, go to the next unsent
1570code line."
1571  (interactive "P")
1572  (or arg (setq arg 1))
1573  (if (> arg 0)
1574      (let (beg end)
1575	(beginning-of-line)
1576	(setq beg (point))
1577	(octave-next-code-line (- arg 1))
1578	(end-of-line)
1579	(setq end (point))
1580	(if octave-send-line-auto-forward
1581	    (octave-next-code-line 1))
1582	(octave-send-region beg end))))
1583
1584(defun octave-eval-print-last-sexp ()
1585  "Evaluate Octave sexp before point and print value into current buffer."
1586  (interactive)
1587  (inferior-octave t)
1588  (let ((standard-output (current-buffer))
1589	(print-escape-newlines nil)
1590	(opoint (point)))
1591    (terpri)
1592    (prin1
1593     (save-excursion
1594       (forward-sexp -1)
1595       (inferior-octave-send-list-and-digest
1596	(list (concat (buffer-substring-no-properties (point) opoint)
1597		      "\n")))
1598       (mapconcat 'identity inferior-octave-output-list "\n")))
1599    (terpri)))
1600
1601
1602
1603(defcustom octave-eldoc-message-style 'auto
1604  "Octave eldoc message style: auto, oneline, multiline."
1605  :type '(choice (const :tag "Automatic" auto)
1606                 (const :tag "One Line" oneline)
1607                 (const :tag "Multi Line" multiline))
1608  :version "24.4")
1609
1610;; (FN SIGNATURE1 SIGNATURE2 ...)
1611(defvar octave-eldoc-cache nil)
1612
1613(defun octave-eldoc-function-signatures (fn)
1614  (unless (equal fn (car octave-eldoc-cache))
1615    (inferior-octave-send-list-and-digest
1616     (list (format "print_usage ('%s');\n" fn)))
1617    (let (result)
1618      (dolist (line inferior-octave-output-list)
1619        ;; The help output has changed a few times in GNU Octave.
1620        ;; Earlier versions output "usage: " before the function signature.
1621        ;; After deprecating the usage function, and up until GNU Octave 4.0.3,
1622        ;; the output looks like this:
1623        ;; -- Mapping Function: abs (Z).
1624        ;; After GNU Octave 4.2.0, the output is less verbose and it looks like
1625        ;; this:
1626        ;; -- abs (Z)
1627        ;; The following regexp matches these three formats.
1628        ;; The "usage: " alternative matches the symbol, because a call to
1629        ;; print_usage with a non-existent function (e.g., print_usage ('A'))
1630        ;; would output:
1631        ;; error: print_usage: 'A' not found
1632        ;; and we wouldn't like to match anything in this case.
1633        ;; See bug #36459.
1634        (when (string-match
1635               "\\s-*\\(?:--[^:]+:\\|\\_<usage:\\|--\\)\\s-*\\(.*\\)$"
1636               line)
1637          (push (match-string 1 line) result)))
1638      (setq octave-eldoc-cache
1639            (cons (substring-no-properties fn)
1640                  (nreverse result)))))
1641  (cdr octave-eldoc-cache))
1642
1643(defun octave-eldoc-function ()
1644  "A function for `eldoc-documentation-function' (which see)."
1645  (when (inferior-octave-process-live-p)
1646    (let* ((ppss (syntax-ppss))
1647           (paren-pos (cadr ppss))
1648           (fn (save-excursion
1649                 (if (and paren-pos
1650                          ;; PAREN-POS must be after the prompt.
1651                          (or (not (eq (get-buffer-process (current-buffer))
1652                                       inferior-octave-process))
1653                              (< (process-mark inferior-octave-process)
1654                                 paren-pos))
1655                          (eq (char-after paren-pos) ?\())
1656                     (goto-char paren-pos)
1657                   (setq paren-pos nil))
1658                 (when (or (< (skip-syntax-backward "-") 0) paren-pos)
1659                   (thing-at-point 'symbol))))
1660           (sigs (and fn (octave-eldoc-function-signatures fn)))
1661           (oneline (mapconcat 'identity sigs
1662                               (propertize " | " 'face 'warning)))
1663           (multiline (mapconcat (lambda (s) (concat "-- " s)) sigs "\n")))
1664      ;;
1665      ;; Return the value according to style.
1666      (pcase octave-eldoc-message-style
1667        ('auto (if (< (length oneline) (window-width (minibuffer-window)))
1668                   oneline
1669                 multiline))
1670        ('oneline oneline)
1671        ('multiline multiline)))))
1672
1673(defcustom octave-help-buffer "*Octave Help*"
1674  "Buffer name for `octave-help'."
1675  :type 'string
1676  :version "24.4")
1677
1678;; Used in a mode derived from help-mode.
1679(declare-function help-button-action "help-mode" (button))
1680
1681(define-button-type 'octave-help-file
1682  'follow-link t
1683  'action #'help-button-action
1684  'help-function 'octave-find-definition)
1685
1686(define-button-type 'octave-help-function
1687  'follow-link t
1688  'action (lambda (b)
1689            (octave-help
1690             (buffer-substring (button-start b) (button-end b)))))
1691
1692(defvar octave-help-mode-map
1693  (let ((map (make-sparse-keymap)))
1694    (define-key map "\M-."  'octave-find-definition)
1695    (define-key map "\C-hd" 'octave-help)
1696    (define-key map "\C-ha" 'octave-lookfor)
1697    map))
1698
1699(define-derived-mode octave-help-mode help-mode "OctHelp"
1700  "Major mode for displaying Octave documentation."
1701  :abbrev-table nil
1702  :syntax-table octave-mode-syntax-table
1703  (eval-and-compile (require 'help-mode))
1704  ;; Don't highlight `EXAMPLE' as elisp symbols by using a regexp that
1705  ;; can never match.
1706  (setq-local help-xref-symbol-regexp regexp-unmatchable))
1707
1708(defun octave-help (fn)
1709  "Display the documentation of FN."
1710  (interactive (list (octave-completing-read)))
1711  (inferior-octave-send-list-and-digest
1712   (list (format "help ('%s');\n" fn)))
1713  (let ((lines inferior-octave-output-list)
1714        (inhibit-read-only t))
1715    (when (string-match "error: \\(.*\\)$" (car lines))
1716      (error "%s" (match-string 1 (car lines))))
1717    (with-help-window octave-help-buffer
1718      (princ (mapconcat 'identity lines "\n"))
1719      (with-current-buffer octave-help-buffer
1720        ;; Bound to t so that `help-buffer' returns current buffer for
1721        ;; `help-setup-xref'.
1722        (let ((help-xref-following t))
1723          (help-setup-xref (list 'octave-help fn)
1724                           (called-interactively-p 'interactive)))
1725        ;; Note: can be turned off by suppress_verbose_help_message.
1726        ;;
1727        ;; Remove boring trailing text: Additional help for built-in functions
1728        ;; and operators ...
1729        (goto-char (point-max))
1730        (when (search-backward "\n\n\n" nil t)
1731          (goto-char (match-beginning 0))
1732          (delete-region (point) (point-max)))
1733        ;; File name highlight
1734        (goto-char (point-min))
1735        (when (re-search-forward "from the file \\(.*\\)$"
1736                                 (line-end-position)
1737                                 t)
1738          (let* ((file (match-string 1))
1739                 (dir (file-name-directory
1740                       (directory-file-name (file-name-directory file)))))
1741            (replace-match "" nil nil nil 1)
1742            (insert (substitute-command-keys "`"))
1743            ;; Include the parent directory which may be regarded as
1744            ;; the category for the FN.
1745            (help-insert-xref-button (file-relative-name file dir)
1746                                     'octave-help-file fn)
1747            (insert (substitute-command-keys "'"))))
1748        ;; Make 'See also' clickable.
1749        (with-syntax-table octave-mode-syntax-table
1750          (when (re-search-forward "^\\s-*See also:" nil t)
1751            (let ((end (save-excursion (re-search-forward "^\\s-*$" nil t))))
1752              (while (re-search-forward
1753                      "\\s-*\\([^,\n]+?\\)\\s-*\\(?:[,]\\|[.]?$\\)" end t)
1754                (make-text-button (match-beginning 1) (match-end 1)
1755                                  :type 'octave-help-function)))))
1756        (octave-help-mode)))))
1757
1758(defun octave-lookfor (str &optional all)
1759  "Search for the string STR in all function help strings.
1760If ALL is non-nil search the entire help string else only search the first
1761sentence."
1762  (interactive "sSearch for: \nP")
1763  (inferior-octave-send-list-and-digest
1764   (list (format "lookfor (%s'%s');\n"
1765                 (if all "'-all', " "")
1766                 str)))
1767  (let ((lines inferior-octave-output-list))
1768    (when (and (stringp (car lines))
1769               (string-match "error: \\(.*\\)$" (car lines)))
1770      (error "%s" (match-string 1 (car lines))))
1771    (with-help-window octave-help-buffer
1772      (with-current-buffer octave-help-buffer
1773        (if lines
1774            (insert (mapconcat 'identity lines "\n"))
1775          (insert (format "Nothing found for \"%s\".\n" str)))
1776        ;; Bound to t so that `help-buffer' returns current buffer for
1777        ;; `help-setup-xref'.
1778        (let ((help-xref-following t))
1779          (help-setup-xref (list 'octave-lookfor str all)
1780                           (called-interactively-p 'interactive)))
1781        (goto-char (point-min))
1782        (when lines
1783          (while (re-search-forward "^\\([^[:blank:]]+\\) " nil 'noerror)
1784            (make-text-button (match-beginning 1) (match-end 1)
1785                              :type 'octave-help-function)))
1786        (unless all
1787          (goto-char (point-max))
1788          (insert "\nRetry with ")
1789          (insert-text-button "'-all'"
1790                              'follow-link t
1791                              'action #'(lambda (_b)
1792                                          (octave-lookfor str '-all)))
1793          (insert ".\n"))
1794        (octave-help-mode)))))
1795
1796(defcustom octave-source-directories nil
1797  "A list of directories for Octave sources.
1798If the environment variable OCTAVE_SRCDIR is set, it is searched first."
1799  :type '(repeat directory)
1800  :version "24.4")
1801
1802(defun octave-source-directories ()
1803  (let ((srcdir (or (and inferior-octave-process
1804                         (process-get inferior-octave-process 'octave-srcdir))
1805                    (getenv "OCTAVE_SRCDIR"))))
1806    (if srcdir
1807        (cons srcdir octave-source-directories)
1808      octave-source-directories)))
1809
1810(defvar octave-find-definition-filename-function
1811  #'octave-find-definition-default-filename)
1812
1813(defun octave-find-definition-default-filename (name)
1814  "Default value for `octave-find-definition-filename-function'."
1815  (pcase (file-name-extension name)
1816    ("oct"
1817     (octave-find-definition-default-filename
1818      (concat "libinterp/dldfcn/"
1819              (file-name-sans-extension (file-name-nondirectory name))
1820              ".cc")))
1821    ("cc"
1822     (let ((file (or (locate-file name (octave-source-directories))
1823                     (locate-file (file-name-nondirectory name)
1824                                  (octave-source-directories)))))
1825       (or (and file (file-exists-p file))
1826           (error "File `%s' not found" name))
1827       file))
1828    ("mex"
1829     (if (yes-or-no-p (format-message "File `%s' may be binary; open? "
1830				      (file-name-nondirectory name)))
1831         name
1832       (user-error "Aborted")))
1833    (_ name)))
1834
1835(defvar find-tag-marker-ring)
1836
1837(defun octave-find-definition (fn)
1838  "Find the definition of FN.
1839Functions implemented in C++ can be found if
1840variable `octave-source-directories' is set correctly."
1841  (interactive (list (octave-completing-read)))
1842  (require 'etags)
1843  (let ((orig (point)))
1844    (if (and (derived-mode-p 'octave-mode)
1845             (octave-goto-function-definition fn))
1846        (ring-insert find-tag-marker-ring (copy-marker orig))
1847      (inferior-octave-send-list-and-digest
1848       ;; help NAME is more verbose
1849       (list (format "\
1850if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n"
1851                     fn fn fn)))
1852      (let (line file)
1853        ;; Skip garbage lines such as
1854        ;;     warning: fmincg.m: possible Matlab-style ....
1855        (while (and (not file) (consp inferior-octave-output-list))
1856          (setq line (pop inferior-octave-output-list))
1857          (when (string-match "from the file \\(.*\\)$" line)
1858            (setq file (match-string 1 line))))
1859        (if (not file)
1860            (user-error "%s" (or line (format-message "`%s' not found" fn)))
1861          (ring-insert find-tag-marker-ring (point-marker))
1862          (setq file (funcall octave-find-definition-filename-function file))
1863          (when file
1864            (find-file file)
1865            (octave-goto-function-definition fn)))))))
1866
1867(provide 'octave)
1868;;; octave.el ends here
1869