--- gforth/gforth.el 2002/01/17 19:26:34 1.57 +++ gforth/gforth.el 2002/02/04 21:25:17 1.60 @@ -33,6 +33,7 @@ ;; Changes by David ;; Added a syntax-hilighting engine, rewrote auto-indentation engine. ;; 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 @@ -49,13 +50,65 @@ ;;; Code: +;(setq debug-on-error t) + ;; 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))))) +(if (not (boundp 'emacs-major-version)) + (defconst emacs-major-version + (progn (string-match "^[0-9]+" emacs-version) + (string-to-int (match-string 0 emacs-version))))) + +(defun forth-emacs-older (major minor) + (or (< emacs-major-version major) + (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) + (progn + (defmacro when (cond &rest body) + "If COND yields non-nil, do BODY, else return nil." + (list 'if cond (cons 'progn body))) + (defmacro unless (cond &rest body) + "If COND yields nil, do BODY, else return nil." + (cons 'if (cons cond (cons nil body))))))) + +;; `no-error' argument of require not supported in Emacs versions +;; prior to 20.4 :-( +(defun forth-require (feature) + (condition-case err (require feature) (error nil))) + +(require 'font-lock) + +;; define `font-lock-warning-face' in emacs-versions prior to 20.1 +;; (ripped from `font-lock.el') +(unless (boundp 'font-lock-warning-face) + (message "defining font-lock-warning-face") + (make-face 'font-lock-warning-face) + (defvar font-lock-warning-face 'font-lock-warning-face) + (set-face-foreground font-lock-warning-face "red") + (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) + (defvar font-lock-constant-face 'font-lock-comment-face)) + +;; define `regexp-opt' in emacs versions prior to 20.1 +;; (this implementation is extremely inefficient, though) +(eval-and-compile (forth-require 'regexp-opt)) +(unless (memq 'regexp-opt features) + (message (concat + "Warning: your Emacs version doesn't support `regexp-opt'. " + "Hilighting will be slow.")) + (defun regexp-opt (STRINGS &optional PAREN) + (let ((open (if PAREN "\\(" "")) (close (if PAREN "\\)" ""))) + (concat open (mapconcat 'regexp-quote STRINGS "\\|") close))) + (defun regexp-opt-depth (re) + (if (string= (substring re 0 2) "\\(") 1 0))) ; todo: ; @@ -85,8 +138,6 @@ ;;; Hilighting and indentation engine (dk) ;;; -(require 'font-lock) - (defvar forth-disable-parser nil "*Non-nil means to disable on-the-fly parsing of Forth-code. @@ -182,7 +233,8 @@ PARSED-TYPE specifies what kind of text (("[ifdef]" "[ifundef]") immediate (font-lock-keyword-face . 2) "[ \t\n]" t name (font-lock-function-name-face . 3)) (("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" "loop" "+loop" "-loop" "next" "endcase" "endof" "else" "while" "try" "recover" "endtry" "assert(" "assert0(" "assert1(" "assert2(" "assert3(" ")" "" @@ -332,7 +384,7 @@ INDENT1 and INDENT2 are indentation spec (0 . 2) (0 . 2) non-immediate) ("\\S-+%$" (0 . 2) (0 . 0) non-immediate) ((";" ";m") (-2 . 0) (0 . -2)) - (("again" "repeat" "then" "endtry" "endcase" "endof" + (("again" "repeat" "then" "endif" "endtry" "endcase" "endof" "[then]" "[endif]" "[loop]" "[+loop]" "[next]" "[until]" "[repeat]" "[again]" "loop") (-2 . 0) (0 . -2)) @@ -388,11 +440,14 @@ End:\" construct).") ;; Helper function for `forth-compile-word': translate one entry from ;; `forth-words' into the form (regexp regexp-depth word-description) (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)) - (regexp (if (stringp matcher) (concat "\\(" matcher "\\)") - (if (listp matcher) (regexp-opt matcher t) - (error "Invalid matcher (stringp or listp expected `%s'" - matcher)))) + (regexp + (concat "\\(" (cond ((stringp matcher) matcher) + ((listp matcher) (regexp-opt matcher)) + (t (error "Invalid matcher `%s'"))) + "\\)")) (depth (regexp-opt-depth regexp)) (description (cdr word))) (list regexp depth description))) @@ -498,7 +553,8 @@ End:\" construct).") ;; expression that matched. (used for identifying branches "a\\|b\\|c...") (defun forth-get-regexp-branch () (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))) count)) @@ -671,10 +727,10 @@ Used for imenu index generation.") index)) ;; top-level require is executed at byte-compile and load time -(require 'speedbar nil t) +(eval-and-compile (forth-require 'speedbar)) ;; this code is executed at load-time only -(when (require 'speedbar nil t) +(when (memq 'speedbar features) (speedbar-add-supported-extension ".fs") (speedbar-add-supported-extension ".fb")) @@ -1013,15 +1069,22 @@ exceeds 64 characters." (define-key forth-mode-map "\e." 'forth-find-tag) ;setup for C-h C-i to work -(require 'info-look nil t) -(when (require 'info-look nil t) - (info-lookup-add-help - :topic 'symbol - :mode 'forth-mode - :regexp "[^ -]+" - :ignore-case t - :doc-spec '(("(gforth)Name Index" nil "`" "' ")))) +(eval-and-compile (forth-require 'info-look)) +(when (memq 'info-look features) + ;; info-lookup-add-help not supported in XEmacs :-( + (defvar forth-info-lookup '(symbol (forth-mode "\\w+" t + (("(gforth)Word Index")) + "\\w+"))) + (unless (memq forth-info-lookup info-lookup-alist) + (setq info-lookup-alist (cons forth-info-lookup info-lookup-alist)))) + +;; (info-lookup-add-help +;; :topic 'symbol +;; :mode 'forth-mode +;; :regexp "[^ +;; ]+" +;; :ignore-case t +;; :doc-spec '(("(gforth)Name Index" nil "`" "' ")))) (require 'etags)