Diff for /gforth/gforth.el between versions 1.59 and 1.80

version 1.59, 2002/01/26 13:05:26 version 1.80, 2010/09/04 10:15:57
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,2001 Free Software Foundation, Inc.  ;; Copyright (C) 1995,1996,1997,1998,2000,2001,2003,2004,2007,2008 Free Software Foundation, Inc.
   
 ;; This file is part of Gforth.  ;; This file is part of Gforth.
   
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  ;; Replaced forth-process code with comint-based implementation.
   
   ;; Tested with Emacs 19.34, 20.5, 21 and XEmacs 21
     
 ;;-------------------------------------------------------------------  ;;-------------------------------------------------------------------
 ;; A Forth indentation, documentation search and interaction library  ;; A Forth indentation, documentation search and interaction library
Line 57 Line 59
 (if (not (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-number (match-string 0 emacs-version)))))
   
   ;; Code ripped from `subr.el' for compatability with Emacs versions
   ;; prior to 20.1
   (eval-when-compile 
 (defun forth-emacs-older (major minor)  (defun forth-emacs-older (major minor)
   (or (< emacs-major-version major)    (or (< emacs-major-version major)
       (and (= emacs-major-version major) (< emacs-minor-version minor))))        (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)    (if (forth-emacs-older 20 1)
       (progn        (progn
         (defmacro when (cond &rest body)          (defmacro when (cond &rest body)
Line 77 Line 79
   
 ;; `no-error' argument of require not supported in Emacs versions  ;; `no-error' argument of require not supported in Emacs versions
 ;; prior to 20.4 :-(  ;; prior to 20.4 :-(
   (eval-and-compile
 (defun forth-require (feature)  (defun forth-require (feature)
   (condition-case err (require feature) (error nil)))      (condition-case err (require feature) (error nil))))
   
 (require 'font-lock)  (require 'font-lock)
   
Line 94 Line 97
 ;; define `font-lock-constant-face' in XEmacs (just copy  ;; define `font-lock-constant-face' in XEmacs (just copy
 ;; `font-lock-preprocessor-face')  ;; `font-lock-preprocessor-face')
 (unless (boundp 'font-lock-constant-face)  (unless (boundp 'font-lock-constant-face)
   (copy-face font-lock-preprocessor-face '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   ;; define `regexp-opt' in emacs versions prior to 20.1 
 ;; (this implementation is extremely inefficient, though)  ;; (this implementation is extremely inefficient, though)
Line 113 Line 116
 ; todo:  ; todo:
 ;  ;
   
   ; screen-height existiert nicht in XEmacs, frame-height ersetzen?
   ; 
   
 ; Wörter ordentlich hilighten, die nicht auf Whitespace beginnen ( ..)IF  ; Wörter ordentlich hilighten, die nicht auf Whitespace beginnen ( ..)IF
 ; -- mit aktueller Konzeption nicht möglich??  ; -- mit aktueller Konzeption nicht möglich??
 ;  ;
Line 136 Line 142
 ;   ; 
 ; 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 203  PARSED-TYPE specifies what kind of text Line 241  PARSED-TYPE specifies what kind of text
          immediate (font-lock-keyword-face . 1))           immediate (font-lock-keyword-face . 1))
         (("does>") compile-only (font-lock-keyword-face . 1))          (("does>") compile-only (font-lock-keyword-face . 1))
         ((":noname") definition-starter (font-lock-keyword-face . 1))          ((":noname") definition-starter (font-lock-keyword-face . 1))
         ((";" ";code") definition-ender (font-lock-keyword-face . 1))          ((";" ";code" ";abi-code") definition-ender (font-lock-keyword-face . 1))
         (("include" "require" "needs" "use")           (("include" "require" "needs" "use") 
          non-immediate (font-lock-keyword-face . 1)            non-immediate (font-lock-keyword-face . 1) 
          "[\n\t ]" t string (font-lock-string-face . 1))           "[\n\t ]" t string (font-lock-string-face . 1))
         (("included" "required" "thru" "load")          (("included" "required" "thru" "load")
          non-immediate (font-lock-keyword-face . 1))           non-immediate (font-lock-keyword-face . 1))
           (("code" "abi-code")
            non-immediate (font-lock-keyword-face . 1)
            "[ \t\n]" t name (font-lock-function-name-face . 3))
           (("end-code")
            non-immediate (font-lock-keyword-face . 1))
         (("[char]") compile-only (font-lock-keyword-face . 1)          (("[char]") compile-only (font-lock-keyword-face . 1)
          "[ \t\n]" t string (font-lock-string-face . 1))           "[ \t\n]" t string (font-lock-string-face . 1))
         (("char") non-immediate (font-lock-keyword-face . 1)          (("char") non-immediate (font-lock-keyword-face . 1)
Line 233  PARSED-TYPE specifies what kind of text Line 276  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" "iferror" "restore" "endtry-iferror"
             "assert(" "assert0(" "assert1(" "assert2("
           "assert3(" ")" "<interpretation" "<compilation" "interpretation>"             "assert3(" ")" "<interpretation" "<compilation" "interpretation>" 
           "compilation>")            "compilation>")
          compile-only (font-lock-keyword-face . 2))           compile-only (font-lock-keyword-face . 2))
