Diff for /gforth/gforth.el between versions 1.58 and 1.64

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)
   

Removed from v.1.58  
changed lines
  Added in v.1.64


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