gforth/gforth.el - diff

Return to gforth.el CVS log

Up to [gforth] / gforth

Diff for /gforth/gforth.el between versions 1.53 and 1.56

version 1.53, 2001/06/26 19:51:49	version 1.56, 2002/01/05 17:42:29
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 Free Software Foundation, Inc.	;; Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.

;; This file is part of Gforth.	;; This file is part of Gforth.

Line 49	Line 49

;;; Code:	;;; Code:

	;; Code ripped from `version.el' for compatability with Emacs versions
	;; prior to 19.23.
	(unless (boundp 'emacs-major-version)
	(defconst emacs-major-version
	(progn (string-match "^[0-9]+" emacs-version)
	(string-to-int (match-string 0 emacs-version)))))


;;; Hilighting and indentation engine (dk)	;;; Hilighting and indentation engine (dk)
;;;	;;;

	(defvar forth-disable-parser nil
	"*Non-nil means to disable on-the-fly parsing of Forth-code.

	This will disable hilighting of forth-mode buffers and will decrease
	the smartness of the indentation engine. Only set it to non-nil, if
	your computer is very slow. To disable hilighting, set
	`forth-hilight-level' to zero.")

	(defvar forth-jit-parser nil
	"*Non-nil means to parse Forth-code just-in-time.

	This eliminates the need for initially parsing forth-mode buffers and
	thus speeds up loading of Forth files. That feature is only available
	in Emacs21 (and newer versions).")

(defvar forth-words nil	(defvar forth-words nil
"List of words for hilighting and recognition of parsed text areas.	"List of words for hilighting and recognition of parsed text areas.
You can enable hilighting of object-oriented Forth code, by appending either
`forth-objects-words' or `forth-oof-words' to the list, depending on which	Hilighting of object-oriented Forth code is achieved, by appending either
OOP package you're using. After `forth-words' changed, `forth-compile-words'	`forth-objects-words' or `forth-oof-words' to the list, depending on the values of `forth-use-objects' or `forth-use-oof'.
must be called to make the changes take effect.
	After `forth-words' changed, `forth-compile-words' must be called to
	make the changes take effect.

Each item of `forth-words' has the form	Each item of `forth-words' has the form
(MATCHER TYPE HILIGHT . &optional PARSED-TEXT ...)	(MATCHER TYPE HILIGHT . &optional PARSED-TEXT ...)
Line 141 PARSED-TYPE specifies what kind of text	Line 164 PARSED-TYPE specifies what kind of text

(("true" "false" "c/l" "bl" "cell" "pi" "w/o" "r/o" "r/w")	(("true" "false" "c/l" "bl" "cell" "pi" "w/o" "r/o" "r/w")
non-immediate (font-lock-constant-face . 2))	non-immediate (font-lock-constant-face . 2))
(("~~") compile-only (font-lock-warning-face . 2))	(("~~" "break:" "dbg") compile-only (font-lock-warning-face . 2))
	(("break\"") compile-only (font-lock-warning-face . 1)
	"[\"\n]" nil string (font-lock-string-face . 1))
(("postpone" "[is]" "defers" "[']" "[compile]")	(("postpone" "[is]" "defers" "[']" "[compile]")
compile-only (font-lock-keyword-face . 2)	compile-only (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))
(("is" "what's") immediate (font-lock-keyword-face . 2)	(("is" "what's") 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))
(("<is>" "'") non-immediate (font-lock-keyword-face . 2)	(("<is>" "'" "see") non-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))
(("[to]") compile-only (font-lock-keyword-face . 2)	(("[to]") compile-only (font-lock-keyword-face . 2)
"[ \t\n]" t name (font-lock-variable-name-face . 3))	"[ \t\n]" t name (font-lock-variable-name-face . 3))
Line 161 PARSED-TYPE specifies what kind of text	Line 186 PARSED-TYPE specifies what kind of text
"create-interpret/compile")	"create-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))
(("defer" "alias" "create-interpret/compile:")	(("defer" "alias" "create-interpret/compile:")
non-immediate (font-lock-type-face . 1)	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))
Line 214 PARSED-TYPE specifies what kind of text	Line 240 PARSED-TYPE specifies what kind of text
"[ \t\n]" t name (font-lock-type-face . 3))	"[ \t\n]" t name (font-lock-type-face . 3))
(("var") non-immediate (font-lock-type-face . 2)	(("var") 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))
(("method") non-immediate (font-lock-type-face . 2)	(("method" "early") non-immediate (font-lock-type-face . 2)
"[ \t\n]" t name (font-lock-function-name-face . 3))	"[ \t\n]" t name (font-lock-function-name-face . 3))
(("::" "super" "bind" "bound" "link")	(("::" "super" "bind" "bound" "link")
immediate (font-lock-keyword-face . 2)	immediate (font-lock-keyword-face . 2)
Line 244 PARSED-TYPE specifies what kind of text	Line 270 PARSED-TYPE specifies what kind of text
; todo:	; todo:
;	;

; W�rter ordentlich hilighten, die nicht auf whitespace beginning ( ..)IF	; W�rter ordentlich hilighten, die nicht auf Whitespace beginnen ( ..)IF
; Additional `forth-use-objects' or	; -- mit aktueller Konzeption nicht m�glich??
; `forth-use-oof' could be set to non-nil for automatical adding of those
; word-lists. Using local variable list?
;	;
; Konfiguration �ber customization groups	; Konfiguration �ber customization groups
;	;
; Bereich nur auf Wortanfang/ende ausweiten, wenn anfang bzw ende in einem	; Bereich nur auf Wortanfang/ende ausweiten, wenn Anfang bzw Ende in einem
; Wort liegen (?) -- speed!	; Wort liegen (?) -- speed!
;	;
; User interface
;
; 'forth-word' property muss eindeutig sein!	; 'forth-word' property muss eindeutig sein!
;	;
; imenu support schlauer machen	; Forth-Menu
	;
	; Interface zu GForth Prozessen (Patches von Michael Scholz)
	;
	; Byte-compile-Code rausschmei�en, Compilieren im Makefile �ber Emacs
	; batch-Modus
	;
	; forth-help Kram rausschmei�en
	;
	; XEmacs Kompatibilit�t? imenu/speedbar -> fume?
	;
	; Folding neuschreiben (neue Parser-Informationen benutzen)

(setq debug-on-error t)	;(setq debug-on-error t)

;; Filter list by predicate. This is a somewhat standard function for	;; Filter list by predicate. This is a somewhat standard function for
;; functional programming languages. So why isn't it already implemented	;; functional programming languages. So why isn't it already implemented
Line 390 PARSED-TYPE specifies what kind of text	Line 423 PARSED-TYPE specifies what kind of text
;; Delete all properties, used by Forth mode, from `from' to `to'.	;; Delete all properties, used by Forth mode, from `from' to `to'.
(defun forth-delete-properties (from to)	(defun forth-delete-properties (from to)
(remove-text-properties	(remove-text-properties
from to '(face nil forth-parsed nil forth-word nil forth-state nil)))	from to '(face nil fontified nil
	forth-parsed nil forth-word nil forth-state nil)))

;; Get the index of the branch of the most recently evaluated regular	;; Get the index of the branch of the most recently evaluated regular
;; expression that matched. (used for identifying branches "a\\\|b\\\|c...")	;; expression that matched. (used for identifying branches "a\\\|b\\\|c...")
Line 469 PARSED-TYPE specifies what kind of text	Line 503 PARSED-TYPE specifies what kind of text
(setq state (get-text-property (point) 'forth-state))	(setq state (get-text-property (point) 'forth-state))
(setq last-location (point))	(setq last-location (point))
(forth-delete-properties (point) to)	(forth-delete-properties (point) to)
	(put-text-property (point) to 'fontified t)
;; hilight loop...	;; hilight loop...
(while (setq word-descr (forth-next-known-forth-word to))	(while (setq word-descr (forth-next-known-forth-word to))
(when loudly	(when loudly
Line 512 PARSED-TYPE specifies what kind of text	Line 547 PARSED-TYPE specifies what kind of text
;; and stuff like that.	;; and stuff like that.
(defun forth-change-function (from to len &optional loudly)	(defun forth-change-function (from to len &optional loudly)
(save-match-data	(save-match-data
(forth-save-buffer-state ()	(forth-save-buffer-state
(unwind-protect	()
(progn	(unless forth-disable-parser (forth-update-properties from to loudly))
(forth-update-properties from to loudly)	(forth-update-warn-long-lines))))
(forth-update-show-screen)
(forth-update-warn-long-lines))))))	(defun forth-fontification-function (from)
	"Function to be called from `fontification-functions' of Emacs 21."
	(save-match-data
	(forth-save-buffer-state
	((to (min (point-max) (+ from 100))))
	(unless (or forth-disable-parser (not forth-jit-parser)
	(get-text-property from 'fontified))
	(forth-update-properties from to)))))

(eval-when-compile	(eval-when-compile
(byte-compile 'forth-set-word-properties)	(byte-compile 'forth-set-word-properties)
Line 533 PARSED-TYPE specifies what kind of text	Line 575 PARSED-TYPE specifies what kind of text
"USER" "VALUE" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE"	"USER" "VALUE" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE"
"DEFER" "ALIAS")	"DEFER" "ALIAS")
"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.")


(defun forth-next-definition-starter ()	(defun forth-next-definition-starter ()
Line 558 PARSED-TYPE specifies what kind of text	Line 600 PARSED-TYPE specifies what kind of text
(setq index (cons (cons (match-string 1) (point)) index))))	(setq index (cons (cons (match-string 1) (point)) index))))
index))	index))

