[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
axiom mode
From: |
Martin Rubey |
Subject: |
axiom mode |
Date: |
09 Jun 2007 20:29:48 +0200 |
Dear emacs gurus,
as I have posted some time ago, I am writing an emacs mode for the free
computer algebra system axiom available at
http://wiki.axiom-developer.org/FrontPage
Meanwhile I am quite happy with it, save a few glitches. Maybe some guru here
could help me out. I attach the complete source, hoping not to violate
nettiquette... I start the mode (after M-x load-file Ret axiom.el) with M-x
axiom.
I have three major problems:
* after loading axiom.el, using shell mode is a pain. This is most annoying.
It seems that all the hooks are still there, but I do not know the necessary
magic to remove them. I suppose, there are also some style guidelines?
* if axiom produces a lot of output, and one presses M-p while the output is
being written to the buffer, everything gets messed up. In particular, point
moves to the previous prompt and further output is written *before* that
prompt instead of afterwards. For example, if you have axiom installed,
enter, for example,
for i in 1..20 repeat (output(i); [j for j in 1..5000])
and
press M-p during the computation. I don't understand this behaviour, since I
defined
(defun axiom-scroll-previous-input (&optional arg)
"Fetch the previous input."
(interactive "p")
(unless (axiom-output? (point))
(axiom-previous-prompt)
(comint-set-process-mark)
(comint-previous-input arg)
;; delete the rest
(delete-region (point) (axiom-end-of-input))))
So, before doing anything, I check whether I am in the output region, in
which case I do nothing. Can anyone explain that behaviour? (I also tries
(1- (point)), this didn't make any difference.)
* I cannot get it to run under xemacs. I keep getting ^M characters, and
comint-strip-ctrl-m didn't work for me. I'm completely lost here.
Any help would be *greatly* appreciated, and of course, get your name on the
copyright message.
Many thanks in advance,
Martin
;; Copyright (C) 1995, 2006, 2007 by Jay Belanger, Francois Maltey, Martin
;; Rubey and Cliff Yapp
;; This program 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 of
;; the License, or (at your option) any later version.
;;
;; This program 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 this program; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307 USA
(require 'comint)
;; Variables used when starting Axiom
(defvar axiom-command "") ;; There is a function to determine this value
(defvar axiom-localpaths) ;; Used when searching the system path
(defvar axiom-args "-noclef") ;; Ignored when AXIOMsys is used.
(defvar axiom-prompt "^(\\([0-9]+\\)) -> ")
(defvar axiom-after-output-wait 100) ;; time to wait for axiom's prompt
;; Utility variables
(defvar axiom-mode-hook nil)
(defvar axiom-process nil)
(defvar axiom-system-command nil)
(defvar axiom-end-of-input 0)
;;due to William G. Dubuque 1994
(defun looking-backward-at (regexp &optional bound)
(let ((point (point)))
(save-restriction
(narrow-to-region (or bound (point-min)) point)
;; Recall that \' matches end of buffer in a regexp.
;; Todo: bug: regexp compiler does not appear to optimize this well
;; (seems like test (eobp) is done after each match instead of anchoring
;; at eob), so use a bound to improve efficiency.
(prog1 (re-search-backward (concat regexp "\\'") bound t)
(goto-char point)))))
;; Utility functions
(defun axiom-buffer ()
"Return the buffer in which the Axiom process is running, nil
otherwise"
(and (processp axiom-process) (process-buffer axiom-process)))
(defun axiom-clean-up-prompt ()
(let ((inhibit-read-only t)
(point-after-last-message nil)
(point-before-current-marker nil))
(goto-char (point-min))
(search-forward "(1) ->")
(search-backward "(1) ->")
(setq point-after-last-message (point-marker))
(goto-char (point-max))
(re-search-backward "([0-9]+) -> ")
(setq point-before-current-marker (point-marker))
(if (not (eq point-after-last-message point-before-current-marker))
(delete-region point-after-last-message point-before-current-marker))
(goto-char (point-max))))
(defun axiom-cleanup ()
(setq axiom-process nil))
(defun axiom-output? (position)
"Non-nil if position is in the output region"
(get-text-property position 'axiom-output))
(defun axiom-prompt? (position)
"Non-nil if position is in the prompt region"
(get-text-property position 'axiom-prompt))
(defun axiom-make-prompt (begin end)
"Makes the region a prompt. In particular, it gets the field property, the
right face, and is made read-only"
(let ((inhibit-read-only t))
(put-text-property begin end 'axiom-prompt t)
(remove-text-properties begin end '(axiom-output nil))
(put-text-property begin end 'face 'comint-highlight-prompt)
(put-text-property begin end 'field t)
(put-text-property begin end 'front-sticky t)
(put-text-property begin end 'rear-nonsticky t)
(put-text-property begin end 'read-only t)
))
(defun axiom-make-output (begin end)
(let ((inhibit-read-only t))
(put-text-property begin end 'axiom-output t)
(put-text-property begin end 'face 'axiom-output)
(put-text-property begin end 'front-sticky t) ; otherwise can insert
(put-text-property begin end 'rear-nonsticky t); otherwise cannot append
(put-text-property begin end 'read-only t)
))
(defun axiom-output-filter (str)
"Look for a new input prompt."
(let ((comint-last-output-end
(process-mark (get-buffer-process (current-buffer))))
(prompt-start
(string-match axiom-prompt str)))
; (print (list comint-last-output-start comint-last-output-end))
(axiom-make-output (1+ axiom-end-of-input)
(if prompt-start
(+ comint-last-output-start
prompt-start)
comint-last-output-end))
(when prompt-start
(axiom-make-prompt (+ comint-last-output-start
prompt-start)
comint-last-output-end))))
; for i in 1..5 repeat (output "(1) -> "; [j for j in 1..6000])
; )lisp (dotimes (i 5) (sleep 1) (format t "(1) -> ~%"))
(defun axiom-wait-for-output ()
"Wait for output from the Axiom process."
(sit-for 0 axiom-after-output-wait))
(defun axiom-get-command ()
"Searches the local system PATH variable for the axiom binary"
(setq axiom-localpaths exec-path)
(while axiom-localpaths
(when (file-executable-p (concat (car axiom-localpaths) "/axiom"))
(setq axiom-localpaths nil)
(setq axiom-command "axiom"))
(setq axiom-localpaths (cdr axiom-localpaths)))
;; If we come up empty, default to AXIOMsys
(unless (equal axiom-command "axiom")
(setq axiom-command "AXIOMsys")))
(defun axiom-comint-run ()
"Run PROGRAM in a comint buffer with ARGS and switch to it."
(switch-to-buffer (make-comint "axiom" axiom-command nil axiom-args)))
(defun axiom-run()
"Run Axiom in a buffer."
;; Get the command to use
(axiom-get-command)
;; Run that command and switch to the new buffer
(axiom-comint-run)
;; and identify the process as well:
(setq axiom-process (get-buffer-process (current-buffer)))
;; We need a custom wait condition for the first case, since two input
;; prompts appear when "axiom" is used to as the startup command.
;; Note that the REGEXP used in re-search-backward
;; is not compatible with grep or other tools - it is specific to the
;; behavior of Emacs
(when (equal axiom-command "axiom")
(while (not (re-search-backward "(1) -> [^ ](1) ->" nil t))
(accept-process-output axiom-process)))
(when (equal axiom-command "AXIOMsys")
(while (not (re-search-backward "(1) -> " nil t))
(accept-process-output axiom-process)))
(add-hook 'comint-output-filter-functions 'axiom-output-filter)
(sit-for 0 axiom-after-output-wait))
;;################### Terminal Mode ########################
(defun axiom-previous-prompt ()
"Put point just after the previous prompt and return this position. If
there is no previous prompt, point stays where it is end we return nil. We use
the regular expression to find a prompt, rather than the text-property, for
axiom-reset."
(let ((found?))
(while (and (setq found? (re-search-backward axiom-prompt nil t))
(not (axiom-prompt? (point)))))
(when found?
(end-of-line)
(point))))
(defun axiom-previous-input ()
"If in input, puts point just after the prompt before the previous prompt and
return this position. If in output, or at the first input line, puts point just
after the previous prompt. Otherwise, the behaviour is undefined."
(interactive)
(let ((found?))
(if (or (axiom-output? (point))
(axiom-prompt? (point)))
(axiom-previous-prompt)
(while (and (re-search-backward axiom-prompt nil t)
(not (axiom-prompt? (point)))))
(while (and (setq found? (re-search-backward axiom-prompt nil t))
(not (axiom-prompt? (point)))))
(end-of-line)
(when found? (point)))))
(defun axiom-next-input ()
"Puts point just after the next prompt and return this position. If there
is no next prompt, point stays where it is end we return nil."
(interactive)
(let ((found?))
(while (and (setq found? (re-search-forward axiom-prompt nil t))
(not (axiom-prompt? (1- (point))))))
found?))
(defun axiom-next-prompt ()
"Puts point just before the next prompt and return this position. If there
is no next prompt, point stays where it is end we return nil."
(when (axiom-next-input) (re-search-backward axiom-prompt nil t)))
(defun axiom-end-of-input ()
"Puts point at the end of the last input line and returns that position."
(while (and (not (axiom-output? (point))) (looking-at ".*_ *$"))
(next-line 1)
(beginning-of-line))
(end-of-line)
(point))
(defun axiom-scroll-previous-input (&optional arg)
"Fetch the previous input."
(interactive "p")
(unless (axiom-output? (point))
(axiom-previous-prompt)
(comint-set-process-mark)
(comint-previous-input arg)
;; delete the rest
(delete-region (point) (axiom-end-of-input))))
(defun axiom-scroll-next-input (&optional arg)
"Move to the next input line."
(interactive "p")
(unless (axiom-output? (point))
(axiom-previous-prompt)
(comint-set-process-mark)
(comint-next-input arg)
;; delete the rest
(delete-region (point) (axiom-end-of-input))))
(defun axiom-backward-char (&optional arg)
"Move left only if we stay in the input region."
(interactive "p")
(dotimes (i arg)
(if (axiom-prompt? (1- (point)))
(when (axiom-previous-input)
(axiom-end-of-input))
(backward-char))))
(defun axiom-forward-char (&optional arg)
"Move right depending on the region we are in."
(interactive "p")
(dotimes (i arg)
(cond ((eobp)) ; at the end of the buffer we signal an error
((looking-at axiom-prompt)
(re-search-forward axiom-prompt))
((and (not (axiom-output? (point)))
(axiom-output? (1+ (point))))
(axiom-next-input))
(t (forward-char)))))
(defvar axiom-mode-map (copy-keymap comint-mode-map)
"local key map for Axiom terminal mode")
(define-key axiom-mode-map [(meta up)] 'axiom-previous-input)
(define-key axiom-mode-map [(meta down)] 'axiom-next-input)
(define-key axiom-mode-map [left] 'axiom-backward-char)
(define-key axiom-mode-map [right] 'axiom-forward-char)
(defun axiom-reset ()
"Remove read-only properties from everything after the last prompt."
(interactive)
(save-excursion
(let ((inhibit-read-only t))
(goto-char (point-max))
(remove-text-properties (axiom-previous-prompt)
(point-max)
(list 'axiom-output nil 'axiom-prompt nil
'face nil 'field nil 'front-sticky nil
'rear-nonsticky nil 'read-only nil))
(axiom-make-prompt (re-search-backward axiom-prompt nil t) (point)))))
(defun axiom-copy-to-clipboard (&optional arg)
"Copy the arg previous input-output combinations into the kill-ring."
(interactive "p")
(save-excursion
(let* ((end (or (axiom-next-prompt) (point-max)))
(n arg)
(begin (progn (while (< 0 n)
(axiom-previous-prompt)
(if (re-search-backward axiom-prompt nil t)
(setq n (1- n))
(setq n 0)
(goto-char (point-min))))
(point))))
(clipboard-kill-ring-save begin end))))
(define-key axiom-mode-map [(meta k)] 'axiom-copy-to-clipboard)
(defface axiom-output '((t (:background "green")))
"Face used for output."
:group 'axiom)
(defface axiom-paint-lightblue '((t (:background "lightblue")))
"Lightblue face to use for painting."
:group 'axiom)
(defface axiom-paint-red '((t (:background "red")))
"Red face to use for painting."
:group 'axiom)
(defface axiom-paint-custom '((t nil))
"Custom face to use for painting."
:group 'axiom)
(defvar axiom-paint-face-alist
'(("lightblue" axiom-paint-lightblue)
("red" axiom-paint-red)
("custom" axiom-paint-custom)
("output" axiom-output)))
(defvar axiom-paint-face 'axiom-paint-lightblue)
(defun axiom-paint-face ()
(interactive)
(let ((newpaint (completing-read "New paint face: "
axiom-paint-face-alist
nil t)))
(setq axiom-paint-face (cadr (assoc newpaint axiom-paint-face-alist)))))
(defun axiom-make-space-if-necessary-and-paint ()
;; The following is to make sure that a line does not end with a painted
;; character. This would have the unwanted effect, that spaces appended by
;; either axiom-paint-previous-line or axiom-paint-next-line inherit the face
;; of the last character.
(when (eolp)
(insert-char 32 2 t)
(backward-char 2))
(forward-char 1)
(when (eolp)
(insert-char 32 1 t)
(backward-char 1))
(backward-char 1)
(if (equal (get-text-property (point) 'face)
axiom-paint-face)
(if (axiom-output? (point))
(put-text-property (point) (1+ (point)) 'face 'axiom-output)
(remove-text-properties (point) (1+ (point)) '(face nil)))
(put-text-property (point) (1+ (point)) 'face axiom-paint-face)))
(defun axiom-paint-previous-line ()
(interactive)
(when (axiom-output? (point))
(let ((inhibit-read-only t)
(old-column (current-column))
(old-pos (point)))
(axiom-make-space-if-necessary-and-paint)
(previous-line 1)
(if (axiom-output? (point))
(let ((difference (- old-column (current-column))))
(when (> difference 0)
(insert-char 32 difference t)))
(goto-char old-pos)))))
(defun axiom-paint-next-line ()
(interactive)
(when (axiom-output? (point))
(let ((inhibit-read-only t)
(old-column (current-column))
(old-pos (point)))
(axiom-make-space-if-necessary-and-paint)
(next-line 1)
(if (axiom-output? (point))
(let ((difference (- old-column (current-column))))
(when (> difference 0)
(insert-char 32 difference t)))
(goto-char old-pos)))))
(defun axiom-paint-previous-char ()
(interactive)
(when (axiom-output? (point))
(let ((inhibit-read-only t))
(axiom-make-space-if-necessary-and-paint)
(when (axiom-output? (1- (point)))
(backward-char 1)))))
(defun axiom-paint-next-char ()
(interactive)
(when (axiom-output? (point))
(let ((inhibit-read-only t))
(axiom-make-space-if-necessary-and-paint)
(forward-char 1))))
(define-key axiom-mode-map [(shift up)] 'axiom-paint-previous-line)
(define-key axiom-mode-map [(shift down)] 'axiom-paint-next-line)
(define-key axiom-mode-map [(shift left)] 'axiom-paint-previous-char)
(define-key axiom-mode-map [(shift right)] 'axiom-paint-next-char)
(defface axiom-changed-input '((t (:foreground "red")))
"Face to use to highlight input when `comint-highlight-input' is non-nil."
:group 'axiom)
(defun axiom-clear-overlays ()
"Clears all text properties at point"
(while (overlays-at (point))
(delete-overlay (car (overlays-at (point))))))
(defvar axiom-current-input "")
(defun axiom-flag-as-changed (overlay after-change begin end &optional len)
"Handles updating the input prompt in question after a change. We assume
that point is between begin and end."
(let ((new-input (buffer-substring begin end)))
(if after-change
(unless (string= axiom-current-input new-input)
;; Change the look of the text
(overlay-put overlay 'face 'axiom-changed-input)
;; And remove this function from the modification hooks list
(overlay-put overlay 'modification-hooks '())
;; Mark all prompts below to indicate that they have to be taken with
;; care
(let ((position end)
(max (point-max))
(inhibit-read-only t))
(while (not (= position max))
(if (axiom-prompt? position)
(let ((begin position))
(while (and (axiom-prompt? position)
(< position max))
(setq position (1+ position)))
(let ((overlay (make-overlay begin (- position 4)
nil nil t)))
(overlay-put overlay 'face 'axiom-changed-input)))
(setq position (1+ position))))
(sit-for 0)))
(setq axiom-current-input new-input))))
(defun axiom-make-input (begin end)
"Call this when a new evaluation begins. It sets the 'modification-hooks
property for the input after the current prompt. It sets point at the end
of the current input"
(interactive)
(axiom-clear-overlays)
(let ((over (make-overlay begin end nil nil t)))
(overlay-put over 'modification-hooks '(axiom-flag-as-changed))))
(defun axiom-repair-prompts ()
"Repairs prompts at the end of the document once an overwrite eval is
complete. Point is expected to be at the new prompt, after the last output.
Afterwards, point is where it was before."
(save-excursion
(let* ((new-prompt-start (re-search-backward axiom-prompt nil t))
(new-prompt-end (re-search-forward axiom-prompt nil t))
(new-prompt (buffer-substring new-prompt-start new-prompt-end))
(inhibit-read-only t))
;; Remove the new prompt and put it in the kill ring
(delete-region new-prompt-start new-prompt-end)
;; Weed out the extra newline, if present. For example, in case of an
;; error it is not present. I guess it would be better to detect
;; errors by parsing the prompt, but I leave this for somebody else.
(when (char-equal (char-after) 10)
(delete-char 1))
;; Finally we get rid of the old prompt at the end of the buffer and
;; insert the new one, which is currently somewhere in the middle of the
;; buffer.
(goto-char (point-max))
(let ((old-prompt-start (re-search-backward axiom-prompt nil t)))
(delete-region old-prompt-start (line-end-position))
(insert new-prompt)
(axiom-make-prompt old-prompt-start (point))))))
(defun axiom-overwrite-output-eval ()
"Function which handles the actual mechanics of inserting a new IO pair. It
expects point to be between the current and the next prompt."
(let* (;; the old prompt is just before the input we want to evaluate
(old-prompt-end (axiom-previous-prompt))
(old-prompt-start (re-search-backward axiom-prompt nil t))
;; the new prompt is at the very end of the buffer
(new-prompt (buffer-substring
(progn (goto-char (point-max))
(re-search-backward axiom-prompt nil t))
(re-search-forward axiom-prompt nil t)))
(inhibit-read-only t))
;; Delete the old prompt
(delete-region old-prompt-start old-prompt-end)
;; Clear out any pre-existing text overlays - needed for the case
;; where the same input is being re-evaluated - if this isn't
;; removed, the new prompt is bold. If no overlay do nothing.
(goto-char old-prompt-start)
(axiom-clear-overlays)
;; Put the new prompt in
(insert new-prompt)
;; Now we are done changing this prompt, and can prepare the input
(comint-set-process-mark)
(axiom-make-input (1- (point))
(setq axiom-end-of-input (axiom-end-of-input)))
;; Delete the old output
(delete-region (1+ axiom-end-of-input)
(axiom-next-prompt))
;; send new input
(goto-char axiom-end-of-input)
(comint-send-input)
(axiom-wait-for-output)))
(defun axiom-normal-eval ()
"This function is used for evaluation at the 'front' Axiom prompt. It
expects point anywhere after the last prompt."
(axiom-make-input (1- (axiom-previous-prompt))
(setq axiom-end-of-input (axiom-end-of-input)))
(comint-send-input)
(axiom-wait-for-output))
(defun axiom-eval ()
"Evaluate the current input and insert output."
(interactive)
(if axiom-system-command
;; we are responding to a system command.
(progn
(setq axiom-system-command nil
axiom-end-of-input (axiom-end-of-input))
(comint-send-input)
(axiom-wait-for-output)
;; If there is a prompt further down, we are overwriting old stuff.
(when (re-search-forward axiom-prompt nil t)
(re-search-backward axiom-prompt)
(axiom-repair-prompts)
(re-search-forward axiom-prompt nil t)
(comint-set-process-mark)))
;; otherwise, we first check whether we have multiline input.
(beginning-of-line)
(if (looking-at ".*_ *$")
(progn (end-of-line)
(newline))
;; move to the the end of the preceding prompt
(axiom-previous-prompt)
(comint-set-process-mark)
;; is it a system command?
(setq axiom-system-command (looking-at " *)"))
;; If there is a prompt further down, we are overwriting old stuff.
(if (axiom-next-prompt)
(progn (axiom-overwrite-output-eval)
;; if we are now looking at a prompt, we are certainly not
;; answering a question posed by axiom.
(when (looking-backward-at axiom-prompt)
(setq axiom-system-command nil)
(axiom-repair-prompts)
(end-of-line) ;; this moves point to the end of the prompt!
;; it seems to work even if we type text
;; during a computation.
(comint-set-process-mark)))
(axiom-normal-eval)
(when (looking-backward-at axiom-prompt)
(setq axiom-system-command nil))))))
;; Now that everything is defined, bind the return key to our new eval function
(define-key axiom-mode-map [return] 'axiom-eval)
(defun axiom-eval-append ()
"Evaluate the current input and append output."
(interactive)
(let* ((input (buffer-substring (axiom-previous-prompt)
(axiom-end-of-input)))
(end (progn (goto-char (point-max))
(point))))
(delete-region (axiom-previous-prompt) end)
(comint-set-process-mark)
(insert input)
(axiom-eval)))
(define-key axiom-mode-map [(meta return)] 'axiom-eval-append)
(define-derived-mode axiom-mode comint-mode "AXIOM")
(defun axiom ()
"Run axiom in a terminal environment"
(interactive)
(if (and (processp axiom-process)
(eq (process-status axiom-process) 'run))
(switch-to-buffer (axiom-buffer))
(axiom-mode-new-axiom-process))
(axiom-mode))
;; If there is a running axiom process switch to this axiom buffer
;; In the other case clean buffer and process variables and
;; start a new process in a new buffer.
(defun axiom-mode-new-axiom-process ()
(when (processp axiom-process)
(delete-process axiom-process)
(kill-buffer (axiom-buffer))
(setq axiom-process nil))
(setq axiom-end-of-input 0)
;; First, let's get axiom up and running.
(axiom-run)
;; we make also the banner write-protected
;; note that because of the axiom-output-filter we might be already have
;; write protected the banner.
(let ((inhibit-read-only t))
(remove-text-properties 1 (point) '(face nil rear-nonsticky nil))
(put-text-property 1 (point) 'front-sticky t)
(put-text-property 1 (point) 'read-only t)
;; We need to tell Emacs how to clean up if we close this
;; buffer - otherwise restarting is difficult:
(add-hook 'kill-buffer-hook 'axiom-cleanup)
;; Then we clean up the prompt.
(axiom-clean-up-prompt)
;; We need to explicitly write protect the first prompt, since it
;; is outside the normal write protect mode used for subsequent
;; output:
(axiom-make-prompt (- (point) 7) (point))
;; Next, we turn on some key bindings for our new mode:
(use-local-map axiom-mode-map)
(substitute-key-definition 'comint-previous-input
'axiom-scroll-previous-input axiom-mode-map)
(substitute-key-definition 'comint-next-input
'axiom-scroll-next-input axiom-mode-map)
;; HyperDoc currently sends loading messages to the buffer. Because of the
;; current setup, they are going to be read-only, and they are not followed
;; by a prompt. Thus, lest we cannot append any further input, we have to
;; mute them. Currently this is only possible via
;; )set messages autoload off
(insert ")se me au of")
(axiom-eval)))
- axiom mode,
Martin Rubey <=
- Re: axiom mode, Tom Tromey, 2007/06/09
- Re: axiom mode, Martin Rubey, 2007/06/10
- Re: axiom mode, martin rudalics, 2007/06/10
- Re: axiom mode, Martin Rubey, 2007/06/10
- Re: axiom mode, martin rudalics, 2007/06/11
- Re: axiom mode, Martin Rubey, 2007/06/11