version 1.74, 2007/12/31 17:34:58
|
version 1.87, 2012/05/04 00:11:04
|
Line 1
|
Line 1
|
;;; 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,2003,2004,2007 Free Software Foundation, Inc. |
;; Copyright (C) 1995,1996,1997,1998,2000,2001,2003,2004,2007,2008,2010,2011 Free Software Foundation, Inc. |
|
|
;; This file is part of Gforth. |
;; This file is part of Gforth. |
|
|
Line 59
|
Line 59
|
(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 |
;; Code ripped from `subr.el' for compatability with Emacs versions |
;; prior to 20.1 |
;; prior to 20.1 |
Line 237 PARSED-TYPE specifies what kind of text
|
Line 237 PARSED-TYPE specifies what kind of text
|
(("]" "]l") definition-starter (font-lock-keyword-face . 1)) |
(("]" "]l") definition-starter (font-lock-keyword-face . 1)) |
((":") definition-starter (font-lock-keyword-face . 1) |
((":") definition-starter (font-lock-keyword-face . 1) |
"[ \t\n]" t name (font-lock-function-name-face . 3)) |
"[ \t\n]" t name (font-lock-function-name-face . 3)) |
|
(("event:") definition-starter (font-lock-keyword-face . 1) |
|
"[ \t\n]" t name (font-lock-function-name-face . 3)) |
(("immediate" "compile-only" "restrict") |
(("immediate" "compile-only" "restrict") |
immediate (font-lock-keyword-face . 1)) |
immediate (font-lock-keyword-face . 1)) |
(("does>") compile-only (font-lock-keyword-face . 1)) |
(("does>") compile-only (font-lock-keyword-face . 1)) |
((":noname") definition-starter (font-lock-keyword-face . 1)) |
((":noname") definition-starter (font-lock-keyword-face . 1)) |
((";" ";code") definition-ender (font-lock-keyword-face . 1)) |
((";" ";code" ";abi-code") definition-ender (font-lock-keyword-face . 1)) |
(("include" "require" "needs" "use") |
(("include" "require" "needs" "use") |
non-immediate (font-lock-keyword-face . 1) |
non-immediate (font-lock-keyword-face . 1) |
"[\n\t ]" t string (font-lock-string-face . 1)) |
"[\n\t ]" t string (font-lock-string-face . 1)) |
(("included" "required" "thru" "load") |
(("included" "required" "thru" "load") |
non-immediate (font-lock-keyword-face . 1)) |
non-immediate (font-lock-keyword-face . 1)) |
|
(("code" "abi-code") |
|
non-immediate (font-lock-keyword-face . 1) |
|
"[ \t\n]" t name (font-lock-function-name-face . 3)) |
|
(("end-code") |
|
non-immediate (font-lock-keyword-face . 1)) |
(("[char]") compile-only (font-lock-keyword-face . 1) |
(("[char]") compile-only (font-lock-keyword-face . 1) |
"[ \t\n]" t string (font-lock-string-face . 1)) |
"[ \t\n]" t string (font-lock-string-face . 1)) |
(("char") non-immediate (font-lock-keyword-face . 1) |
(("char") non-immediate (font-lock-keyword-face . 1) |
"[ \t\n]" t string (font-lock-string-face . 1)) |
"[ \t\n]" t string (font-lock-string-face . 1)) |
(("s\"" "c\"") immediate (font-lock-string-face . 1) |
("'.'?" non-immediate (font-lock-string-face . 1)) |
|
(("s\"" "c\"" "s\\\"") immediate (font-lock-string-face . 1) |
"[\"\n]" nil string (font-lock-string-face . 1)) |
"[\"\n]" nil string (font-lock-string-face . 1)) |
((".\"") compile-only (font-lock-string-face . 1) |
((".\"" ".\\\"") compile-only (font-lock-string-face . 1) |
"[\"\n]" nil string (font-lock-string-face . 1)) |
"[\"\n]" nil string (font-lock-string-face . 1)) |
(("abort\"") compile-only (font-lock-keyword-face . 1) |
(("abort\"") compile-only (font-lock-keyword-face . 1) |
"[\"\n]" nil string (font-lock-string-face . 1)) |
"[\"\n]" nil string (font-lock-string-face . 1)) |
Line 301 PARSED-TYPE specifies what kind of text
|
Line 309 PARSED-TYPE specifies what kind of text
|
|
|
(("create" "variable" "constant" "2variable" "2constant" "fvariable" |
(("create" "variable" "constant" "2variable" "2constant" "fvariable" |
"fconstant" "value" "field" "user" "vocabulary" |
"fconstant" "value" "field" "user" "vocabulary" |
"create-interpret/compile") |
"create-interpret/compile" "interpret/compile:") |
non-immediate (font-lock-type-face . 2) |
non-immediate (font-lock-type-face . 2) |
"[ \t\n]" t name (font-lock-variable-name-face . 3)) |
"[ \t\n]" t name (font-lock-variable-name-face . 3)) |
("\\S-+%" non-immediate (font-lock-type-face . 2)) |
("\\S-+%" non-immediate (font-lock-type-face . 2)) |
Line 310 PARSED-TYPE specifies what kind of text
|
Line 318 PARSED-TYPE specifies what kind of text
|
"[ \t\n]" t name (font-lock-function-name-face . 3)) |
"[ \t\n]" t name (font-lock-function-name-face . 3)) |
(("end-struct") non-immediate (font-lock-keyword-face . 2) |
(("end-struct") non-immediate (font-lock-keyword-face . 2) |
"[ \t\n]" t name (font-lock-type-face . 3)) |
"[ \t\n]" t name (font-lock-type-face . 3)) |
(("struct") non-immediate (font-lock-keyword-face . 2)) |
(("struct" "end-c-library" "c-library-name") |
|
non-immediate (font-lock-keyword-face . 2)) |
|
(("c-library") non-immediate (font-lock-keyword-face . 2) |
|
"[ \t\n]" t name (font-lock-variable-name-face . 3)) |
|
(("c-variable") non-immediate (font-lock-type-face . 1) |
|
"[ \t\n]" t name (font-lock-function-name-face . 3) |
|
"[ \t\n]" t name (font-lock-function-name-face . 3)) |
|
(("c-function" "c-value") non-immediate (font-lock-type-face . 1) |
|
"[ \t\n]" t name (font-lock-function-name-face . 3) |
|
"[ \t\n]" t name (font-lock-function-name-face . 3) |
|
"[\n]" nil comment (font-lock-variable-name-face . 3)) |
|
(("\\c") non-immediate (font-lock-keyword-face . 1) |
|
"[\n]" nil string (font-lock-string-face . 1)) |
("-?[0-9]+\\(\\.[0-9]*e\\(-?[0-9]+\\)?\\|\\.?[0-9a-f]*\\)" |
("-?[0-9]+\\(\\.[0-9]*e\\(-?[0-9]+\\)?\\|\\.?[0-9a-f]*\\)" |
immediate (font-lock-constant-face . 3)) |
immediate (font-lock-constant-face . 3)) |
|
("-?\\([&#][0-9]+\\|\\(0x\\|\\$\\)[0-9a-f]+\\|%[01]+\\)" |
|
immediate (font-lock-constant-face . 3)) |
)) |
)) |
|
|
(defvar forth-use-objects nil |
(defvar forth-use-objects nil |
Line 420 INDENT1 and INDENT2 are indentation spec
|
Line 442 INDENT1 and INDENT2 are indentation spec
|
"u-do" "?dup-if" "?dup-0=-if" "case" "of" "try" "iferror" |
"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" "abi-code" "struct" "m:" ":m" "class" |
|
"interface" "c-library" "c-library-name") |
(0 . 2) (0 . 2) non-immediate) |
(0 . 2) (0 . 2) non-immediate) |
("\\S-+%$" (0 . 2) (0 . 0) non-immediate) |
("\\S-+%$" (0 . 2) (0 . 0) non-immediate) |
((";" ";m") (-2 . 0) (0 . -2)) |
((";" ";m") (-2 . 0) (0 . -2)) |
Line 429 INDENT1 and INDENT2 are indentation spec
|
Line 452 INDENT1 and INDENT2 are indentation spec
|
"[until]" "[again]" "loop") |
"[until]" "[again]" "loop") |
(-2 . 0) (0 . -2)) |
(-2 . 0) (0 . -2)) |
(("end-code" "end-class" "end-interface" "end-class-noname" |
(("end-code" "end-class" "end-interface" "end-class-noname" |
"end-interface-noname" "end-struct" "class;") |
"end-interface-noname" "end-struct" "class;" "end-c-library") |
(-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" "restore" "endtry-iferror" "[else]") |
(("else" "recover" "restore" "endtry-iferror" "[else]") |
(-2 . 2) (0 . 0)) |
(-2 . 2) (0 . 0)) |
(("does>") (-1 . 1) (0 . 0)) |
(("does>" ";code" ";abi-code") (-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)))) |
|
|
Line 462 End:\" construct).")
|
Line 485 End:\" construct).")
|
;; 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 |
Line 488 End:\" construct).")
|
Line 510 End:\" construct).")
|
(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))) |
Line 530 End:\" construct).")
|
Line 552 End:\" construct).")
|
"Parse and bind local variables, set in the contents of the current |
"Parse and bind local variables, set in the contents of the current |
forth-mode buffer. Prepend `forth-local-words' to `forth-words' and |
forth-mode buffer. Prepend `forth-local-words' to `forth-words' and |
`forth-local-indent-words' to `forth-indent-words'." |
`forth-local-indent-words' to `forth-indent-words'." |
|
(put 'forth-local-indent-words 'safe-local-variable 'listp) |
|
(put 'forth-local-words 'safe-local-variable 'listp) |
(hack-local-variables) |
(hack-local-variables) |
(setq forth-words (append forth-local-words forth-words)) |
(setq forth-words (append forth-local-words forth-words)) |
(setq forth-indent-words (append forth-local-indent-words |
(setq forth-indent-words (append forth-local-indent-words |
Line 699 End:\" construct).")
|
Line 723 End:\" construct).")
|
(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 |
Line 739 End:\" construct).")
|
Line 763 End:\" construct).")
|
(defvar forth-defining-words |
(defvar forth-defining-words |
'("VARIABLE" "CONSTANT" "2VARIABLE" "2CONSTANT" "FVARIABLE" "FCONSTANT" |
'("VARIABLE" "CONSTANT" "2VARIABLE" "2CONSTANT" "FVARIABLE" "FCONSTANT" |
"USER" "VALUE" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE" |
"USER" "VALUE" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE" |
"DEFER" "ALIAS") |
"DEFER" "ALIAS" "interpret/compile:") |
"List of words, that define the following word. |
"List of words, that define the following word. |
Used for imenu index generation.") |
Used for imenu index generation.") |
|
|
Line 1094 exceeds 64 characters."
|
Line 1118 exceeds 64 characters."
|
(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 "\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 "\t" 'forth-indent-command) |
(define-key forth-mode-map "\t" 'forth-indent-command) |
(define-key forth-mode-map "\C-m" 'forth-reindent-then-newline-and-indent) |
(define-key forth-mode-map "\C-m" 'forth-reindent-then-newline-and-indent) |
(define-key forth-mode-map "\M-q" 'forth-fill-paragraph) |
(define-key forth-mode-map "\M-q" 'forth-fill-paragraph) |
Line 1367 programmers who tend to fill code won't
|
Line 1390 programmers who tend to fill code won't
|
(defun forth-remove-tracers () |
(defun forth-remove-tracers () |
"Remove tracers of the form `~~ '. Queries the user for each occurrence." |
"Remove tracers of the form `~~ '. Queries the user for each occurrence." |
(interactive) |
(interactive) |
(query-replace-regexp "\\(~~ \\| ~~$\\)" "" nil)) |
(query-replace-regexp "\\(~~[ \t]\\|[ \t]~~$\\)" "" nil)) |
|
|
(define-key forth-mode-map "\C-x\C-e" 'compile) |
(define-key forth-mode-map "\C-x\C-e" 'compile) |
(define-key forth-mode-map "\C-x\C-n" 'next-error) |
(define-key forth-mode-map "\C-x\C-n" 'next-error) |
Line 1385 programmers who tend to fill code won't
|
Line 1408 programmers who tend to fill code won't
|
(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-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> |
|
|
Line 1616 of `forth-program-name'). Runs the hook
|
Line 1633 of `forth-program-name'). Runs the hook
|
(forth-end-of-paragraph) |
(forth-end-of-paragraph) |
(skip-chars-backward "\t\n ") |
(skip-chars-backward "\t\n ") |
(setq end (point)) |
(setq end (point)) |
(if (re-search-backward "\n[ \t]*\n" nil t) |
(if (null (re-search-backward "\n[ \t]*\n" nil t)) |
(setq start (point)) |
|
(goto-char (point-min))) |
(goto-char (point-min))) |
(skip-chars-forward "\t\n ") |
(skip-chars-forward "\t\n ") |
(forth-send-region (point) end)))) |
(forth-send-region (point) end)))) |
Line 1655 With argument, position cursor at end of
|
Line 1671 With argument, position cursor at end of
|
(push-mark) |
(push-mark) |
(goto-char (point-max))))) |
(goto-char (point-max))))) |
|
|
(defun forth-send-region-and-go (start end) |
(defun forth-send-region-and-go (my-start end) |
"Send the current region to the inferior Forth process. |
"Send the current region to the inferior Forth process. |
Then switch to the process buffer." |
Then switch to the process buffer." |
(interactive "r") |
(interactive "r") |
(forth-send-region start end) |
(forth-send-region my-start end) |
(forth-switch-to-interactive t)) |
(forth-switch-to-interactive t)) |
|
|
(defcustom forth-source-modes '(forth-mode forth-block-mode) |
(defcustom forth-source-modes '(forth-mode forth-block-mode) |