mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-29 07:58:28 +00:00
1848 lines
72 KiB
EmacsLisp
1848 lines
72 KiB
EmacsLisp
;;; octave.el --- editing octave source files under emacs -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 1997-2023 Free Software Foundation, Inc.
|
||
|
||
;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>
|
||
;; John Eaton <jwe@octave.org>
|
||
;; Maintainer: emacs-devel@gnu.org
|
||
;; Keywords: languages
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This package provides Emacs support for Octave. It defines a major
|
||
;; mode for editing Octave code and contains code for interacting with
|
||
;; an inferior Octave process using comint.
|
||
|
||
;; See the documentation of `octave-mode' and `run-octave' for further
|
||
;; information on usage and customization.
|
||
|
||
;;; Code:
|
||
(require 'comint)
|
||
|
||
(defgroup octave nil
|
||
"Editing Octave code."
|
||
:link '(custom-manual "(octave-mode)Top")
|
||
:link '(url-link "https://www.gnu.org/s/octave")
|
||
:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
|
||
:group 'languages)
|
||
|
||
(define-obsolete-function-alias 'octave-submit-bug-report
|
||
'report-emacs-bug "24.4")
|
||
|
||
(define-abbrev-table 'octave-abbrev-table nil
|
||
"Abbrev table for Octave's reserved words.
|
||
Used in `octave-mode' and `inferior-octave-mode' buffers.")
|
||
|
||
(defvar octave-comment-char ?#
|
||
"Character to start an Octave comment.")
|
||
|
||
(defvar octave-comment-start (char-to-string octave-comment-char)
|
||
"Octave-specific `comment-start' (which see).")
|
||
|
||
(defvar octave-comment-start-skip "\\(^\\|\\S<\\)\\(?:%!\\|\\s<+\\)\\s-*"
|
||
"Octave-specific `comment-start-skip' (which see).")
|
||
|
||
(defvar octave-function-header-regexp
|
||
(concat "^\\s-*\\_<\\(function\\)\\_>"
|
||
"\\([^=;(\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>")
|
||
"Regexp to match an Octave function header.
|
||
The string `function' and its name are given by the first and third
|
||
parenthetical grouping.")
|
||
|
||
|
||
(defvar-keymap octave-mode-map
|
||
:doc "Keymap used in Octave mode."
|
||
"M-." #'octave-find-definition
|
||
"C-M-j" #'octave-indent-new-comment-line
|
||
"C-c C-p" #'octave-previous-code-line
|
||
"C-c C-n" #'octave-next-code-line
|
||
"C-c C-a" #'octave-beginning-of-line
|
||
"C-c C-e" #'octave-end-of-line
|
||
"<remap> <down-list>" #'smie-down-list
|
||
"C-c C-M-h" #'octave-mark-block
|
||
"C-c ]" #'smie-close-block
|
||
"C-c /" #'smie-close-block
|
||
"C-c ;" #'octave-update-function-file-comment
|
||
"C-h d" #'octave-help
|
||
"C-h a" #'octave-lookfor
|
||
"C-c C-l" #'octave-source-file
|
||
"C-c C-f" #'octave-insert-defun
|
||
"C-c C-i l" #'octave-send-line
|
||
"C-c C-i b" #'octave-send-block
|
||
"C-c C-i f" #'octave-send-defun
|
||
"C-c C-i r" #'octave-send-region
|
||
"C-c C-i a" #'octave-send-buffer
|
||
"C-c C-i s" #'octave-show-process-buffer
|
||
"C-c C-i q" #'octave-hide-process-buffer
|
||
"C-c C-i k" #'octave-kill-process
|
||
"C-c C-i C-l" #'octave-send-line
|
||
"C-c C-i C-b" #'octave-send-block
|
||
"C-c C-i C-f" #'octave-send-defun
|
||
"C-c C-i C-r" #'octave-send-region
|
||
"C-c C-i C-a" #'octave-send-buffer
|
||
"C-c C-i C-s" #'octave-show-process-buffer
|
||
"C-c C-i C-q" #'octave-hide-process-buffer
|
||
"C-c C-i C-k" #'octave-kill-process)
|
||
|
||
(easy-menu-define octave-mode-menu octave-mode-map
|
||
"Menu for Octave mode."
|
||
'("Octave"
|
||
["Split Line at Point" octave-indent-new-comment-line t]
|
||
["Previous Code Line" octave-previous-code-line t]
|
||
["Next Code Line" octave-next-code-line t]
|
||
["Begin of Line" octave-beginning-of-line t]
|
||
["End of Line" octave-end-of-line t]
|
||
["Mark Block" octave-mark-block t]
|
||
["Close Block" smie-close-block t]
|
||
"---"
|
||
["Start Octave Process" run-octave t]
|
||
["Documentation Lookup" info-lookup-symbol t]
|
||
["Help on Function" octave-help t]
|
||
["Search help" octave-lookfor t]
|
||
["Find Function Definition" octave-find-definition t]
|
||
["Insert Function" octave-insert-defun t]
|
||
["Update Function File Comment" octave-update-function-file-comment t]
|
||
"---"
|
||
["Function Syntax Hints" (eldoc-mode 'toggle)
|
||
:style toggle :selected (bound-and-true-p eldoc-mode)
|
||
:help "Display function signatures after typing `SPC' or `('"]
|
||
["Delimiter Matching" show-paren-mode
|
||
:style toggle :selected show-paren-mode
|
||
:help "Highlight matched pairs such as `if ... end'"
|
||
:visible (fboundp 'smie--matching-block-data)]
|
||
["Auto Fill" auto-fill-mode
|
||
:style toggle :selected auto-fill-function
|
||
:help "Automatic line breaking"]
|
||
["Electric Layout" electric-layout-mode
|
||
:style toggle :selected electric-layout-mode
|
||
:help "Automatically insert newlines around some chars"]
|
||
"---"
|
||
("Debug"
|
||
["Send Current Line" octave-send-line t]
|
||
["Send Current Block" octave-send-block t]
|
||
["Send Current Function" octave-send-defun t]
|
||
["Send Region" octave-send-region t]
|
||
["Send Buffer" octave-send-buffer t]
|
||
["Source Current File" octave-source-file t]
|
||
["Show Process Buffer" octave-show-process-buffer t]
|
||
["Hide Process Buffer" octave-hide-process-buffer t]
|
||
["Kill Process" octave-kill-process t])
|
||
"---"
|
||
["Octave Mode Manual" (info "(octave-mode)Top") t]
|
||
["Customize Octave" (customize-group 'octave) t]
|
||
["Submit Bug Report" report-emacs-bug t]))
|
||
|
||
(defvar octave-mode-syntax-table
|
||
(let ((table (make-syntax-table)))
|
||
(modify-syntax-entry ?\r " " table)
|
||
(modify-syntax-entry ?+ "." table)
|
||
(modify-syntax-entry ?- "." table)
|
||
(modify-syntax-entry ?= "." table)
|
||
(modify-syntax-entry ?* "." table)
|
||
(modify-syntax-entry ?/ "." table)
|
||
(modify-syntax-entry ?> "." table)
|
||
(modify-syntax-entry ?< "." table)
|
||
(modify-syntax-entry ?& "." table)
|
||
(modify-syntax-entry ?| "." table)
|
||
(modify-syntax-entry ?! "." table)
|
||
(modify-syntax-entry ?\\ "." table)
|
||
(modify-syntax-entry ?\' "." table)
|
||
(modify-syntax-entry ?\` "." table)
|
||
(modify-syntax-entry ?. "." table)
|
||
(modify-syntax-entry ?\" "\"" table)
|
||
(modify-syntax-entry ?_ "_" table)
|
||
;; The "b" flag only applies to the second letter of the comstart and
|
||
;; the first letter of the comend, i.e. a "4b" below would be ineffective.
|
||
;; If we try to put `b' on the single-line comments, we get a similar
|
||
;; problem where the % and # chars appear as first chars of the 2-char
|
||
;; comend, so the multi-line ender is also turned into style-b.
|
||
;; So we need the new "c" comment style.
|
||
(modify-syntax-entry ?\% "< 13" table)
|
||
(modify-syntax-entry ?\# "< 13" table)
|
||
(modify-syntax-entry ?\{ "(} 2c" table)
|
||
(modify-syntax-entry ?\} "){ 4c" table)
|
||
(modify-syntax-entry ?\n ">" table)
|
||
table)
|
||
"Syntax table in use in `octave-mode' buffers.")
|
||
|
||
(defcustom octave-font-lock-texinfo-comment t
|
||
"Control whether to highlight the texinfo comment block."
|
||
:type 'boolean
|
||
:version "24.4")
|
||
|
||
(defcustom octave-blink-matching-block t
|
||
"Control the blinking of matching Octave block keywords.
|
||
Non-nil means show matching begin of block when inserting a space,
|
||
newline or semicolon after an else or end keyword."
|
||
:type 'boolean)
|
||
|
||
(defcustom octave-block-offset 2
|
||
"Extra indentation applied to statements in Octave block structures."
|
||
:type 'integer
|
||
:safe #'integerp)
|
||
|
||
(defvar octave-block-comment-start
|
||
(concat (make-string 2 octave-comment-char) " ")
|
||
"String to insert to start a new Octave comment on an empty line.")
|
||
|
||
(defcustom octave-continuation-offset 4
|
||
"Extra indentation applied to Octave continuation lines."
|
||
:type 'integer)
|
||
|
||
(eval-and-compile
|
||
(defconst octave-continuation-marker-regexp "\\\\\\|\\.\\.\\."))
|
||
|
||
(defvar octave-continuation-regexp
|
||
(concat "[^#%\n]*\\(" octave-continuation-marker-regexp
|
||
"\\)\\s-*\\(\\s<.*\\)?$"))
|
||
|
||
(defconst octave-continuation-string "..."
|
||
"Character string used for Octave continuation lines.
|
||
Joins current line with following line, except within
|
||
double-quoted strings, where `octave-string-continuation-marker'
|
||
is used instead.")
|
||
|
||
(defconst octave-string-continuation-marker "\\"
|
||
"Line continuation marker for double-quoted Octave strings.
|
||
Non-string statements use `octave-continuation-string'.")
|
||
|
||
(defvar octave-mode-imenu-generic-expression
|
||
(list
|
||
;; Functions
|
||
(list nil octave-function-header-regexp 3))
|
||
"Imenu expression for Octave mode. See `imenu-generic-expression'.")
|
||
|
||
(defcustom octave-mode-hook nil
|
||
"Hook to be run when Octave mode is started."
|
||
:type 'hook)
|
||
|
||
(defcustom octave-send-show-buffer t
|
||
"Non-nil means display `inferior-octave-buffer' after sending to it."
|
||
:type 'boolean)
|
||
|
||
(defcustom octave-send-line-auto-forward t
|
||
"Control auto-forward after sending to the inferior Octave process.
|
||
Non-nil means always go to the next Octave code line after sending."
|
||
:type 'boolean)
|
||
|
||
(defcustom octave-send-echo-input t
|
||
"Non-nil means echo input sent to the inferior Octave process."
|
||
:type 'boolean)
|
||
|
||
|
||
;;; SMIE indentation
|
||
|
||
(require 'smie)
|
||
|
||
(let-when-compile
|
||
((operator-table
|
||
;; Use '__operators__' in Octave REPL to get a full list?
|
||
'((assoc ";" "\n") (assoc ",") ;The doc says they have equal precedence!?
|
||
(right "=" "+=" "-=" "*=" "/=")
|
||
(assoc "&&") (assoc "||") ; The doc claims they have equal precedence!?
|
||
(assoc "&") (assoc "|") ; The doc claims they have equal precedence!?
|
||
(nonassoc "<" "<=" "==" ">=" ">" "!=" "~=")
|
||
(nonassoc ":") ;No idea what this is.
|
||
(assoc "+" "-")
|
||
(assoc "*" "/" "\\" ".\\" ".*" "./")
|
||
(nonassoc "'" ".'")
|
||
(nonassoc "++" "--" "!" "~") ;And unary "+" and "-".
|
||
(right "^" "**" ".^" ".**")
|
||
;; It's not really an operator, but for indentation purposes it
|
||
;; could be convenient to treat it as one.
|
||
(assoc "...")))
|
||
|
||
(matchedrules
|
||
;; We can't distinguish the first element in a sequence with
|
||
;; precedence grammars, so we can't distinguish the condition
|
||
;; of the `if' from the subsequent body, for example.
|
||
;; This has to be done later in the indentation rules.
|
||
'(("try" exp "catch" exp "end_try_catch")
|
||
("unwind_protect" exp
|
||
"unwind_protect_cleanup" exp "end_unwind_protect")
|
||
("for" exp "endfor")
|
||
("parfor" exp "endparfor")
|
||
("while" exp "endwhile")
|
||
("if" exp "endif")
|
||
("if" exp "else" exp "endif")
|
||
("if" exp "elseif" exp "else" exp "endif")
|
||
("if" exp "elseif" exp "elseif" exp "else" exp "endif")
|
||
("switch" exp "case" exp "endswitch")
|
||
("switch" exp "case" exp "otherwise" exp "endswitch")
|
||
("switch" exp "case" exp "case" exp "otherwise" exp "endswitch")
|
||
("function" exp "endfunction")
|
||
("enumeration" exp "endenumeration")
|
||
("events" exp "endevents")
|
||
("methods" exp "endmethods")
|
||
("properties" exp "endproperties")
|
||
("classdef" exp "endclassdef")
|
||
("spmd" exp "endspmd")
|
||
))
|
||
|
||
(bnf-table
|
||
`((atom)
|
||
;; FIXME: We don't parse these declarations correctly since
|
||
;; SMIE *really* likes to parse "a b = 2 c" as "(a b) = (2 c)".
|
||
;; IOW to do it right, we'd need to change octave-smie-*ward-token
|
||
;; so that the spaces between vars in var-decls are lexed as
|
||
;; something like ",".
|
||
;; Doesn't seem worth the trouble/slowdown for now.
|
||
;; We could hack smie-rules so as to work around the bad parse,
|
||
;; but even that doesn't seem worth the trouble.
|
||
(var-decls (atom "=" atom)) ;; (var-decls "," var-decls)
|
||
(single-exp (atom "=" atom))
|
||
(exp (exp "\n" exp)
|
||
;; We need to mention at least one of the operators in this part
|
||
;; of the grammar: if the BNF and the operator table have
|
||
;; no overlap, SMIE can't know how they relate.
|
||
(exp ";" exp)
|
||
("do" exp "until" single-exp)
|
||
,@matchedrules
|
||
;; For every rule that ends in "endfoo", add a corresponding
|
||
;; rule which uses "end" instead.
|
||
,@(mapcar (lambda (rule) (nconc (butlast rule) '("end")))
|
||
matchedrules)
|
||
("global" var-decls) ("persistent" var-decls)
|
||
;; These aren't super-important, but having them here
|
||
;; makes it easier to extract all keywords.
|
||
("break") ("continue") ("return")
|
||
;; The following rules do not correspond to valid code AFAIK,
|
||
;; but they lead to a grammar that degrades more gracefully
|
||
;; on incomplete/incorrect code. It also helps us in
|
||
;; computing octave--block-offset-keywords.
|
||
("try" exp "end") ("unwind_protect" exp "end")
|
||
)
|
||
;; (fundesc (atom "=" atom))
|
||
)))
|
||
|
||
(defconst octave-smie-grammar
|
||
(eval-when-compile
|
||
(smie-prec2->grammar
|
||
(smie-merge-prec2s
|
||
(smie-bnf->prec2 bnf-table '((assoc "\n" ";")))
|
||
(smie-precs->prec2 operator-table)))))
|
||
|
||
(defconst octave-operator-regexp
|
||
(eval-when-compile
|
||
(regexp-opt (remove "\n" (apply #'append
|
||
(mapcar #'cdr operator-table)))))))
|
||
|
||
;; Tokenizing needs to be refined so that ";;" is treated as two
|
||
;; tokens and also so as to recognize the \n separator (and
|
||
;; corresponding continuation lines).
|
||
|
||
(defun octave-smie--funcall-p ()
|
||
"Return non-nil if we're in an expression context. Move point."
|
||
(looking-at "[ \t]*("))
|
||
|
||
(defun octave-smie--end-index-p ()
|
||
(let ((ppss (syntax-ppss)))
|
||
(and (nth 1 ppss)
|
||
(memq (char-after (nth 1 ppss)) '(?\( ?\[ ?\{)))))
|
||
|
||
(defun octave-smie--in-parens-p ()
|
||
(let ((ppss (syntax-ppss)))
|
||
(and (nth 1 ppss)
|
||
(eq ?\( (char-after (nth 1 ppss))))))
|
||
|
||
(defun octave-smie-backward-token ()
|
||
(let ((pos (point)))
|
||
(forward-comment (- (point)))
|
||
(cond
|
||
((and (not (eq (char-before) ?\;)) ;Coalesce ";" and "\n".
|
||
(> pos (line-end-position))
|
||
(if (looking-back octave-continuation-marker-regexp (- (point) 3))
|
||
(progn
|
||
(goto-char (match-beginning 0))
|
||
(forward-comment (- (point)))
|
||
nil)
|
||
t)
|
||
(not (octave-smie--in-parens-p)))
|
||
(skip-chars-forward " \t")
|
||
;; Why bother distinguishing \n and ;?
|
||
";") ;;"\n"
|
||
((and (looking-back octave-operator-regexp (- (point) 3) 'greedy)
|
||
;; Don't mistake a string quote for a transpose.
|
||
(not (looking-back "\\s\"" (1- (point)))))
|
||
(goto-char (match-beginning 0))
|
||
(match-string-no-properties 0))
|
||
(t
|
||
(let ((tok (smie-default-backward-token)))
|
||
(cond
|
||
((equal tok "enumeration")
|
||
(if (save-excursion (smie-default-forward-token)
|
||
(octave-smie--funcall-p))
|
||
"enumeration (function)"
|
||
tok))
|
||
((equal tok "end") (if (octave-smie--end-index-p) "end (index)" tok))
|
||
(t tok)))))))
|
||
|
||
(defun octave-smie-forward-token ()
|
||
(skip-chars-forward " \t")
|
||
(when (looking-at (eval-when-compile
|
||
(concat "\\(" octave-continuation-marker-regexp
|
||
"\\)[ \t]*\\($\\|[%#]\\)")))
|
||
(goto-char (match-end 1))
|
||
(forward-comment 1))
|
||
(cond
|
||
((and (looking-at "[%#\n]")
|
||
(not (or (save-excursion (skip-chars-backward " \t")
|
||
;; Only add implicit ; when needed.
|
||
(or (bolp) (eq (char-before) ?\;)))
|
||
(octave-smie--in-parens-p))))
|
||
(if (eolp) (forward-char 1) (forward-comment 1))
|
||
;; Why bother distinguishing \n and ;?
|
||
";") ;;"\n"
|
||
((progn (forward-comment (point-max)) nil))
|
||
((looking-at ";[ \t]*\\($\\|[%#]\\)")
|
||
;; Combine the ; with the subsequent \n.
|
||
(goto-char (match-beginning 1))
|
||
(forward-comment 1)
|
||
";")
|
||
((and (looking-at octave-operator-regexp)
|
||
;; Don't mistake a string quote for a transpose.
|
||
(not (looking-at "\\s\"")))
|
||
(goto-char (match-end 0))
|
||
(match-string-no-properties 0))
|
||
(t
|
||
(let ((tok (smie-default-forward-token)))
|
||
(cond
|
||
((equal tok "enumeration")
|
||
(if (octave-smie--funcall-p)
|
||
"enumeration (function)"
|
||
tok))
|
||
((equal tok "end") (if (octave-smie--end-index-p) "end (index)" tok))
|
||
(t tok))))))
|
||
|
||
(defconst octave--block-offset-keywords
|
||
(let* ((end-prec (nth 1 (assoc "end" octave-smie-grammar)))
|
||
(end-matchers
|
||
(delq nil
|
||
(mapcar (lambda (x) (if (eq end-prec (nth 2 x)) (car x)))
|
||
octave-smie-grammar))))
|
||
;; Not sure if it would harm to keep "switch", but the previous code
|
||
;; excluded it, presumably because there shouldn't be any code on
|
||
;; the lines between "switch" and "case".
|
||
(delete "switch" end-matchers)))
|
||
|
||
(defun octave-smie-rules (kind token)
|
||
(pcase (cons kind token)
|
||
;; We could set smie-indent-basic instead, but that would have two
|
||
;; disadvantages:
|
||
;; - changes to octave-block-offset wouldn't take effect immediately.
|
||
;; - edebug wouldn't show the use of this variable.
|
||
('(:elem . basic) octave-block-offset)
|
||
(`(:list-intro . ,(or "global" "persistent")) t)
|
||
;; Since "case" is in the same BNF rules as switch..end, SMIE by default
|
||
;; aligns it with "switch".
|
||
('(:before . "case") (if (not (smie-rule-sibling-p)) octave-block-offset))
|
||
('(:after . ";")
|
||
(if (apply #'smie-rule-parent-p octave--block-offset-keywords)
|
||
(smie-rule-parent octave-block-offset)
|
||
;; For (invalid) code between switch and case.
|
||
;; (if (smie-rule-parent-p "switch") 4)
|
||
nil))
|
||
('(:after . "=") (smie-rule-parent octave-block-offset))))
|
||
|
||
(defun octave-indent-comment ()
|
||
"A function for `smie-indent-functions' (which see)."
|
||
(save-excursion
|
||
(back-to-indentation)
|
||
(cond
|
||
((octave-in-string-or-comment-p) nil)
|
||
((looking-at-p "\\(\\s<\\)\\1\\{2,\\}")
|
||
0)
|
||
;; Exclude %{, %} and %!.
|
||
((and (looking-at-p "\\s<\\(?:[^{}!]\\|$\\)")
|
||
(not (looking-at-p "\\(\\s<\\)\\1")))
|
||
(comment-choose-indent)))))
|
||
|
||
|
||
(defvar octave-reserved-words
|
||
(delq nil
|
||
(mapcar (lambda (x)
|
||
(setq x (car x))
|
||
(and (stringp x) (string-match "\\`[[:alpha:]]" x) x))
|
||
octave-smie-grammar))
|
||
"Reserved words in Octave.")
|
||
|
||
(defvar octave-font-lock-keywords
|
||
(list
|
||
;; Fontify all builtin keywords.
|
||
(cons (concat "\\_<" (regexp-opt octave-reserved-words) "\\_>")
|
||
'font-lock-keyword-face)
|
||
;; Note: 'end' also serves as the last index in an indexing expression,
|
||
;; and 'enumerate' is also a function.
|
||
;; Ref: https://www.mathworks.com/help/matlab/ref/end.html
|
||
;; Ref: https://www.mathworks.com/help/matlab/ref/enumeration.html
|
||
(list (lambda (limit)
|
||
(while (re-search-forward "\\_<en\\(?:d\\|umeratio\\(n\\)\\)\\_>"
|
||
limit 'move)
|
||
(let ((beg (match-beginning 0))
|
||
(end (match-end 0)))
|
||
(unless (octave-in-string-or-comment-p)
|
||
(when (if (match-end 1)
|
||
(octave-smie--funcall-p)
|
||
(octave-smie--end-index-p))
|
||
(put-text-property beg end 'face nil)))))
|
||
nil))
|
||
;; Fontify all operators.
|
||
(cons octave-operator-regexp 'font-lock-builtin-face)
|
||
;; Fontify all function declarations.
|
||
(list octave-function-header-regexp
|
||
'(1 font-lock-keyword-face)
|
||
'(3 font-lock-function-name-face nil t)))
|
||
"Additional Octave expressions to highlight.")
|
||
|
||
(defun octave-syntax-propertize-function (start end)
|
||
(goto-char start)
|
||
(octave-syntax-propertize-sqs end)
|
||
(funcall (syntax-propertize-rules
|
||
("\\\\" (0 (when (eq (nth 3 (save-excursion
|
||
(syntax-ppss (match-beginning 0))))
|
||
?\")
|
||
(string-to-syntax "\\"))))
|
||
;; Try to distinguish the string-quotes from the transpose-quotes.
|
||
("\\(?:^\\|[[({,; ]\\)\\('\\)"
|
||
(1 (prog1 "\"'" (octave-syntax-propertize-sqs end)))))
|
||
(point) end))
|
||
|
||
(defun octave-syntax-propertize-sqs (end)
|
||
"Propertize the content/end of single-quote strings."
|
||
(when (eq (nth 3 (syntax-ppss)) ?\')
|
||
;; A '..' string.
|
||
(when (re-search-forward
|
||
"\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move)
|
||
(goto-char (match-beginning 2))
|
||
(when (eq (char-before (match-beginning 1)) ?\\)
|
||
;; Backslash cannot escape a single quote.
|
||
(put-text-property (1- (match-beginning 1)) (match-beginning 1)
|
||
'syntax-table (string-to-syntax ".")))
|
||
(put-text-property (match-beginning 1) (match-end 1)
|
||
'syntax-table (string-to-syntax "\"'")))))
|
||
|
||
(defvar electric-layout-rules)
|
||
|
||
;; FIXME: cc-mode.el also adds an entry for .m files, mapping them to
|
||
;; objc-mode. We here rely on the fact that loaddefs.el is filled in
|
||
;; alphabetical order, so cc-mode.el comes before octave-mode.el, which lets
|
||
;; our entry come first!
|
||
;;;###autoload (add-to-list 'auto-mode-alist '("\\.m\\'" . octave-maybe-mode))
|
||
|
||
;;;###autoload
|
||
(defun octave-maybe-mode ()
|
||
"Select `octave-mode' if the current buffer seems to hold Octave code."
|
||
(if (save-excursion
|
||
(with-syntax-table octave-mode-syntax-table
|
||
(goto-char (point-min))
|
||
(forward-comment (point-max))
|
||
;; FIXME: What about Octave files which don't start with "function"?
|
||
(looking-at "function")))
|
||
(octave-mode)
|
||
(let ((x (rassq 'octave-maybe-mode auto-mode-alist)))
|
||
(when x
|
||
(let ((auto-mode-alist (remove x auto-mode-alist)))
|
||
(set-auto-mode))))))
|
||
|
||
;;;###autoload
|
||
(define-derived-mode octave-mode prog-mode "Octave"
|
||
"Major mode for editing Octave code.
|
||
|
||
Octave is a high-level language, primarily intended for numerical
|
||
computations. It provides a convenient command line interface
|
||
for solving linear and nonlinear problems numerically. Function
|
||
definitions can also be stored in files and used in batch mode.
|
||
|
||
See Info node `(octave-mode) Using Octave Mode' for more details.
|
||
|
||
Key bindings:
|
||
\\{octave-mode-map}"
|
||
:abbrev-table octave-abbrev-table
|
||
:group 'octave
|
||
|
||
(smie-setup octave-smie-grammar #'octave-smie-rules
|
||
:forward-token #'octave-smie-forward-token
|
||
:backward-token #'octave-smie-backward-token)
|
||
(setq-local smie-indent-basic 'octave-block-offset)
|
||
(add-hook 'smie-indent-functions #'octave-indent-comment nil t)
|
||
|
||
(setq-local smie-blink-matching-triggers
|
||
(cons ?\; smie-blink-matching-triggers))
|
||
(unless octave-blink-matching-block
|
||
(remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local))
|
||
|
||
(setq-local electric-indent-chars
|
||
(cons ?\; electric-indent-chars))
|
||
;; IIUC matlab-mode takes the opposite approach: it makes RET insert
|
||
;; a ";" at those places where it's correct (i.e. outside of parens).
|
||
(setq-local electric-layout-rules '((?\; . after)))
|
||
|
||
(setq-local comment-use-syntax t)
|
||
(setq-local comment-start octave-comment-start)
|
||
(setq-local comment-end "")
|
||
(setq-local comment-start-skip octave-comment-start-skip)
|
||
(setq-local comment-add 1)
|
||
|
||
(setq-local parse-sexp-ignore-comments t)
|
||
(setq-local paragraph-start (concat "\\s-*$\\|" page-delimiter))
|
||
(setq-local paragraph-separate paragraph-start)
|
||
(setq-local paragraph-ignore-fill-prefix t)
|
||
(setq-local fill-paragraph-function 'octave-fill-paragraph)
|
||
|
||
(setq-local fill-nobreak-predicate
|
||
(lambda () (eq (octave-in-string-p) ?')))
|
||
(add-function :around (local 'comment-line-break-function)
|
||
#'octave--indent-new-comment-line)
|
||
|
||
(setq font-lock-defaults '(octave-font-lock-keywords))
|
||
|
||
(setq-local syntax-propertize-function #'octave-syntax-propertize-function)
|
||
|
||
(setq-local imenu-generic-expression octave-mode-imenu-generic-expression)
|
||
(setq-local imenu-case-fold-search nil)
|
||
|
||
(setq-local add-log-current-defun-function #'octave-add-log-current-defun)
|
||
|
||
(add-hook 'completion-at-point-functions 'octave-completion-at-point nil t)
|
||
(add-hook 'before-save-hook 'octave-sync-function-file-names nil t)
|
||
(setq-local beginning-of-defun-function 'octave-beginning-of-defun)
|
||
(and octave-font-lock-texinfo-comment (octave-font-lock-texinfo-comment))
|
||
(add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t))
|
||
|
||
|
||
(defcustom inferior-octave-program "octave"
|
||
"Program invoked by `inferior-octave'."
|
||
:type 'string)
|
||
|
||
(defcustom inferior-octave-buffer "*Inferior Octave*"
|
||
"Name of buffer for running an inferior Octave process."
|
||
:type 'string)
|
||
|
||
(defcustom inferior-octave-prompt
|
||
;; For Octave >= 3.8, default is always 'octave', see
|
||
;; https://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50
|
||
"\\(?:^octave\\(?:.bin\\|.exe\\)?\\(?:-[.0-9]+\\)?\\(?::[0-9]+\\)?\\|^debug\\|^\\)>+ "
|
||
"Regexp to match prompts for the inferior Octave process."
|
||
:type 'regexp)
|
||
|
||
(defcustom inferior-octave-prompt-read-only comint-prompt-read-only
|
||
"If non-nil, the Octave prompt is read only.
|
||
See `comint-prompt-read-only' for details."
|
||
:type 'boolean
|
||
:version "24.4")
|
||
|
||
(defcustom inferior-octave-startup-file
|
||
(let ((n (file-name-nondirectory inferior-octave-program)))
|
||
(locate-user-emacs-file (format "init_%s.m" n) (format ".emacs-%s" n)))
|
||
"Name of the inferior Octave startup file.
|
||
The contents of this file are sent to the inferior Octave process on
|
||
startup."
|
||
:type '(choice (const :tag "None" nil) file)
|
||
:version "24.4")
|
||
|
||
(defcustom inferior-octave-startup-args '("-i" "--no-line-editing")
|
||
"List of command line arguments for the inferior Octave process.
|
||
For example, for suppressing the startup message and using `traditional'
|
||
mode, include \"-q\" and \"--traditional\"."
|
||
:type '(repeat string)
|
||
:version "24.4")
|
||
|
||
(define-obsolete-variable-alias 'inferior-octave-startup-hook
|
||
'inferior-octave-mode-hook "24.4")
|
||
|
||
(defcustom inferior-octave-mode-hook nil
|
||
"Hook to be run when Inferior Octave mode is started."
|
||
:type 'hook)
|
||
|
||
(defcustom inferior-octave-error-regexp-alist
|
||
'(("error:\\s-*\\(.*?\\) at line \\([0-9]+\\), column \\([0-9]+\\)"
|
||
1 2 3 2 1)
|
||
("warning:\\s-*\\([^:\n]+\\):.*at line \\([0-9]+\\), column \\([0-9]+\\)"
|
||
1 2 3 1 1))
|
||
"Value for `compilation-error-regexp-alist' in inferior octave."
|
||
:version "24.4"
|
||
:type '(repeat (choice (symbol :tag "Predefined symbol")
|
||
(sexp :tag "Error specification"))))
|
||
|
||
(defvar inferior-octave-compilation-font-lock-keywords
|
||
'(("\\_<PASS\\_>" . compilation-info-face)
|
||
("\\_<FAIL\\_>" . compilation-error-face)
|
||
("\\_<\\(warning\\):" 1 compilation-warning-face)
|
||
("\\_<\\(error\\):" 1 compilation-error-face)
|
||
("^\\s-*!!!!!.*\\|^.*failed$" . compilation-error-face))
|
||
"Value for `compilation-mode-font-lock-keywords' in inferior octave.")
|
||
|
||
(defvar inferior-octave-process nil)
|
||
|
||
(defvar inferior-octave-mode-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(set-keymap-parent map comint-mode-map)
|
||
(define-key map "\M-." 'octave-find-definition)
|
||
(define-key map "\t" 'completion-at-point)
|
||
(define-key map "\C-hd" 'octave-help)
|
||
(define-key map "\C-ha" 'octave-lookfor)
|
||
;; Same as in `shell-mode'.
|
||
(define-key map "\M-?" 'comint-dynamic-list-filename-completions)
|
||
(define-key map "\C-c\C-l" 'inferior-octave-dynamic-list-input-ring)
|
||
(define-key map [menu-bar inout list-history]
|
||
'("List Input History" . inferior-octave-dynamic-list-input-ring))
|
||
map)
|
||
"Keymap used in Inferior Octave mode.")
|
||
|
||
(defvar inferior-octave-mode-syntax-table
|
||
(let ((table (make-syntax-table octave-mode-syntax-table)))
|
||
table)
|
||
"Syntax table in use in `inferior-octave-mode' buffers.")
|
||
|
||
(defvar inferior-octave-font-lock-keywords
|
||
(list
|
||
(cons inferior-octave-prompt 'font-lock-type-face))
|
||
;; Could certainly do more font locking in inferior Octave ...
|
||
"Additional expressions to highlight in Inferior Octave mode.")
|
||
|
||
(defvar inferior-octave-output-list nil)
|
||
(defvar inferior-octave-output-string nil)
|
||
(defvar inferior-octave-receive-in-progress nil)
|
||
|
||
(defvar inferior-octave-dynamic-complete-functions
|
||
'(inferior-octave-completion-at-point comint-filename-completion)
|
||
"List of functions called to perform completion for inferior Octave.
|
||
This variable is used to initialize `comint-dynamic-complete-functions'
|
||
in the Inferior Octave buffer.")
|
||
|
||
(defvar info-lookup-mode)
|
||
(defvar compilation-error-regexp-alist)
|
||
(defvar compilation-mode-font-lock-keywords)
|
||
|
||
(declare-function compilation-forget-errors "compile" ())
|
||
|
||
(defun inferior-octave-process-live-p ()
|
||
(process-live-p inferior-octave-process))
|
||
|
||
(define-derived-mode inferior-octave-mode comint-mode "Inferior Octave"
|
||
"Major mode for interacting with an inferior Octave process.
|
||
|
||
See Info node `(octave-mode) Running Octave from Within Emacs' for more
|
||
details.
|
||
|
||
Key bindings:
|
||
\\{inferior-octave-mode-map}"
|
||
:abbrev-table octave-abbrev-table
|
||
:group 'octave
|
||
|
||
(setq comint-prompt-regexp inferior-octave-prompt)
|
||
|
||
(setq-local comment-use-syntax t)
|
||
(setq-local comment-start octave-comment-start)
|
||
(setq-local comment-end "")
|
||
(setq comment-column 32)
|
||
(setq-local comment-start-skip octave-comment-start-skip)
|
||
|
||
(setq font-lock-defaults '(inferior-octave-font-lock-keywords nil nil))
|
||
|
||
(setq-local info-lookup-mode 'octave-mode)
|
||
(add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t)
|
||
|
||
(setq-local comint-input-ring-file-name
|
||
(or (getenv "OCTAVE_HISTFILE") "~/.octave_hist"))
|
||
(setq-local comint-input-ring-size
|
||
(string-to-number (or (getenv "OCTAVE_HISTSIZE") "1024")))
|
||
(comint-read-input-ring t)
|
||
(setq-local comint-dynamic-complete-functions
|
||
inferior-octave-dynamic-complete-functions)
|
||
(setq-local comint-prompt-read-only inferior-octave-prompt-read-only)
|
||
(add-hook 'comint-input-filter-functions
|
||
'inferior-octave-directory-tracker nil t)
|
||
;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572
|
||
(add-hook 'window-configuration-change-hook
|
||
'inferior-octave-track-window-width-change nil t)
|
||
(setq-local compilation-error-regexp-alist inferior-octave-error-regexp-alist)
|
||
(setq-local compilation-mode-font-lock-keywords
|
||
inferior-octave-compilation-font-lock-keywords)
|
||
(compilation-shell-minor-mode 1)
|
||
(compilation-forget-errors))
|
||
|
||
;;;###autoload
|
||
(defun inferior-octave (&optional arg)
|
||
"Run an inferior Octave process, I/O via `inferior-octave-buffer'.
|
||
This buffer is put in Inferior Octave mode. See `inferior-octave-mode'.
|
||
|
||
Unless ARG is non-nil, switches to this buffer.
|
||
|
||
The elements of the list `inferior-octave-startup-args' are sent as
|
||
command line arguments to the inferior Octave process on startup.
|
||
|
||
Additional commands to be executed on startup can be provided either in
|
||
the file specified by `inferior-octave-startup-file' or by the default
|
||
startup file, `~/.emacs-octave'."
|
||
(interactive "P")
|
||
(let ((buffer (get-buffer-create inferior-octave-buffer)))
|
||
(unless arg
|
||
(pop-to-buffer buffer))
|
||
(unless (comint-check-proc buffer)
|
||
(with-current-buffer buffer
|
||
(inferior-octave-startup)
|
||
(inferior-octave-mode)))
|
||
buffer))
|
||
|
||
;;;###autoload
|
||
(defalias 'run-octave 'inferior-octave)
|
||
|
||
(defun inferior-octave-startup ()
|
||
"Start an inferior Octave process."
|
||
(let ((proc (comint-exec-1
|
||
(substring inferior-octave-buffer 1 -1)
|
||
inferior-octave-buffer
|
||
inferior-octave-program
|
||
(append
|
||
inferior-octave-startup-args
|
||
;; --no-gui is introduced in Octave > 3.7
|
||
(and (not (member "--no-gui" inferior-octave-startup-args))
|
||
(zerop (process-file inferior-octave-program
|
||
nil nil nil "--no-gui" "--help"))
|
||
'("--no-gui"))))))
|
||
(set-process-filter proc 'inferior-octave-output-digest)
|
||
(setq inferior-octave-process proc
|
||
inferior-octave-output-list nil
|
||
inferior-octave-output-string nil
|
||
inferior-octave-receive-in-progress t)
|
||
|
||
;; This may look complicated ... However, we need to make sure that
|
||
;; we additional startup code only AFTER Octave is ready (otherwise,
|
||
;; output may be mixed up). Hence, we need to digest the Octave
|
||
;; output to see when it issues a prompt.
|
||
(while inferior-octave-receive-in-progress
|
||
(unless (inferior-octave-process-live-p)
|
||
;; Spit out the error messages.
|
||
(when inferior-octave-output-list
|
||
(princ (concat (mapconcat 'identity inferior-octave-output-list "\n")
|
||
"\n")
|
||
(process-mark inferior-octave-process)))
|
||
(error "Process `%s' died" inferior-octave-process))
|
||
(accept-process-output inferior-octave-process))
|
||
(goto-char (point-max))
|
||
(set-marker (process-mark proc) (point))
|
||
(insert-before-markers
|
||
(concat
|
||
(if (not (bobp)) " \n")
|
||
(if inferior-octave-output-list
|
||
(concat (mapconcat
|
||
'identity inferior-octave-output-list "\n")
|
||
"\n"))))
|
||
|
||
;; An empty secondary prompt, as e.g. obtained by '--braindead',
|
||
;; means trouble.
|
||
(inferior-octave-send-list-and-digest (list "PS2\n"))
|
||
(when (string-match "\\(PS2\\|ans\\) = *$"
|
||
(car inferior-octave-output-list))
|
||
(inferior-octave-send-list-and-digest (list "PS2 ('> ');\n")))
|
||
|
||
(inferior-octave-send-list-and-digest
|
||
(list "disp (getenv ('OCTAVE_SRCDIR'))\n"))
|
||
(process-put proc 'octave-srcdir
|
||
(unless (equal (car inferior-octave-output-list) "")
|
||
(car inferior-octave-output-list)))
|
||
|
||
;; O.K., now we are ready for the Inferior Octave startup commands.
|
||
(inferior-octave-send-list-and-digest
|
||
(list "more off;\n"
|
||
(unless (equal inferior-octave-output-string ">> ")
|
||
;; See https://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50
|
||
"PS1 ('octave> ');\n")
|
||
(when (and inferior-octave-startup-file
|
||
(file-exists-p inferior-octave-startup-file))
|
||
(format "source ('%s');\n" inferior-octave-startup-file))))
|
||
(when inferior-octave-output-list
|
||
(insert-before-markers
|
||
(mapconcat 'identity inferior-octave-output-list "\n")))
|
||
|
||
;; And finally, everything is back to normal.
|
||
(set-process-filter proc 'comint-output-filter)
|
||
;; Just in case, to be sure a cd in the startup file won't have
|
||
;; detrimental effects.
|
||
(with-demoted-errors "Octave resync error: %S"
|
||
(inferior-octave-resync-dirs))
|
||
;; Generate a proper prompt, which is critical to
|
||
;; `comint-history-isearch-backward-regexp'. Bug#14433.
|
||
(comint-send-string proc "\n")))
|
||
|
||
(defun inferior-octave-completion-table ()
|
||
(completion-table-with-cache
|
||
(lambda (command)
|
||
(inferior-octave-send-list-and-digest
|
||
(list (format "completion_matches ('%s');\n" command)))
|
||
(delete-consecutive-dups
|
||
(sort inferior-octave-output-list 'string-lessp)))))
|
||
|
||
(defun inferior-octave-completion-at-point ()
|
||
"Return the data to complete the Octave symbol at point."
|
||
;; https://debbugs.gnu.org/14300
|
||
(unless (string-search "/" (or (comint--match-partial-filename) ""))
|
||
(let ((beg (save-excursion
|
||
(skip-syntax-backward "w_" (comint-line-beginning-position))
|
||
(point)))
|
||
(end (point)))
|
||
(when (and beg (> end beg))
|
||
(list beg end (completion-table-in-turn
|
||
(inferior-octave-completion-table)
|
||
'comint-completion-file-name-table))))))
|
||
|
||
(defun inferior-octave-dynamic-list-input-ring ()
|
||
"List the buffer's input history in a help buffer."
|
||
;; We cannot use `comint-dynamic-list-input-ring', because it replaces
|
||
;; "completion" by "history reference" ...
|
||
(interactive)
|
||
(if (or (not (ring-p comint-input-ring))
|
||
(ring-empty-p comint-input-ring))
|
||
(message "No history")
|
||
(let ((history nil)
|
||
(history-buffer " *Input History*")
|
||
(index (1- (ring-length comint-input-ring)))
|
||
(conf (current-window-configuration)))
|
||
;; We have to build up a list ourselves from the ring vector.
|
||
(while (>= index 0)
|
||
(setq history (cons (ring-ref comint-input-ring index) history)
|
||
index (1- index)))
|
||
;; Change "completion" to "history reference"
|
||
;; to make the display accurate.
|
||
(with-output-to-temp-buffer history-buffer
|
||
(display-completion-list history)
|
||
(set-buffer history-buffer))
|
||
(message "Hit space to flush")
|
||
(let ((ch (read-event)))
|
||
(if (eq ch ?\ )
|
||
(set-window-configuration conf)
|
||
(push ch unread-command-events))))))
|
||
|
||
(defun inferior-octave-output-digest (_proc string)
|
||
"Special output filter for the inferior Octave process.
|
||
Save all output between newlines into `inferior-octave-output-list', and
|
||
the rest to `inferior-octave-output-string'."
|
||
(setq string (concat inferior-octave-output-string string))
|
||
(while (string-match "\n" string)
|
||
(setq inferior-octave-output-list
|
||
(append inferior-octave-output-list
|
||
(list (substring string 0 (match-beginning 0))))
|
||
string (substring string (match-end 0))))
|
||
(if (string-match inferior-octave-prompt string)
|
||
(setq inferior-octave-receive-in-progress nil))
|
||
(setq inferior-octave-output-string string))
|
||
|
||
(defun inferior-octave-check-process ()
|
||
(or (inferior-octave-process-live-p)
|
||
(error (substitute-command-keys
|
||
"No inferior octave process running. Type \\[run-octave]"))))
|
||
|
||
(defun inferior-octave-send-list-and-digest (list)
|
||
"Send LIST to the inferior Octave process and digest the output.
|
||
The elements of LIST have to be strings and are sent one by one. All
|
||
output is passed to the filter `inferior-octave-output-digest'."
|
||
(inferior-octave-check-process)
|
||
(let* ((proc inferior-octave-process)
|
||
(filter (process-filter proc))
|
||
string)
|
||
(set-process-filter proc 'inferior-octave-output-digest)
|
||
(setq inferior-octave-output-list nil)
|
||
(unwind-protect
|
||
(while (setq string (car list))
|
||
(setq inferior-octave-output-string nil
|
||
inferior-octave-receive-in-progress t)
|
||
(comint-send-string proc string)
|
||
(while inferior-octave-receive-in-progress
|
||
(accept-process-output proc))
|
||
(setq list (cdr list)))
|
||
(set-process-filter proc filter))))
|
||
|
||
(defvar-local inferior-octave-directory-tracker-resync nil)
|
||
|
||
(defun inferior-octave-directory-tracker (string)
|
||
"Tracks `cd' commands issued to the inferior Octave process.
|
||
Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused."
|
||
(when inferior-octave-directory-tracker-resync
|
||
(or (inferior-octave-resync-dirs 'noerror)
|
||
(setq inferior-octave-directory-tracker-resync nil)))
|
||
(cond
|
||
((string-match "^[ \t]*cd[ \t;]*$" string)
|
||
(cd "~"))
|
||
((string-match "^[ \t]*cd[ \t]+\\([^ \t\n;]*\\)[ \t\n;]*" string)
|
||
(condition-case err
|
||
(cd (match-string 1 string))
|
||
(error (setq inferior-octave-directory-tracker-resync t)
|
||
(message "%s: `%s'"
|
||
(error-message-string err)
|
||
(match-string 1 string)))))))
|
||
|
||
(defun inferior-octave-resync-dirs (&optional noerror)
|
||
"Resync the buffer's idea of the current directory.
|
||
This command queries the inferior Octave process about its current
|
||
directory and makes this the current buffer's default directory."
|
||
(interactive)
|
||
(inferior-octave-send-list-and-digest '("disp (pwd ())\n"))
|
||
(condition-case err
|
||
(progn
|
||
(cd (car inferior-octave-output-list))
|
||
t)
|
||
(error (unless noerror (signal (car err) (cdr err))))))
|
||
|
||
(defcustom inferior-octave-minimal-columns 80
|
||
"The minimal column width for the inferior Octave process."
|
||
:type 'integer
|
||
:version "24.4")
|
||
|
||
(defvar inferior-octave-last-column-width nil)
|
||
|
||
(defun inferior-octave-track-window-width-change ()
|
||
;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572
|
||
(let ((width (max inferior-octave-minimal-columns (window-width))))
|
||
(unless (eq inferior-octave-last-column-width width)
|
||
(setq-local inferior-octave-last-column-width width)
|
||
(when (inferior-octave-process-live-p)
|
||
(inferior-octave-send-list-and-digest
|
||
(list (format "putenv ('COLUMNS', '%s');\n" width)))))))
|
||
|
||
|
||
;;; Miscellaneous useful functions
|
||
|
||
(defun octave-in-comment-p ()
|
||
"Return non-nil if point is inside an Octave comment."
|
||
(nth 4 (syntax-ppss)))
|
||
|
||
(defun octave-in-string-p ()
|
||
"Return non-nil if point is inside an Octave string."
|
||
(nth 3 (syntax-ppss)))
|
||
|
||
(defun octave-in-string-or-comment-p ()
|
||
"Return non-nil if point is inside an Octave string or comment."
|
||
(nth 8 (syntax-ppss)))
|
||
|
||
(defun octave-looking-at-kw (regexp)
|
||
"Like `looking-at', but set `case-fold-search' nil first."
|
||
(let ((case-fold-search nil))
|
||
(looking-at regexp)))
|
||
|
||
(defun octave-maybe-insert-continuation-string ()
|
||
(declare (obsolete nil "28.1"))
|
||
(unless (or (octave-in-comment-p)
|
||
(save-excursion
|
||
(beginning-of-line)
|
||
(looking-at octave-continuation-regexp)))
|
||
(delete-horizontal-space)
|
||
(insert (concat " " octave-continuation-string))))
|
||
|
||
(defun octave-completing-read ()
|
||
(let ((def (or (thing-at-point 'symbol)
|
||
(save-excursion
|
||
(skip-syntax-backward "-(")
|
||
(thing-at-point 'symbol)))))
|
||
(completing-read (format-prompt "Function" def)
|
||
(inferior-octave-completion-table)
|
||
nil nil nil nil def)))
|
||
|
||
(defun octave-goto-function-definition (fn)
|
||
"Go to the function definition of FN in current buffer."
|
||
(let ((search
|
||
(lambda (re sub)
|
||
(let ((orig (point)) found)
|
||
(goto-char (point-min))
|
||
(while (and (not found) (re-search-forward re nil t))
|
||
(when (and (equal (match-string sub) fn)
|
||
(not (nth 8 (syntax-ppss))))
|
||
(setq found t)))
|
||
(unless found (goto-char orig))
|
||
found))))
|
||
(pcase (and buffer-file-name (file-name-extension buffer-file-name))
|
||
("cc" (funcall search
|
||
"\\_<DEFUN\\(?:_DLD\\)?\\s-*(\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)" 1))
|
||
(_ (funcall search octave-function-header-regexp 3)))))
|
||
|
||
(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-strictly -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 ()
|
||
"Beginning and end positions of the function file comment."
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
;; Copyright block: octave/libinterp/parse-tree/lex.ll around line 1634
|
||
(while (save-excursion
|
||
(when (comment-search-forward (point-max) 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 (point-max)))
|
||
(let ((beg (comment-search-forward (point-max) t)))
|
||
(when beg
|
||
(goto-char beg)
|
||
(octave-skip-comment-forward (point-max))
|
||
(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)))
|
||
(help-form (format-message "\
|
||
a: Use function name `%s'
|
||
b: Use file name `%s'
|
||
q: Don't fix\n" func file))
|
||
(c (unless (equal file func)
|
||
(save-window-excursion
|
||
(help-form-show)
|
||
(read-char-choice
|
||
"Which name to use? (a/b/q) " '(?a ?b ?q))))))
|
||
(pcase c
|
||
(?a (let ((newname (expand-file-name
|
||
(concat func (file-name-extension
|
||
buffer-file-name t)))))
|
||
(when (or (not (file-exists-p newname))
|
||
(yes-or-no-p
|
||
(format "Target file %s exists; proceed? " newname)))
|
||
(when (file-exists-p buffer-file-name)
|
||
(rename-file buffer-file-name newname t))
|
||
(set-visited-file-name newname))))
|
||
(?b (save-excursion
|
||
(goto-char name-start)
|
||
(delete-region name-start name-end)
|
||
(insert file)))))))))
|
||
|
||
(defun octave-update-function-file-comment (beg end)
|
||
"Query replace function names in function file comment."
|
||
(interactive
|
||
(progn
|
||
(barf-if-buffer-read-only)
|
||
(if (use-region-p)
|
||
(list (region-beginning) (region-end))
|
||
(or (octave-function-file-comment)
|
||
(error "No function file comment found")))))
|
||
(save-excursion
|
||
(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 (re-search-forward
|
||
"[=}]\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>"
|
||
(min (line-end-position 4) end)
|
||
t)
|
||
(match-string 1))))
|
||
(old-func (read-string (format-prompt "Name to replace" old-func)
|
||
nil nil old-func)))
|
||
(if (and func old-func (not (equal func old-func)))
|
||
(perform-replace old-func func 'query
|
||
nil 'delimited nil nil beg end)
|
||
(message "Function names match")))))
|
||
|
||
(defface octave-function-comment-block
|
||
'((t (:inherit font-lock-doc-face)))
|
||
"Face used to highlight function comment block.")
|
||
|
||
(eval-when-compile (require 'texinfo))
|
||
;; Undo the effects of texinfo loading tex-mode loading compile.
|
||
(declare-function compilation-forget-errors "compile" ())
|
||
|
||
(defun octave-font-lock-texinfo-comment ()
|
||
(let ((kws
|
||
(eval-when-compile
|
||
(delq nil (mapcar
|
||
(lambda (kw)
|
||
(if (numberp (nth 1 kw))
|
||
`(,(nth 0 kw) ,(nth 1 kw) ,(nth 2 kw) prepend)
|
||
(message "Ignoring Texinfo highlight: %S" kw)))
|
||
texinfo-font-lock-keywords)))))
|
||
(font-lock-add-keywords
|
||
nil
|
||
`((,(lambda (limit)
|
||
(while (and (< (point) limit)
|
||
(search-forward "-*- texinfo -*-" limit t)
|
||
(octave-in-comment-p))
|
||
(let ((beg (nth 8 (syntax-ppss)))
|
||
(end (progn
|
||
(octave-skip-comment-forward (point-max))
|
||
(point))))
|
||
(put-text-property beg end 'font-lock-multiline t)
|
||
(font-lock-prepend-text-property
|
||
beg end 'face 'octave-function-comment-block)
|
||
(dolist (kw kws)
|
||
(goto-char beg)
|
||
(while (re-search-forward (car kw) end 'move)
|
||
(font-lock-apply-highlight (cdr kw))))))
|
||
nil)))
|
||
'append)))
|
||
|
||
|
||
;;; Indentation
|
||
|
||
(defun octave-indent-new-comment-line (&optional soft)
|
||
"Break Octave line at point, continuing comment if within one.
|
||
Insert `octave-continuation-string' before breaking the line
|
||
unless inside a list. If within a double-quoted string, insert
|
||
`octave-string-continuation-marker' instead. Signal an error if
|
||
within a single-quoted string."
|
||
(interactive)
|
||
(funcall comment-line-break-function soft))
|
||
|
||
(defun octave--indent-new-comment-line (orig &rest args)
|
||
(pcase (syntax-ppss)
|
||
((app ppss-string-terminator ?\')
|
||
(user-error "Cannot split a single-quoted string"))
|
||
((app ppss-string-terminator ?\")
|
||
(insert octave-string-continuation-marker))
|
||
((pred (not ppss-comment-depth))
|
||
(delete-horizontal-space)
|
||
(unless (octave-smie--in-parens-p)
|
||
(insert " " octave-continuation-string))))
|
||
(apply orig args)
|
||
(indent-according-to-mode))
|
||
|
||
(define-obsolete-function-alias
|
||
'octave-indent-defun 'prog-indent-sexp "24.4")
|
||
|
||
|
||
;;; Motion
|
||
(defun octave-next-code-line (&optional arg)
|
||
"Move ARG lines of Octave code forward (backward if ARG is negative).
|
||
Skips past all empty and comment lines. Default for ARG is 1.
|
||
|
||
On success, return 0. Otherwise, go as far as possible and return -1."
|
||
(interactive "p")
|
||
(or arg (setq arg 1))
|
||
(beginning-of-line)
|
||
(let ((n 0)
|
||
(inc (if (> arg 0) 1 -1)))
|
||
(while (and (/= arg 0) (= n 0))
|
||
(setq n (forward-line inc))
|
||
(while (and (= n 0)
|
||
(looking-at "\\s-*\\($\\|\\s<\\)"))
|
||
(setq n (forward-line inc)))
|
||
(setq arg (- arg inc)))
|
||
n))
|
||
|
||
(defun octave-previous-code-line (&optional arg)
|
||
"Move ARG lines of Octave code backward (forward if ARG is negative).
|
||
Skips past all empty and comment lines. Default for ARG is 1.
|
||
|
||
On success, return 0. Otherwise, go as far as possible and return -1."
|
||
(interactive "p")
|
||
(or arg (setq arg 1))
|
||
(octave-next-code-line (- arg)))
|
||
|
||
(defun octave-beginning-of-line ()
|
||
"Move point to beginning of current Octave line.
|
||
If on an empty or comment line, go to the beginning of that line.
|
||
Otherwise, move backward to the beginning of the first Octave code line
|
||
which is not inside a continuation statement, i.e., which does not
|
||
follow a code line ending with `...' or is inside an open
|
||
parenthesis list."
|
||
(interactive)
|
||
(beginning-of-line)
|
||
(unless (looking-at "\\s-*\\($\\|\\s<\\)")
|
||
(while (or (when (cadr (syntax-ppss))
|
||
(goto-char (cadr (syntax-ppss)))
|
||
(beginning-of-line)
|
||
t)
|
||
(and (or (looking-at "\\s-*\\($\\|\\s<\\)")
|
||
(save-excursion
|
||
(if (zerop (octave-previous-code-line))
|
||
(looking-at octave-continuation-regexp))))
|
||
(zerop (forward-line -1)))))))
|
||
|
||
(defun octave-end-of-line ()
|
||
"Move point to end of current Octave line.
|
||
If on an empty or comment line, go to the end of that line.
|
||
Otherwise, move forward to the end of the first Octave code line which
|
||
does not end with `...' or is inside an open parenthesis list."
|
||
(interactive)
|
||
(end-of-line)
|
||
(unless (save-excursion
|
||
(beginning-of-line)
|
||
(looking-at "\\s-*\\($\\|\\s<\\)"))
|
||
(while (or (when (cadr (syntax-ppss))
|
||
(condition-case nil
|
||
(progn
|
||
(up-list 1)
|
||
(end-of-line)
|
||
t)
|
||
(error nil)))
|
||
(and (save-excursion
|
||
(beginning-of-line)
|
||
(or (looking-at "\\s-*\\($\\|\\s<\\)")
|
||
(looking-at octave-continuation-regexp)))
|
||
(zerop (forward-line 1)))))
|
||
(end-of-line)))
|
||
|
||
(defun octave-mark-block ()
|
||
"Put point at the beginning of this Octave block, mark at the end.
|
||
The block marked is the one that contains point or follows point."
|
||
(interactive)
|
||
(if (and (looking-at "\\sw\\|\\s_")
|
||
(looking-back "\\sw\\|\\s_" (1- (point))))
|
||
(skip-syntax-forward "w_"))
|
||
(unless (or (looking-at "\\s(")
|
||
(save-excursion
|
||
(let* ((token (funcall smie-forward-token-function))
|
||
(level (assoc token smie-grammar)))
|
||
(and level (not (numberp (cadr level)))))))
|
||
(backward-up-list 1))
|
||
(mark-sexp))
|
||
|
||
(defun octave-beginning-of-defun (&optional arg)
|
||
"Octave-specific `beginning-of-defun-function' (which see)."
|
||
(or arg (setq arg 1))
|
||
;; Move out of strings or comments.
|
||
(when (octave-in-string-or-comment-p)
|
||
(goto-char (octave-in-string-or-comment-p)))
|
||
(letrec ((orig (point))
|
||
(toplevel (lambda (pos)
|
||
(condition-case nil
|
||
(progn
|
||
(backward-up-list 1)
|
||
(funcall toplevel (point)))
|
||
(scan-error pos)))))
|
||
(goto-char (funcall toplevel (point)))
|
||
(when (and (> arg 0) (/= orig (point)))
|
||
(setq arg (1- arg)))
|
||
(forward-sexp (- arg))
|
||
(and (< arg 0) (forward-sexp -1))
|
||
(/= orig (point))))
|
||
|
||
(defun octave-fill-paragraph (&optional _arg)
|
||
"Fill paragraph of Octave code, handling Octave comments."
|
||
;; FIXME: difference with generic fill-paragraph:
|
||
;; - code lines are only split, never joined.
|
||
;; - \n that end comments are never removed.
|
||
;; - insert continuation marker when splitting code lines.
|
||
(interactive "P")
|
||
(save-excursion
|
||
(let ((end (progn (forward-paragraph) (copy-marker (point) t)))
|
||
(beg (progn
|
||
(forward-paragraph -1)
|
||
(skip-chars-forward " \t\n")
|
||
(beginning-of-line)
|
||
(point)))
|
||
(cfc (current-fill-column))
|
||
comment-prefix)
|
||
(goto-char beg)
|
||
(while (< (point) end)
|
||
(condition-case nil
|
||
(indent-according-to-mode)
|
||
(error nil))
|
||
(move-to-column cfc)
|
||
;; First check whether we need to combine non-empty comment lines
|
||
(if (and (< (current-column) cfc)
|
||
(octave-in-comment-p)
|
||
(not (save-excursion
|
||
(beginning-of-line)
|
||
(looking-at "^\\s-*\\s<+\\s-*$"))))
|
||
;; This is a nonempty comment line which does not extend
|
||
;; past the fill column. If it is followed by a nonempty
|
||
;; comment line with the same comment prefix, try to
|
||
;; combine them, and repeat this until either we reach the
|
||
;; fill-column or there is nothing more to combine.
|
||
(progn
|
||
;; Get the comment prefix
|
||
(save-excursion
|
||
(beginning-of-line)
|
||
(while (and (re-search-forward "\\s<+")
|
||
(not (octave-in-comment-p))))
|
||
(setq comment-prefix (match-string 0)))
|
||
;; And keep combining ...
|
||
(while (and (< (current-column) cfc)
|
||
(save-excursion
|
||
(forward-line 1)
|
||
(and (looking-at
|
||
(concat "^\\s-*"
|
||
comment-prefix
|
||
"\\S<"))
|
||
(not (looking-at
|
||
(concat "^\\s-*"
|
||
comment-prefix
|
||
"\\s-*$"))))))
|
||
(delete-char 1)
|
||
(re-search-forward comment-prefix)
|
||
(delete-region (match-beginning 0) (match-end 0))
|
||
(fixup-whitespace)
|
||
(move-to-column cfc))))
|
||
;; We might also try to combine continued code lines> Perhaps
|
||
;; some other time ...
|
||
(skip-chars-forward "^ \t\n")
|
||
(delete-horizontal-space)
|
||
(if (or (< (current-column) cfc)
|
||
(and (= (current-column) cfc) (eolp)))
|
||
(forward-line 1)
|
||
(if (not (eolp)) (insert " "))
|
||
(or (funcall normal-auto-fill-function)
|
||
(forward-line 1))))
|
||
t)))
|
||
|
||
(defun octave-completion-at-point ()
|
||
"Find the text to complete and the corresponding table."
|
||
(let* ((beg (save-excursion (skip-syntax-backward "w_") (point)))
|
||
(end (point)))
|
||
(if (< beg (point))
|
||
;; Extend region past point, if applicable.
|
||
(save-excursion (skip-syntax-forward "w_")
|
||
(setq end (point))))
|
||
(when (> end beg)
|
||
(list beg end (or (and (inferior-octave-process-live-p)
|
||
(inferior-octave-completion-table))
|
||
octave-reserved-words)))))
|
||
|
||
(defun octave-add-log-current-defun ()
|
||
"A function for `add-log-current-defun-function' (which see)."
|
||
(save-excursion
|
||
(end-of-line)
|
||
(and (beginning-of-defun)
|
||
(re-search-forward octave-function-header-regexp
|
||
(line-end-position) t)
|
||
(match-string 3))))
|
||
|
||
|
||
;;; Electric characters && friends
|
||
(define-skeleton octave-insert-defun
|
||
"Insert an Octave function skeleton.
|
||
Prompt for the function's name, arguments and return values (to be
|
||
entered without parens)."
|
||
(let* ((defname (file-name-sans-extension (buffer-name)))
|
||
(name (read-string (format-prompt "Function name" defname)
|
||
nil nil defname))
|
||
(args (read-string "Arguments: "))
|
||
(vals (read-string "Return values: ")))
|
||
(format "%s%s (%s)"
|
||
(cond
|
||
((string-equal vals "") vals)
|
||
((string-match "[ ,]" vals) (concat "[" vals "] = "))
|
||
(t (concat vals " = ")))
|
||
name
|
||
args))
|
||
\n octave-block-comment-start "usage: " str \n
|
||
octave-block-comment-start '(delete-horizontal-space) \n
|
||
octave-block-comment-start '(delete-horizontal-space) \n
|
||
"function " > str \n
|
||
_ \n
|
||
"endfunction" > \n)
|
||
|
||
;;; Communication with the inferior Octave process
|
||
(defun octave-kill-process ()
|
||
"Kill inferior Octave process and its buffer."
|
||
(interactive)
|
||
(when (and (buffer-live-p (get-buffer inferior-octave-buffer))
|
||
(or (yes-or-no-p (format "Kill %S and its buffer? "
|
||
inferior-octave-process))
|
||
(user-error "Aborted")))
|
||
(when (inferior-octave-process-live-p)
|
||
(set-process-query-on-exit-flag inferior-octave-process nil)
|
||
(process-send-string inferior-octave-process "quit;\n")
|
||
(accept-process-output inferior-octave-process))
|
||
(kill-buffer inferior-octave-buffer)))
|
||
|
||
(defun octave-show-process-buffer ()
|
||
"Make sure that `inferior-octave-buffer' is displayed."
|
||
(interactive)
|
||
(if (get-buffer inferior-octave-buffer)
|
||
(display-buffer inferior-octave-buffer)
|
||
(message "No buffer named %s" inferior-octave-buffer)))
|
||
|
||
(defun octave-hide-process-buffer ()
|
||
"Delete all windows that display `inferior-octave-buffer'."
|
||
(interactive)
|
||
(if (get-buffer inferior-octave-buffer)
|
||
(delete-windows-on inferior-octave-buffer)
|
||
(message "No buffer named %s" inferior-octave-buffer)))
|
||
|
||
(defun octave-source-file (file)
|
||
"Execute FILE in the inferior Octave process.
|
||
This is done using Octave's source function. FILE defaults to
|
||
current buffer file unless called with a prefix arg \\[universal-argument]."
|
||
(interactive (list (or (and (not current-prefix-arg) buffer-file-name)
|
||
(read-file-name "File: " nil nil t))))
|
||
(or (stringp file)
|
||
(signal 'wrong-type-argument (list 'stringp file)))
|
||
(inferior-octave t)
|
||
(with-current-buffer inferior-octave-buffer
|
||
(comint-send-string inferior-octave-process
|
||
(format "source '%s'\n" file))))
|
||
|
||
(defun octave-send-region (beg end)
|
||
"Send current region to the inferior Octave process."
|
||
(interactive "r")
|
||
(inferior-octave t)
|
||
(let ((proc inferior-octave-process)
|
||
(string (buffer-substring-no-properties beg end)))
|
||
(with-current-buffer inferior-octave-buffer
|
||
;; https://lists.gnu.org/r/emacs-devel/2013-10/msg00095.html
|
||
(compilation-forget-errors)
|
||
(insert-before-markers string "\n")
|
||
(comint-send-string proc (concat string "\n")))
|
||
(deactivate-mark))
|
||
(if octave-send-show-buffer
|
||
(display-buffer inferior-octave-buffer)))
|
||
|
||
(defun octave-send-buffer ()
|
||
"Send current buffer to the inferior Octave process."
|
||
(interactive)
|
||
(octave-send-region (point-min) (point-max)))
|
||
|
||
(defun octave-send-block ()
|
||
"Send current Octave block to the inferior Octave process."
|
||
(interactive)
|
||
(save-excursion
|
||
(octave-mark-block)
|
||
(octave-send-region (point) (mark))))
|
||
|
||
(defun octave-send-defun ()
|
||
"Send current Octave function to the inferior Octave process."
|
||
(interactive)
|
||
(save-excursion
|
||
(mark-defun)
|
||
(octave-send-region (point) (mark))))
|
||
|
||
(defun octave-send-line (&optional arg)
|
||
"Send current Octave code line to the inferior Octave process.
|
||
With positive prefix ARG, send that many lines.
|
||
If `octave-send-line-auto-forward' is non-nil, go to the next unsent
|
||
code line."
|
||
(interactive "P")
|
||
(or arg (setq arg 1))
|
||
(if (> arg 0)
|
||
(let (beg end)
|
||
(beginning-of-line)
|
||
(setq beg (point))
|
||
(octave-next-code-line (- arg 1))
|
||
(end-of-line)
|
||
(setq end (point))
|
||
(if octave-send-line-auto-forward
|
||
(octave-next-code-line 1))
|
||
(octave-send-region beg end))))
|
||
|
||
(defun octave-eval-print-last-sexp ()
|
||
"Evaluate Octave sexp before point and print value into current buffer."
|
||
(interactive)
|
||
(inferior-octave t)
|
||
(let ((standard-output (current-buffer))
|
||
(print-escape-newlines nil)
|
||
(opoint (point)))
|
||
(terpri)
|
||
(prin1
|
||
(save-excursion
|
||
(forward-sexp -1)
|
||
(inferior-octave-send-list-and-digest
|
||
(list (concat (buffer-substring-no-properties (point) opoint)
|
||
"\n")))
|
||
(mapconcat 'identity inferior-octave-output-list "\n")))
|
||
(terpri)))
|
||
|
||
|
||
|
||
(defcustom octave-eldoc-message-style 'auto
|
||
"Octave eldoc message style: auto, oneline, multiline."
|
||
:type '(choice (const :tag "Automatic" auto)
|
||
(const :tag "One Line" oneline)
|
||
(const :tag "Multi Line" multiline))
|
||
:version "24.4")
|
||
|
||
;; (FN SIGNATURE1 SIGNATURE2 ...)
|
||
(defvar octave-eldoc-cache nil)
|
||
|
||
(defun octave-eldoc-function-signatures (fn)
|
||
(unless (equal fn (car octave-eldoc-cache))
|
||
(while-no-input
|
||
(inferior-octave-send-list-and-digest
|
||
(list (format "print_usage ('%s');\n" fn))))
|
||
(let (result)
|
||
(dolist (line inferior-octave-output-list)
|
||
;; The help output has changed a few times in GNU Octave.
|
||
;; Earlier versions output "usage: " before the function signature.
|
||
;; After deprecating the usage function, and up until GNU Octave 4.0.3,
|
||
;; the output looks like this:
|
||
;; -- Mapping Function: abs (Z).
|
||
;; After GNU Octave 4.2.0, the output is less verbose and it looks like
|
||
;; this:
|
||
;; -- abs (Z)
|
||
;; The following regexp matches these three formats.
|
||
;; The "usage: " alternative matches the symbol, because a call to
|
||
;; print_usage with a non-existent function (e.g., print_usage ('A'))
|
||
;; would output:
|
||
;; error: print_usage: 'A' not found
|
||
;; and we wouldn't like to match anything in this case.
|
||
;; See bug #36459.
|
||
(when (string-match
|
||
"\\s-*\\(?:--[^:]+:\\|\\_<usage:\\|--\\)\\s-*\\(.*\\)$"
|
||
line)
|
||
(push (match-string 1 line) result)))
|
||
(setq octave-eldoc-cache
|
||
(cons (substring-no-properties fn)
|
||
(nreverse result)))))
|
||
(cdr octave-eldoc-cache))
|
||
|
||
(defun octave-eldoc-function (&rest _ignored)
|
||
"A function for `eldoc-documentation-functions' (which see)."
|
||
(when (inferior-octave-process-live-p)
|
||
(let* ((ppss (syntax-ppss))
|
||
(paren-pos (cadr ppss))
|
||
(fn (save-excursion
|
||
(if (and paren-pos
|
||
;; PAREN-POS must be after the prompt.
|
||
(or (not (eq (get-buffer-process (current-buffer))
|
||
inferior-octave-process))
|
||
(< (process-mark inferior-octave-process)
|
||
paren-pos))
|
||
(eq (char-after paren-pos) ?\())
|
||
(goto-char paren-pos)
|
||
(setq paren-pos nil))
|
||
(when (or (< (skip-syntax-backward "-") 0) paren-pos)
|
||
(thing-at-point 'symbol))))
|
||
(sigs (and fn (octave-eldoc-function-signatures fn)))
|
||
(oneline (mapconcat 'identity sigs
|
||
(propertize " | " 'face 'warning)))
|
||
(multiline (mapconcat (lambda (s) (concat "-- " s)) sigs "\n")))
|
||
;;
|
||
;; Return the value according to style.
|
||
(pcase octave-eldoc-message-style
|
||
('auto (if (< (length oneline) (window-width (minibuffer-window)))
|
||
oneline
|
||
multiline))
|
||
('oneline oneline)
|
||
('multiline multiline)))))
|
||
|
||
(defcustom octave-help-buffer "*Octave Help*"
|
||
"Buffer name for `octave-help'."
|
||
:type 'string
|
||
:version "24.4")
|
||
|
||
;; Used in a mode derived from help-mode.
|
||
(declare-function help-button-action "help-mode" (button))
|
||
|
||
(define-button-type 'octave-help-file
|
||
'follow-link t
|
||
'action #'help-button-action
|
||
'help-function 'octave-find-definition)
|
||
|
||
(define-button-type 'octave-help-function
|
||
'follow-link t
|
||
'action (lambda (b) (octave-help (button-label b))))
|
||
|
||
(defvar octave-help-mode-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map "\M-." 'octave-find-definition)
|
||
(define-key map "\C-hd" 'octave-help)
|
||
(define-key map "\C-ha" 'octave-lookfor)
|
||
map))
|
||
|
||
(define-derived-mode octave-help-mode help-mode "OctHelp"
|
||
"Major mode for displaying Octave documentation."
|
||
:abbrev-table nil
|
||
:syntax-table octave-mode-syntax-table
|
||
(eval-and-compile (require 'help-mode))
|
||
;; Don't highlight `EXAMPLE' as elisp symbols by using a regexp that
|
||
;; can never match.
|
||
(setq-local help-xref-symbol-regexp regexp-unmatchable))
|
||
|
||
(defun octave-help (fn)
|
||
"Display the documentation of FN."
|
||
(interactive (list (octave-completing-read)))
|
||
(inferior-octave-send-list-and-digest
|
||
(list (format "help ('%s');\n" fn)))
|
||
(let ((lines inferior-octave-output-list)
|
||
(inhibit-read-only t))
|
||
(when (string-match "error: \\(.*\\)$" (car lines))
|
||
(error "%s" (match-string 1 (car lines))))
|
||
(with-help-window octave-help-buffer
|
||
(princ (mapconcat 'identity lines "\n"))
|
||
(with-current-buffer octave-help-buffer
|
||
;; Bound to t so that `help-buffer' returns current buffer for
|
||
;; `help-setup-xref'.
|
||
(let ((help-xref-following t))
|
||
(help-setup-xref (list 'octave-help fn)
|
||
(called-interactively-p 'interactive)))
|
||
;; Note: can be turned off by suppress_verbose_help_message.
|
||
;;
|
||
;; Remove boring trailing text: Additional help for built-in functions
|
||
;; and operators ...
|
||
(goto-char (point-max))
|
||
(when (search-backward "\n\n\n" nil t)
|
||
(goto-char (match-beginning 0))
|
||
(delete-region (point) (point-max)))
|
||
;; File name highlight
|
||
(goto-char (point-min))
|
||
(when (re-search-forward "from the file \\(.*\\)$"
|
||
(line-end-position)
|
||
t)
|
||
(let* ((file (match-string 1))
|
||
(dir (file-name-directory
|
||
(directory-file-name (file-name-directory file)))))
|
||
(replace-match "" nil nil nil 1)
|
||
(insert (substitute-quotes "`"))
|
||
;; Include the parent directory which may be regarded as
|
||
;; the category for the FN.
|
||
(help-insert-xref-button (file-relative-name file dir)
|
||
'octave-help-file fn)
|
||
(insert (substitute-quotes "'"))))
|
||
;; Make 'See also' clickable.
|
||
(with-syntax-table octave-mode-syntax-table
|
||
(when (re-search-forward "^\\s-*See also:" nil t)
|
||
(let ((end (save-excursion (re-search-forward "^\\s-*$" nil t))))
|
||
(while (re-search-forward
|
||
"\\s-*\\([^,\n]+?\\)\\s-*\\(?:[,]\\|[.]?$\\)" end t)
|
||
(make-text-button (match-beginning 1) (match-end 1)
|
||
:type 'octave-help-function)))))
|
||
(octave-help-mode)))))
|
||
|
||
(defun octave-lookfor (str &optional all)
|
||
"Search for the string STR in all function help strings.
|
||
If ALL is non-nil search the entire help string else only search the first
|
||
sentence."
|
||
(interactive "sSearch for: \nP")
|
||
(inferior-octave-send-list-and-digest
|
||
(list (format "lookfor (%s'%s');\n"
|
||
(if all "'-all', " "")
|
||
str)))
|
||
(let ((lines inferior-octave-output-list))
|
||
(when (and (stringp (car lines))
|
||
(string-match "error: \\(.*\\)$" (car lines)))
|
||
(error "%s" (match-string 1 (car lines))))
|
||
(with-help-window octave-help-buffer
|
||
(with-current-buffer octave-help-buffer
|
||
(if lines
|
||
(insert (mapconcat 'identity lines "\n"))
|
||
(insert (format "Nothing found for \"%s\".\n" str)))
|
||
;; Bound to t so that `help-buffer' returns current buffer for
|
||
;; `help-setup-xref'.
|
||
(let ((help-xref-following t))
|
||
(help-setup-xref (list 'octave-lookfor str all)
|
||
(called-interactively-p 'interactive)))
|
||
(goto-char (point-min))
|
||
(when lines
|
||
(while (re-search-forward "^\\([^[:blank:]]+\\) " nil 'noerror)
|
||
(make-text-button (match-beginning 1) (match-end 1)
|
||
:type 'octave-help-function)))
|
||
(unless all
|
||
(goto-char (point-max))
|
||
(insert "\nRetry with ")
|
||
(insert-text-button "'-all'"
|
||
'follow-link t
|
||
'action (lambda (_b)
|
||
(octave-lookfor str '-all)))
|
||
(insert ".\n"))
|
||
(octave-help-mode)))))
|
||
|
||
(defcustom octave-source-directories nil
|
||
"A list of directories for Octave sources.
|
||
If the environment variable OCTAVE_SRCDIR is set, it is searched first."
|
||
:type '(repeat directory)
|
||
:version "24.4")
|
||
|
||
(defun octave-source-directories ()
|
||
(let ((srcdir (or (and inferior-octave-process
|
||
(process-get inferior-octave-process 'octave-srcdir))
|
||
(getenv "OCTAVE_SRCDIR"))))
|
||
(if srcdir
|
||
(cons srcdir octave-source-directories)
|
||
octave-source-directories)))
|
||
|
||
(defvar octave-find-definition-filename-function
|
||
#'octave-find-definition-default-filename)
|
||
|
||
(defun octave-find-definition-default-filename (name)
|
||
"Default value for `octave-find-definition-filename-function'."
|
||
(pcase (file-name-extension name)
|
||
("oct"
|
||
(octave-find-definition-default-filename
|
||
(concat "libinterp/dldfcn/"
|
||
(file-name-sans-extension (file-name-nondirectory name))
|
||
".cc")))
|
||
("cc"
|
||
(let ((file (or (locate-file name (octave-source-directories))
|
||
(locate-file (file-name-nondirectory name)
|
||
(octave-source-directories)))))
|
||
(or (and file (file-exists-p file))
|
||
(error "File `%s' not found" name))
|
||
file))
|
||
("mex"
|
||
(if (yes-or-no-p (format-message "File `%s' may be binary; open? "
|
||
(file-name-nondirectory name)))
|
||
name
|
||
(user-error "Aborted")))
|
||
(_ name)))
|
||
|
||
(declare-function xref-push-marker-stack "xref" (&optional m))
|
||
|
||
(defun octave-find-definition (fn)
|
||
"Find the definition of FN.
|
||
Functions implemented in C++ can be found if
|
||
variable `octave-source-directories' is set correctly."
|
||
(interactive (list (octave-completing-read)))
|
||
(require 'xref)
|
||
(let ((orig (point)))
|
||
(if (and (derived-mode-p 'octave-mode)
|
||
(octave-goto-function-definition fn))
|
||
(xref-push-marker-stack (copy-marker orig))
|
||
(inferior-octave-send-list-and-digest
|
||
;; help NAME is more verbose
|
||
(list (format "\
|
||
if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n"
|
||
fn fn fn)))
|
||
(let (line file)
|
||
;; Skip garbage lines such as
|
||
;; warning: fmincg.m: possible Matlab-style ....
|
||
(while (and (not file) (consp inferior-octave-output-list))
|
||
(setq line (pop inferior-octave-output-list))
|
||
(when (string-match "from the file \\(.*\\)$" line)
|
||
(setq file (match-string 1 line))))
|
||
(if (not file)
|
||
(user-error "%s" (or line (format-message "`%s' not found" fn)))
|
||
(xref-push-marker-stack)
|
||
(setq file (funcall octave-find-definition-filename-function file))
|
||
(when file
|
||
(find-file file)
|
||
(octave-goto-function-definition fn)))))))
|
||
|
||
(provide 'octave)
|
||
;;; octave.el ends here
|