version 1.66, 2003/02/08 17:32:28
|
version 1.73, 2007/08/17 22:00:14
|
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 Free Software Foundation, Inc. |
|
|
;; This file is part of Gforth. |
;; This file is part of Gforth. |
|
|
Line 61
|
Line 61
|
(progn (string-match "^[0-9]+" emacs-version) |
(progn (string-match "^[0-9]+" emacs-version) |
(string-to-int (match-string 0 emacs-version))))) |
(string-to-int (match-string 0 emacs-version))))) |
|
|
|
;; 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 115
|
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 270 PARSED-TYPE specifies what kind of text
|
Line 274 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 412 INDENT1 and INDENT2 are indentation spec
|
Line 417 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" "struct" "m:" ":m" "class" "interface") |
Line 428 INDENT1 and INDENT2 are indentation spec
|
Line 433 INDENT1 and INDENT2 are indentation spec
|
(-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]") |
|
(-2 . 2) (0 . 0)) |
(("does>") (-1 . 1) (0 . 0)) |
(("does>") (-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)))) |
(("\\g") (-2 . 2) (0 . 0)))) |
|
|
|
(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 824 Used for imenu index generation.")
|
Line 829 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 1104 exceeds 64 characters."
|
Line 1109 exceeds 64 characters."
|
(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 |
;; 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)) |
(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 1120 exceeds 64 characters."
|
Line 1124 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 1678 next one.")
|
Line 1682 next one.")
|
forth-source-modes t)) ; T because LOAD |
forth-source-modes t)) ; T because LOAD |
; needs an exact name |
; needs an exact name |
(comint-check-source file-name) ; Check to see if buffer needs saved. |
(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) |
(setq forth-prev-l/c-dir/file (cons (file-name-directory file-name) |
(file-name-nondirectory file-name))) |
(file-name-nondirectory file-name))) |
(comint-send-string (forth-proc) (concat "(load \"" |
(comint-send-string (forth-proc) |
file-name |
(concat "s\" " file-name "\" included\n"))) |
"\"\)\n"))) |
|
|
|
|
|
|
|
(defvar forth-process-buffer nil "*The current Forth process buffer. |
(defvar forth-process-buffer nil "*The current Forth process buffer. |