| ;;; gforth.el --- major mode for editing (G)Forth sources |
;;; gforth.el --- major mode for editing (G)Forth sources |
| |
|
| ;; Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. |
;; Copyright (C) 1995,1996,1997,1998,2000,2001,2003,2004,2007 Free Software Foundation, Inc. |
| |
|
| ;; This file is part of Gforth. |
;; This file is part of Gforth. |
| |
|
| ;; Changes by David |
;; Changes by David |
| ;; Added a syntax-hilighting engine, rewrote auto-indentation engine. |
;; Added a syntax-hilighting engine, rewrote auto-indentation engine. |
| ;; Added support for block files. |
;; Added support for block files. |
| ;; Tested with Emacs 19.34, 20.5, 21.1 and XEmacs 21.1 |
;; Replaced forth-process code with comint-based implementation. |
| |
|
| |
;; Tested with Emacs 19.34, 20.5, 21 and XEmacs 21 |
| |
|
| ;;------------------------------------------------------------------- |
;;------------------------------------------------------------------- |
| ;; A Forth indentation, documentation search and interaction library |
;; A Forth indentation, documentation search and interaction library |
| (if (not (boundp 'emacs-major-version)) |
(if (not (boundp 'emacs-major-version)) |
| (defconst emacs-major-version |
(defconst emacs-major-version |
| (progn (string-match "^[0-9]+" emacs-version) |
(progn (string-match "^[0-9]+" emacs-version) |
| (string-to-int (match-string 0 emacs-version))))) |
(string-to-number (match-string 0 emacs-version))))) |
| |
|
| |
;; Code ripped from `subr.el' for compatability with Emacs versions |
| |
;; prior to 20.1 |
| |
(eval-when-compile |
| (defun forth-emacs-older (major minor) |
(defun forth-emacs-older (major minor) |
| (or (< emacs-major-version major) |
(or (< emacs-major-version major) |
| (and (= emacs-major-version major) (< emacs-minor-version minor)))) |
(and (= emacs-major-version major) (< emacs-minor-version minor)))) |
| |
|
| ;; Code ripped from `subr.el' for compatability with Emacs versions |
|
| ;; prior to 20.1 |
|
| (eval-when-compile |
|
| (if (forth-emacs-older 20 1) |
(if (forth-emacs-older 20 1) |
| (progn |
(progn |
| (defmacro when (cond &rest body) |
(defmacro when (cond &rest body) |
| |
|
| ;; `no-error' argument of require not supported in Emacs versions |
;; `no-error' argument of require not supported in Emacs versions |
| ;; prior to 20.4 :-( |
;; prior to 20.4 :-( |
| |
(eval-and-compile |
| (defun forth-require (feature) |
(defun forth-require (feature) |
| (condition-case err (require feature) (error nil))) |
(condition-case err (require feature) (error nil)))) |
| |
|
| (require 'font-lock) |
(require 'font-lock) |
| |
|
| ; todo: |
; todo: |
| ; |
; |
| |
|
| |
; screen-height existiert nicht in XEmacs, frame-height ersetzen? |
| |
; |
| |
|
| ; Wörter ordentlich hilighten, die nicht auf Whitespace beginnen ( ..)IF |
; Wörter ordentlich hilighten, die nicht auf Whitespace beginnen ( ..)IF |
| ; -- mit aktueller Konzeption nicht möglich?? |
; -- mit aktueller Konzeption nicht möglich?? |
| ; |
; |
| "[ \t\n]" t name (font-lock-function-name-face . 3)) |
"[ \t\n]" t name (font-lock-function-name-face . 3)) |
| (("if" "begin" "ahead" "do" "?do" "+do" "u+do" "-do" "u-do" "for" |
(("if" "begin" "ahead" "do" "?do" "+do" "u+do" "-do" "u-do" "for" |
| "case" "of" "?dup-if" "?dup-0=-if" "then" "endif" "until" |
"case" "of" "?dup-if" "?dup-0=-if" "then" "endif" "until" |
| "repeat" "again" |
"repeat" "again" "leave" "?leave" |
| "loop" "+loop" "-loop" "next" "endcase" "endof" "else" "while" "try" |
"loop" "+loop" "-loop" "next" "endcase" "endof" "else" "while" "try" |
| "recover" "endtry" "assert(" "assert0(" "assert1(" "assert2(" |
"recover" "endtry" "iferror" "restore" "endtry-iferror" |
| |
"assert(" "assert0(" "assert1(" "assert2(" |
| "assert3(" ")" "<interpretation" "<compilation" "interpretation>" |
"assert3(" ")" "<interpretation" "<compilation" "interpretation>" |
| "compilation>") |
"compilation>") |
| compile-only (font-lock-keyword-face . 2)) |
compile-only (font-lock-keyword-face . 2)) |
| |
|
| (setq forth-indent-words |
(setq forth-indent-words |
| '((("if" "begin" "do" "?do" "+do" "-do" "u+do" |
'((("if" "begin" "do" "?do" "+do" "-do" "u+do" |
| "u-do" "?dup-if" "?dup-0=-if" "case" "of" "try" |
"u-do" "?dup-if" "?dup-0=-if" "case" "of" "try" "iferror" |
| "[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]") |
"[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]") |
| (0 . 2) (0 . 2)) |
(0 . 2) (0 . 2)) |
| ((":" ":noname" "code" "struct" "m:" ":m" "class" "interface") |
((":" ":noname" "code" "struct" "m:" ":m" "class" "interface") |
| (-2 . 0) (0 . -2) non-immediate) |
(-2 . 0) (0 . -2) non-immediate) |
| (("protected" "public" "how:") (-1 . 1) (0 . 0) non-immediate) |
(("protected" "public" "how:") (-1 . 1) (0 . 0) non-immediate) |
| (("+loop" "-loop" "until") (-2 . 0) (-2 . 0)) |
(("+loop" "-loop" "until") (-2 . 0) (-2 . 0)) |
| (("else" "recover" "[else]") (-2 . 2) (0 . 0)) |
(("else" "recover" "restore" "endtry-iferror" "[else]") |
| |
(-2 . 2) (0 . 0)) |
| (("does>") (-1 . 1) (0 . 0)) |
(("does>") (-1 . 1) (0 . 0)) |
| (("while" "[while]") (-2 . 4) (0 . 2)) |
(("while" "[while]") (-2 . 4) (0 . 2)) |
| (("repeat" "[repeat]") (-4 . 0) (0 . -4)) |
(("repeat" "[repeat]") (-4 . 0) (0 . -4)))) |
| (("\\g") (-2 . 2) (0 . 0)))) |
|
| |
|
| (defvar forth-local-indent-words nil |
(defvar forth-local-indent-words nil |
| "List of Forth words to prepend to `forth-indent-words', when a forth-mode |
"List of Forth words to prepend to `forth-indent-words', when a forth-mode |
| ;; in Lisp?? |
;; in Lisp?? |
| (defun forth-filter (predicate list) |
(defun forth-filter (predicate list) |
| (let ((filtered nil)) |
(let ((filtered nil)) |
| (mapcar (lambda (item) |
(dolist (item list) |
| (when (funcall predicate item) |
(when (funcall predicate item) |
| (if filtered |
(if filtered |
| (nconc filtered (list item)) |
(nconc filtered (list item)) |
| (setq filtered (cons item nil)))) |
(setq filtered (cons item nil))))) |
| nil) list) |
|
| filtered)) |
filtered)) |
| |
|
| ;; Helper function for `forth-compile-word': return whether word has to be |
;; Helper function for `forth-compile-word': return whether word has to be |
| (regexp |
(regexp |
| (concat "\\(" (cond ((stringp matcher) matcher) |
(concat "\\(" (cond ((stringp matcher) matcher) |
| ((listp matcher) (regexp-opt matcher)) |
((listp matcher) (regexp-opt matcher)) |
| (t (error "Invalid matcher `%s'"))) |
(t (error "Invalid matcher"))) |
| "\\)")) |
"\\)")) |
| (depth (regexp-opt-depth regexp)) |
(depth (regexp-opt-depth regexp)) |
| (description (cdr word))) |
(description (cdr word))) |
| (eval-when-compile |
(eval-when-compile |
| (defmacro forth-save-buffer-state (varlist &rest body) |
(defmacro forth-save-buffer-state (varlist &rest body) |
| "Bind variables according to VARLIST and eval BODY restoring buffer state." |
"Bind variables according to VARLIST and eval BODY restoring buffer state." |
| (` (let* ((,@ (append varlist |
`(let* (,@(append varlist |
| '((modified (buffer-modified-p)) (buffer-undo-list t) |
'((modified (buffer-modified-p)) (buffer-undo-list t) |
| (inhibit-read-only t) (inhibit-point-motion-hooks t) |
(inhibit-read-only t) (inhibit-point-motion-hooks t) |
| before-change-functions after-change-functions |
before-change-functions after-change-functions |
| deactivate-mark buffer-file-name buffer-file-truename)))) |
deactivate-mark buffer-file-name buffer-file-truename))) |
| (,@ body) |
,@body |
| (when (and (not modified) (buffer-modified-p)) |
(when (and (not modified) (buffer-modified-p)) |
| (set-buffer-modified-p nil)))))) |
(set-buffer-modified-p nil))))) |
| |
|
| ;; Function that is added to the `change-functions' hook. Calls |
;; Function that is added to the `change-functions' hook. Calls |
| ;; `forth-update-properties' and keeps care of disabling undo information |
;; `forth-update-properties' and keeps care of disabling undo information |
| |
|
| ;; Return the column increment, that the current line of forth code does to |
;; Return the column increment, that the current line of forth code does to |
| ;; the current or following lines. `which' specifies which indentation values |
;; the current or following lines. `which' specifies which indentation values |
| ;; to use. 0 means the indentation of following lines relative to current |
;; to use. 1 means the indentation of following lines relative to current |
| ;; line, 1 means the indentation of the current line relative to the previous |
;; line, 0 means the indentation of the current line relative to the previous |
| ;; line. Return `nil', if there are no indentation words on the current line. |
;; line. Return `nil', if there are no indentation words on the current line. |
| (defun forth-get-column-incr (which) |
(defun forth-get-column-incr (which) |
| (save-excursion |
(save-excursion |
| ;(define-key forth-mode-map "\M-\C-x" 'compile) |
;(define-key forth-mode-map "\M-\C-x" 'compile) |
| (define-key forth-mode-map "\C-x\\" 'comment-region) |
(define-key forth-mode-map "\C-x\\" 'comment-region) |
| (define-key forth-mode-map "\C-x~" 'forth-remove-tracers) |
(define-key forth-mode-map "\C-x~" 'forth-remove-tracers) |
| (define-key forth-mode-map "\e\C-m" 'forth-send-paragraph) |
|
| (define-key forth-mode-map "\eo" 'forth-send-buffer) |
|
| (define-key forth-mode-map "\C-x\C-m" 'forth-split) |
(define-key forth-mode-map "\C-x\C-m" 'forth-split) |
| (define-key forth-mode-map "\e " 'forth-reload) |
(define-key forth-mode-map "\e " 'forth-reload) |
| (define-key forth-mode-map "\t" 'forth-indent-command) |
(define-key forth-mode-map "\t" 'forth-indent-command) |
| (unless (memq forth-info-lookup info-lookup-alist) |
(unless (memq forth-info-lookup info-lookup-alist) |
| (setq info-lookup-alist (cons forth-info-lookup info-lookup-alist))) |
(setq info-lookup-alist (cons forth-info-lookup info-lookup-alist))) |
| ;; in X-Emacs C-h C-i is by default bound to Info-query |
;; in X-Emacs C-h C-i is by default bound to Info-query |
| (define-key forth-mode-map "\C-h\C-i" 'info-lookup-symbol)) |
(define-key forth-mode-map [?\C-h ?\C-i] 'info-lookup-symbol)) |
| |
|
| |
|
| ;; (info-lookup-add-help |
;; (info-lookup-add-help |
| ;; :topic 'symbol |
;; :topic 'symbol |
| (defun forth-find-tag (tagname &optional next-p regexp-p) |
(defun forth-find-tag (tagname &optional next-p regexp-p) |
| (interactive (find-tag-interactive "Find tag: ")) |
(interactive (find-tag-interactive "Find tag: ")) |
| (unless (or regexp-p next-p) |
(unless (or regexp-p next-p) |
| (setq tagname (concat "\\(^\\|\\s-\\)\\(" (regexp-quote tagname) |
(setq tagname (concat "\\(^\\|\\s-+\\)\\(" (regexp-quote tagname) |
| "\\)\\(\\s-\\|$\\)"))) |
"\\)\\s-*\x7f"))) |
| (switch-to-buffer |
(switch-to-buffer |
| (find-tag-noselect tagname next-p t))) |
(find-tag-noselect tagname next-p t))) |
| |
|
| (make-local-variable 'comment-column) |
(make-local-variable 'comment-column) |
| (setq comment-column 40) |
(setq comment-column 40) |
| (make-local-variable 'comment-start-skip) |
(make-local-variable 'comment-start-skip) |
| (setq comment-start-skip "\\ ") |
(setq comment-start-skip "\\\\ ") |
| (make-local-variable 'comment-indent-function) |
(make-local-variable 'comment-indent-function) |
| (setq comment-indent-function 'forth-comment-indent) |
(setq comment-indent-function 'forth-comment-indent) |
| (make-local-variable 'parse-sexp-ignore-comments) |
(make-local-variable 'parse-sexp-ignore-comments) |
| only. Block files are autodetected, when read, and converted to normal |
only. Block files are autodetected, when read, and converted to normal |
| stream source format. See also `forth-block-mode'. |
stream source format. See also `forth-block-mode'. |
| \\{forth-mode-map} |
\\{forth-mode-map} |
| Forth-split |
|
| Positions the current buffer on top and a forth-interaction window |
|
| below. The window size is controlled by the forth-percent-height |
|
| variable (see below). |
|
| Forth-reload |
|
| Reloads the forth library and restarts the forth process. |
|
| Forth-send-buffer |
|
| Sends the current buffer, in text representation, as input to the |
|
| forth process. |
|
| Forth-send-paragraph |
|
| Sends the previous or the current paragraph to the forth-process. |
|
| Note that the cursor only need to be with in the paragraph to be sent. |
|
| forth-documentation |
|
| Search for documentation of forward adjacent to cursor. Note! To use |
|
| this mode you have to add a line, to your .emacs file, defining the |
|
| directories to search through for documentation files (se variable |
|
| forth-help-load-path below) e.g. (setq forth-help-load-path '(nil)). |
|
| |
|
| Variables controlling interaction and startup |
|
| forth-percent-height |
|
| Tells split how high to make the edit portion, in percent of the |
|
| current screen height. |
|
| forth-program-name |
|
| Tells the library which program name to execute in the interation |
|
| window. |
|
| |
|
| Variables controlling syntax hilighting/recognition of parsed text: |
Variables controlling syntax hilighting/recognition of parsed text: |
| `forth-words' |
`forth-words' |
| length that can be stored into a block file). This variable defaults to |
length that can be stored into a block file). This variable defaults to |
| t for `forth-block-mode' and to nil for `forth-mode'. |
t for `forth-block-mode' and to nil for `forth-mode'. |
| |
|
| Variables controling documentation search |
Variables controlling interaction with the Forth-process (also see |
| forth-help-load-path |
`run-forth'): |
| List of directories to search through to find *.doc |
forth-program-name |
| (forth-help-file-suffix) files. Nil means current default directory. |
Program invoked by the `run-forth' command (including arguments). |
| The specified directories must contain at least one .doc file. If it |
inferior-forth-mode-hook |
| does not and you still want the load-path to scan that directory, create |
Hook for customising inferior-forth-mode. |
| an empty file dummy.doc. |
forth-compile-command |
| forth-help-file-suffix |
Default command to execute on `compile'. |
| The file names to search for in each directory specified by |
|
| forth-help-load-path. Defaulted to '*.doc'. |
|
| " |
" |
| (interactive) |
(interactive) |
| (kill-all-local-variables) |
(kill-all-local-variables) |
| (interactive) |
(interactive) |
| (query-replace-regexp "\\(~~ \\| ~~$\\)" "" nil)) |
(query-replace-regexp "\\(~~ \\| ~~$\\)" "" nil)) |
| |
|
| (defvar forth-program-name "gforth" |
(define-key forth-mode-map "\C-x\C-e" 'compile) |
| "*Program invoked by the `run-forth' command.") |
(define-key forth-mode-map "\C-x\C-n" 'next-error) |
| |
(require 'compile) |
| (defvar forth-band-name nil |
|
| "*Band loaded by the `run-forth' command.") |
|
| |
|
| (defvar forth-program-arguments nil |
|
| "*Arguments passed to the Forth program by the `run-forth' command.") |
|
| |
|
| (defun run-forth (command-line) |
|
| "Run an inferior Forth process. Output goes to the buffer `*forth*'. |
|
| With argument, asks for a command line. Split up screen and run forth |
|
| in the lower portion. The current-buffer when called will stay in the |
|
| upper portion of the screen, and all other windows are deleted. |
|
| Call run-forth again to make the *forth* buffer appear in the lower |
|
| part of the screen." |
|
| (interactive |
|
| (list (let ((default |
|
| (or forth-process-command-line |
|
| (forth-default-command-line)))) |
|
| (if current-prefix-arg |
|
| (read-string "Run Forth: " default) |
|
| default)))) |
|
| (setq forth-process-command-line command-line) |
|
| (forth-start-process command-line) |
|
| (forth-split) |
|
| (forth-set-runlight forth-runlight:input)) |
|
| |
|
| (defun run-forth-if-not () |
|
| (if (not (forth-process-running-p)) |
|
| (run-forth forth-program-name))) |
|
| |
|
| (defun reset-forth () |
|
| "Reset the Forth process." |
|
| (interactive) |
|
| (let ((process (get-process forth-program-name))) |
|
| (cond ((or (not process) |
|
| (not (eq (process-status process) 'run)) |
|
| (yes-or-no-p |
|
| "The Forth process is running, are you SURE you want to reset it? ")) |
|
| (message "Resetting Forth process...") |
|
| (forth-reload) |
|
| (message "Resetting Forth process...done"))))) |
|
| |
|
| (defun forth-default-command-line () |
|
| (concat forth-program-name |
|
| (if forth-program-arguments |
|
| (concat " " forth-program-arguments) |
|
| ""))) |
|
| |
|
| ;;;; Internal Variables |
|
| |
|
| (defvar forth-process-command-line nil |
|
| "Command used to start the most recent Forth process.") |
|
| |
|
| (defvar forth-previous-send "" |
|
| "Most recent expression transmitted to the Forth process.") |
|
| |
|
| (defvar forth-process-filter-queue '() |
|
| "Queue used to synchronize filter actions properly.") |
|
| |
|
| (defvar forth-prompt "ok" |
|
| "The current forth prompt string.") |
|
| |
|
| (defvar forth-start-hook nil |
|
| "If non-nil, a procedure to call when the Forth process is started. |
|
| When called, the current buffer will be the Forth process-buffer.") |
|
| |
|
| (defvar forth-signal-death-message nil |
|
| "If non-nil, causes a message to be generated when the Forth process dies.") |
|
| |
|
| (defvar forth-percent-height 50 |
|
| "Tells run-forth how high the upper window should be in percent.") |
|
| |
|
| (defconst forth-runlight:input ?I |
|
| "The character displayed when the Forth process is waiting for input.") |
|
| |
|
| (defvar forth-mode-string "" |
|
| "String displayed in the mode line when the Forth process is running.") |
|
| |
|
| ;;;; Evaluation Commands |
|
| |
|
| (defun forth-send-string (&rest strings) |
|
| "Send the string arguments to the Forth process. |
|
| The strings are concatenated and terminated by a newline." |
|
| (cond ((forth-process-running-p) |
|
| (forth-send-string-1 strings)) |
|
| ((yes-or-no-p "The Forth process has died. Reset it? ") |
|
| (reset-forth) |
|
| (goto-char (point-max)) |
|
| (forth-send-string-1 strings)))) |
|
| |
|
| (defun forth-send-string-1 (strings) |
|
| (let ((string (apply 'concat strings))) |
|
| (forth-send-string-2 string))) |
|
| |
|
| (defun forth-send-string-2 (string) |
|
| (let ((process (get-process forth-program-name))) |
|
| (if (not (eq (current-buffer) (get-buffer forth-program-name))) |
|
| (progn |
|
| (forth-process-filter-output string) |
|
| (forth-process-filter:finish))) |
|
| (send-string process (concat string "\n")) |
|
| (if (eq (current-buffer) (process-buffer process)) |
|
| (set-marker (process-mark process) (point))))) |
|
| |
|
| |
|
| (defun forth-send-region (start end) |
|
| "Send the current region to the Forth process. |
|
| The region is sent terminated by a newline." |
|
| (interactive "r") |
|
| (let ((process (get-process forth-program-name))) |
|
| (if (and process (eq (current-buffer) (process-buffer process))) |
|
| (progn (goto-char end) |
|
| (set-marker (process-mark process) end)))) |
|
| (forth-send-string "\n" (buffer-substring start end) "\n")) |
|
| |
|
| (defun forth-end-of-paragraph () |
|
| (if (looking-at "[\t\n ]+") (skip-chars-backward "\t\n ")) |
|
| (if (not (re-search-forward "\n[ \t]*\n" nil t)) |
|
| (goto-char (point-max)))) |
|
| |
|
| (defun forth-send-paragraph () |
|
| "Send the current or the previous paragraph to the Forth process" |
|
| (interactive) |
|
| (let (end) |
|
| (save-excursion |
|
| (forth-end-of-paragraph) |
|
| (skip-chars-backward "\t\n ") |
|
| (setq end (point)) |
|
| (if (re-search-backward "\n[ \t]*\n" nil t) |
|
| (setq start (point)) |
|
| (goto-char (point-min))) |
|
| (skip-chars-forward "\t\n ") |
|
| (forth-send-region (point) end)))) |
|
| |
|
| (defun forth-send-buffer () |
|
| "Send the current buffer to the Forth process." |
|
| (interactive) |
|
| (if (eq (current-buffer) (forth-process-buffer)) |
|
| (error "Not allowed to send this buffer's contents to Forth")) |
|
| (forth-send-region (point-min) (point-max))) |
|
| |
|
| |
|
| ;;;; Basic Process Control |
|
| |
|
| (defun forth-start-process (command-line) |
|
| (let ((buffer (get-buffer-create "*forth*"))) |
|
| (let ((process (get-buffer-process buffer))) |
|
| (save-excursion |
|
| (set-buffer buffer) |
|
| (progn (if process (delete-process process)) |
|
| (goto-char (point-max)) |
|
| (setq mode-line-process '(": %s")) |
|
| (add-to-global-mode-string 'forth-mode-string) |
|
| (setq process |
|
| (apply 'start-process |
|
| (cons forth-program-name |
|
| (cons buffer |
|
| (forth-parse-command-line |
|
| command-line))))) |
|
| (set-marker (process-mark process) (point-max)) |
|
| (forth-process-filter-initialize t) |
|
| (forth-modeline-initialize) |
|
| (set-process-sentinel process 'forth-process-sentinel) |
|
| (set-process-filter process 'forth-process-filter) |
|
| (run-hooks 'forth-start-hook))) |
|
| buffer))) |
|
| |
|
| (defun forth-parse-command-line (string) |
|
| (setq string (substitute-in-file-name string)) |
|
| (let ((start 0) |
|
| (result '())) |
|
| (while start |
|
| (let ((index (string-match "[ \t]" string start))) |
|
| (setq start |
|
| (cond ((not index) |
|
| (setq result |
|
| (cons (substring string start) |
|
| result)) |
|
| nil) |
|
| ((= index start) |
|
| (string-match "[^ \t]" string start)) |
|
| (t |
|
| (setq result |
|
| (cons (substring string start index) |
|
| result)) |
|
| (1+ index)))))) |
|
| (nreverse result))) |
|
| |
|
| |
|
| (defun forth-process-running-p () |
|
| "True iff there is a Forth process whose status is `run'." |
|
| (let ((process (get-process forth-program-name))) |
|
| (and process |
|
| (eq (process-status process) 'run)))) |
|
| |
|
| (defun forth-process-buffer () |
|
| (let ((process (get-process forth-program-name))) |
|
| (and process (process-buffer process)))) |
|
| |
|
| ;;;; Process Filter |
|
| |
|
| (defun forth-process-sentinel (proc reason) |
|
| (let ((inhibit-quit nil)) |
|
| (forth-process-filter-initialize (eq reason 'run)) |
|
| (if (eq reason 'run) |
|
| (forth-modeline-initialize) |
|
| (setq forth-mode-string ""))) |
|
| (if (and (not (memq reason '(run stop))) |
|
| forth-signal-death-message) |
|
| (progn (beep) |
|
| (message |
|
| "The Forth process has died! Do M-x reset-forth to restart it")))) |
|
| |
|
| (defun forth-process-filter-initialize (running-p) |
|
| (setq forth-process-filter-queue (cons '() '())) |
|
| (setq forth-prompt "ok")) |
|
| |
|
| |
|
| (defun forth-process-filter (proc string) |
|
| (forth-process-filter-output string) |
|
| (forth-process-filter:finish)) |
|
| |
|
| (defun forth-process-filter:enqueue (action) |
|
| (let ((next (cons action '()))) |
|
| (if (cdr forth-process-filter-queue) |
|
| (setcdr (cdr forth-process-filter-queue) next) |
|
| (setcar forth-process-filter-queue next)) |
|
| (setcdr forth-process-filter-queue next))) |
|
| |
|
| (defun forth-process-filter:finish () |
|
| (while (car forth-process-filter-queue) |
|
| (let ((next (car forth-process-filter-queue))) |
|
| (setcar forth-process-filter-queue (cdr next)) |
|
| (if (not (cdr next)) |
|
| (setcdr forth-process-filter-queue '())) |
|
| (apply (car (car next)) (cdr (car next)))))) |
|
| |
|
| ;;;; Process Filter Output |
|
| |
|
| (defun forth-process-filter-output (&rest args) |
|
| (if (not (and args |
|
| (null (cdr args)) |
|
| (stringp (car args)) |
|
| (string-equal "" (car args)))) |
|
| (forth-process-filter:enqueue |
|
| (cons 'forth-process-filter-output-1 args)))) |
|
| |
|
| (defun forth-process-filter-output-1 (&rest args) |
|
| (save-excursion |
|
| (forth-goto-output-point) |
|
| (apply 'insert-before-markers args))) |
|
| |
|
| (defun forth-guarantee-newlines (n) |
|
| (save-excursion |
|
| (forth-goto-output-point) |
|
| (let ((stop nil)) |
|
| (while (and (not stop) |
|
| (bolp)) |
|
| (setq n (1- n)) |
|
| (if (bobp) |
|
| (setq stop t) |
|
| (backward-char)))) |
|
| (forth-goto-output-point) |
|
| (while (> n 0) |
|
| (insert-before-markers ?\n) |
|
| (setq n (1- n))))) |
|
| |
|
| (defun forth-goto-output-point () |
|
| (let ((process (get-process forth-program-name))) |
|
| (set-buffer (process-buffer process)) |
|
| (goto-char (process-mark process)))) |
|
| |
|
| (defun forth-modeline-initialize () |
|
| (setq forth-mode-string " ")) |
|
| |
|
| (defun forth-set-runlight (runlight) |
|
| (aset forth-mode-string 0 runlight) |
|
| (forth-modeline-redisplay)) |
|
| |
|
| (defun forth-modeline-redisplay () |
|
| (save-excursion (set-buffer (other-buffer))) |
|
| (set-buffer-modified-p (buffer-modified-p)) |
|
| (sit-for 0)) |
|
| |
|
| ;;;; Process Filter Operations |
|
| |
|
| (defun add-to-global-mode-string (x) |
|
| (cond ((null global-mode-string) |
|
| (setq global-mode-string (list "" x " "))) |
|
| ((not (memq x global-mode-string)) |
|
| (setq global-mode-string |
|
| (cons "" |
|
| (cons x |
|
| (cons " " |
|
| (if (equal "" (car global-mode-string)) |
|
| (cdr global-mode-string) |
|
| global-mode-string)))))))) |
|
| |
|
| |
|
| ;; Misc |
|
| |
|
| (setq auto-mode-alist (append auto-mode-alist |
(defvar forth-compile-command "gforth ") |
| '(("\\.fs$" . forth-mode)))) |
;(defvar forth-compilation-window-percent-height 30) |
| |
|
| (defun forth-split () |
(defun forth-split () |
| (interactive) |
(interactive) |
| (progn |
(progn |
| (delete-other-windows) |
(delete-other-windows) |
| (split-window-vertically |
(split-window-vertically |
| (/ (* (screen-height) forth-percent-height) 100)) |
(/ (frame-height) 2)) |
| (other-window 1) |
(other-window 1) |
| (switch-to-buffer buffer) |
(switch-to-buffer buffer) |
| (goto-char (point-max)) |
(goto-char (point-max)) |
| (other-window 1)))) |
(other-window 1)))) |
| |
|
| (defun forth-reload () |
|
| (interactive) |
|
| (let ((process (get-process forth-program-name))) |
|
| (if process (kill-process process t))) |
|
| (sleep-for 0 100) |
|
| (forth-mode)) |
|
| |
|
| |
|
| ;; Special section for forth-help |
|
| |
|
| (defvar forth-help-buffer "*Forth-help*" |
|
| "Buffer used to display the requested documentation.") |
|
| |
|
| (defvar forth-help-load-path nil |
|
| "List of directories to search through to find *.doc |
|
| (forth-help-file-suffix) files. Nil means current default directory. |
|
| The specified directories must contain at least one .doc file. If it |
|
| does not and you still want the load-path to scan that directory, create |
|
| an empty file dummy.doc.") |
|
| |
|
| (defvar forth-help-file-suffix "*.doc" |
|
| "The file names to search for in each directory.") |
|
| |
|
| (setq forth-search-command-prefix "grep -n \"^ [^(]* ") |
|
| (defvar forth-search-command-suffix "/dev/null") |
|
| (defvar forth-grep-error-regexp ": No such file or directory") |
|
| |
|
| (defun forth-function-called-at-point () |
|
| "Return the space delimited word a point." |
|
| (save-excursion |
|
| (save-restriction |
|
| (narrow-to-region (max (point-min) (- (point) 1000)) (point-max)) |
|
| (skip-chars-backward "^ \t\n" (point-min)) |
|
| (if (looking-at "[ \t\n]") |
|
| (forward-char 1)) |
|
| (let (obj (p (point))) |
|
| (skip-chars-forward "^ \t\n") |
|
| (buffer-substring p (point)))))) |
|
| |
|
| (defun forth-help-names-extend-comp (path-list result) |
|
| (cond ((null path-list) result) |
|
| ((null (car path-list)) |
|
| (forth-help-names-extend-comp (cdr path-list) |
|
| (concat result forth-help-file-suffix " "))) |
|
| (t (forth-help-names-extend-comp |
|
| (cdr path-list) (concat result |
|
| (expand-file-name (car path-list)) "/" |
|
| forth-help-file-suffix " "))))) |
|
| |
|
| (defun forth-help-names-extended () |
|
| (if forth-help-load-path |
|
| (forth-help-names-extend-comp forth-help-load-path "") |
|
| (error "forth-help-load-path not specified"))) |
|
| |
|
| |
|
| ;(define-key forth-mode-map "\C-hf" 'forth-documentation) |
|
| |
|
| (defun forth-documentation (function) |
|
| "Display the full documentation of FORTH word." |
|
| (interactive |
|
| (let ((fn (forth-function-called-at-point)) |
|
| (enable-recursive-minibuffers t) |
|
| search-list |
|
| val) |
|
| (setq val (read-string (format "Describe forth word (default %s): " fn))) |
|
| (list (if (equal val "") fn val)))) |
|
| (forth-get-doc (concat forth-search-command-prefix |
|
| (grep-regexp-quote (concat function " (")) |
|
| "[^)]*\-\-\" " (forth-help-names-extended) |
|
| forth-search-command-suffix)) |
|
| (message "C-x C-m switches back to the forth interaction window")) |
|
| |
|
| (defun forth-get-doc (command) |
|
| "Display the full documentation of command." |
|
| (let ((curwin (get-buffer-window (window-buffer))) |
|
| reswin |
|
| pointmax) |
|
| (with-output-to-temp-buffer forth-help-buffer |
|
| (progn |
|
| (call-process "sh" nil forth-help-buffer t "-c" command) |
|
| (setq reswin (get-buffer-window forth-help-buffer)))) |
|
| (setq reswin (get-buffer-window forth-help-buffer)) |
|
| (select-window reswin) |
|
| (save-excursion |
|
| (goto-char (setq pointmax (point-max))) |
|
| (insert "--------------------\n\n")) |
|
| (let (fd doc) |
|
| (while (setq fd (forth-get-file-data pointmax)) |
|
| (setq doc (forth-get-doc-string fd)) |
|
| (save-excursion |
|
| (goto-char (point-max)) |
|
| (insert (substring (car fd) (string-match "[^/]*$" (car fd))) |
|
| ":\n\n" doc "\n"))) |
|
| (if (not doc) |
|
| (progn (goto-char (point-max)) (insert "Not found")))) |
|
| (select-window curwin))) |
|
| |
|
| (defun forth-skip-error-lines () |
|
| (let ((lines 0)) |
|
| (save-excursion |
|
| (while (re-search-forward forth-grep-error-regexp nil t) |
|
| (beginning-of-line) |
|
| (forward-line 1) |
|
| (setq lines (1+ lines)))) |
|
| (forward-line lines))) |
|
| |
|
| (defun forth-get-doc-string (fd) |
|
| "Find file (car fd) and extract documentation from line (nth 1 fd)." |
|
| (let (result) |
|
| (save-window-excursion |
|
| (find-file (car fd)) |
|
| (goto-line (nth 1 fd)) |
|
| (if (not (eq (nth 1 fd) (1+ (count-lines (point-min) (point))))) |
|
| (error "forth-get-doc-string: serious error")) |
|
| (if (not (re-search-backward "\n[\t ]*\n" nil t)) |
|
| (goto-char (point-min)) |
|
| (goto-char (match-end 0))) |
|
| (let ((p (point))) |
|
| (if (not (re-search-forward "\n[\t ]*\n" nil t)) |
|
| (goto-char (point-max))) |
|
| (setq result (buffer-substring p (point)))) |
|
| (bury-buffer (current-buffer))) |
|
| result)) |
|
| |
|
| (defun forth-get-file-data (limit) |
|
| "Parse grep output and return '(filename line#) list. Return nil when |
|
| passing limit." |
|
| (forth-skip-error-lines) |
|
| (if (< (point) limit) |
|
| (let ((result (forth-get-file-data-cont limit))) |
|
| (forward-line 1) |
|
| (beginning-of-line) |
|
| result))) |
|
| |
|
| (defun forth-get-file-data-cont (limit) |
|
| (let (result) |
|
| (let ((p (point))) |
|
| (skip-chars-forward "^:") |
|
| (setq result (buffer-substring p (point)))) |
|
| (if (< (point) limit) |
|
| (let ((p (1+ (point)))) |
|
| (forward-char 1) |
|
| (skip-chars-forward "^:") |
|
| (list result (string-to-int (buffer-substring p (point)))))))) |
|
| |
|
| (defun grep-regexp-quote (str) |
|
| (let ((i 0) (m 1) (res "")) |
|
| (while (/= m 0) |
|
| (setq m (string-to-char (substring str i))) |
|
| (if (/= m 0) |
|
| (progn |
|
| (setq i (1+ i)) |
|
| (if (string-match (regexp-quote (char-to-string m)) |
|
| ".*\\^$[]") |
|
| (setq res (concat res "\\"))) |
|
| (setq res (concat res (char-to-string m)))))) |
|
| res)) |
|
| |
|
| |
|
| (define-key forth-mode-map "\C-x\C-e" 'compile) |
|
| (define-key forth-mode-map "\C-x\C-n" 'next-error) |
|
| (require 'compile) |
|
| |
|
| (defvar forth-compile-command "gforth ") |
|
| ;(defvar forth-compilation-window-percent-height 30) |
|
| |
|
| (defun forth-compile (command) |
|
| (interactive (list (setq forth-compile-command (read-string "Compile command: " forth-compile-command)))) |
|
| (forth-split-1 "*compilation*") |
|
| (setq ctools-compile-command command) |
|
| (compile1 ctools-compile-command "No more errors")) |
|
| |
|
| |
|
| ;;; Forth menu |
;;; Forth menu |
| ;;; Mikael Karlsson <qramika@eras70.ericsson.se> |
;;; Mikael Karlsson <qramika@eras70.ericsson.se> |
| |
|
| ;; ; (define-key global-map '(shift button3) 'mouse-function-menu) |
;; ; (define-key global-map '(shift button3) 'mouse-function-menu) |
| ;; )) |
;; )) |
| |
|
| |
;;; |
| |
;;; Inferior Forth interpreter |
| |
;;; -- mostly copied from `cmuscheme.el' of Emacs 21.2 |
| |
;;; |
| |
|
| |
(eval-and-compile (forth-require 'comint)) |
| |
|
| |
(when (memq 'comint features) |
| |
|
| |
(defvar forth-program-name "gforth" |
| |
"*Program invoked by the `run-forth' command, including program arguments") |
| |
|
| |
(defcustom inferior-forth-mode-hook nil |
| |
"*Hook for customising inferior-forth-mode." |
| |
:type 'hook |
| |
:group 'forth) |
| |
|
| |
(defvar inferior-forth-mode-map |
| |
(let ((m (make-sparse-keymap))) |
| |
(define-key m "\r" 'comint-send-input) |
| |
(define-key m "\M-\C-x" 'forth-send-paragraph-and-go) |
| |
(define-key m "\C-c\C-l" 'forth-load-file) |
| |
m)) |
| |
;; Install the process communication commands in the forth-mode keymap. |
| |
(define-key forth-mode-map "\e\C-m" 'forth-send-paragraph-and-go) |
| |
(define-key forth-mode-map "\eo" 'forth-send-buffer-and-go) |
| |
|
| |
(define-key forth-mode-map "\M-\C-x" 'forth-send-paragraph-and-go) |
| |
(define-key forth-mode-map "\C-c\C-r" 'forth-send-region) |
| |
(define-key forth-mode-map "\C-c\M-r" 'forth-send-region-and-go) |
| |
(define-key forth-mode-map "\C-c\C-z" 'forth-switch-to-interactive) |
| |
(define-key forth-mode-map "\C-c\C-l" 'forth-load-file) |
| |
|
| |
(defvar forth-process-buffer) |
| |
|
| |
(define-derived-mode inferior-forth-mode comint-mode "Inferior Forth" |
| |
"Major mode for interacting with an inferior Forth process. |
| |
|
| |
The following commands are available: |
| |
\\{inferior-forth-mode-map} |
| |
|
| |
A Forth process can be fired up with M-x run-forth. |
| |
|
| |
Customisation: Entry to this mode runs the hooks on comint-mode-hook and |
| |
inferior-forth-mode-hook (in that order). |
| |
|
| |
You can send text to the inferior Forth process from other buffers containing |
| |
Forth source. |
| |
forth-switch-to-interactive switches the current buffer to the Forth |
| |
process buffer. |
| |
forth-send-paragraph sends the current paragraph to the Forth process. |
| |
forth-send-region sends the current region to the Forth process. |
| |
forth-send-buffer sends the current buffer to the Forth process. |
| |
|
| |
forth-send-paragraph-and-go, forth-send-region-and-go, |
| |
forth-send-buffer-and-go switch to the Forth process buffer after |
| |
sending their text. |
| |
For information on running multiple processes in multiple buffers, see |
| |
documentation for variable `forth-process-buffer'. |
| |
|
| |
Commands: |
| |
Return after the end of the process' output sends the text from the |
| |
end of process to point. If you accidentally suspend your process, use |
| |
\\[comint-continue-subjob] to continue it. " |
| |
;; Customise in inferior-forth-mode-hook |
| |
(setq comint-prompt-regexp "^") |
| |
(setq mode-line-process '(":%s"))) |
| |
|
| |
(defun forth-args-to-list (string) |
| |
(let ((where (string-match "[ \t]" string))) |
| |
(cond ((null where) (list string)) |
| |
((not (= where 0)) |
| |
(cons (substring string 0 where) |
| |
(forth-args-to-list (substring string (+ 1 where) |
| |
(length string))))) |
| |
(t (let ((pos (string-match "[^ \t]" string))) |
| |
(if (null pos) |
| |
nil |
| |
(forth-args-to-list (substring string pos |
| |
(length string))))))))) |
| |
|
| |
;;;###autoload |
| |
(defun run-forth (cmd) |
| |
"Run an inferior Forth process, input and output via buffer *forth*. |
| |
If there is a process already running in `*forth*', switch to that buffer. |
| |
With argument, allows you to edit the command line (default is value |
| |
of `forth-program-name'). Runs the hooks `inferior-forth-mode-hook' |
| |
\(after the `comint-mode-hook' is run). |
| |
\(Type \\[describe-mode] in the process buffer for a list of commands.)" |
| |
|
| |
(interactive (list (if current-prefix-arg |
| |
(read-string "Run Forth: " forth-program-name) |
| |
forth-program-name))) |
| |
(if (not (comint-check-proc "*forth*")) |
| |
(let ((cmdlist (forth-args-to-list cmd))) |
| |
(set-buffer (apply 'make-comint "forth" (car cmdlist) |
| |
nil (cdr cmdlist))) |
| |
(inferior-forth-mode))) |
| |
(setq forth-program-name cmd) |
| |
(setq forth-process-buffer "*forth*") |
| |
(pop-to-buffer "*forth*")) |
| |
|
| |
(defun forth-send-region (start end) |
| |
"Send the current region to the inferior Forth process." |
| |
(interactive "r") |
| |
(comint-send-region (forth-proc) start end) |
| |
(comint-send-string (forth-proc) "\n")) |
| |
|
| |
(defun forth-end-of-paragraph () |
| |
(if (looking-at "[\t\n ]+") (skip-chars-backward "\t\n ")) |
| |
(if (not (re-search-forward "\n[ \t]*\n" nil t)) |
| |
(goto-char (point-max)))) |
| |
|
| |
(defun forth-send-paragraph () |
| |
"Send the current or the previous paragraph to the Forth process" |
| |
(interactive) |
| |
(let (end) |
| |
(save-excursion |
| |
(forth-end-of-paragraph) |
| |
(skip-chars-backward "\t\n ") |
| |
(setq end (point)) |
| |
(if (null (re-search-backward "\n[ \t]*\n" nil t)) |
| |
(goto-char (point-min))) |
| |
(skip-chars-forward "\t\n ") |
| |
(forth-send-region (point) end)))) |
| |
|
| |
(defun forth-send-paragraph-and-go () |
| |
"Send the current or the previous paragraph to the Forth process. |
| |
Then switch to the process buffer." |
| |
(interactive) |
| |
(forth-send-paragraph) |
| |
(forth-switch-to-interactive t)) |
| |
|
| |
(defun forth-send-buffer () |
| |
"Send the current buffer to the Forth process." |
| |
(interactive) |
| |
(if (eq (current-buffer) forth-process-buffer) |
| |
(error "Not allowed to send this buffer's contents to Forth")) |
| |
(forth-send-region (point-min) (point-max))) |
| |
|
| |
(defun forth-send-buffer-and-go () |
| |
"Send the current buffer to the Forth process. |
| |
Then switch to the process buffer." |
| |
(interactive) |
| |
(forth-send-buffer) |
| |
(forth-switch-to-interactive t)) |
| |
|
| |
|
| |
(defun forth-switch-to-interactive (eob-p) |
| |
"Switch to the Forth process buffer. |
| |
With argument, position cursor at end of buffer." |
| |
(interactive "P") |
| |
(if (get-buffer forth-process-buffer) |
| |
(pop-to-buffer forth-process-buffer) |
| |
(error "No current process buffer. See variable `forth-process-buffer'")) |
| |
(cond (eob-p |
| |
(push-mark) |
| |
(goto-char (point-max))))) |
| |
|
| |
(defun forth-send-region-and-go (my-start end) |
| |
"Send the current region to the inferior Forth process. |
| |
Then switch to the process buffer." |
| |
(interactive "r") |
| |
(forth-send-region my-start end) |
| |
(forth-switch-to-interactive t)) |
| |
|
| |
(defcustom forth-source-modes '(forth-mode forth-block-mode) |
| |
"*Used to determine if a buffer contains Forth source code. |
| |
If it's loaded into a buffer that is in one of these major modes, it's |
| |
considered a Forth source file by `forth-load-file' and `forth-compile-file'. |
| |
Used by these commands to determine defaults." |
| |
:type '(repeat function) |
| |
:group 'forth) |
| |
|
| |
(defvar forth-prev-l/c-dir/file nil |
| |
"Caches the last (directory . file) pair. |
| |
Caches the last pair used in the last `forth-load-file' or |
| |
`forth-compile-file' command. Used for determining the default in the |
| |
next one.") |
| |
|
| |
(defun forth-load-file (file-name) |
| |
"Load a Forth file FILE-NAME into the inferior Forth process." |
| |
(interactive (comint-get-source "Load Forth file: " forth-prev-l/c-dir/file |
| |
forth-source-modes t)) ; T because LOAD |
| |
; needs an exact name |
| |
(comint-check-source file-name) ; Check to see if buffer needs saved. |
| |
(setq forth-prev-l/c-dir/file (cons (file-name-directory file-name) |
| |
(file-name-nondirectory file-name))) |
| |
(comint-send-string (forth-proc) |
| |
(concat "s\" " file-name "\" included\n"))) |
| |
|
| |
|
| |
(defvar forth-process-buffer nil "*The current Forth process buffer. |
| |
|
| |
See `scheme-buffer' for an explanation on how to run multiple Forth |
| |
processes.") |
| |
|
| |
(defun forth-proc () |
| |
"Return the current Forth process. See variable `forth-process-buffer'." |
| |
(let ((proc (get-buffer-process (if (eq major-mode 'inferior-forth-mode) |
| |
(current-buffer) |
| |
forth-process-buffer)))) |
| |
(or proc |
| |
(error "No current process. See variable `forth-process-buffer'")))) |
| |
) ; (memq 'comint features) |
| |
|
| (provide 'forth-mode) |
(provide 'forth-mode) |
| |
|
| ;;; gforth.el ends here |
;;; gforth.el ends here |
