You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1627 lines
60 KiB
1627 lines
60 KiB
;;; sage-mode.el --- Major mode for editing Sage code |
|
|
|
;; Copyright (C) 2007, 2008 Nick Alexander |
|
|
|
;; Author: Nick Alexander <ncalexander@gmail.com> |
|
;; Keywords: sage ipython python math |
|
|
|
;; This file 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 2, or (at your option) |
|
;; any later version. |
|
|
|
;; This file 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; see the file COPYING. If not, write to |
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
|
;; Boston, MA 02110-1301, USA. |
|
|
|
;;; Commentary: |
|
|
|
;; `sage-mode' is a major mode for editing sage (and python, and cython) |
|
;; source code. `inferior-sage-mode' is the companion mode for interacting |
|
;; with a slave sage session. See the help for `sage-mode' for help getting |
|
;; started and the default key bindings. |
|
|
|
;;; Todo: |
|
|
|
;; (DONE) Print path in instructions again? |
|
;; |
|
;; M-q fills comments correctly after """ ; " |
|
;; |
|
;; (DONE) C-x ` jump from one error to the next one. |
|
;; |
|
;; Replace test output. |
|
;; Replace output for all tests. |
|
;; Actually compare test outputs? |
|
;; (DONE) C-c C-j copies multiline tests. |
|
;; (DONE) C-u sage-test only tests, does not rebuild. |
|
;; (DONE) C-c C-j in the *Help* buffer. |
|
;; |
|
;; (DONE) Make sage-send-{buffer, doctest} quit pdb before sending. |
|
;; (DONE) Remove pdb history/different history based on prompt. |
|
;; |
|
;; (DONE) sage-rerun exits from pdb. |
|
;; (DONE) C-u sage-build hangs with exiting from pdb code. |
|
;; (DONE) search *sage-test* buffer for test status rather than rely on exit codes |
|
;; search *sage-build* buffer for build status rather than rely on exit codes (how to tell?) |
|
;; |
|
;; (DONE) Fix pyrex-mode |
|
;; |
|
;; Upload an optional package? |
|
|
|
;;; Code: |
|
|
|
(eval-when-compile (require 'cl)) |
|
(eval-when-compile (require 'hippie-exp nil t)) |
|
(eval-when-compile (require 'eshell nil t)) |
|
(eval-when-compile (require 'esh-cmd nil t)) |
|
(eval-when-compile (require 'esh-io nil t)) |
|
(eval-when-compile (require 'pcomplete nil t)) |
|
(require 'sage-compat) |
|
(require 'python) |
|
(require 'comint) |
|
(require 'ansi-color) |
|
(require 'compile) |
|
(require 'help-mode) |
|
(require 'find-func) |
|
(require 'apropos) |
|
|
|
;;;_ + Sage mode key bindings |
|
|
|
(defvar sage-mode-map |
|
(let ((map (make-keymap))) ;`sparse' doesn't allow binding to charsets. |
|
(define-key map [(control c) (control c)] 'sage-send-buffer) |
|
(define-key map [(control c) (control r)] 'sage-send-region) |
|
(define-key map [(control c) (control d)] 'sage-send-defun) |
|
(define-key map [(control c) (control e)] 'sage-send-statement) |
|
(define-key map [(control c) (control j)] 'sage-send-doctest) |
|
(define-key map [(control c) (control t)] 'sage-test) |
|
(define-key map [(control c) (control b)] 'sage-build) |
|
(define-key map [(control c) (control z)] 'run-sage) |
|
(define-key map [(control h) (control f)] 'ipython-describe-symbol) |
|
(define-key map [(control h) (control g)] 'sage-find-symbol-other-window) |
|
|
|
(easy-menu-define menu-map map "Sage Mode menu" |
|
`("Sage" |
|
:help "sage-mode Specific Features" |
|
["Send Buffer" sage-send-buffer |
|
:help "Send current buffer to inferior sage"] |
|
["Send Region" sage-send-region :active mark-active |
|
:help "Send current region to inferior sage"] |
|
["Send Defun" sage-send-defun |
|
:help "Send current function definition to inferior sage"] |
|
["Send Statement" sage-send-statement |
|
:help "Send current statement to inferior sage"] |
|
["Send Doctest" sage-send-doctest |
|
:help "Send current doctest to inferior sage"] |
|
"-" |
|
["Run Sage" sage |
|
:help "Run sage"] |
|
["Rerun Sage" sage-rerun |
|
:help "Kill running sage and rerun sage"] |
|
["Build Sage" sage-build |
|
:help "Build sage with \"sage -b\""] |
|
["Run Doctests" sage-test |
|
:help "Run doctests with \"sage -t\""])) |
|
map) |
|
"Keymap for `sage-mode'.") |
|
|
|
(defvar inferior-sage-mode-map |
|
(let ((map (make-keymap))) ;`sparse' doesn't allow binding to charsets. |
|
(define-key map [(control c) (control t)] 'sage-test) |
|
(define-key map [(control c) (control b)] 'sage-build) |
|
(define-key map [(control h) (control f)] 'ipython-describe-symbol) |
|
(define-key map [(control h) (control g)] 'sage-find-symbol-other-window) |
|
(define-key map (kbd "TAB") 'sage-pcomplete-or-help) |
|
|
|
(easy-menu-define menu-map map "Inferior Sage Mode menu" |
|
`("Sage" |
|
["Run Sage" sage |
|
:help "Run sage"] |
|
["Rerun Sage" sage-rerun |
|
:help "Kill running sage and rerun sage"] |
|
["Build Sage" sage-build |
|
:help "Build sage with \"sage -b\""] |
|
["Run Doctests" sage-test |
|
:help "Run doctests with \"sage -t\""] |
|
"-" |
|
["Enable Inline Plots" sage-view-enable-inline-plots |
|
:help "Enable display of plots in the inferior Sage buffer." |
|
:visible (not sage-view-inline-plots-enabled)] |
|
["Disable Inline Plots" sage-view-disable-inline-plots |
|
:help "Enable display of plots in the inferior Sage buffer." |
|
:visible sage-view-inline-plots-enabled] |
|
|
|
["Enable Typeset Output" sage-view-enable-inline-output |
|
:help "Enable typesetting of output in the inferior Sage buffer." |
|
:visible (not sage-view-inline-output-enabled)] |
|
["Disable Typeset Output" sage-view-disable-inline-output |
|
:help "Disable typesetting of output in the inferior Sage buffer." |
|
:visible sage-view-inline-output-enabled] |
|
"-" |
|
["Hide all backtraces" hs-hide-all |
|
:help "Hide all backtraces to reduce clutter"] |
|
["Show all backtraces" hs-show-all |
|
:help "Show all backtraces"] |
|
["Show current backtrace" hs-show-block |
|
:help "Show all backtraces"])) |
|
map) |
|
"Keymap for `inferior-sage-mode'.") |
|
|
|
;;;_* Inferior Sage major mode for interacting with a slave Sage process |
|
|
|
;;;###autoload |
|
(define-derived-mode |
|
inferior-sage-mode |
|
inferior-python-mode |
|
"Inferior Sage" |
|
"Major mode for interacting with an inferior Sage process." |
|
|
|
(when (and (markerp comint-last-output-start) |
|
(not (marker-buffer comint-last-output-start))) |
|
(set-marker comint-last-output-start (point-min))) |
|
(sage-set-buffer (current-buffer)) |
|
|
|
(setq comint-prompt-regexp inferior-sage-prompt) |
|
(setq comint-prompt-read-only t) |
|
(setq comint-redirect-finished-regexp comint-prompt-regexp) |
|
|
|
(setq comint-input-sender 'sage-input-sender) |
|
;; I type x? a lot |
|
(set 'comint-input-filter 'sage-input-filter) |
|
|
|
;; Old python.el doesn't define comment start, which then confuses up hs-minor-mode |
|
(set (make-local-variable 'comment-start) "#") |
|
(make-local-variable 'compilation-error-regexp-alist) |
|
(make-local-variable 'compilation-error-regexp-alist-alist) |
|
(add-to-list 'compilation-error-regexp-alist-alist sage-test-compilation-regexp) |
|
(add-to-list 'compilation-error-regexp-alist 'sage-test-compilation) |
|
(add-to-list 'compilation-error-regexp-alist-alist sage-build-compilation-regexp) |
|
(add-to-list 'compilation-error-regexp-alist 'sage-build-compilation) |
|
(pcomplete-sage-setup) |
|
|
|
;; The new python.el does things a little differently wrt prompts. |
|
;; In particular it has debugger and normal operation separated. |
|
;; If we don't set them correctly things like completion don't work. |
|
(with-no-warnings ;; They give warnings with old python.el |
|
;; Some similar prompt variables are set in the top level of |
|
;; sage-compat.el so that when inferior-python-mode is called it |
|
;; will have the right prompts |
|
(setq python-shell-prompt-regexp ">>> \\|\\(sage: \\)+") |
|
(setq python-shell-prompt-pdb-regexp "[(<]*[Ii]?[PpGg]db[>)]+ ") |
|
(setq python-shell-prompt-block-regexp "\\.\\.\\.\\(\\.:\\)? ") |
|
(python-shell-prompt-set-calculated-regexps) |
|
|
|
;; Respect python-shell-enable-font-lock |
|
(when (or (not (boundp 'python-shell-enable-font-lock)) |
|
python-shell-enable-font-lock) |
|
(sage-font-lock))) |
|
;; Hiding backtraces |
|
(when (require 'hideshow nil t) |
|
(add-to-list 'hs-special-modes-alist |
|
`(inferior-sage-mode "^--------+\n" |
|
,inferior-sage-prompt |
|
,comment-start |
|
sage-hs-forward-sexp |
|
nil)) |
|
(hs-minor-mode)) |
|
(compilation-shell-minor-mode 1)) |
|
|
|
(defun sage-hs-forward-sexp (&rest bob) |
|
"Used for `hs-minor-mode' to fold backtraces." |
|
(search-forward-regexp inferior-sage-prompt nil t) |
|
(forward-line -1) |
|
(end-of-line)) |
|
|
|
(defun inferior-sage-wait-for-prompt () |
|
"Wait until the Sage process is ready for input." |
|
(message "Waiting for sage: prompt...") |
|
(with-current-buffer sage-buffer |
|
(let* ((sprocess (get-buffer-process sage-buffer)) |
|
(success nil) |
|
(timeout 0)) |
|
(sage-send-command "" t) |
|
(while (progn |
|
(if (not (eq (process-status sprocess) 'run)) |
|
(error "Sage process has died unexpectedly") |
|
(if (> (setq timeout (1+ timeout)) inferior-sage-timeout) |
|
(error "Timeout waiting for Sage prompt. Check inferior-sage-timeout")) |
|
(accept-process-output nil 0 1) |
|
(sit-for 0) |
|
(goto-char (point-max)) |
|
;; (forward-line 0) |
|
;; (setq success (looking-at inferior-sage-prompt)) |
|
(setq success (looking-back "^.*sage:.*$")) |
|
(not (or success (looking-at ".*\\?\\s *")))))) |
|
(if success |
|
(message "Waiting for sage: prompt... DONE") |
|
(message "Waiting for sage: prompt... FAILED")) |
|
(goto-char (point-max)) |
|
success))) |
|
|
|
(defun sage-last-prompt () |
|
"Return the text of the last prompt seen in this inferior buffer." |
|
(with-current-buffer sage-buffer |
|
(cond |
|
((and (boundp 'comint-last-prompt-overlay) |
|
comint-last-prompt-overlay) |
|
(buffer-substring-no-properties (overlay-start comint-last-prompt-overlay) |
|
(overlay-end comint-last-prompt-overlay))) |
|
((and (boundp 'comint-last-prompt) |
|
comint-last-prompt) |
|
(buffer-substring-no-properties (car comint-last-prompt) |
|
(cdr comint-last-prompt))) |
|
(t "")))) |
|
|
|
(defun sage-last-prompt-is-debugger () |
|
"Return t if the last prompt seen in this inferior buffer was a debugger prompt." |
|
(save-match-data |
|
(string-match "[pPgG]db" (sage-last-prompt)))) |
|
|
|
(defun sage-input-filter (string) |
|
"A `comint-input-filter' that keeps some input in the history. |
|
|
|
We don't save if we're at a pdb or gdb prompt and the string is |
|
short; otherwise, we save." |
|
(or (not (sage-last-prompt-is-debugger)) ;; regular prompt |
|
(> (length string) 2) ;; or a long-ish entry to the debugger |
|
nil)) |
|
|
|
;;;_* IPython magic commands |
|
|
|
(defcustom ipython-input-handle-magic-p t |
|
"Non-nil means handle IPython magic commands specially." |
|
:group 'ipython |
|
:type 'boolean) |
|
|
|
(defvar ipython-input-string-is-magic-regexp |
|
"\\(\\**\\?\\??\\)\\'" |
|
"Regexp matching IPython magic input. |
|
|
|
The first match group is used to dispatch handlers in |
|
`ipython-input-handle-magic'.") |
|
|
|
(defun ipython-input-string-is-magic-p (string) |
|
"Return non-nil if STRING is IPython magic." |
|
(string-match ipython-input-string-is-magic-regexp string)) |
|
|
|
(defvar ipython-input-magic-handlers '(("**?" . ipython-handle-magic-**?) |
|
("??" . ipython-handle-magic-??) |
|
("?" . ipython-handle-magic-?)) |
|
"Association list (STRING . FUNCTION) of IPython magic handlers. |
|
|
|
Each FUNCTION should take arguments (PROC STRING MATCH) and |
|
return non-nil if magic input was handled, nil if input should be |
|
sent normally.") |
|
|
|
;; (cons nil (cdr apropos-item))))) |
|
;; (insert-text-button (symbol-name symbol) |
|
;; 'type 'apropos-symbol |
|
;; ;; Can't use default, since user may have |
|
;; ;; changed the variable! |
|
;; ;; Just say `no' to variables containing faces! |
|
;; 'face apropos-symbol-face) |
|
|
|
(define-button-type 'sage-apropos-command |
|
'face 'bold |
|
'apropos-label "Command:" |
|
'help-echo "mouse-2, RET: Display more help on this command" |
|
'follow-link t |
|
'action (lambda (button) |
|
(ipython-describe-symbol (button-get button 'apropos-symbol)))) |
|
|
|
(defun sage-apropos-mode () |
|
(interactive) |
|
(apropos-mode) |
|
(save-excursion |
|
(goto-char (point-min)) |
|
(let ((case-fold-search nil)) |
|
(while (re-search-forward "^ \\* \\(.*?\\) \\(.*?\\):" nil t) |
|
(let ((type (match-string 1)) |
|
(name (match-string 2))) |
|
;; reformat everything |
|
(replace-match "") |
|
(insert |
|
(format "%s\n " (propertize name 'face 'bold))) |
|
(insert-text-button (format "%s:" type) |
|
'type 'sage-apropos-command |
|
'apropos-label (format "%s:" type) |
|
'face apropos-label-face |
|
'apropos-symbol name) |
|
))))) |
|
|
|
(defun sage-apropos (symbol) |
|
(interactive "sApropos Sage command: ") |
|
(when (or (null symbol) (equal "" symbol)) |
|
(error "No command")) |
|
(with-output-to-temp-buffer "*sage-apropos*" |
|
(python-send-receive-to-buffer (format "apropos('%s')" symbol) "*sage-apropos*")) |
|
(with-current-buffer "*sage-apropos*" |
|
(sage-apropos-mode) |
|
(goto-char 0) |
|
(let ((inhibit-read-only t)) |
|
(insert (format "Sage apropos for %s:\n\n" symbol))) |
|
t)) |
|
|
|
(defun ipython-handle-magic-**? (proc string &optional match) |
|
"Handle Sage apropos **?." |
|
(when (string-match "\\(.*?\\)\\*\\*\\?" string) |
|
(sage-apropos (match-string 1 string)))) |
|
|
|
(defun ipython-handle-magic-? (proc string &optional match) |
|
"Handle IPython magic ?." |
|
(when (string-match "\\(.*?\\)\\?" string) |
|
(ipython-describe-symbol (match-string 1 string)))) |
|
|
|
(defun ipython-handle-magic-?? (proc string &optional match) |
|
"Handle IPython magic ??." |
|
(when (string-match "\\(.*?\\)\\?\\?" string) |
|
(sage-find-symbol-other-window (match-string 1 string)))) |
|
|
|
(defun ipython-input-handle-magic (proc string) |
|
"Handle IPython magic input STRING in process PROC. |
|
|
|
Return non-nil if input was handled; nil if input should be sent |
|
normally." |
|
(when (string-match ipython-input-string-is-magic-regexp string) |
|
(let* ((match (match-string 1 string)) |
|
(handler (cdr (assoc match ipython-input-magic-handlers)))) |
|
(when handler |
|
(condition-case () |
|
;; I can't explain why, but this seems to work perfectly with ?? |
|
(save-excursion |
|
(funcall handler proc string match)) |
|
;; XXX print error message? |
|
(error nil)))))) |
|
|
|
(defun ipython-input-sender (proc string) |
|
"Function for sending to process PROC input STRING. |
|
|
|
When `ipython-input-handle-magic-p' is non-nil, this uses |
|
`ipython-input-string-is-magic-p' to look for ipython magic |
|
commands, such as %prun, etc, and magic suffixes, such as ? and |
|
??, and handles them... magically? It hands them off to |
|
`ipython-input-handle-magic' for special treatment. |
|
|
|
Otherwise, `comint-simple-send' just sends STRING plus a newline." |
|
(if (and ipython-input-handle-magic-p ; must want to handle magic |
|
(ipython-input-string-is-magic-p string) ; ... be magic |
|
(ipython-input-handle-magic proc string)) ; and be handled |
|
;; To have just an input history creating, clearing new line entered |
|
(comint-simple-send proc "") |
|
(comint-simple-send proc string))) ; otherwise, you're sent |
|
|
|
;;;_* Make it easy to read long output |
|
(defun sage-input-sender (proc string) |
|
"A `comint-input-sender' that might send output to a buffer." |
|
;; this used to be fancier, but checking the prefix argument caused problems |
|
;; with programmatic invocation, so `sage-move-output-to-buffer' was added |
|
|
|
(ipython-input-sender proc string)) |
|
|
|
;; (when (not current-prefix-arg) |
|
;; ;; When not prefixed, send normally |
|
;; (ipython-input-sender proc string)) |
|
;; (when current-prefix-arg |
|
;; ;; When prefixed, output to buffer -- modelled after shell-command |
|
;; (let ((output-buffer (get-buffer-create "*Sage Output*"))) |
|
;; (save-excursion |
|
;; ;; Clear old output -- maybe this is a bad idea? |
|
;; (set-buffer output-buffer) |
|
;; (setq buffer-read-only nil) |
|
;; (erase-buffer)) |
|
;; (python-send-receive-to-buffer string output-buffer) |
|
;; (comint-simple-send proc "") ;; Clears input, saves history |
|
;; (if (with-current-buffer output-buffer (> (point-max) (point-min))) |
|
;; (message "XXX YYY") |
|
;; (error "XXX") |
|
;; (display-message-or-buffer output-buffer))))) |
|
|
|
(defun sage-move-output-to-buffer () |
|
"Delete output from interpreter since last input, moving it to *sage-output* buffer. |
|
Does not delete the prompt." |
|
(interactive) |
|
(with-current-buffer sage-buffer |
|
(let ((proc (get-buffer-process (current-buffer))) |
|
(replacement nil) |
|
(saved nil) |
|
(inhibit-read-only t)) |
|
(save-excursion |
|
(let ((pmark (progn (goto-char (process-mark proc)) |
|
(forward-line 0) |
|
(point-marker)))) |
|
|
|
;; save old text |
|
(setq saved (buffer-substring comint-last-input-end pmark)) |
|
|
|
(delete-region comint-last-input-end pmark) |
|
(goto-char (process-mark proc)) |
|
(setq replacement (concat "*** output moved to *sage-output* buffer ***\n" |
|
(buffer-substring pmark (point)))) |
|
(delete-region pmark (point)))) |
|
;; Output message and put back prompt |
|
(comint-output-filter proc replacement) |
|
|
|
;; now insert text in output buffer |
|
(let ((output-buffer (get-buffer-create "*sage-output*"))) |
|
(with-current-buffer output-buffer |
|
;; Clear old output -- maybe this is a bad idea? |
|
(setq buffer-read-only nil) |
|
(erase-buffer) |
|
(insert saved)) |
|
;; and possibly display the output-buffer, either in status bar or onscreen |
|
(if (with-current-buffer output-buffer (> (point-max) (point-min))) |
|
(display-buffer output-buffer)))))) |
|
|
|
;;;_* Sage process management |
|
|
|
(if (boundp 'python-shell-internal-buffer) |
|
(defvaralias 'sage-buffer 'python-shell-internal-buffer) |
|
(defvaralias 'sage-buffer 'python-buffer)) |
|
;; (defvar sage-buffer nil |
|
;; "*The current Sage process buffer. |
|
|
|
;; Commands that send text from source buffers to Sage processes have |
|
;; to choose a process to send to. This is determined by buffer-local |
|
;; value of `sage-buffer'. If its value in the current buffer, |
|
;; i.e. both any local value and the default one, is nil, `run-sage' |
|
;; and commands that send to the Python process will start a new process. |
|
|
|
;; Whenever \\[run-sage] starts a new process, it resets the default |
|
;; value of `sage-buffer' to be the new process's buffer and sets the |
|
;; buffer-local value similarly if the current buffer is in Sage mode |
|
;; or Inferior Sage mode, so that source buffer stays associated with a |
|
;; specific sub-process. |
|
|
|
;; Use \\[sage-set-proc] to set the default value from a buffer with a |
|
;; local value.") |
|
;; (make-variable-buffer-local 'sage-buffer) |
|
|
|
(defun sage-mode-p () |
|
(interactive) |
|
(derived-mode-p 'sage-mode 'pyrex-mode)) |
|
|
|
(defun inferior-sage-mode-p () |
|
(interactive) |
|
(derived-mode-p 'inferior-sage-mode)) |
|
|
|
(defun sage-all-inferior-sage-buffers () |
|
"List of names of sage buffers." |
|
(let ((bufs nil)) |
|
(save-excursion |
|
(dolist (buf (buffer-list)) |
|
(with-current-buffer buf |
|
(when (inferior-sage-mode-p) |
|
(push (buffer-name buf) bufs)))) |
|
(nreverse bufs)))) |
|
|
|
(defun sage-running-inferior-sage-buffers () |
|
(let ((bufs nil)) |
|
(save-excursion |
|
(dolist (buf (sage-all-inferior-sage-buffers)) |
|
(with-current-buffer buf |
|
(when (get-buffer-process (current-buffer)) |
|
(push (current-buffer) bufs)))) |
|
bufs))) |
|
|
|
(defun sage-mode-line-name-for-sage-buffer (buffer) |
|
(format ": [%s]" (buffer-name buffer))) |
|
|
|
(defun sage-update-mode-line (buffer) |
|
(setq mode-line-process (sage-mode-line-name-for-sage-buffer buffer)) |
|
(force-mode-line-update)) |
|
|
|
(defalias 'set-sage-buffer 'sage-set-buffer) |
|
(defun sage-set-buffer (buffer) |
|
(interactive |
|
(list (progn |
|
;; (unless (sage-mode-p) |
|
;; (error "Not in a sage-mode buffer!")) |
|
(completing-read |
|
"Sage buffer: " (sage-all-inferior-sage-buffers) nil nil |
|
(car (sage-all-inferior-sage-buffers)))))) |
|
(let ((chosen-buffer (with-current-buffer buffer (current-buffer)))) |
|
(setq sage-buffer chosen-buffer) |
|
(when (sage-mode-p) |
|
(sage-update-mode-line chosen-buffer)))) |
|
|
|
(defun python-proc () |
|
"Return the current Python process. |
|
See variable `python-buffer'. Starts a new process if necessary." |
|
;; Fixme: Maybe should look for another active process if there |
|
;; isn't one for `python-buffer'. |
|
|
|
(cond ((inferior-sage-mode-p) |
|
;; if we're in a sage buffer, that's us |
|
(get-buffer-process (current-buffer))) |
|
((comint-check-proc sage-buffer) |
|
;; if we refer to a good sage instance, use it |
|
(get-buffer-process sage-buffer)) |
|
((sage-running-inferior-sage-buffers) |
|
;; if there are other good sage instances, use one of them |
|
(call-interactively 'sage-set-buffer) |
|
(python-proc)) |
|
(t |
|
;; otherwise, start a new sage and try again |
|
(run-sage nil sage-command t) |
|
(python-proc)))) |
|
|
|
|
|
;; Use our version of python-proc (even though I have my doubts) |
|
;; for the new fgallina python.el |
|
(defun python-shell-internal-get-or-create-process () |
|
(python-proc)) |
|
|
|
;; History of sage-run commands. |
|
;;;###autoload |
|
(defvar sage-run-history nil) |
|
|
|
;; Convert a string to a list of arguments. |
|
;; Taken from old python.el. |
|
;; Does not handle quoted whitespace. |
|
(defun sage-args-to-list (string) |
|
(let ((where (string-match "[ \t]" string))) |
|
(cond ((null where) (list string)) |
|
((not (= where 0)) |
|
(cons (substring string 0 where) |
|
(sage-args-to-list (substring string (+ 1 where))))) |
|
(t (let ((pos (string-match "[^ \t]" string))) |
|
(if pos (sage-args-to-list (substring string pos)))))))) |
|
|
|
(defun sage-create-new-sage (cmd &optional new) |
|
(interactive |
|
(progn |
|
(let ((default (or cmd sage-command))) |
|
(list (read-from-minibuffer "Run sage (like this): " |
|
default |
|
nil nil 'sage-run-history |
|
default) |
|
current-prefix-arg)))) |
|
(unless cmd |
|
(setq cmd sage-command)) |
|
(with-current-buffer |
|
(let* ((sage-buffer-base-name (format "*Sage-%s*" (sage-current-branch))) |
|
(sage-buffer-name (if new (generate-new-buffer sage-buffer-base-name) sage-buffer-base-name)) |
|
(cmdlist (sage-args-to-list cmd)) |
|
;; Set PYTHONPATH to import module emacs from emacs.py, |
|
;; but ensure that a user specified PYTHONPATH will |
|
;; override our setting, so that emacs.py can be |
|
;; customized easily. |
|
(orig-path (getenv "PYTHONPATH")) |
|
(path-sep (if (and orig-path (length orig-path)) ":" "")) |
|
(data-path (concat "PYTHONPATH=" orig-path path-sep data-directory)) |
|
(process-environment |
|
(cons data-path process-environment))) |
|
(apply 'make-comint-in-buffer "Sage" |
|
sage-buffer-name |
|
(car cmdlist) nil (cdr cmdlist))))) |
|
|
|
(defun sage-new-sage-p () |
|
(interactive) |
|
(or (and (inferior-sage-mode-p) ; in a sage buffer but it's dead |
|
(not (comint-check-proc (current-buffer)))) |
|
(or (null sage-buffer) ; if there isn't a running sage |
|
(not (comint-check-proc sage-buffer))))) ; or the sage buffer is dead |
|
|
|
;;;###autoload |
|
(defalias 'sage 'run-sage) |
|
;;;###autoload |
|
(defalias 'sage-run 'run-sage) |
|
;;;###autoload |
|
(defun run-sage (&optional new cmd noshow) |
|
"Run an inferior Sage process, input and output via buffer *Sage*. |
|
|
|
NEW non-nil means always create a new buffer and Sage process. |
|
CMD is the Sage command to run. |
|
NOSHOW non-nil means toggle whether to show the buffer automatically. |
|
The default value depends on `sage-display-inferior-buffer'. |
|
If NOSHOW is t (from lisp), then the buffer will not be displayed. |
|
|
|
Normally, if there is a process already running in `sage-buffer', |
|
switch to that buffer. A new process is started if: one isn't |
|
running attached to `sage-buffer', or interactively the default |
|
`sage-command', or argument NEW is non-nil. See also the |
|
documentation for `sage-buffer'. |
|
|
|
Runs the hook `inferior-sage-mode-hook' \(after the |
|
`comint-mode-hook' is run). \(Type \\[describe-mode] in the process |
|
buffer for a list of commands.)" |
|
;; Fixme: Consider making `sage-buffer' buffer-local as a buffer |
|
;; (not a name) in Sage buffers from which `run-sage' &c is |
|
;; invoked. Would support multiple processes better. |
|
(interactive (list |
|
(and current-prefix-arg |
|
(not (eq '- current-prefix-arg))) |
|
nil ;; command |
|
(if (or (eq '- current-prefix-arg) |
|
(and (numberp current-prefix-arg) |
|
(< current-prefix-arg 0))) |
|
'toggle |
|
nil))) |
|
;; Use the prefix argument to toggle |
|
(setq noshow (cond |
|
((eq noshow t) |
|
t) |
|
(noshow |
|
sage-display-inferior-buffer) |
|
(t |
|
(not sage-display-inferior-buffer)))) |
|
(if (not (or new (sage-new-sage-p))) |
|
(unless noshow (pop-to-buffer sage-buffer)) |
|
(setq sage-buffer (if (sage-called-interactively-p 'all) |
|
(call-interactively 'sage-create-new-sage) |
|
(sage-create-new-sage cmd))) |
|
(set-default 'sage-buffer sage-buffer) ; update defaults |
|
|
|
(with-current-buffer sage-buffer |
|
(unless noshow (pop-to-buffer sage-buffer)) ; show progress |
|
(unless (inferior-sage-mode-p) |
|
(inferior-sage-mode)) |
|
(run-hooks 'sage-startup-before-prompt-hook) |
|
|
|
;; if there are commands to be executed after the prompt, wait for prompt... |
|
(when (and sage-startup-after-prompt-hook (inferior-sage-wait-for-prompt)) |
|
;; ... and execute them. |
|
(run-hooks 'sage-startup-after-prompt-hook))) |
|
|
|
;; newlines to clear things out |
|
(accept-process-output nil 0 1) |
|
(sage-send-command "" t) |
|
(accept-process-output nil 0 1) |
|
|
|
(when (sage-mode-p) |
|
;; If we're coming from a sage-mode buffer, update inferior buffer |
|
(message "Buffer %s will use sage %s" (current-buffer) sage-buffer) |
|
(sage-set-buffer sage-buffer)) |
|
(unless noshow (pop-to-buffer sage-buffer)))) |
|
|
|
(defun sage-set-buffer-name () |
|
(interactive) |
|
"Change the current Sage buffer name to include the current branch." |
|
(when (sage-current-branch) |
|
(rename-buffer |
|
(generate-new-buffer-name (format "*Sage-%s*" (sage-current-branch)))))) |
|
|
|
(defun sage-root () |
|
"Return SAGE_ROOT." |
|
(interactive) |
|
(save-match-data |
|
(let ((lst (split-string (shell-command-to-string (concat sage-command " -root"))))) |
|
(nth 0 lst)))) |
|
|
|
(defun sage-current-branch-link () |
|
"Return the current Sage branch link, i.e., the target of devel/sage. Meaningless with Sage 6.0." |
|
(interactive) |
|
(save-match-data |
|
(let ((lst (split-string (shell-command-to-string (concat sage-command " -branch"))))) |
|
(if (= 1 (length lst)) |
|
(nth 0 lst) |
|
"main")))) |
|
|
|
(defun sage-current-branch () |
|
"Return the current Sage branch name. Meaningless with Sage 6.0." |
|
(interactive) |
|
(save-match-data |
|
(if (and (inferior-sage-mode-p) |
|
(string-match "\\*Sage-\\(.*\\)\\*" (buffer-name))) |
|
(match-string 1 (buffer-name)) |
|
(sage-current-branch-link)))) |
|
|
|
(defun sage-current-devel-root () |
|
(interactive) |
|
"Return the current Sage branch directory." |
|
(let ((root-6+ (format "%s/src" (sage-root)))) |
|
(if (file-exists-p root-6+) |
|
root-6+ |
|
(format "%s/devel/sage-%s" (sage-root) (sage-current-branch))))) |
|
|
|
;;;_* Sage major mode for editing Sage library code |
|
|
|
;;;###autoload |
|
(define-derived-mode |
|
sage-mode |
|
python-mode |
|
"Sage" |
|
"Major mode for editing Sage files. |
|
|
|
The major entry points are: |
|
|
|
`sage', to spawn a new sage session. |
|
|
|
`sage-send-buffer', to send the current buffer to the inferior sage, using |
|
\"%runfile\"; `sage-send-region', to send the current region to the inferior |
|
sage, using \"%runfile\"; and `sage-send-doctest', to send the docstring point is |
|
currently looking at to the inferior sage interactively. |
|
|
|
`sage-test', to execute \"sage -t\" and friends and parse the output |
|
|
|
`sage-build', to execute \"sage -b\" and friends and parse the output. |
|
|
|
`sage-rerun' to restart an inferior sage in an existing buffer, and |
|
`sage-build' with a prefix argument to execute \"sage -br\" to rebuild sage |
|
and restart a fresh inferior sage in an existing buffer. |
|
|
|
\\{sage-mode-map}" |
|
(setq comment-column 60) |
|
(set (make-local-variable 'font-lock-multiline) t) |
|
(sage-font-lock)) |
|
|
|
(defun sage-font-lock () |
|
"Install Sage font-lock patterns." |
|
(interactive) |
|
(font-lock-add-keywords 'sage-mode python-font-lock-keywords 'set) ;; XXX |
|
;; (font-lock-add-keywords 'sage-mode |
|
;; `(("\\(\\*\\*\\)test\\(\\*\\*\\)" . 'font-lock-comment-face))) |
|
) |
|
|
|
;;;_* Treat Sage code as Python source code |
|
|
|
;;;###autoload |
|
(add-to-list 'interpreter-mode-alist '("sage" . sage-mode)) |
|
;;;###autoload |
|
(add-to-list 'auto-mode-alist '("\\.sage\\'" . sage-mode)) |
|
|
|
(if (boundp 'python-source-modes) |
|
(add-to-list 'python-source-modes 'sage-mode) |
|
;; It's only used to help get defaults in some cases |
|
(defvar python-source-modes nil)) |
|
|
|
(defvar sage-load-file-command "%%runfile %s" |
|
"Format string to make sage load a filename") |
|
|
|
(defun sage-quit-debugger () |
|
"Quit debugger if looking at a debugger prompt." |
|
(when (sage-last-prompt-is-debugger) |
|
(with-current-buffer sage-buffer |
|
(comint-kill-input) |
|
(comint-send-eof) |
|
(accept-process-output nil 0 1) |
|
(sit-for 0)))) |
|
|
|
(defun sage-maybe-quit-debugger () |
|
"Maybe quit debugger if looking at a debugger prompt. |
|
Quits if `sage-quit-debugger-automatically' is non-nil or user requests quit." |
|
(when (or sage-quit-debugger-automatically |
|
(y-or-n-p "Quit debugger before sending input? ")) |
|
(sage-quit-debugger))) |
|
|
|
;;;###autoload |
|
(defun sage-send-buffer () |
|
"Send the current buffer to the inferior sage process. |
|
The buffer is loaded using sage's \"%runfile\" command." |
|
(interactive) |
|
(sage-maybe-quit-debugger) |
|
|
|
(when (buffer-file-name) |
|
;; named file -- offer to save it, then send it |
|
(when (buffer-modified-p) |
|
(save-some-buffers)) |
|
(sage-send-command (format sage-load-file-command (buffer-file-name)) t)) |
|
(unless (buffer-file-name) |
|
;; un-named buffer -- use sage-send-region |
|
(sage-send-region (point-min) (point-max))) |
|
(pop-to-buffer sage-buffer)) |
|
|
|
;;;###autoload |
|
(defun sage-send-region (start end) |
|
"Send the region to the inferior Sage process. |
|
The region is treated as a temporary \".sage\" file with minimal |
|
processing. The logic is that this command is intended to |
|
emulate interactive input, although this isn't perfect: sending |
|
the region \"2\" does not print \"2\"." |
|
;; The region is evaluated from a temporary file. This avoids |
|
;; problems with blank lines, which have different semantics |
|
;; interactively and in files. It also saves the inferior process |
|
;; buffer filling up with interpreter prompts. We need a Python |
|
;; function to remove the temporary file when it has been evaluated |
|
;; (though we could probably do it in Lisp with a Comint output |
|
;; filter). This function also catches exceptions and truncates |
|
;; tracebacks not to mention the frame of the function itself. |
|
;; |
|
;; The `compilation-shell-minor-mode' parsing takes care of relating |
|
;; the reference to the temporary file to the source. |
|
;; |
|
;; Fixme: Write a `coding' header to the temp file if the region is |
|
;; non-ASCII. |
|
(interactive "r") |
|
(sage-maybe-quit-debugger) |
|
|
|
(let* ((f (make-temp-file "sage" nil ".sage")) |
|
(command (format sage-load-file-command f)) |
|
(orig-start (copy-marker start))) |
|
(when (save-excursion |
|
(goto-char start) |
|
(/= 0 (current-indentation))) ; need dummy block |
|
(save-excursion |
|
(goto-char orig-start) |
|
;; Wrong if we had indented code at buffer start. |
|
(set-marker orig-start (line-beginning-position 0))) |
|
(write-region "if True:\n" nil f nil 'nomsg)) |
|
(write-region start end f t 'nomsg) |
|
(message "Sending region to sage buffer...") |
|
(sage-send-command command t) ;; the true is whether to show the input line or not |
|
(pop-to-buffer sage-buffer) |
|
(message "Sending region to sage buffer... done.") |
|
(with-current-buffer (process-buffer (python-proc)) |
|
;; Tell compile.el to redirect error locations in file `f' to |
|
;; positions past marker `orig-start'. It has to be done *after* |
|
;; `python-send-command''s call to `compilation-forget-errors'. |
|
(compilation-fake-loc orig-start f)))) |
|
|
|
(defun sage-send-defun () |
|
"Send the current defun to the inferior Sage process via `sage-send-region'." |
|
(interactive) |
|
(sage-send-region (save-excursion (beginning-of-defun) (point)) |
|
(save-excursion (end-of-defun) (point)))) |
|
|
|
(defun sage-send-statement () |
|
"Send the current statement to the inferior Sage process via `sage-send-region'." |
|
(interactive) |
|
;; We have to use the line-beginning-position since indentation is important in |
|
;; Python and sage-send-region creates a fake block in case things are indented. |
|
(sage-send-region (save-excursion (python-beginning-of-statement) (line-beginning-position)) |
|
(save-excursion (python-end-of-statement)))) |
|
|
|
(defun sage-attach-this-file () |
|
"Attach this file to the current Sage process." |
|
(interactive) |
|
(sage-maybe-quit-debugger) |
|
(if buffer-file-name |
|
(sage-send-command (format "attach(r'''%s''')" buffer-file-name) t) |
|
(error "This buffer is not associated with a file. Please save it first"))) |
|
|
|
;;;_* Integrate Sage mode with Emacs |
|
|
|
;;;###autoload |
|
(defun sage-pcomplete-or-help () |
|
"If point is after ?, describe preceding symbol; otherwise, pcomplete." |
|
(interactive) |
|
(if (not (looking-back "[^\\?]\\?")) |
|
(pcomplete) |
|
(save-excursion |
|
(backward-char) |
|
(when (python-current-word) |
|
(ipython-describe-symbol (python-current-word)))))) |
|
|
|
;;;_ + Set better grep defaults for Sage and Pyrex code |
|
|
|
;; (eval-after-load "grep" |
|
;; (progn |
|
;; (add-to-list 'grep-files-aliases '("py" . "{*.py,*.pyx}")) |
|
;; (add-to-list 'grep-files-aliases '("pyx" . "{*.py,*.pyx}")))) |
|
|
|
;;;_ + Make src/sage files play nicely, and don't jump into site-packages if possible |
|
|
|
;;; It's annoying to get lost in sage/.../site-packages version of files when |
|
;;; `sage-find-symbol' and friends jump to files. It's even more annoying when |
|
;;; the file is not correctly recognized as sage source! |
|
|
|
(add-to-list 'auto-mode-alist '("devel/sage.*?\\.py\\'" . sage-mode)) |
|
(add-to-list 'auto-mode-alist '("devel/sage.*?\\.pyx\\'" . pyrex-mode)) |
|
(add-to-list 'auto-mode-alist '("src/sage.*?\\.py\\'" . sage-mode)) |
|
(add-to-list 'auto-mode-alist '("src/sage.*?\\.pyx\\'" . pyrex-mode)) |
|
|
|
(defvar sage-site-packages-regexp "\\(local/lib/python[0-9.]*/site-packages.*?\\)/sage" |
|
"Regexp to match sage site-packages files. |
|
|
|
Match group 1 will be replaced with src") |
|
|
|
(add-hook 'find-file-hook 'sage-warn-if-site-packages-file) |
|
(defun sage-warn-if-site-packages-file() |
|
"Warn if sage FILE is in site-packages and offer to find current branch version." |
|
(let ((f (buffer-file-name (current-buffer)))) |
|
(and f (string-match sage-site-packages-regexp f) |
|
(let ((should-jump (if (eq sage-site-packages-find-original 'query) |
|
(y-or-n-p "This is a sage site-packages file, open the real file? ") |
|
sage-site-packages-find-original))) |
|
(if should-jump |
|
(sage-jump-to-development-version) |
|
(push '(:propertize "SAGE-SITE-PACKAGES-FILE:" face font-lock-warning-face) |
|
mode-line-buffer-identification)))))) |
|
|
|
(defun sage-development-version (filename) |
|
"If FILENAME is in site-packages, current branch version, else FILENAME." |
|
(save-match-data |
|
(let* ((match (string-match sage-site-packages-regexp filename))) |
|
(if (and filename match) |
|
(let ((file-6+ (concat (substring filename 0 (match-beginning 1)) |
|
"src" |
|
(substring filename (match-end 1))))) |
|
(if (file-exists-p file-6+) |
|
file-6+ |
|
;; handle current branch somewhat intelligiently |
|
(let* ((base (concat (substring filename 0 (match-beginning 1)) "devel/")) |
|
(branch (or (file-symlink-p (concat base "sage")) "sage"))) |
|
(concat base branch (substring filename (match-end 1)))))) |
|
filename)))) |
|
|
|
(defun sage-jump-to-development-version () |
|
"Jump to current branch version of current FILE if we're in site-packages version." |
|
(interactive) |
|
(let* ((filename (sage-development-version (buffer-file-name (current-buffer)))) |
|
(maybe-buf (find-buffer-visiting filename))) |
|
(if maybe-buf (pop-to-buffer maybe-buf) |
|
(find-alternate-file filename)))) |
|
|
|
(require 'advice) |
|
(defadvice compilation-find-file |
|
(before sage-compilation-find-file (marker filename directory &rest formats)) |
|
"Always try to find compilation errors in FILENAME in the current branch version." |
|
(ad-set-arg 1 (sage-development-version filename))) |
|
(ad-activate 'compilation-find-file) |
|
|
|
;;;_ + Integrate eshell with hg |
|
|
|
(defadvice hg-root |
|
(before eshell-hg-root (&optional path)) |
|
"Use current directory in eshell-mode for hg-root if possible. |
|
Use current devel directory in inferior-sage-mode for hg-root if possible. |
|
Meaningless with Sage 6.0." |
|
(when (derived-mode-p 'eshell-mode) ; buffer local in eshell buffers |
|
(ad-set-arg 0 default-directory)) |
|
(when (inferior-sage-mode-p) ; buffer local in inferior sage buffers |
|
(ad-set-arg 0 (sage-current-devel-root)))) |
|
|
|
(ad-activate 'hg-root) |
|
|
|
;;;_ + Integrate with eshell |
|
|
|
(defconst sage-test-compilation-regexp |
|
(list 'sage-test-compilation |
|
"^File \"\\(.*\\)\", line \\([0-9]+\\)" |
|
1 |
|
2)) |
|
|
|
(defconst sage-build-compilation-regexp |
|
(list 'sage-build-compilation |
|
"^\\(.*\\):\\([0-9]+\\):\\([0-9]+\\):" |
|
1 2 3)) |
|
|
|
;; To add support for Sage build and test errors to *compilation* buffers by |
|
;; default, evaluate the following four lines. |
|
;; |
|
;; (add-to-list 'compilation-error-regexp-alist-alist sage-test-compilation-regexp) |
|
;; (add-to-list 'compilation-error-regexp-alist 'sage-test-compilation) |
|
;; (add-to-list 'compilation-error-regexp-alist-alist sage-build-compilation-regexp) |
|
;; (add-to-list 'compilation-error-regexp-alist 'sage-build-compilation) |
|
|
|
(defun eshell-sage-command-hook (command args) |
|
"Handle some Sage invocations specially. |
|
|
|
Without ARGS, run Sage in an emacs `sage-mode' buffer. |
|
|
|
With first ARGS starting with \"-b\" or \"-t\", run Sage in an |
|
emacs `compilation-mode' buffer. |
|
|
|
Otherwise (for example, with ARGS \"-hg\", run Sage at the eshell |
|
prompt as normal. |
|
|
|
This is an `eshell-named-command-hook' because only some parameters modify the |
|
command; other times, it has to execute as a standard eshell command." |
|
(when (equal command "sage") |
|
(cond ((not args) |
|
;; run sage inside emacs |
|
(run-sage nil sage-command t) |
|
t) |
|
((member (substring (car args) 0 2) '("-t" "-b")) |
|
;; echo sage build into compilation buffer |
|
(throw 'eshell-replace-command |
|
(eshell-parse-command |
|
"compile" |
|
(cons "sage" (eshell-flatten-list args)))))))) |
|
(add-hook 'eshell-named-command-hook 'eshell-sage-command-hook) |
|
|
|
;; From http://www.emacswiki.org/cgi-bin/wiki?EshellFunctions |
|
(defun eshell/compile (&rest args) |
|
"Use `compile' to do background makes." |
|
(if (eshell-interactive-output-p) |
|
(let ((compilation-process-setup-function |
|
(list 'lambda nil |
|
(list 'setq 'process-environment |
|
(list 'quote (eshell-copy-environment)))))) |
|
(compile (eshell-flatten-and-stringify args)) |
|
(pop-to-buffer compilation-last-buffer)) |
|
(throw 'eshell-replace-command |
|
(let ((l (eshell-stringify-list (eshell-flatten-list args)))) |
|
(eshell-parse-command (car l) (cdr l)))))) |
|
(put 'eshell/compile 'eshell-no-numeric-conversions t) |
|
|
|
;;;_* Load relative modules correctly |
|
|
|
(defun python-qualified-module-name (file) |
|
"Find the qualified module name for filename FILE. |
|
|
|
This recurses down the directory tree as long as there are __init__.py |
|
files there, signalling that we are inside a package. |
|
|
|
Returns a pair (PACKAGE . MODULE). The first is the top level |
|
package directory; the second is the dotted Python module name. |
|
|
|
Adapted from a patch posted to the python-mode trac." |
|
(flet ((rec (d f) |
|
(let* ((dir (file-name-directory d)) |
|
(initpy (concat dir "__init__.py"))) |
|
(if (file-exists-p initpy) |
|
(let ((d2 (directory-file-name d))) |
|
(rec (file-name-directory d2) |
|
(concat (file-name-nondirectory d2) "." f))) |
|
(list d f))))) |
|
(rec (file-name-directory file) |
|
(file-name-sans-extension (file-name-nondirectory file))))) |
|
|
|
;;; Replace original `python-load-file' to use xreload and packages. |
|
(defadvice python-load-file |
|
(around nca-python-load-file first (file-name &optional no-xreload)) |
|
"Load a Python file FILE-NAME into the inferior Python process. |
|
|
|
Without prefix argument, use fancy new xreload. With prefix |
|
argument, use default Python reload. |
|
|
|
THIS REPLACES THE ORIGINAL `python-load-file'. |
|
|
|
If the file has extension `.py' import or reload it as a module. |
|
Treating it as a module keeps the global namespace clean, provides |
|
function location information for debugging, and supports users of |
|
module-qualified names." |
|
(interactive |
|
(append (comint-get-source |
|
(format "%s Python file: " (if current-prefix-arg "reload" "xreload")) |
|
python-prev-dir/file |
|
python-source-modes |
|
t) |
|
current-prefix-arg)) ; because execfile needs exact name |
|
(comint-check-source file-name) ; Check to see if buffer needs saving. |
|
(setq python-prev-dir/file (cons (file-name-directory file-name) |
|
(file-name-nondirectory file-name))) |
|
(sage-send-command |
|
(if (string-match "\\.py\\'" file-name) |
|
(let* ((directory-module (python-qualified-module-name file-name)) |
|
(directory (car directory-module)) |
|
(module (cdr directory-module)) |
|
(xreload-flag (if no-xreload "False" "True"))) |
|
(format "emacs.eimport(%S, %S, use_xreload=%s)" |
|
module directory xreload-flag)) |
|
(format "execfile(%S)" file-name))) |
|
(message "%s loaded" file-name)) |
|
(ad-activate 'python-load-file) |
|
|
|
;;;_* Convenient *programmatic* Python interaction |
|
|
|
(defvar python-default-tag-noerror "_XXX1XXX_NOERROR") |
|
(defvar python-default-tag-error "_XXX1XXX_ERROR") |
|
|
|
(defun python-protect-command (command &optional tag-noerror tag-error) |
|
"Wrap Python COMMAND in a try-except block and signal error conditions. |
|
|
|
Print TAG-NOERROR on successful Python execution and TAG-ERROR on |
|
error conditions." |
|
(let* ((tag-noerror (or tag-noerror python-default-tag-noerror)) |
|
(tag-error (or tag-error python-default-tag-error)) |
|
(lines (split-string command "\n")) |
|
(indented-lines |
|
(mapconcat (lambda (x) (concat " " x)) lines "\n"))) |
|
(format "try: |
|
%s |
|
print %S, |
|
except e: |
|
print e |
|
print %S, |
|
" indented-lines tag-noerror tag-error))) |
|
|
|
(defmacro with-python-output-to-buffer (buffer command &rest body) |
|
"Send COMMAND to inferior Python, redirect output to BUFFER, and execute |
|
BODY in that buffer. |
|
|
|
The value returned is the value of the last form in body. |
|
|
|
Block while waiting for output." |
|
(declare (indent 2) (debug t)) |
|
`(with-current-buffer ,buffer |
|
;; Grab what Python has to say |
|
(comint-redirect-send-command-to-process |
|
(python-protect-command ,command) |
|
(current-buffer) (python-proc) nil t) |
|
;; Wait for the redirection to complete |
|
(with-current-buffer (process-buffer (python-proc)) |
|
(while (null comint-redirect-completed) |
|
(accept-process-output nil 1))) |
|
(message (buffer-name)) |
|
;; Execute BODY |
|
,@body |
|
)) |
|
|
|
(defmacro with-python-output-buffer (command &rest body) |
|
"Send COMMAND to inferior Python and execute BODY in temp buffer with |
|
output. |
|
|
|
The value returned is the value of the last form in body. |
|
|
|
Block while waiting for output." |
|
(declare (indent 1) (debug t)) |
|
`(with-temp-buffer |
|
(with-python-output-to-buffer (current-buffer) ,command |
|
,@body))) |
|
|
|
;; (with-python-output-to-buffer "*scratch*" "x?\x?" |
|
;; (message "%s" (buffer-name))) |
|
|
|
;;;###autoload |
|
(defun sage-send-command (command &optional echo-input needs-prompt) |
|
"Evaluate COMMAND in inferior Python process. |
|
|
|
If ECHO-INPUT is non-nil, echo input in process buffer. |
|
If NEEDS-PROMPT is non-nil, sents a print newline statement in an attempt |
|
to ensure that the prompt appears correctly. |
|
" |
|
(interactive "sCommand: ") |
|
(accept-process-output nil 0 1) |
|
(with-current-buffer (process-buffer (python-proc)) |
|
(goto-char (point-max)) |
|
(if echo-input |
|
(with-current-buffer (process-buffer (python-proc)) |
|
;; Insert and evaluate input string in place |
|
(let ((old (comint-get-old-input-default))) |
|
(delete-field) |
|
(insert command) |
|
(comint-send-input nil t) |
|
(insert old))) |
|
;; Work around bug in python-send-command or compilation-forget-errors |
|
(unless (hash-table-p compilation-locs) |
|
(compilation-minor-mode 1)) |
|
(python-send-string (concat command |
|
(if needs-prompt "\nprint('\\n')" nil)))))) |
|
|
|
(defun python-send-receive-to-buffer (command buffer &optional echo-output) |
|
"Send COMMAND to inferior Python (if any) and send output to BUFFER. |
|
|
|
If ECHO-OUTPUT is non-nil, echo output to process buffer. |
|
|
|
This is an alternate `python-send-receive' that uses temporary buffers and |
|
`comint-redirect-send-command-to-process'. Block while waiting for output. |
|
This implementation handles multi-line output strings gracefully. At this |
|
time, it does not handle multi-line input strings at all." |
|
(interactive "sCommand: ") |
|
(with-current-buffer buffer |
|
;; Grab what Python has to say |
|
(comint-redirect-send-command-to-process |
|
command (current-buffer) (python-proc) echo-output t) |
|
;; Wait for the redirection to complete |
|
(with-current-buffer (process-buffer (python-proc)) |
|
(while (null comint-redirect-completed) |
|
(accept-process-output nil 1))))) |
|
|
|
(defun python-send-receive-multiline (command) |
|
"Send COMMAND to inferior Python (if any) and return result as a string. |
|
|
|
This is an alternate `python-send-receive' that uses temporary buffers and |
|
`comint-redirect-send-command-to-process'. Block while waiting for output. |
|
This implementation handles multi-line output strings gracefully. At this |
|
time, it does not handle multi-line input strings at all." |
|
(interactive "sCommand: ") |
|
|
|
(if (fboundp 'python-shell-send-string-no-output) |
|
(python-shell-send-string-no-output command (python-proc)) |
|
(with-temp-buffer |
|
;; Grab what Python has to say |
|
(comint-redirect-send-command-to-process |
|
command (current-buffer) (python-proc) nil t) |
|
;; Wait for the redirection to complete |
|
(with-current-buffer (process-buffer (python-proc)) |
|
(while (null comint-redirect-completed) |
|
(accept-process-output nil 1))) |
|
;; Return the output |
|
(let ((output (buffer-substring-no-properties (point-min) (point-max)))) |
|
(when (sage-called-interactively-p 'interactive) |
|
(message output)) |
|
output)))) |
|
|
|
;;;_* Generally useful tidbits |
|
|
|
(defun python-current-word () |
|
"Return python symbol at point." |
|
(with-syntax-table python-dotty-syntax-table |
|
;; the t makes current-word strict: returns nil if point is not in the word |
|
(current-word t))) |
|
|
|
;;;_* IPython and Sage completing reads |
|
|
|
;;;_ + `ipython-completing-read-symbol' is `completing-read' for python symbols |
|
;;; using IPython's *? mechanism |
|
|
|
(defvar ipython-completing-read-symbol-history () |
|
"List of Python symbols recently queried.") |
|
|
|
(defvar ipython-completing-read-symbol-pred nil |
|
"Default predicate for filtering queried Python symbols.") |
|
|
|
(defvar ipython-completing-read-symbol-command "%%psearch -a %s*" |
|
"IPython command for generating completions. |
|
Each completion should appear separated by whitespace.") |
|
|
|
(defvar ipython-completing-read-symbol-cache () |
|
"A pair (LAST-QUERIED-STRING . COMPLETIONS).") |
|
|
|
(defun ipython-completing-read-symbol-clear-cache () |
|
"Clear the IPython completing read cache." |
|
(interactive) |
|
(setq ipython-completing-read-symbol-cache ())) |
|
|
|
(defun ipython-completing-read-symbol-make-completions (string) |
|
"Query IPython for completions of STRING. |
|
|
|
Return a list of completion strings. |
|
Uses `ipython-completing-read-symbol-command' to query IPython." |
|
(let* ((command (format ipython-completing-read-symbol-command string)) |
|
(output (python-send-receive-multiline command))) |
|
(condition-case () |
|
(split-string output) |
|
(error nil)))) |
|
|
|
(defun ipython-completing-read-symbol-function (string predicate action) |
|
"A `completing-read' programmable completion function for querying IPython. |
|
|
|
See `try-completion' and `all-completions' for interface details." |
|
(let ((cached-string (car ipython-completing-read-symbol-cache)) |
|
(completions (cdr ipython-completing-read-symbol-cache))) |
|
;; Recompute table using IPython if neccessary |
|
(when (or (null completions) |
|
(not (equal string cached-string))) |
|
(setq ipython-completing-read-symbol-cache |
|
(cons string (ipython-completing-read-symbol-make-completions string))) |
|
(setq completions |
|
(cdr ipython-completing-read-symbol-cache))) |
|
;; Complete as necessary |
|
(cond ((eq action 'lambda) ; action is 'lambda |
|
(test-completion string completions)) |
|
(action ; action is t |
|
(pcomplete-uniqify-list (all-completions string completions predicate))) |
|
(t ; action is nil |
|
(try-completion string completions predicate))))) |
|
|
|
(defun ipython-completing-read-symbol |
|
(&optional prompt def require-match predicate) |
|
"Read a Python symbol (default: DEF) from user, completing with IPython. |
|
|
|
Return a single element list, suitable for use in `interactive' forms. |
|
PROMPT is the prompt to display, without colon or space. |
|
If DEF is nil, default is `python-current-word'. |
|
PREDICATE returns non-nil for potential completions. |
|
See `completing-read' for REQUIRE-MATCH." |
|
(let* ((default (or def (python-current-word))) |
|
(prompt (if (null default) (concat prompt ": ") |
|
(concat prompt (format " (default %s): " default)))) |
|
(func 'ipython-completing-read-symbol-function) |
|
(pred (or predicate ipython-completing-read-symbol-pred)) |
|
(hist 'ipython-completing-read-symbol-history) |
|
(enable-recursive-minibuffers t)) |
|
(ipython-completing-read-symbol-clear-cache) |
|
(list (completing-read prompt func pred require-match nil hist default)))) |
|
|
|
;;; `ipython-describe-symbol' is `find-function' for python symbols using |
|
;;; IPython's ? magic mechanism. |
|
|
|
(defvar ipython-describe-symbol-not-found-regexp "Object `.*?` not found." |
|
"Regexp that matches IPython's 'symbol not found' warning.") |
|
|
|
(defvar ipython-describe-symbol-command "%s?") |
|
|
|
(defvar ipython-describe-symbol-temp-buffer-show-hook |
|
(lambda () ; avoid xref stuff |
|
(setq buffer-read-only t) |
|
(setq view-return-to-alist |
|
(list (cons (selected-window) help-return-method)))) |
|
"`temp-buffer-show-hook' installed for `ipython-describe-symbol' output.") |
|
|
|
(defun ipython-describe-symbol-markup-function (string) |
|
"Markup IPython's inspection (?) for display." |
|
(when (string-match "[ \t\n]+\\'" string) |
|
(concat (substring string 0 (match-beginning 0)) "\n"))) |
|
|
|
(define-button-type 'help-sage-function-def |
|
:supertype 'help-xref |
|
'help-function #'sage-find-symbol-other-window |
|
'help-echo (purecopy "mouse-2, RET: find function's definition")) |
|
|
|
(defun ipython-describe-symbol-markup-buffer (symbol) |
|
"Markup IPython's inspection (?) in current buffer for display." |
|
(help-make-xrefs (current-buffer)) |
|
(save-excursion |
|
(save-match-data |
|
(let ((case-fold-search nil)) |
|
;; Make HEADERS: stand out |
|
(goto-char (point-min)) |
|
(while (re-search-forward "\\([A-Z][^a-z]+\\):" nil t) ;; t means no error |
|
(setq buffer-read-only nil) |
|
(add-text-properties (match-beginning 1) (match-end 1) '(face bold))) |
|
|
|
;; make File: a link |
|
(goto-char (point-min)) |
|
(while (re-search-forward "File:\\s-*\\(.*\\)" nil t) ;; t means no error |
|
(setq buffer-read-only nil) |
|
(replace-match (sage-development-version (match-string 1)) nil nil nil 1) |
|
(help-xref-button 1 'help-sage-function-def symbol) |
|
(setq buffer-read-only t)) |
|
t)))) |
|
|
|
(defun ipython-describe-symbol (symbol) |
|
"Get help on SYMBOL using IPython's inspection (?). |
|
Interactively, prompt for SYMBOL." |
|
;; Note that we do this in the inferior process, not a separate one, to |
|
;; ensure the environment is appropriate. |
|
(interactive (ipython-completing-read-symbol "Describe symbol" nil t)) |
|
(when (or (null symbol) (equal "" symbol)) |
|
(error "No symbol")) |
|
(let* ((command (format ipython-describe-symbol-command symbol)) |
|
(raw-contents (python-send-receive-multiline command)) |
|
(help-contents |
|
(or (ipython-describe-symbol-markup-function raw-contents) |
|
raw-contents)) |
|
(temp-buffer-show-hook ipython-describe-symbol-temp-buffer-show-hook)) |
|
;; XXX Handle exceptions; perhaps (with-python-output ...) or similar |
|
;; Handle symbol not found gracefully |
|
(when (string-match ipython-describe-symbol-not-found-regexp raw-contents) |
|
(error "Symbol not found")) |
|
(when (= 0 (length help-contents)) |
|
(error "Symbol has no description")) |
|
;; Ensure we have a suitable help buffer. |
|
(with-output-to-temp-buffer (help-buffer) |
|
(with-current-buffer standard-output |
|
;; Fixme: Is this actually useful? |
|
(help-setup-xref (list 'ipython-describe-symbol symbol) |
|
(sage-called-interactively-p 'interactive)) |
|
(set (make-local-variable 'comint-redirect-subvert-readonly) t) |
|
(help-print-return-message) |
|
;; Finally, display help contents |
|
(princ help-contents))) |
|
;; Markup help buffer |
|
(with-current-buffer (help-buffer) |
|
(ipython-describe-symbol-markup-buffer symbol) |
|
;; make it easy to send doctests from a help buffer, for example |
|
(run-hooks 'sage-after-help-hook))) |
|
t) |
|
|
|
;;;_ + `sage-find-symbol' is `find-function' for Sage. |
|
|
|
(defun sage-find-symbol-command (symbol) |
|
"Return Sage command to fetch position of SYMBOL." |
|
(format |
|
(concat "sage.misc.sageinspect.sage_getfile(%s), " |
|
"sage.misc.sageinspect.sage_getsourcelines(%s)[-1] + 1") |
|
symbol symbol)) |
|
|
|
(defvar sage-find-symbol-regexp "('\\(.*?\\)',[ \t\n]+\\([0-9]+\\))" |
|
"Match (FILENAME . LINE) from `sage-find-symbol-command'.") |
|
|
|
(defun sage-find-symbol-noselect (symbol) |
|
"Return a pair (BUFFER . POINT) pointing to the definition of SYMBOL. |
|
|
|
Queries Sage to find the source file containing the definition of |
|
FUNCTION in a buffer and the point of the definition. The buffer |
|
is not selected. |
|
|
|
At this time, there is no error checking. Later, if the function |
|
definition can't be found in the buffer, returns (BUFFER)." |
|
(when (not symbol) |
|
(error "You didn't specify a symbol")) |
|
(let* ((command (sage-find-symbol-command symbol)) |
|
(raw-contents (python-send-receive-multiline command))) |
|
(unless (string-match sage-find-symbol-regexp raw-contents) |
|
(error "Symbol source not found")) |
|
(let* ((raw-filename (match-string 1 raw-contents)) |
|
(filename (sage-development-version raw-filename)) |
|
(line-num (string-to-number (match-string 2 raw-contents)))) |
|
(with-current-buffer (find-file-noselect filename) |
|
(save-restriction |
|
(widen) |
|
(goto-char (point-min)) |
|
(forward-line (1- line-num))) ; XXX error checking? |
|
(cons (current-buffer) (point)))))) |
|
|
|
(defun sage-find-symbol-do-it (symbol switch-fn) |
|
"Find definition of SYMBOL in a buffer and display it. |
|
|
|
SWITCH-FN is the function to call to display and select the |
|
buffer." |
|
(let* ((orig-point (point)) |
|
(orig-buf (window-buffer)) |
|
(orig-buffers (buffer-list)) |
|
(buffer-point (save-excursion |
|
(sage-find-symbol-noselect symbol))) |
|
(new-buf (car buffer-point)) |
|
(new-point (cdr buffer-point))) |
|
(when buffer-point |
|
(when (memq new-buf orig-buffers) |
|
(push-mark orig-point)) |
|
(funcall switch-fn new-buf) |
|
(when new-point (goto-char new-point)) |
|
(recenter find-function-recenter-line) |
|
;; (run-hooks 'find-function-after-hook) |
|
t))) |
|
|
|
;;;###autoload |
|
(defun sage-find-symbol (symbol) |
|
"Find the definition of the SYMBOL near point. |
|
|
|
Finds the source file containing the defintion of the SYMBOL near point and |
|
places point before the definition. |
|
Set mark before moving, if the buffer already existed." |
|
(interactive (ipython-completing-read-symbol "Find symbol" nil t)) |
|
(when (or (null symbol) (equal "" symbol)) |
|
(error "No symbol")) |
|
(sage-find-symbol-do-it symbol 'switch-to-buffer)) |
|
|
|
;;;###autoload |
|
(defun sage-find-symbol-other-window (symbol) |
|
"Find, in another window, the definition of SYMBOL near point. |
|
|
|
See `sage-find-symbol' for details." |
|
(interactive (ipython-completing-read-symbol "Find symbol" nil t)) |
|
(when (or (null symbol) (equal "" symbol)) |
|
(error "No symbol")) |
|
(sage-find-symbol-do-it symbol 'switch-to-buffer-other-window)) |
|
|
|
;;;###autoload |
|
(defun sage-find-symbol-other-frame (symbol) |
|
"Find, in another frame, the definition of SYMBOL near point. |
|
|
|
See `sage-find-symbol' for details." |
|
(interactive (ipython-completing-read-symbol "Find symbol" nil t)) |
|
(when (or (null symbol) (equal "" symbol)) |
|
(error "No symbol")) |
|
(sage-find-symbol-do-it symbol 'switch-to-buffer-other-frame)) |
|
|
|
;;;_ + `try-complete-sage-symbol-partially' is a `hippie-expand' function for Sage |
|
|
|
(defun he-sage-symbol-beg () |
|
(save-excursion |
|
(with-syntax-table python-dotty-syntax-table |
|
(skip-syntax-backward "w_") |
|
(point)))) |
|
|
|
(defun he-sage-symbol-end () |
|
(save-excursion |
|
(with-syntax-table python-dotty-syntax-table |
|
(skip-syntax-forward "w_") |
|
(point)))) |
|
|
|
(defun try-complete-sage-symbol-partially (old) |
|
"Try to complete as a Sage symbol, as many characters as unique. |
|
|
|
The argument OLD is nil if this is the first call to this |
|
function, non-nil if this is a subsequent call. |
|
|
|
Returns t if a unique, possibly partial, completion is found; nil |
|
otherwise." |
|
(let ((expansion nil)) |
|
(when (not old) |
|
(he-init-string (he-sage-symbol-beg) (point)) |
|
(unless (string= he-search-string "") |
|
(setq expansion (ipython-completing-read-symbol-function |
|
he-search-string nil nil))) |
|
(when (or (eq expansion nil) |
|
(string= expansion he-search-string) |
|
(he-string-member expansion he-tried-table)) |
|
(setq expansion nil))) |
|
(if (not expansion) |
|
(progn |
|
(when old (he-reset-string)) |
|
nil) |
|
(progn |
|
(he-substitute-string expansion) |
|
t)))) |
|
|
|
;;;_ + `pcomplete' support |
|
|
|
;; if pcomplete is available, set it up! |
|
;; (when (featurep 'pcomplete) |
|
|
|
(defun pcomplete-sage-setup () |
|
(interactive) |
|
(set (make-local-variable 'pcomplete-autolist) |
|
nil) |
|
(set (make-local-variable 'pcomplete-cycle-completions) |
|
nil) |
|
(set (make-local-variable 'pcomplete-use-paring) |
|
nil) |
|
|
|
(set (make-local-variable 'pcomplete-default-completion-function) |
|
'pcomplete-sage-default-completion) |
|
(set (make-local-variable 'pcomplete-command-completion-function) |
|
'pcomplete-sage-default-completion) |
|
(set (make-local-variable 'pcomplete-parse-arguments-function) |
|
'pcomplete-parse-sage-arguments) |
|
|
|
(set (make-local-variable 'pcomplete-termination-string) |
|
"") |
|
) |
|
|
|
(defun pcomplete-sage-completions () |
|
(save-excursion |
|
(save-restriction |
|
(let ((stub (nth pcomplete-index pcomplete-args))) |
|
(when (and stub (not (string= stub ""))) |
|
(ipython-completing-read-symbol-clear-cache) |
|
(ipython-completing-read-symbol-function stub nil t)))))) |
|
|
|
(defun pcomplete-sage-default-completion () |
|
(pcomplete-here (pcomplete-sage-completions))) |
|
|
|
(defun pcomplete-parse-sage-arguments () |
|
(list |
|
(list (buffer-substring-no-properties (he-sage-symbol-beg) |
|
(he-sage-symbol-end))) |
|
(he-sage-symbol-beg))) |
|
|
|
;;;_* Make it easy to sagetest files and methods |
|
|
|
(defun sage-test-file-inline (file-name &optional method) |
|
"Run sage-test on file FILE-NAME, with output to underlying the Sage buffer. |
|
|
|
We take pains to test the correct module. |
|
|
|
If METHOD is non-nil, try to test only the single method named METHOD. |
|
Interactively, try to find current method at point." |
|
(interactive |
|
(append |
|
(comint-get-source "Load Sage file: " |
|
python-prev-dir/file python-source-modes t) |
|
(list current-prefix-arg))) |
|
(comint-check-source file-name) ; Check to see if buffer needs saving. |
|
(setq python-prev-dir/file (cons (file-name-directory file-name) |
|
(file-name-nondirectory file-name))) |
|
(let* ((directory-module (python-qualified-module-name file-name)) |
|
(directory (car directory-module)) |
|
(module (cdr directory-module)) |
|
(command (format "sage.misc.sagetest.sagetest(%s)" module))) |
|
(sage-send-command command nil))) ;TODO |
|
|
|
(defun sage-test-file-to-buffer (file-name &optional method) |
|
"Run sage-test on file FILE-NAME, with output to a new buffer. |
|
|
|
We take pains to test the correct module. |
|
|
|
If METHOD is non-nil, try to test only the single method named METHOD. |
|
Interactively, try to find current method at point." |
|
(interactive |
|
(append |
|
(comint-get-source "Load Sage file: " |
|
python-prev-dir/file python-source-modes t) |
|
(list current-prefix-arg))) |
|
(comint-check-source file-name) ; Check to see if buffer needs saving. |
|
(setq python-prev-dir/file (cons (file-name-directory file-name) |
|
(file-name-nondirectory file-name))) |
|
(let* ((directory-module (python-qualified-module-name file-name)) |
|
(directory (car directory-module)) |
|
(module (cdr directory-module)) |
|
(command (format "sage.misc.sagetest.sagetest(%s)" module)) |
|
(compilation-error-regexp-alist '(sage-test sage-build))) |
|
(with-temp-buffer |
|
(python-send-receive-to-buffer command (current-buffer))))) |
|
|
|
(defvar sage-test-file 'sage-test-file-to-buffer) |
|
|
|
|
|
;;;_* Read Mercurial's .hg bundle files naturally |
|
|
|
(define-derived-mode |
|
mercurial-bundle-mode |
|
fundamental-mode |
|
"Mercurial .hg bundle" |
|
"Major mode for reading .hg bundle files naturally." |
|
(completing-read "Against repository: " '("sage-main" "sage-blah" "sage-nuts") nil t "sage-main") |
|
nil |
|
) |
|
(add-to-list 'auto-mode-alist '("\\.hg\\'" . mercurial-bundle-mode)) |
|
|
|
;;;_* Setup imenu by default |
|
(when (featurep 'imenu) |
|
(add-hook 'sage-mode-hook 'imenu-add-menubar-index)) |
|
|
|
(provide 'sage-mode) |
|
|
|
;;; sage-mode.el ends here
|
|
|