(require 'speedbar)	(unwind-protect
(speedbar-add-supported-extension ".fs")	(progn
(speedbar-add-supported-extension ".fb")	(require 'speedbar)
	(speedbar-add-supported-extension ".fs")
	(speedbar-add-supported-extension ".fb")))

;; (require 'profile)	;; (require 'profile)
;; (setq profile-functions-list '(forth-set-word-properties forth-next-known-forth-word forth-update-properties forth-delete-properties forth-get-regexp-branch))	;; (setq profile-functions-list '(forth-set-word-properties forth-next-known-forth-word forth-update-properties forth-delete-properties forth-get-regexp-branch))
Line 571 PARSED-TYPE specifies what kind of text	Line 615 PARSED-TYPE specifies what kind of text
(defvar forth-indent-words nil	(defvar forth-indent-words nil
"List of words that have indentation behaviour.	"List of words that have indentation behaviour.
Each element of `forth-indent-words' should have the form	Each element of `forth-indent-words' should have the form
(MATCHER INDENT1 INDENT2)	(MATCHER INDENT1 INDENT2 &optional TYPE)

MATCHER is either a list of strings to match, or a REGEXP.	MATCHER is either a list of strings to match, or a REGEXP.
If it's a REGEXP, it should not be surrounded by `\\<` or `\\>`, since	If it's a REGEXP, it should not be surrounded by `\\<` or `\\>`, since
that'll be done automatically by the search routines.	that'll be done automatically by the search routines.

	TYPE might be omitted. If it's specified, the only allowed value is
	currently the symbol `non-immediate', meaning that the word will not
	have any effect on indentation inside definitions. (:NONAME is a good
	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 a line's begin,
following any number of whitespaces.	following any number of whitespaces.

Line 595 INDENT1 and INDENT2 are indentation spec	Line 644 INDENT1 and INDENT2 are indentation spec
1 * forth-indent-level + forth-minor-indent-level columns to the right.")	1 * forth-indent-level + forth-minor-indent-level columns to the right.")

(setq forth-indent-words	(setq forth-indent-words
'(((":" ":noname" "code" "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" "struct"	"u-do" "?dup-if" "?dup-0=-if" "case" "of" "try"
"[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]"	"[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]")
"class" "interface" "m:" ":m")
(0 . 2) (0 . 2))	(0 . 2) (0 . 2))
	((":" ":noname" "code" "struct" "m:" ":m" "class" "interface")
	(0 . 2) (0 . 2) non-immediate)
	("\\S-+%$" (0 . 2) (0 . 0) non-immediate)
((";" ";m") (-2 . 0) (0 . -2))	((";" ";m") (-2 . 0) (0 . -2))
(("end-code" "again" "repeat" "then" "endtry" "endcase" "endof"	(("again" "repeat" "then" "endtry" "endcase" "endof"
"end-struct" "[then]" "[endif]" "[loop]" "[+loop]" "[next]"	"[then]" "[endif]" "[loop]" "[+loop]" "[next]"
"[until]" "[repeat]" "[again]" "end-class" "end-interface"	"[until]" "[repeat]" "[again]" "loop")
"end-class-noname" "end-interface-noname" "loop"
"class;")
(-2 . 0) (0 . -2))	(-2 . 0) (0 . -2))
(("protected" "public" "how:") (-1 . 1) (0 . 0))	(("end-code" "end-class" "end-interface" "end-class-noname"
	"end-interface-noname" "end-struct" "class;")
	(-2 . 0) (0 . -2) 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))	(("while" "does>" "[while]") (-1 . 1) (0 . 0))
Line 624 End:\" construct).")	Line 676 End:\" construct).")
your .emacs.")	your .emacs.")

(defvar forth-indent-level 4	(defvar forth-indent-level 4
"Indentation of Forth statements.")	"*Indentation of Forth statements.")
(defvar forth-minor-indent-level 2	(defvar forth-minor-indent-level 2
"Minor indentation of Forth statements.")	"*Minor indentation of Forth statements.")
(defvar forth-compiled-indent-words nil)	(defvar forth-compiled-indent-words nil)

;; Return, whether `pos' is the first forth word on its line	;; Return, whether `pos' is the first forth word on its line
Line 646 End:\" construct).")	Line 698 End:\" construct).")
(let* ((regexp (car forth-compiled-indent-words))	(let* ((regexp (car forth-compiled-indent-words))
(pos (re-search-forward regexp to t)))	(pos (re-search-forward regexp to t)))
(if pos	(if pos
(if (text-property-not-all (match-beginning 0) (match-end 0)	(let* ((start (match-beginning 0))
'forth-parsed nil)	(end (match-end 0))
(forth-next-known-indent-word to)	(branch (forth-get-regexp-branch))
(let* ((branch (forth-get-regexp-branch))	(descr (cdr forth-compiled-indent-words))
(descr (cdr forth-compiled-indent-words))	(indent (cdr (assoc branch descr)))
(indent (cdr (assoc branch descr))))	(type (nth 2 indent)))
	;; skip words that are parsed (strings/comments) and
	;; non-immediate words inside definitions
	(if (or (text-property-not-all start end 'forth-parsed nil)
	(and (eq type 'non-immediate)
	(text-property-not-all start end
	'forth-state nil)))
	(forth-next-known-indent-word to)
(if (forth-first-word-on-line-p (match-beginning 0))	(if (forth-first-word-on-line-p (match-beginning 0))
(nth 0 indent) (nth 1 indent))))	(nth 0 indent) (nth 1 indent))))
nil)))	nil)))
Line 699 End:\" construct).")	Line 758 End:\" construct).")
(defun forth-get-anchor-column ()	(defun forth-get-anchor-column ()
(save-excursion	(save-excursion
(if (/= 0 (forward-line -1)) 0	(if (/= 0 (forward-line -1)) 0
(let ((next-indent)	(let ((indent))
(self-indent))
(while (not (or (setq indent (forth-get-column-incr 1))	(while (not (or (setq indent (forth-get-column-incr 1))
(<= (point) (point-min))))	(<= (point) (point-min))))
(forward-line -1))	(forward-line -1))
Line 863 done by checking whether the first line	Line 921 done by checking whether the first line
(save-restriction	(save-restriction
(widen)	(widen)
(save-excursion	(save-excursion
(beginning-of-buffer)	(goto-char (point-min))
(end-of-line)	(end-of-line)
(>= (current-column) 1024))))	(>= (current-column) 1024))))

Line 916 exceeds 64 characters."	Line 974 exceeds 64 characters."
forth-c/l))))	forth-c/l))))

(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 943 exceeds 64 characters."	Line 1008 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)

;;; hook into motion events (realy ugly!) (dk)
(define-key forth-mode-map "\C-n" 'forth-next-line)
(define-key forth-mode-map "\C-p" 'forth-previous-line)
(define-key forth-mode-map [down] 'forth-next-line)
(define-key forth-mode-map [up] 'forth-previous-line)
(define-key forth-mode-map "\C-f" 'forth-forward-char)
(define-key forth-mode-map "\C-b" 'forth-backward-char)
(define-key forth-mode-map [right] 'forth-forward-char)
(define-key forth-mode-map [left] 'forth-backward-char)
(define-key forth-mode-map "\M-f" 'forth-forward-word)
(define-key forth-mode-map "\M-b" 'forth-backward-word)
(define-key forth-mode-map [C-right] 'forth-forward-word)
(define-key forth-mode-map [C-left] 'forth-backward-word)
(define-key forth-mode-map "\M-v" 'forth-scroll-down)
(define-key forth-mode-map "\C-v" 'forth-scroll-up)
(define-key forth-mode-map [prior] 'forth-scroll-down)
(define-key forth-mode-map [next] 'forth-scroll-up)

(defun forth-next-line (arg)
(interactive "p") (next-line arg) (run-hooks 'forth-motion-hooks))
(defun forth-previous-line (arg)
(interactive "p") (previous-line arg) (run-hooks 'forth-motion-hooks))
(defun forth-backward-char (arg)
(interactive "p") (backward-char arg) (run-hooks 'forth-motion-hooks))
(defun forth-forward-char (arg)
(interactive "p") (forward-char arg) (run-hooks 'forth-motion-hooks))
(defun forth-forward-word (arg)
(interactive "p") (forward-word arg) (run-hooks 'forth-motion-hooks))
(defun forth-backward-word (arg)
(interactive "p") (backward-word arg) (run-hooks 'forth-motion-hooks))
(defun forth-scroll-down (arg)
(interactive "P") (scroll-down arg) (run-hooks 'forth-motion-hooks))
(defun forth-scroll-up (arg)
(interactive "P") (scroll-up arg) (run-hooks 'forth-motion-hooks))

;setup for C-h C-i to work	;setup for C-h C-i to work
(if (fboundp 'info-lookup-add-help)	(if (fboundp 'info-lookup-add-help)
(info-lookup-add-help	(info-lookup-add-help
Line 1042 exceeds 64 characters."	Line 1072 exceeds 64 characters."
(make-local-variable 'parse-sexp-ignore-comments)	(make-local-variable 'parse-sexp-ignore-comments)
(setq parse-sexp-ignore-comments t)	(setq parse-sexp-ignore-comments t)
(setq case-fold-search t)	(setq case-fold-search t)
	(make-local-variable 'forth-was-point)
	(setq forth-was-point -1)
(make-local-variable 'forth-words)	(make-local-variable 'forth-words)
(make-local-variable 'forth-compiled-words)	(make-local-variable 'forth-compiled-words)
(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 1055 exceeds 64 characters."	Line 1088 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 (>= emacs-major-version 21)
	(add-hook 'fontification-functions 'forth-fontification-function))
(setq imenu-create-index-function 'forth-create-index))	(setq imenu-create-index-function 'forth-create-index))

;;;###autoload	;;;###autoload
Line 1098 Variables controlling syntax hilighting/	Line 1134 Variables controlling syntax hilighting/
.emacs, or by setting forth-local-words, in source-files' local	.emacs, or by setting forth-local-words, in source-files' local
variables lists.	variables lists.
forth-use-objects	forth-use-objects
Set this variable to non-nil in your .emacs, or a local variables	Set this variable to non-nil in your .emacs, or in a local variables
list, to hilight and recognize the words from the \"Objects\" package	list, to hilight and recognize the words from the \"Objects\" package
for object-oriented programming.	for object-oriented programming.
forth-use-oof	forth-use-oof
Line 1217 bell during block file read/write operat	Line 1253 bell during block file read/write operat
(forth-hack-local-variables)	(forth-hack-local-variables)
(forth-customize-words)	(forth-customize-words)
(forth-compile-words)	(forth-compile-words)
(forth-change-function (point-min) (point-max) nil t)))	(unless (and forth-jit-parser (>= emacs-major-version 21))
	(forth-change-function (point-min) (point-max) nil t))))

(defun forth-fill-paragraph ()	(defun forth-fill-paragraph ()
"Fill comments (starting with '\'; do not fill code (block style	"Fill comments (starting with '\'; do not fill code (block style

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.53
changed lines
	Added in v.1.56