Line 270  PARSED-TYPE specifies what kind of text Line 315  PARSED-TYPE specifies what kind of text
          "[ \t\n]" t name (font-lock-function-name-face . 3))           "[ \t\n]" t name (font-lock-function-name-face . 3))
         (("end-struct") non-immediate (font-lock-keyword-face . 2)          (("end-struct") non-immediate (font-lock-keyword-face . 2)
          "[ \t\n]" t name (font-lock-type-face . 3))           "[ \t\n]" t name (font-lock-type-face . 3))
         (("struct") non-immediate (font-lock-keyword-face . 2))          (("struct" "end-c-library" "c-library-name") 
            non-immediate (font-lock-keyword-face . 2))
           (("c-library") non-immediate (font-lock-keyword-face . 2)
            "[ \t\n]" t name (font-lock-variable-name-face . 3))
           (("c-variable") 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))
           (("c-function" "c-value") 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)
            "[\n]" nil comment (font-lock-variable-name-face . 3))
           (("\\c") non-immediate (font-lock-keyword-face . 1)
            "[\n]" nil string (font-lock-string-face . 1))
         ("-?[0-9]+\\(\\.[0-9]*e\\(-?[0-9]+\\)?\\|\\.?[0-9a-f]*\\)"           ("-?[0-9]+\\(\\.[0-9]*e\\(-?[0-9]+\\)?\\|\\.?[0-9a-f]*\\)" 
          immediate (font-lock-constant-face . 3))           immediate (font-lock-constant-face . 3))
           ("-?\\([&#][0-9]+\\|\\(0x\\|\\$\\)[0-9a-f]+\\|%[01]+\\)"
            immediate (font-lock-constant-face . 3))
         ))          ))
   
 (defvar forth-use-objects nil   (defvar forth-use-objects nil 
Line 357  TYPE might be omitted. If it's specified Line 416  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 436  INDENT1 and INDENT2 are indentation spec
   
 (setq forth-indent-words  (setq forth-indent-words
       '((("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"             "u-do" "?dup-if" "?dup-0=-if" "case" "of" "try" "iferror"
           "[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]")            "[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]")
          (0 . 2) (0 . 2))           (0 . 2) (0 . 2))
         ((":" ":noname" "code" "struct" "m:" ":m" "class" "interface")          ((":" ":noname" "code" "abi-code" "struct" "m:" ":m" "class" 
             "interface" "c-library" "c-library-name")
          (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;" "end-c-library")
          (-2 . 0) (0 . -2) non-immediate)           (-2 . 0) (0 . -2) non-immediate)
         (("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" "restore" "endtry-iferror" "[else]")
         (("while" "does>" "[while]") (-1 . 1) (0 . 0))           (-2 . 2) (0 . 0))
         (("\\g") (-2 . 2) (0 . 0))))          (("does>" ";code" ";abi-code") (-1 . 1) (0 . 0))
           (("while" "[while]") (-2 . 4) (0 . 2))
           (("repeat" "[repeat]") (-4 . 0) (0 . -4))))
   
 (defvar forth-local-indent-words nil   (defvar forth-local-indent-words nil 
   "List of Forth words to prepend to `forth-indent-words', when a forth-mode    "List of Forth words to prepend to `forth-indent-words', when a forth-mode
Line 419  End:\" construct).") Line 482  End:\" construct).")
 ;; in Lisp??  ;; in Lisp??
 (defun forth-filter (predicate list)  (defun forth-filter (predicate list)
   (let ((filtered nil))    (let ((filtered nil))
     (mapcar (lambda (item)      (dolist (item list)
               (when (funcall predicate item)                (when (funcall predicate item)
                 (if filtered                  (if filtered
                     (nconc filtered (list item))                      (nconc filtered (list item))
                   (setq filtered (cons item nil))))            (setq filtered (cons item nil)))))
               nil) list)  
     filtered))      filtered))
   
 ;; Helper function for `forth-compile-word': return whether word has to be  ;; Helper function for `forth-compile-word': return whether word has to be
Line 445  End:\" construct).") Line 507  End:\" construct).")
          (regexp            (regexp 
           (concat "\\(" (cond ((stringp matcher) matcher)            (concat "\\(" (cond ((stringp matcher) matcher)
                               ((listp matcher) (regexp-opt matcher))                                ((listp matcher) (regexp-opt matcher))
                               (t (error "Invalid matcher `%s'")))                                (t (error "Invalid matcher")))
                   "\\)"))                    "\\)"))
          (depth (regexp-opt-depth regexp))           (depth (regexp-opt-depth regexp))
          (description (cdr word)))           (description (cdr word)))
Line 487  End:\" construct).") Line 549  End:\" construct).")
   "Parse and bind local variables, set in the contents of the current     "Parse and bind local variables, set in the contents of the current 
  forth-mode buffer. Prepend `forth-local-words' to `forth-words' and    forth-mode buffer. Prepend `forth-local-words' to `forth-words' and 
  `forth-local-indent-words' to `forth-indent-words'."   `forth-local-indent-words' to `forth-indent-words'."
     (put 'forth-local-indent-words 'safe-local-variable 'listp)
     (put 'forth-local-words 'safe-local-variable 'listp)
   (hack-local-variables)    (hack-local-variables)
   (setq forth-words (append forth-local-words forth-words))    (setq forth-words (append forth-local-words forth-words))
   (setq forth-indent-words (append forth-local-indent-words     (setq forth-indent-words (append forth-local-indent-words 
Line 656  End:\" construct).") Line 720  End:\" construct).")
 (eval-when-compile   (eval-when-compile 
   (defmacro forth-save-buffer-state (varlist &rest body)    (defmacro forth-save-buffer-state (varlist &rest body)
     "Bind variables according to VARLIST and eval BODY restoring buffer state."      "Bind variables according to VARLIST and eval BODY restoring buffer state."
     (` (let* ((,@ (append varlist      `(let* (,@(append varlist
                    '((modified (buffer-modified-p)) (buffer-undo-list t)                     '((modified (buffer-modified-p)) (buffer-undo-list t)
                      (inhibit-read-only t) (inhibit-point-motion-hooks t)                       (inhibit-read-only t) (inhibit-point-motion-hooks t)
                      before-change-functions after-change-functions                       before-change-functions after-change-functions
                      deactivate-mark buffer-file-name buffer-file-truename))))                          deactivate-mark buffer-file-name buffer-file-truename)))
          (,@ body)         ,@body
          (when (and (not modified) (buffer-modified-p))           (when (and (not modified) (buffer-modified-p))
            (set-buffer-modified-p nil))))))           (set-buffer-modified-p nil)))))
   
 ;; Function that is added to the `change-functions' hook. Calls   ;; Function that is added to the `change-functions' hook. Calls 
 ;; `forth-update-properties' and keeps care of disabling undo information  ;; `forth-update-properties' and keeps care of disabling undo information
