[gforth] / gforth / gforth.el  

gforth: gforth/gforth.el

Diff for /gforth/gforth.el between version 1.70 and 1.86

version 1.70, Thu Apr 8 10:42:26 2004 UTC version 1.86, Sat Dec 31 15:29:25 2011 UTC
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 Free Software Foundation, Inc.  ;; Copyright (C) 1995,1996,1997,1998,2000,2001,2003,2004,2007,2008,2010,2011 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 
Line 241 
          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))
         (("s\"" "c\"") immediate (font-lock-string-face . 1)          ("'.'?" non-immediate (font-lock-string-face . 1))
           (("s\"" "c\"" "s\\\"") 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)
          "[\"\n]" nil string (font-lock-string-face . 1))           "[\"\n]" nil string (font-lock-string-face . 1))
         (("abort\"") compile-only (font-lock-keyword-face . 1)          (("abort\"") compile-only (font-lock-keyword-face . 1)
          "[\"\n]" nil string (font-lock-string-face . 1))           "[\"\n]" nil string (font-lock-string-face . 1))
Line 273 
Line 280 
           "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 299 
Line 307 
   
         (("create" "variable" "constant" "2variable" "2constant" "fvariable"          (("create" "variable" "constant" "2variable" "2constant" "fvariable"
           "fconstant" "value" "field" "user" "vocabulary"            "fconstant" "value" "field" "user" "vocabulary"
           "create-interpret/compile")            "create-interpret/compile" "interpret/compile:")
          non-immediate (font-lock-type-face . 2)           non-immediate (font-lock-type-face . 2)
          "[ \t\n]" t name (font-lock-variable-name-face . 3))           "[ \t\n]" t name (font-lock-variable-name-face . 3))
         ("\\S-+%" non-immediate (font-lock-type-face . 2))          ("\\S-+%" non-immediate (font-lock-type-face . 2))
Line 308 
Line 316 
          "[ \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 
Line 437 
   
 (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 
Line 450 
           "[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 
Line 483 
 ;; 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 
Line 508 
          (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 
Line 550 
   "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 
Line 721 
 (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 736 
Line 761 
 (defvar forth-defining-words  (defvar forth-defining-words
   '("VARIABLE" "CONSTANT" "2VARIABLE" "2CONSTANT" "FVARIABLE" "FCONSTANT"    '("VARIABLE" "CONSTANT" "2VARIABLE" "2CONSTANT" "FVARIABLE" "FCONSTANT"
    "USER" "VALUE" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE"     "USER" "VALUE" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE"
    "DEFER" "ALIAS")     "DEFER" "ALIAS" "interpret/compile:")
   "List of words, that define the following word.    "List of words, that define the following word.
 Used for imenu index generation.")  Used for imenu index generation.")
   
Line 1091 
Line 1116 
 (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 "\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 "\t" 'forth-indent-command)  (define-key forth-mode-map "\t" 'forth-indent-command)
 (define-key forth-mode-map "\C-m" 'forth-reindent-then-newline-and-indent)  (define-key forth-mode-map "\C-m" 'forth-reindent-then-newline-and-indent)
 (define-key forth-mode-map "\M-q" 'forth-fill-paragraph)  (define-key forth-mode-map "\M-q" 'forth-fill-paragraph)
Line 1364 
Line 1388 
 (defun forth-remove-tracers ()  (defun forth-remove-tracers ()
   "Remove tracers of the form `~~ '. Queries the user for each occurrence."    "Remove tracers of the form `~~ '. Queries the user for each occurrence."
   (interactive)    (interactive)
   (query-replace-regexp "\\(~~ \\| ~~$\\)" "" nil))    (query-replace-regexp "\\(~~[ \t]\\|[ \t]~~$\\)" "" nil))
   
 (define-key forth-mode-map "\C-x\C-e" 'compile)  (define-key forth-mode-map "\C-x\C-e" 'compile)
 (define-key forth-mode-map "\C-x\C-n" 'next-error)  (define-key forth-mode-map "\C-x\C-n" 'next-error)
Line 1382 
Line 1406 
       (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 
Line 1631 
         (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 
Line 1669 
            (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)

Generate output suitable for use with a patch program
Legend:
Removed from v.1.70  
changed lines
  Added in v.1.86
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help