Diff for /gforth/gforth.el between versions 1.57 and 1.60

version 1.57, 2002/01/17 19:26:34 version 1.60, 2002/02/04 21:25:17
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)
   
 ;; 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.
 (unless (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-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:  ; todo:
 ;  ;
Line 85 Line 138
   
 ;;; Hilighting and indentation engine                           (dk)  ;;; Hilighting and indentation engine                           (dk)
 ;;;  ;;;
 (require 'font-lock)  
   
 (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 182  PARSED-TYPE specifies what kind of text Line 233  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"
           "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 332  INDENT1 and INDENT2 are indentation spec Line 384  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" "repeat" "then" "endif" "endtry" "endcase" "endof" 
           "[then]" "[endif]" "[loop]" "[+loop]" "[next]"             "[then]" "[endif]" "[loop]" "[+loop]" "[next]" 
           "[until]" "[repeat]" "[again]" "loop")            "[until]" "[repeat]" "[again]" "loop")
          (-2 . 0) (0 . -2))           (-2 . 0) (0 . -2))
Line 388  End:\" construct).") Line 440  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 498  End:\" construct).") Line 553  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 671  Used for imenu index generation.") Line 727  Used for imenu index generation.")
     index))      index))
   
 ;; top-level require is executed at byte-compile and load time  ;; 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  ;; 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 ".fs")
   (speedbar-add-supported-extension ".fb"))    (speedbar-add-supported-extension ".fb"))
   
Line 1013  exceeds 64 characters." Line 1069  exceeds 64 characters."
 (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
 (require 'info-look nil t)  (eval-and-compile (forth-require 'info-look))
 (when (require 'info-look nil t)  (when (memq 'info-look features)
   (info-lookup-add-help    ;; info-lookup-add-help not supported in XEmacs :-(
    :topic 'symbol    (defvar forth-info-lookup '(symbol (forth-mode "\\w+" t 
    :mode 'forth-mode                                                    (("(gforth)Word Index"))
    :regexp "[^                                                      "\\w+")))
 ]+"    (unless (memq forth-info-lookup info-lookup-alist)
    :ignore-case t      (setq info-lookup-alist (cons forth-info-lookup info-lookup-alist))))
    :doc-spec '(("(gforth)Name Index" nil "`" "'  "))))  
   ;;   (info-lookup-add-help
   ;;    :topic 'symbol
   ;;    :mode 'forth-mode
   ;;    :regexp "[^       
   ;; ]+"
   ;;    :ignore-case t
   ;;    :doc-spec '(("(gforth)Name Index" nil "`" "'  "))))
   
 (require 'etags)  (require 'etags)
   

Removed from v.1.57  
changed lines
  Added in v.1.60


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