Line 786  Used for imenu index generation.") Line 850  Used for imenu index generation.")
   
 ;; Return the column increment, that the current line of forth code does to  ;; Return the column increment, that the current line of forth code does to
 ;; the current or following lines. `which' specifies which indentation values  ;; the current or following lines. `which' specifies which indentation values
 ;; to use. 0 means the indentation of following lines relative to current   ;; to use. 1 means the indentation of following lines relative to current 
 ;; line, 1 means the indentation of the current line relative to the previous   ;; line, 0 means the indentation of the current line relative to the previous 
 ;; line. Return `nil', if there are no indentation words on the current line.  ;; line. Return `nil', if there are no indentation words on the current line.
 (defun forth-get-column-incr (which)  (defun forth-get-column-incr (which)
   (save-excursion    (save-excursion
Line 875  Used for imenu index generation.") Line 939  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 1034  exceeds 64 characters." Line 1097  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 1058  exceeds 64 characters." Line 1114  exceeds 64 characters."
 ;(define-key forth-mode-map "\M-\C-x" 'compile)  ;(define-key forth-mode-map "\M-\C-x" 'compile)
 (define-key forth-mode-map "\C-x\\" 'comment-region)  (define-key forth-mode-map "\C-x\\" 'comment-region)
 (define-key forth-mode-map "\C-x~" 'forth-remove-tracers)  (define-key forth-mode-map "\C-x~" 'forth-remove-tracers)
 (define-key forth-mode-map "\e\C-m" 'forth-send-paragraph)  
 (define-key forth-mode-map "\eo" 'forth-send-buffer)  
 (define-key forth-mode-map "\C-x\C-m" 'forth-split)  (define-key forth-mode-map "\C-x\C-m" 'forth-split)
 (define-key forth-mode-map "\e " 'forth-reload)  (define-key forth-mode-map "\e " 'forth-reload)
 (define-key forth-mode-map "\t" 'forth-indent-command)  (define-key forth-mode-map "\t" 'forth-indent-command)
Line 1067  exceeds 64 characters." Line 1121  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 not supported in XEmacs :-(    (defvar forth-info-lookup '(symbol (forth-mode "\\S-+" t 
   (defvar forth-info-lookup '(symbol (forth-mode "\\w+" t   
                                                   (("(gforth)Word Index"))                                                    (("(gforth)Word Index"))
                                                   "\\w+")))                                                    "\\S-+")))
   (unless (memq forth-info-lookup info-lookup-alist)    (unless (memq forth-info-lookup info-lookup-alist)
     (setq info-lookup-alist (cons forth-info-lookup info-lookup-alist))))      (setq info-lookup-alist (cons forth-info-lookup info-lookup-alist)))
     ;; in X-Emacs C-h C-i is by default bound to Info-query
     (define-key forth-mode-map [?\C-h ?\C-i] 'info-lookup-symbol))
   
 ;;   (info-lookup-add-help  ;;   (info-lookup-add-help
 ;;    :topic 'symbol  ;;    :topic 'symbol
Line 1090  exceeds 64 characters." Line 1145  exceeds 64 characters."
 (defun forth-find-tag (tagname &optional next-p regexp-p)  (defun forth-find-tag (tagname &optional next-p regexp-p)
   (interactive (find-tag-interactive "Find tag: "))    (interactive (find-tag-interactive "Find tag: "))
   (unless (or regexp-p next-p)    (unless (or regexp-p next-p)
     (setq tagname (concat "\\(^\\|\\s-\\)\\(" (regexp-quote tagname)       (setq tagname (concat "\\(^\\|\\s-+\\)\\(" (regexp-quote tagname) 
                             "\\)\\(\\s-\\|$\\)")))                              "\\)\\s-*\x7f")))
   (switch-to-buffer    (switch-to-buffer
    (find-tag-noselect tagname next-p t)))     (find-tag-noselect tagname next-p t)))
   
Line 1114  exceeds 64 characters." Line 1169  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 1133  exceeds 64 characters." Line 1187  exceeds 64 characters."
   (make-local-variable 'comment-column)    (make-local-variable 'comment-column)
   (setq comment-column 40)    (setq comment-column 40)
   (make-local-variable 'comment-start-skip)    (make-local-variable 'comment-start-skip)
   (setq comment-start-skip "\\ ")    (setq comment-start-skip "\\\\ ")
   (make-local-variable 'comment-indent-function)    (make-local-variable 'comment-indent-function)
   (setq comment-indent-function 'forth-comment-indent)    (setq comment-indent-function 'forth-comment-indent)
   (make-local-variable 'parse-sexp-ignore-comments)    (make-local-variable 'parse-sexp-ignore-comments)
Line 1146  exceeds 64 characters." Line 1200  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 1155  exceeds 64 characters." Line 1208  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 1168  are delimited with \\ and newline. Parag Line 1220  are delimited with \\ and newline. Parag
 only. Block files are autodetected, when read, and converted to normal   only. Block files are autodetected, when read, and converted to normal 
 stream source format. See also `forth-block-mode'.  stream source format. See also `forth-block-mode'.
 \\{forth-mode-map}  \\{forth-mode-map}
  Forth-split  
     Positions the current buffer on top and a forth-interaction window  
     below. The window size is controlled by the forth-percent-height  
     variable (see below).  
  Forth-reload  
     Reloads the forth library and restarts the forth process.  
  Forth-send-buffer  
     Sends the current buffer, in text representation, as input to the  
     forth process.  
  Forth-send-paragraph  
     Sends the previous or the current paragraph to the forth-process.  
     Note that the cursor only need to be with in the paragraph to be sent.  
  forth-documentation  
     Search for documentation of forward adjacent to cursor. Note! To use  
     this mode you have to add a line, to your .emacs file, defining the  
     directories to search through for documentation files (se variable  
     forth-help-load-path below) e.g. (setq forth-help-load-path '(nil)).  
   
 Variables controlling interaction and startup  
  forth-percent-height  
     Tells split how high to make the edit portion, in percent of the  
     current screen height.  
  forth-program-name  
     Tells the library which program name to execute in the interation  
     window.  
   
 Variables controlling syntax hilighting/recognition of parsed text:  Variables controlling syntax hilighting/recognition of parsed text:
  `forth-words'   `forth-words'
Line 1255  Variables controlling block-file editing Line 1282  Variables controlling block-file editing
     length that can be stored into a block file). This variable defaults to      length that can be stored into a block file). This variable defaults to
     t for `forth-block-mode' and to nil for `forth-mode'.      t for `forth-block-mode' and to nil for `forth-mode'.
   
 Variables controling documentation search  Variables controlling interaction with the Forth-process (also see
  forth-help-load-path  `run-forth'):
     List of directories to search through to find *.doc    forth-program-name
     (forth-help-file-suffix) files. Nil means current default directory.      Program invoked by the `run-forth' command (including arguments).
     The specified directories must contain at least one .doc file. If it    inferior-forth-mode-hook
     does not and you still want the load-path to scan that directory, create      Hook for customising inferior-forth-mode.
     an empty file dummy.doc.    forth-compile-command
  forth-help-file-suffix      Default command to execute on `compile'.
     The file names to search for in each directory specified by  " 
     forth-help-load-path. Defaulted to '*.doc'.   
 "  
   (interactive)    (interactive)
   (kill-all-local-variables)    (kill-all-local-variables)
   (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 1364  programmers who tend to fill code won't Line 1390  programmers who tend to fill code won't
   (interactive)    (interactive)
   (query-replace-regexp "\\(~~ \\| ~~$\\)" "" nil))    (query-replace-regexp "\\(~~ \\| ~~$\\)" "" nil))
   
 (defvar forth-program-name "gforth"  (define-key forth-mode-map "\C-x\C-e" 'compile)
   "*Program invoked by the `run-forth' command.")  (define-key forth-mode-map "\C-x\C-n" 'next-error)
   (require 'compile)
 (defvar forth-band-name nil  
   "*Band loaded by the `run-forth' command.")  
   
 (defvar forth-program-arguments nil  
   "*Arguments passed to the Forth program by the `run-forth' command.")  
   
 (defun run-forth (command-line)  
   "Run an inferior Forth process. Output goes to the buffer `*forth*'.  
 With argument, asks for a command line. Split up screen and run forth   
 in the lower portion. The current-buffer when called will stay in the  
 upper portion of the screen, and all other windows are deleted.  
 Call run-forth again to make the *forth* buffer appear in the lower  
 part of the screen."  
   (interactive  
    (list (let ((default  
                  (or forth-process-command-line  
                      (forth-default-command-line))))  
            (if current-prefix-arg  
                (read-string "Run Forth: " default)  
                default))))  
   (setq forth-process-command-line command-line)  
   (forth-start-process command-line)  
   (forth-split)  
   (forth-set-runlight forth-runlight:input))  
   
 (defun run-forth-if-not ()  
   (if (not (forth-process-running-p))  
       (run-forth forth-program-name)))  
   
 (defun reset-forth ()  
   "Reset the Forth process."  
   (interactive)  
   (let ((process (get-process forth-program-name)))  
     (cond ((or (not process)  
                (not (eq (process-status process) 'run))  
                (yes-or-no-p  
 "The Forth process is running, are you SURE you want to reset it? "))  
            (message "Resetting Forth process...")  
            (forth-reload)  
            (message "Resetting Forth process...done")))))  
   
 (defun forth-default-command-line ()  
   (concat forth-program-name  
           (if forth-program-arguments  
               (concat " " forth-program-arguments)  
               "")))  
   
 ;;;; Internal Variables  
   
 (defvar forth-process-command-line nil  
   "Command used to start the most recent Forth process.")  
   
 (defvar forth-previous-send ""  
   "Most recent expression transmitted to the Forth process.")  
   
 (defvar forth-process-filter-queue '()  
   "Queue used to synchronize filter actions properly.")  
   
 (defvar forth-prompt "ok"  
   "The current forth prompt string.")  
   
 (defvar forth-start-hook nil  
   "If non-nil, a procedure to call when the Forth process is started.  
 When called, the current buffer will be the Forth process-buffer.")  
   
 (defvar forth-signal-death-message nil  
   "If non-nil, causes a message to be generated when the Forth process dies.")  
   
 (defvar forth-percent-height 50  
   "Tells run-forth how high the upper window should be in percent.")  
   
 (defconst forth-runlight:input ?I  
   "The character displayed when the Forth process is waiting for input.")  
   
 (defvar forth-mode-string ""  
   "String displayed in the mode line when the Forth process is running.")  
   
 ;;;; Evaluation Commands  
   
 (defun forth-send-string (&rest strings)  
   "Send the string arguments to the Forth process.  
 The strings are concatenated and terminated by a newline."  
   (cond ((forth-process-running-p)  
          (forth-send-string-1 strings))  
         ((yes-or-no-p "The Forth process has died.  Reset it? ")  
          (reset-forth)  
          (goto-char (point-max))  
          (forth-send-string-1 strings))))  
   
 (defun forth-send-string-1 (strings)  
   (let ((string (apply 'concat strings)))  
     (forth-send-string-2 string)))  
   
 (defun forth-send-string-2 (string)  
   (let ((process (get-process forth-program-name)))  
     (if (not (eq (current-buffer) (get-buffer forth-program-name)))  
         (progn  
          (forth-process-filter-output string)  
          (forth-process-filter:finish)))  
     (send-string process (concat string "\n"))  
     (if (eq (current-buffer) (process-buffer process))  
         (set-marker (process-mark process) (point)))))  
   
   
 (defun forth-send-region (start end)  
   "Send the current region to the Forth process.  
 The region is sent terminated by a newline."  
   (interactive "r")  
   (let ((process (get-process forth-program-name)))  
     (if (and process (eq (current-buffer) (process-buffer process)))  
         (progn (goto-char end)  
                (set-marker (process-mark process) end))))  
   (forth-send-string "\n" (buffer-substring start end) "\n"))  
   
 (defun forth-end-of-paragraph ()  
   (if (looking-at "[\t\n ]+") (skip-chars-backward  "\t\n "))  
   (if (not (re-search-forward "\n[ \t]*\n" nil t))  
       (goto-char (point-max))))  
   
 (defun forth-send-paragraph ()  
   "Send the current or the previous paragraph to the Forth process"  
   (interactive)  
   (let (end)  
     (save-excursion  
       (forth-end-of-paragraph)  
       (skip-chars-backward  "\t\n ")  
       (setq end (point))  
       (if (re-search-backward "\n[ \t]*\n" nil t)  
           (setq start (point))  
         (goto-char (point-min)))  
       (skip-chars-forward  "\t\n ")  
       (forth-send-region (point) end))))  
     
 (defun forth-send-buffer ()  
   "Send the current buffer to the Forth process."  
   (interactive)  
   (if (eq (current-buffer) (forth-process-buffer))  
       (error "Not allowed to send this buffer's contents to Forth"))  
   (forth-send-region (point-min) (point-max)))  
   
   
 ;;;; Basic Process Control  
   
 (defun forth-start-process (command-line)  
   (let ((buffer (get-buffer-create "*forth*")))  
     (let ((process (get-buffer-process buffer)))  
       (save-excursion  
         (set-buffer buffer)  
         (progn (if process (delete-process process))  
                (goto-char (point-max))  
                (setq mode-line-process '(": %s"))  
                (add-to-global-mode-string 'forth-mode-string)  
                (setq process  
                      (apply 'start-process  
                             (cons forth-program-name  
                                   (cons buffer  
                                         (forth-parse-command-line  
                                          command-line)))))  
                (set-marker (process-mark process) (point-max))  
                (forth-process-filter-initialize t)  
                (forth-modeline-initialize)  
                (set-process-sentinel process 'forth-process-sentinel)  
                (set-process-filter process 'forth-process-filter)  
                (run-hooks 'forth-start-hook)))  
     buffer)))  
   
 (defun forth-parse-command-line (string)  
   (setq string (substitute-in-file-name string))  
   (let ((start 0)  
         (result '()))  
     (while start  
       (let ((index (string-match "[ \t]" string start)))  
         (setq start  
               (cond ((not index)  
                      (setq result  
                            (cons (substring string start)  
                                  result))  
                      nil)  
                     ((= index start)  
                      (string-match "[^ \t]" string start))  
                     (t  
                      (setq result  
                            (cons (substring string start index)  
                                  result))  
                      (1+ index))))))  
     (nreverse result)))  
   
   
 (defun forth-process-running-p ()  
   "True iff there is a Forth process whose status is `run'."  
   (let ((process (get-process forth-program-name)))  
     (and process  
          (eq (process-status process) 'run))))  
   
 (defun forth-process-buffer ()  
   (let ((process (get-process forth-program-name)))  
     (and process (process-buffer process))))  
   
 ;;;; Process Filter  
   
 (defun forth-process-sentinel (proc reason)  
   (let ((inhibit-quit nil))  
     (forth-process-filter-initialize (eq reason 'run))  
     (if (eq reason 'run)  
         (forth-modeline-initialize)  
         (setq forth-mode-string "")))  
   (if (and (not (memq reason '(run stop)))  
            forth-signal-death-message)  
       (progn (beep)  
              (message  
 "The Forth process has died!  Do M-x reset-forth to restart it"))))  
   
 (defun forth-process-filter-initialize (running-p)  
   (setq forth-process-filter-queue (cons '() '()))  
   (setq forth-prompt "ok"))  
   
   
 (defun forth-process-filter (proc string)  
   (forth-process-filter-output string)  
   (forth-process-filter:finish))  
   
 (defun forth-process-filter:enqueue (action)  
   (let ((next (cons action '())))  
     (if (cdr forth-process-filter-queue)  
         (setcdr (cdr forth-process-filter-queue) next)  
         (setcar forth-process-filter-queue next))  
     (setcdr forth-process-filter-queue next)))  
   
 (defun forth-process-filter:finish ()  
   (while (car forth-process-filter-queue)  
     (let ((next (car forth-process-filter-queue)))  
       (setcar forth-process-filter-queue (cdr next))  
       (if (not (cdr next))  
           (setcdr forth-process-filter-queue '()))  
       (apply (car (car next)) (cdr (car next))))))  
   
 ;;;; Process Filter Output  
   
 (defun forth-process-filter-output (&rest args)  
   (if (not (and args  
                 (null (cdr args))  
                 (stringp (car args))  
                 (string-equal "" (car args))))  
       (forth-process-filter:enqueue  
        (cons 'forth-process-filter-output-1 args))))  
   
 (defun forth-process-filter-output-1 (&rest args)  
   (save-excursion  
     (forth-goto-output-point)  
     (apply 'insert-before-markers args)))  
   
 (defun forth-guarantee-newlines (n)  
   (save-excursion  
     (forth-goto-output-point)  
     (let ((stop nil))  
       (while (and (not stop)  
                   (bolp))  
         (setq n (1- n))  
         (if (bobp)  
             (setq stop t)  
           (backward-char))))  
     (forth-goto-output-point)  
     (while (> n 0)  
       (insert-before-markers ?\n)  
       (setq n (1- n)))))  
   
 (defun forth-goto-output-point ()  
   (let ((process (get-process forth-program-name)))  
     (set-buffer (process-buffer process))  
     (goto-char (process-mark process))))  
   
 (defun forth-modeline-initialize ()  
   (setq forth-mode-string "  "))  
   
 (defun forth-set-runlight (runlight)  
   (aset forth-mode-string 0 runlight)  
   (forth-modeline-redisplay))  
   
 (defun forth-modeline-redisplay ()  
   (save-excursion (set-buffer (other-buffer)))  
   (set-buffer-modified-p (buffer-modified-p))  
   (sit-for 0))  
   
 ;;;; Process Filter Operations  
   
 (defun add-to-global-mode-string (x)  
   (cond ((null global-mode-string)  
          (setq global-mode-string (list "" x " ")))  
         ((not (memq x global-mode-string))  
          (setq global-mode-string  
                (cons ""  
                      (cons x  
                            (cons " "  
                                  (if (equal "" (car global-mode-string))  
                                      (cdr global-mode-string)  
                                      global-mode-string))))))))  
   
   
 ;; Misc  
   
 (setq auto-mode-alist (append auto-mode-alist  (defvar forth-compile-command "gforth ")
                                 '(("\\.fs$" . forth-mode))))  ;(defvar forth-compilation-window-percent-height 30)
   
 (defun forth-split ()  (defun forth-split ()
   (interactive)    (interactive)
Line 1679  The region is sent terminated by a newli Line 1406  The region is sent terminated by a newli
       (progn        (progn
         (delete-other-windows)          (delete-other-windows)
         (split-window-vertically          (split-window-vertically
          (/ (* (screen-height) forth-percent-height) 100))           (/ (frame-height) 2))
         (other-window 1)          (other-window 1)
         (switch-to-buffer buffer)          (switch-to-buffer buffer)
         (goto-char (point-max))          (goto-char (point-max))
         (other-window 1))))          (other-window 1))))
       
 (defun forth-reload ()  
   (interactive)  
   (let ((process (get-process forth-program-name)))  
     (if process (kill-process process t)))  
   (sleep-for 0 100)  
   (forth-mode))  
   
   
 ;; Special section for forth-help  
   
 (defvar forth-help-buffer "*Forth-help*"  
   "Buffer used to display the requested documentation.")  
   
 (defvar forth-help-load-path nil  
   "List of directories to search through to find *.doc  
  (forth-help-file-suffix) files. Nil means current default directory.  
  The specified directories must contain at least one .doc file. If it  
  does not and you still want the load-path to scan that directory, create  
  an empty file dummy.doc.")  
   
 (defvar forth-help-file-suffix "*.doc"  
   "The file names to search for in each directory.")  
   
 (setq forth-search-command-prefix "grep -n \"^    [^(]* ")  
 (defvar forth-search-command-suffix "/dev/null")  
 (defvar forth-grep-error-regexp ": No such file or directory")  
   
 (defun forth-function-called-at-point ()  
   "Return the space delimited word a point."  
   (save-excursion  
     (save-restriction  
       (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))  
       (skip-chars-backward "^ \t\n" (point-min))  
       (if (looking-at "[ \t\n]")  
           (forward-char 1))  
       (let (obj (p (point)))  
         (skip-chars-forward "^ \t\n")  
         (buffer-substring p (point))))))  
   
 (defun forth-help-names-extend-comp (path-list result)  
   (cond ((null path-list) result)  
         ((null (car path-list))  
          (forth-help-names-extend-comp (cdr path-list)   
                (concat result forth-help-file-suffix " ")))  
         (t (forth-help-names-extend-comp  
             (cdr path-list) (concat result  
                                     (expand-file-name (car path-list)) "/"  
                                     forth-help-file-suffix " ")))))  
   
 (defun forth-help-names-extended ()  
   (if forth-help-load-path  
       (forth-help-names-extend-comp forth-help-load-path "")  
     (error "forth-help-load-path not specified")))  
   
   
 ;(define-key forth-mode-map "\C-hf" 'forth-documentation)  
   
 (defun forth-documentation (function)  
   "Display the full documentation of FORTH word."  
   (interactive  
    (let ((fn (forth-function-called-at-point))  
          (enable-recursive-minibuffers t)              
          search-list  
          val)  
      (setq val (read-string (format "Describe forth word (default %s): " fn)))  
      (list (if (equal val "") fn val))))  
   (forth-get-doc (concat forth-search-command-prefix  
                          (grep-regexp-quote (concat function " ("))  
                          "[^)]*\-\-\" " (forth-help-names-extended)  
                          forth-search-command-suffix))  
   (message "C-x C-m switches back to the forth interaction window"))  
   
 (defun forth-get-doc (command)  
   "Display the full documentation of command."  
   (let ((curwin (get-buffer-window (window-buffer)))  
         reswin  
         pointmax)  
     (with-output-to-temp-buffer forth-help-buffer  
       (progn  
         (call-process "sh" nil forth-help-buffer t "-c" command)  
         (setq reswin (get-buffer-window forth-help-buffer))))  
     (setq reswin (get-buffer-window forth-help-buffer))  
     (select-window reswin)  
     (save-excursion  
       (goto-char (setq pointmax (point-max)))  
       (insert "--------------------\n\n"))  
     (let (fd doc)   
       (while (setq fd (forth-get-file-data pointmax))  
         (setq doc (forth-get-doc-string fd))  
         (save-excursion  
           (goto-char (point-max))  
           (insert (substring (car fd) (string-match "[^/]*$" (car fd)))  
                   ":\n\n" doc "\n")))  
       (if (not doc)  
           (progn (goto-char (point-max)) (insert "Not found"))))  
     (select-window curwin)))  
     
 (defun forth-skip-error-lines ()  
   (let ((lines 0))  
     (save-excursion  
       (while (re-search-forward forth-grep-error-regexp nil t)  
         (beginning-of-line)  
         (forward-line 1)  
         (setq lines (1+ lines))))  
     (forward-line lines)))  
   
 (defun forth-get-doc-string (fd)  
   "Find file (car fd) and extract documentation from line (nth 1 fd)."  
   (let (result)  
     (save-window-excursion  
       (find-file (car fd))  
       (goto-line (nth 1 fd))  
       (if (not (eq (nth 1 fd) (1+ (count-lines (point-min) (point)))))  
           (error "forth-get-doc-string: serious error"))  
       (if (not (re-search-backward "\n[\t ]*\n" nil t))  
           (goto-char (point-min))  
         (goto-char (match-end 0)))  
       (let ((p (point)))  
         (if (not (re-search-forward "\n[\t ]*\n" nil t))  
             (goto-char (point-max)))  
         (setq result (buffer-substring p (point))))  
       (bury-buffer (current-buffer)))  
     result))  
   
 (defun forth-get-file-data (limit)  
   "Parse grep output and return '(filename line#) list. Return nil when  
  passing limit."  
   (forth-skip-error-lines)  
   (if (< (point) limit)  
       (let ((result (forth-get-file-data-cont limit)))  
         (forward-line 1)  
         (beginning-of-line)  
         result)))  
   
 (defun forth-get-file-data-cont (limit)  
   (let (result)  
     (let ((p (point)))  
       (skip-chars-forward "^:")  
       (setq result (buffer-substring p (point))))  
     (if (< (point) limit)  
         (let ((p (1+ (point))))  
           (forward-char 1)  
           (skip-chars-forward "^:")  
           (list result (string-to-int (buffer-substring p (point))))))))  
   
 (defun grep-regexp-quote (str)  
   (let ((i 0) (m 1) (res ""))  
     (while (/= m 0)  
       (setq m (string-to-char (substring str i)))  
       (if (/= m 0)  
           (progn  
             (setq i (1+ i))  
             (if (string-match (regexp-quote (char-to-string m))  
                               ".*\\^$[]")  
                 (setq res (concat res "\\")))  
             (setq res (concat res (char-to-string m))))))  
     res))  
   
   
 (define-key forth-mode-map "\C-x\C-e" 'compile)  
 (define-key forth-mode-map "\C-x\C-n" 'next-error)  
 (require 'compile)  
   
 (defvar forth-compile-command "gforth ")  
 ;(defvar forth-compilation-window-percent-height 30)  
   
 (defun forth-compile (command)  
   (interactive (list (setq forth-compile-command (read-string "Compile command: " forth-compile-command))))  
   (forth-split-1 "*compilation*")  
   (setq ctools-compile-command command)  
   (compile1 ctools-compile-command "No more errors"))  
   
   
 ;;; 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.
   (defconst fume-function-name-regexp-forth  
    "^\\(:\\)[ \t]+\\([^ \t]*\\)"  ;; (cond ((string-match "XEmacs\\|Lucid" emacs-version)
    "Expression to get word definitions in Forth.")  ;;        (require 'func-menu)
   
   (setq fume-function-name-regexp-alist  ;;   (defconst fume-function-name-regexp-forth
       (append '((forth-mode . fume-function-name-regexp-forth)   ;;    "^\\(:\\)[ \t]+\\([^ \t]*\\)"
              ) fume-function-name-regexp-alist))  ;;    "Expression to get word definitions in Forth.")
   
   ;; Find next forth word in the buffer  ;;   (setq fume-function-name-regexp-alist
   (defun fume-find-next-forth-function-name (buffer)  ;;       (append '((forth-mode . fume-function-name-regexp-forth) 
     "Searches for the next forth word in BUFFER."  ;;              ) fume-function-name-regexp-alist))
     (set-buffer buffer)  
     (if (re-search-forward fume-function-name-regexp nil t)  ;;   ;; Find next forth word in the buffer
       (let ((beg (match-beginning 2))  ;;   (defun fume-find-next-forth-function-name (buffer)
             (end (match-end 2)))  ;;     "Searches for the next forth word in BUFFER."
         (cons (buffer-substring beg end) beg))))  ;;     (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  ;;   (setq fume-find-function-name-method-alist
   (append '((forth-mode    . fume-find-next-forth-function-name))))  ;;   (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 1895  The region is sent terminated by a newli Line 1453  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 1940  The region is sent terminated by a newli Line 1502  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)
 ))  ;; ))
   
   ;;;
   ;;; Inferior Forth interpreter 
   ;;;     -- mostly copied from `cmuscheme.el' of Emacs 21.2
   ;;;
   
   (eval-and-compile (forth-require 'comint))
   
   (when (memq 'comint features)
   
     (defvar forth-program-name "gforth"
       "*Program invoked by the `run-forth' command, including program arguments")
   
     (defcustom inferior-forth-mode-hook nil
       "*Hook for customising inferior-forth-mode."
       :type 'hook
       :group 'forth)
   
     (defvar inferior-forth-mode-map
       (let ((m (make-sparse-keymap)))
         (define-key m "\r" 'comint-send-input)
         (define-key m "\M-\C-x" 'forth-send-paragraph-and-go)
         (define-key m "\C-c\C-l" 'forth-load-file)
         m))
     ;; Install the process communication commands in the forth-mode keymap.
     (define-key forth-mode-map "\e\C-m" 'forth-send-paragraph-and-go)
     (define-key forth-mode-map "\eo" 'forth-send-buffer-and-go)
   
     (define-key forth-mode-map "\M-\C-x" 'forth-send-paragraph-and-go)
     (define-key forth-mode-map "\C-c\C-r" 'forth-send-region)
     (define-key forth-mode-map "\C-c\M-r" 'forth-send-region-and-go)
     (define-key forth-mode-map "\C-c\C-z" 'forth-switch-to-interactive)
     (define-key forth-mode-map "\C-c\C-l" 'forth-load-file)
   
     (defvar forth-process-buffer)
   
     (define-derived-mode inferior-forth-mode comint-mode "Inferior Forth"
       "Major mode for interacting with an inferior Forth process.
   
   The following commands are available:
   \\{inferior-forth-mode-map}
   
   A Forth process can be fired up with M-x run-forth.
   
   Customisation: Entry to this mode runs the hooks on comint-mode-hook and
   inferior-forth-mode-hook (in that order).
   
   You can send text to the inferior Forth process from other buffers containing
   Forth source.
       forth-switch-to-interactive switches the current buffer to the Forth
           process buffer. 
       forth-send-paragraph sends the current paragraph to the Forth process.
       forth-send-region sends the current region to the Forth process.
       forth-send-buffer sends the current buffer to the Forth process.
   
       forth-send-paragraph-and-go, forth-send-region-and-go,
           forth-send-buffer-and-go switch to the Forth process buffer after
           sending their text.
   For information on running multiple processes in multiple buffers, see
   documentation for variable `forth-process-buffer'.
   
   Commands:
   Return after the end of the process' output sends the text from the
   end of process to point. If you accidentally suspend your process, use
   \\[comint-continue-subjob] to continue it. "
       ;; Customise in inferior-forth-mode-hook
       (setq comint-prompt-regexp "^") 
       (setq mode-line-process '(":%s")))
   
     (defun forth-args-to-list (string)
       (let ((where (string-match "[ \t]" string)))
         (cond ((null where) (list string))
               ((not (= where 0))
                (cons (substring string 0 where)
                      (forth-args-to-list (substring string (+ 1 where)
                                                     (length string)))))
               (t (let ((pos (string-match "[^ \t]" string)))
                    (if (null pos)
                        nil
                      (forth-args-to-list (substring string pos
                                                     (length string)))))))))
   
   ;;;###autoload
     (defun run-forth (cmd)
       "Run an inferior Forth process, input and output via buffer *forth*.
   If there is a process already running in `*forth*', switch to that buffer.
   With argument, allows you to edit the command line (default is value
   of `forth-program-name').  Runs the hooks `inferior-forth-mode-hook'
   \(after the `comint-mode-hook' is run).
   \(Type \\[describe-mode] in the process buffer for a list of commands.)"
   
       (interactive (list (if current-prefix-arg
                              (read-string "Run Forth: " forth-program-name)
                            forth-program-name)))
       (if (not (comint-check-proc "*forth*"))
           (let ((cmdlist (forth-args-to-list cmd)))
             (set-buffer (apply 'make-comint "forth" (car cmdlist)
                                nil (cdr cmdlist)))
             (inferior-forth-mode)))
       (setq forth-program-name cmd)
       (setq forth-process-buffer "*forth*")
       (pop-to-buffer "*forth*"))
   
     (defun forth-send-region (start end)
       "Send the current region to the inferior Forth process."
       (interactive "r")
       (comint-send-region (forth-proc) start end)
       (comint-send-string (forth-proc) "\n"))
   
     (defun forth-end-of-paragraph ()
       (if (looking-at "[\t\n ]+") (skip-chars-backward  "\t\n "))
       (if (not (re-search-forward "\n[ \t]*\n" nil t))
           (goto-char (point-max))))
   
     (defun forth-send-paragraph ()
       "Send the current or the previous paragraph to the Forth process"
       (interactive)
       (let (end)
         (save-excursion
           (forth-end-of-paragraph)
           (skip-chars-backward  "\t\n ")
           (setq end (point))
           (if (null (re-search-backward "\n[ \t]*\n" nil t))
             (goto-char (point-min)))
           (skip-chars-forward  "\t\n ")
           (forth-send-region (point) end))))
   
     (defun forth-send-paragraph-and-go ()
       "Send the current or the previous paragraph to the Forth process.
   Then switch to the process buffer."
       (interactive)
       (forth-send-paragraph)
       (forth-switch-to-interactive t))
   
     (defun forth-send-buffer ()
       "Send the current buffer to the Forth process."
       (interactive)
       (if (eq (current-buffer) forth-process-buffer)
           (error "Not allowed to send this buffer's contents to Forth"))
       (forth-send-region (point-min) (point-max)))
   
     (defun forth-send-buffer-and-go ()
       "Send the current buffer to the Forth process.
   Then switch to the process buffer."
       (interactive)
       (forth-send-buffer)
       (forth-switch-to-interactive t))
   
   
     (defun forth-switch-to-interactive (eob-p)
       "Switch to the Forth process buffer.
   With argument, position cursor at end of buffer."
       (interactive "P")
       (if (get-buffer forth-process-buffer)
           (pop-to-buffer forth-process-buffer)
         (error "No current process buffer.  See variable `forth-process-buffer'"))
       (cond (eob-p
              (push-mark)
              (goto-char (point-max)))))
   
     (defun forth-send-region-and-go (my-start end)
       "Send the current region to the inferior Forth process.
   Then switch to the process buffer."
       (interactive "r")
       (forth-send-region my-start end)
       (forth-switch-to-interactive t))
   
     (defcustom forth-source-modes '(forth-mode forth-block-mode)
       "*Used to determine if a buffer contains Forth source code.
   If it's loaded into a buffer that is in one of these major modes, it's
   considered a Forth source file by `forth-load-file' and `forth-compile-file'.
   Used by these commands to determine defaults."
       :type '(repeat function)
       :group 'forth)
   
     (defvar forth-prev-l/c-dir/file nil
       "Caches the last (directory . file) pair.
   Caches the last pair used in the last `forth-load-file' or
   `forth-compile-file' command. Used for determining the default in the
   next one.")
   
     (defun forth-load-file (file-name)
       "Load a Forth file FILE-NAME into the inferior Forth process."
       (interactive (comint-get-source "Load Forth file: " forth-prev-l/c-dir/file
                                       forth-source-modes t)) ; T because LOAD
                                           ; needs an exact name
       (comint-check-source file-name) ; Check to see if buffer needs saved.
       (setq forth-prev-l/c-dir/file (cons (file-name-directory file-name)
                                           (file-name-nondirectory file-name)))
       (comint-send-string (forth-proc)
                           (concat "s\" " file-name "\" included\n")))
   
    
     (defvar forth-process-buffer nil "*The current Forth process buffer.
   
   See `scheme-buffer' for an explanation on how to run multiple Forth 
   processes.")
   
     (defun forth-proc ()
       "Return the current Forth process.  See variable `forth-process-buffer'."
       (let ((proc (get-buffer-process (if (eq major-mode 'inferior-forth-mode)
                                           (current-buffer)
                                         forth-process-buffer))))
         (or proc
             (error "No current process.  See variable `forth-process-buffer'"))))
     )  ; (memq 'comint features)
   
 (provide 'forth-mode)  (provide 'forth-mode)
   

Removed from v.1.59  
changed lines
  Added in v.1.80


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