Diff for /gforth/gforth.el between versions 1.71 and 1.81

version 1.71, 2004/12/31 13:23:57 version 1.81, 2010/09/04 17:24:17
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,2003,2004 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 59 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 79 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 240  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)
          "[ \t\n]" t string (font-lock-string-face . 1))           "[ \t\n]" t string (font-lock-string-face . 1))
           ("'.'?" non-immediate (font-lock-string-face . 1))
         (("s\"" "c\"") immediate (font-lock-string-face . 1)          (("s\"" "c\"") immediate (font-lock-string-face . 1)
          "[\"\n]" nil string (font-lock-string-face . 1))           "[\"\n]" nil string (font-lock-string-face . 1))
         ((".\"") compile-only (font-lock-string-face . 1)          ((".\"") compile-only (font-lock-string-face . 1)
Line 273  PARSED-TYPE specifies what kind of text Line 280  PARSED-TYPE specifies what kind of text
           "case" "of" "?dup-if" "?dup-0=-if" "then" "endif" "until"            "case" "of" "?dup-if" "?dup-0=-if" "then" "endif" "until"
           "repeat" "again" "leave" "?leave"            "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 308  PARSED-TYPE specifies what kind of text Line 316  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 415  INDENT1 and INDENT2 are indentation spec Line 437  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))
Line 427  INDENT1 and INDENT2 are indentation spec Line 450  INDENT1 and INDENT2 are indentation spec
           "[until]" "[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]")
         (("does>") (-1 . 1) (0 . 0))           (-2 . 2) (0 . 0))
           (("does>" ";code" ";abi-code") (-1 . 1) (0 . 0))
         (("while" "[while]") (-2 . 4) (0 . 2))          (("while" "[while]") (-2 . 4) (0 . 2))
         (("repeat" "[repeat]") (-4 . 0) (0 . -4))))          (("repeat" "[repeat]") (-4 . 0) (0 . -4))))
   
Line 459  End:\" construct).") Line 483  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 485  End:\" construct).") Line 508  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 527  End:\" construct).") Line 550  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 696  End:\" construct).") Line 721  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 1382  programmers who tend to fill code won't Line 1407  programmers who tend to fill code won't
       (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-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>
   
Line 1613  of `forth-program-name').  Runs the hook Line 1632  of `forth-program-name').  Runs the hook
         (forth-end-of-paragraph)          (forth-end-of-paragraph)
         (skip-chars-backward  "\t\n ")          (skip-chars-backward  "\t\n ")
         (setq end (point))          (setq end (point))
         (if (re-search-backward "\n[ \t]*\n" nil t)          (if (null (re-search-backward "\n[ \t]*\n" nil t))
             (setq start (point))  
           (goto-char (point-min)))            (goto-char (point-min)))
         (skip-chars-forward  "\t\n ")          (skip-chars-forward  "\t\n ")
         (forth-send-region (point) end))))          (forth-send-region (point) end))))
Line 1652  With argument, position cursor at end of Line 1670  With argument, position cursor at end of
            (push-mark)             (push-mark)
            (goto-char (point-max)))))             (goto-char (point-max)))))
   
   (defun forth-send-region-and-go (start end)    (defun forth-send-region-and-go (my-start end)
     "Send the current region to the inferior Forth process.      "Send the current region to the inferior Forth process.
 Then switch to the process buffer."  Then switch to the process buffer."
     (interactive "r")      (interactive "r")
     (forth-send-region start end)      (forth-send-region my-start end)
     (forth-switch-to-interactive t))      (forth-switch-to-interactive t))
   
   (defcustom forth-source-modes '(forth-mode forth-block-mode)    (defcustom forth-source-modes '(forth-mode forth-block-mode)

Removed from v.1.71  
changed lines
  Added in v.1.81


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