version 1.58, 2002/01/19 17:43:28
|
version 1.64, 2002/12/21 17:27:13
|
Line 33
|
Line 33
|
;; 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 |
|
|
;;------------------------------------------------------------------- |
;;------------------------------------------------------------------- |
;; A Forth indentation, documentation search and interaction library |
;; A Forth indentation, documentation search and interaction library |
Line 49
|
Line 50
|
|
|
;;; Code: |
;;; Code: |
|
|
(setq debug-on-error t) |
;(setq debug-on-error t) |
|
|
;; Code ripped from `version.el' for compatability with Emacs versions |
;; Code ripped from `version.el' for compatability with Emacs versions |
;; prior to 19.23. |
;; prior to 19.23. |
Line 90
|
Line 91
|
(set-face-foreground font-lock-warning-face "red") |
(set-face-foreground font-lock-warning-face "red") |
(make-face-bold font-lock-warning-face)) |
(make-face-bold font-lock-warning-face)) |
|
|
|
;; define `font-lock-constant-face' in XEmacs (just copy |
|
;; `font-lock-preprocessor-face') |
|
(unless (boundp 'font-lock-constant-face) |
|
(copy-face font-lock-preprocessor-face 'font-lock-constant-face)) |
|
|
|
|
;; define `regexp-opt' in emacs versions prior to 20.1 |
;; define `regexp-opt' in emacs versions prior to 20.1 |
;; (this implementation is extremely inefficient, though) |
;; (this implementation is extremely inefficient, though) |
(unless (boundp 'regexp-opt) |
(eval-and-compile (forth-require 'regexp-opt)) |
|
(unless (memq 'regexp-opt features) |
(message (concat |
(message (concat |
"Warning: your Emacs version doesn't support `regexp-opt'. " |
"Warning: your Emacs version doesn't support `regexp-opt'. " |
"Hilighting will be slow.")) |
"Hilighting will be slow.")) |
Line 102
|
Line 110
|
(defun regexp-opt-depth (re) |
(defun regexp-opt-depth (re) |
(if (string= (substring re 0 2) "\\(") 1 0))) |
(if (string= (substring re 0 2) "\\(") 1 0))) |
|
|
|
|
; todo: |
; todo: |
; |
; |
|
|
Line 129
|
Line 136
|
; |
; |
; Folding neuschreiben (neue Parser-Informationen benutzen) |
; Folding neuschreiben (neue Parser-Informationen benutzen) |
|
|
;;; Hilighting and indentation engine (dk) |
;;; Motion-hooking (dk) |
|
;;; |
|
(defun forth-idle-function () |
|
"Function that is called when Emacs is idle to detect cursor motion |
|
in forth-block-mode buffers (which is mainly used for screen number |
|
display in). Currently ignores forth-mode buffers but that may change |
|
in the future." |
|
(if (eq major-mode 'forth-block-mode) |
|
(forth-check-motion))) |
|
|
|
(defvar forth-idle-function-timer nil |
|
"Timer that runs `forth-idle-function' or nil if no timer installed.") |
|
|
|
(defun forth-install-motion-hook () |
|
"Install the motion-hooking mechanism. Currently uses idle timers |
|
but might be transparently changed in the future." |
|
(unless forth-idle-function-timer |
|
;; install idle function only once (first time forth-mode is used) |
|
(setq forth-idle-function-timer |
|
(run-with-idle-timer .05 t 'forth-idle-function)))) |
|
|
|
(defvar forth-was-point nil) |
|
|
|
(defun forth-check-motion () |
|
"Run `forth-motion-hooks', if `point' changed since last call. This |
|
used to be called via `post-command-hook' but uses idle timers now as |
|
users complaint about lagging performance." |
|
(when (or (eq forth-was-point nil) (/= forth-was-point (point))) |
|
(setq forth-was-point (point)) |
|
(run-hooks 'forth-motion-hooks))) |
|
|
|
|
|
;;; Hilighting and indentation engine (dk) |
;;; |
;;; |
(defvar forth-disable-parser nil |
(defvar forth-disable-parser nil |
"*Non-nil means to disable on-the-fly parsing of Forth-code. |
"*Non-nil means to disable on-the-fly parsing of Forth-code. |
Line 226 PARSED-TYPE specifies what kind of text
|
Line 265 PARSED-TYPE specifies what kind of text
|
(("[ifdef]" "[ifundef]") immediate (font-lock-keyword-face . 2) |
(("[ifdef]" "[ifundef]") immediate (font-lock-keyword-face . 2) |
"[ \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" "until" "repeat" "again" |
"case" "of" "?dup-if" "?dup-0=-if" "then" "endif" "until" |
|
"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" "assert(" "assert0(" "assert1(" "assert2(" |
"assert3(" ")" "<interpretation" "<compilation" "interpretation>" |
"assert3(" ")" "<interpretation" "<compilation" "interpretation>" |
Line 350 TYPE might be omitted. If it's specified
|
Line 390 TYPE might be omitted. If it's specified
|
have any effect on indentation inside definitions. (:NONAME is a good |
have any effect on indentation inside definitions. (:NONAME is a good |
example for this kind of word). |
example for this kind of word). |
|
|
INDENT1 specifies how to indent a word that's located at a line's begin, |
INDENT1 specifies how to indent a word that's located at the beginning |
following any number of whitespaces. |
of a line, following any number of whitespaces. |
|
|
INDENT2 specifies how to indent words that are not located at a line's begin. |
INDENT2 specifies how to indent words that are not located at the |
|
beginning of a line. |
|
|
INDENT1 and INDENT2 are indentation specifications of the form |
INDENT1 and INDENT2 are indentation specifications of the form |
(SELF-INDENT . NEXT-INDENT), where SELF-INDENT is a numerical value, |
(SELF-INDENT . NEXT-INDENT), where SELF-INDENT is a numerical value, |
Line 376 INDENT1 and INDENT2 are indentation spec
|
Line 417 INDENT1 and INDENT2 are indentation spec
|
(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)) |
(("again" "repeat" "then" "endtry" "endcase" "endof" |
(("again" "then" "endif" "endtry" "endcase" "endof" |
"[then]" "[endif]" "[loop]" "[+loop]" "[next]" |
"[then]" "[endif]" "[loop]" "[+loop]" "[next]" |
"[until]" "[repeat]" "[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;") |
Line 386 INDENT1 and INDENT2 are indentation spec
|
Line 427 INDENT1 and INDENT2 are indentation spec
|
(("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" "[else]") (-2 . 2) (0 . 0)) |
(("while" "does>" "[while]") (-1 . 1) (0 . 0)) |
(("does>") (-1 . 1) (0 . 0)) |
|
(("while" "[while]") (-2 . 4) (0 . 2)) |
|
(("repeat" "[repeat]") (-4 . 0) (0 . -4)) |
(("\\g") (-2 . 2) (0 . 0)))) |
(("\\g") (-2 . 2) (0 . 0)))) |
|
|
(defvar forth-local-indent-words nil |
(defvar forth-local-indent-words nil |
Line 432 End:\" construct).")
|
Line 475 End:\" construct).")
|
;; Helper function for `forth-compile-word': translate one entry from |
;; Helper function for `forth-compile-word': translate one entry from |
;; `forth-words' into the form (regexp regexp-depth word-description) |
;; `forth-words' into the form (regexp regexp-depth word-description) |
(defun forth-compile-words-mapper (word) |
(defun forth-compile-words-mapper (word) |
|
;; warning: we cannot rely on regexp-opt's PAREN argument, since |
|
;; XEmacs will use shy parens by default :-( |
(let* ((matcher (car word)) |
(let* ((matcher (car word)) |
(regexp (if (stringp matcher) (concat "\\(" matcher "\\)") |
(regexp |
(if (listp matcher) (regexp-opt matcher t) |
(concat "\\(" (cond ((stringp matcher) matcher) |
(error "Invalid matcher (stringp or listp expected `%s'" |
((listp matcher) (regexp-opt matcher)) |
matcher)))) |
(t (error "Invalid matcher `%s'"))) |
|
"\\)")) |
(depth (regexp-opt-depth regexp)) |
(depth (regexp-opt-depth regexp)) |
(description (cdr word))) |
(description (cdr word))) |
(list regexp depth description))) |
(list regexp depth description))) |
Line 542 End:\" construct).")
|
Line 588 End:\" construct).")
|
;; expression that matched. (used for identifying branches "a\\|b\\|c...") |
;; expression that matched. (used for identifying branches "a\\|b\\|c...") |
(defun forth-get-regexp-branch () |
(defun forth-get-regexp-branch () |
(let ((count 2)) |
(let ((count 2)) |
(while (not (match-beginning count)) |
(while (not (condition-case err (match-beginning count) |
|
(args-out-of-range t))) ; XEmacs requires error handling |
(setq count (1+ count))) |
(setq count (1+ count))) |
count)) |
count)) |
|
|
Line 864 Used for imenu index generation.")
|
Line 911 Used for imenu index generation.")
|
(forth-newline-remove-trailing) |
(forth-newline-remove-trailing) |
(indent-according-to-mode)) |
(indent-according-to-mode)) |
|
|
;;; end hilighting/indentation |
|
|
|
;;; Block file encoding/decoding (dk) |
;;; Block file encoding/decoding (dk) |
;;; |
;;; |
Line 1023 exceeds 64 characters."
|
Line 1069 exceeds 64 characters."
|
|
|
(add-hook 'forth-motion-hooks 'forth-update-warn-long-lines) |
(add-hook 'forth-motion-hooks 'forth-update-warn-long-lines) |
|
|
(defvar forth-was-point nil) |
|
(defun forth-check-motion () |
|
"Run `forth-motion-hooks', if `point' changed since last call." |
|
(when (or (eq forth-was-point nil) (/= forth-was-point (point))) |
|
(setq forth-was-point (point)) |
|
(run-hooks 'forth-motion-hooks))) |
|
|
|
;;; End block file editing |
;;; End block file editing |
|
|
|
|
Line 1056 exceeds 64 characters."
|
Line 1095 exceeds 64 characters."
|
(define-key forth-mode-map "\M-q" 'forth-fill-paragraph) |
(define-key forth-mode-map "\M-q" 'forth-fill-paragraph) |
(define-key forth-mode-map "\e." 'forth-find-tag) |
(define-key forth-mode-map "\e." 'forth-find-tag) |
|
|
;setup for C-h C-i to work |
;; setup for C-h C-i to work |
(eval-and-compile (forth-require 'info-look)) |
(eval-and-compile (forth-require 'info-look)) |
(when (memq 'info-look features) |
(when (memq 'info-look features) |
(info-lookup-add-help |
(defvar forth-info-lookup '(symbol (forth-mode "\\S-+" t |
:topic 'symbol |
(("(gforth)Word Index")) |
:mode 'forth-mode |
"\\S-+"))) |
:regexp "[^ |
(unless (memq forth-info-lookup info-lookup-alist) |
]+" |
(setq info-lookup-alist (cons forth-info-lookup info-lookup-alist))) |
:ignore-case t |
;; in X-Emacs C-h C-i is by default bound to Info-query |
:doc-spec '(("(gforth)Name Index" nil "`" "' ")))) |
(define-key forth-mode-map "\C-h\C-i" 'info-lookup-symbol)) |
|
|
|
|
|
;; (info-lookup-add-help |
|
;; :topic 'symbol |
|
;; :mode 'forth-mode |
|
;; :regexp "[^ |
|
;; ]+" |
|
;; :ignore-case t |
|
;; :doc-spec '(("(gforth)Name Index" nil "`" "' ")))) |
|
|
(require 'etags) |
(require 'etags) |
|
|
Line 1096 exceeds 64 characters."
|
Line 1144 exceeds 64 characters."
|
(setq char (1+ char)))) |
(setq char (1+ char)))) |
)) |
)) |
|
|
|
|
(defun forth-mode-variables () |
(defun forth-mode-variables () |
(set-syntax-table forth-mode-syntax-table) |
(set-syntax-table forth-mode-syntax-table) |
(setq local-abbrev-table forth-mode-abbrev-table) |
(setq local-abbrev-table forth-mode-abbrev-table) |
Line 1128 exceeds 64 characters."
|
Line 1175 exceeds 64 characters."
|
(make-local-variable 'forth-compiled-indent-words) |
(make-local-variable 'forth-compiled-indent-words) |
(make-local-variable 'forth-hilight-level) |
(make-local-variable 'forth-hilight-level) |
(make-local-variable 'after-change-functions) |
(make-local-variable 'after-change-functions) |
(make-local-variable 'post-command-hook) |
|
(make-local-variable 'forth-show-screen) |
(make-local-variable 'forth-show-screen) |
(make-local-variable 'forth-screen-marker) |
(make-local-variable 'forth-screen-marker) |
(make-local-variable 'forth-warn-long-lines) |
(make-local-variable 'forth-warn-long-lines) |
Line 1137 exceeds 64 characters."
|
Line 1183 exceeds 64 characters."
|
(make-local-variable 'forth-use-objects) |
(make-local-variable 'forth-use-objects) |
(setq forth-screen-marker (copy-marker 0)) |
(setq forth-screen-marker (copy-marker 0)) |
(add-hook 'after-change-functions 'forth-change-function) |
(add-hook 'after-change-functions 'forth-change-function) |
(add-hook 'post-command-hook 'forth-check-motion) |
(if (and forth-jit-parser (>= emacs-major-version 21)) |
(if (>= emacs-major-version 21) |
|
(add-hook 'fontification-functions 'forth-fontification-function)) |
(add-hook 'fontification-functions 'forth-fontification-function)) |
(setq imenu-create-index-function 'forth-create-index)) |
(setq imenu-create-index-function 'forth-create-index)) |
|
|
Line 1253 Variables controling documentation searc
|
Line 1298 Variables controling documentation searc
|
(use-local-map forth-mode-map) |
(use-local-map forth-mode-map) |
(setq mode-name "Forth") |
(setq mode-name "Forth") |
(setq major-mode 'forth-mode) |
(setq major-mode 'forth-mode) |
|
(forth-install-motion-hook) |
;; convert buffer contents from block file format, if necessary |
;; convert buffer contents from block file format, if necessary |
(when (forth-detect-block-file-p) |
(when (forth-detect-block-file-p) |
(widen) |
(widen) |
Line 1843 The region is sent terminated by a newli
|
Line 1889 The region is sent terminated by a newli
|
;;; Forth menu |
;;; Forth menu |
;;; Mikael Karlsson <qramika@eras70.ericsson.se> |
;;; Mikael Karlsson <qramika@eras70.ericsson.se> |
|
|
(cond ((string-match "XEmacs\\|Lucid" emacs-version) |
;; (dk) code commented out due to complaints of XEmacs users. After |
(require 'func-menu) |
;; all, there's imenu/speedbar, which uses much smarter scanning |
|
;; rules. |
|
|
|
;; (cond ((string-match "XEmacs\\|Lucid" emacs-version) |
|
;; (require 'func-menu) |
|
|
|
;; (defconst fume-function-name-regexp-forth |
|
;; "^\\(:\\)[ \t]+\\([^ \t]*\\)" |
|
;; "Expression to get word definitions in Forth.") |
|
|
|
;; (setq fume-function-name-regexp-alist |
|
;; (append '((forth-mode . fume-function-name-regexp-forth) |
|
;; ) fume-function-name-regexp-alist)) |
|
|
|
;; ;; Find next forth word in the buffer |
|
;; (defun fume-find-next-forth-function-name (buffer) |
|
;; "Searches for the next forth word in BUFFER." |
|
;; (set-buffer buffer) |
|
;; (if (re-search-forward fume-function-name-regexp nil t) |
|
;; (let ((beg (match-beginning 2)) |
|
;; (end (match-end 2))) |
|
;; (cons (buffer-substring beg end) beg)))) |
|
|
(defconst fume-function-name-regexp-forth |
;; (setq fume-find-function-name-method-alist |
"^\\(:\\)[ \t]+\\([^ \t]*\\)" |
;; (append '((forth-mode . fume-find-next-forth-function-name)))) |
"Expression to get word definitions in Forth.") |
|
|
|
(setq fume-function-name-regexp-alist |
|
(append '((forth-mode . fume-function-name-regexp-forth) |
|
) fume-function-name-regexp-alist)) |
|
|
|
;; Find next forth word in the buffer |
|
(defun fume-find-next-forth-function-name (buffer) |
|
"Searches for the next forth word in BUFFER." |
|
(set-buffer buffer) |
|
(if (re-search-forward fume-function-name-regexp nil t) |
|
(let ((beg (match-beginning 2)) |
|
(end (match-end 2))) |
|
(cons (buffer-substring beg end) beg)))) |
|
|
|
(setq fume-find-function-name-method-alist |
;; )) |
(append '((forth-mode . fume-find-next-forth-function-name)))) |
|
|
|
)) |
|
;;; End Forth menu |
;;; End Forth menu |
|
|
;;; File folding of forth-files |
;;; File folding of forth-files |
Line 1877 The region is sent terminated by a newli
|
Line 1927 The region is sent terminated by a newli
|
;;; Works most of the times but loses sync with the cursor occasionally |
;;; Works most of the times but loses sync with the cursor occasionally |
;;; Could be improved by also folding on comments |
;;; Could be improved by also folding on comments |
|
|
(require 'outline) |
;; (dk) This code needs a rewrite; just too ugly and doesn't use the |
|
;; newer and smarter scanning rules of `imenu'. Who needs it anyway?? |
|
|
|
;; (require 'outline) |
|
|
(defun f-outline-level () |
;; (defun f-outline-level () |
(cond ((looking-at "\\`\\\\") |
;; (cond ((looking-at "\\`\\\\") |
0) |
;; 0) |
((looking-at "\\\\ SEC") |
;; ((looking-at "\\\\ SEC") |
0) |
;; 0) |
((looking-at "\\\\ \\\\ .*") |
;; ((looking-at "\\\\ \\\\ .*") |
0) |
;; 0) |
((looking-at "\\\\ DEFS") |
;; ((looking-at "\\\\ DEFS") |
1) |
;; 1) |
((looking-at "\\/\\* ") |
;; ((looking-at "\\/\\* ") |
1) |
;; 1) |
((looking-at ": .*") |
;; ((looking-at ": .*") |
1) |
;; 1) |
((looking-at "\\\\G") |
;; ((looking-at "\\\\G") |
2) |
;; 2) |
((looking-at "[ \t]+\\\\") |
;; ((looking-at "[ \t]+\\\\") |
3))) |
;; 3))) |
|
|
(defun fold-f () |
;; (defun fold-f () |
(interactive) |
;; (interactive) |
(add-hook 'outline-minor-mode-hook 'hide-body) |
;; (add-hook 'outline-minor-mode-hook 'hide-body) |
|
|
; outline mode header start, i.e. find word definitions |
;; ; outline mode header start, i.e. find word definitions |
;;; (setq outline-regexp "^\\(:\\)[ \t]+\\([^ \t]*\\)") |
;; ;;; (setq outline-regexp "^\\(:\\)[ \t]+\\([^ \t]*\\)") |
(setq outline-regexp "\\`\\\\\\|:\\|\\\\ SEC\\|\\\\G\\|[ \t]+\\\\\\|\\\\ DEFS\\|\\/\\*\\|\\\\ \\\\ .*") |
;; (setq outline-regexp "\\`\\\\\\|:\\|\\\\ SEC\\|\\\\G\\|[ \t]+\\\\\\|\\\\ DEFS\\|\\/\\*\\|\\\\ \\\\ .*") |
(setq outline-level 'f-outline-level) |
;; (setq outline-level 'f-outline-level) |
|
|
(outline-minor-mode) |
;; (outline-minor-mode) |
(define-key outline-minor-mode-map '(shift up) 'hide-sublevels) |
;; (define-key outline-minor-mode-map '(shift up) 'hide-sublevels) |
(define-key outline-minor-mode-map '(shift right) 'show-children) |
;; (define-key outline-minor-mode-map '(shift right) 'show-children) |
(define-key outline-minor-mode-map '(shift left) 'hide-subtree) |
;; (define-key outline-minor-mode-map '(shift left) 'hide-subtree) |
(define-key outline-minor-mode-map '(shift down) 'show-subtree)) |
;; (define-key outline-minor-mode-map '(shift down) 'show-subtree)) |
|
|
|
|
;;(define-key global-map '(shift up) 'fold-f) |
;;(define-key global-map '(shift up) 'fold-f) |
|
|
Line 1922 The region is sent terminated by a newli
|
Line 1976 The region is sent terminated by a newli
|
;;; for all of the recognized languages. Scanning the buffer takes some time, |
;;; for all of the recognized languages. Scanning the buffer takes some time, |
;;; but not much. |
;;; but not much. |
;;; |
;;; |
(cond ((string-match "XEmacs\\|Lucid" emacs-version) |
;; (cond ((string-match "XEmacs\\|Lucid" emacs-version) |
(require 'func-menu) |
;; (require 'func-menu) |
;; (define-key global-map 'f8 'function-menu) |
;; ;; (define-key global-map 'f8 'function-menu) |
(add-hook 'find-fible-hooks 'fume-add-menubar-entry) |
;; (add-hook 'find-fible-hooks 'fume-add-menubar-entry) |
; (define-key global-map "\C-cg" 'fume-prompt-function-goto) |
;; ; (define-key global-map "\C-cg" 'fume-prompt-function-goto) |
; (define-key global-map '(shift button3) 'mouse-function-menu) |
;; ; (define-key global-map '(shift button3) 'mouse-function-menu) |
)) |
;; )) |
|
|
(provide 'forth-mode) |
(provide 'forth-mode) |
|
|