Powered by ViewCVS 1.0-dev
| 1 : | pazsan | 1.48 | ;;; gforth.el --- major mode for editing (G)Forth sources |
| 2 : | anton | 1.31 | |
| 3 : | dvdkhlng | 1.54 | ;; Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. |
| 4 : | anton | 1.31 | |
| 5 : | ;; This file is part of Gforth. | ||
| 6 : | anton | 1.1 | |
| 7 : | anton | 1.17 | ;; GForth is distributed in the hope that it will be useful, |
| 8 : | anton | 1.1 | ;; but WITHOUT ANY WARRANTY. No author or distributor |
| 9 : | ;; accepts responsibility to anyone for the consequences of using it | ||
| 10 : | ;; or for whether it serves any particular purpose or works at all, | ||
| 11 : | ;; unless he says so in writing. Refer to the GNU Emacs General Public | ||
| 12 : | ;; License for full details. | ||
| 13 : | |||
| 14 : | ;; Everyone is granted permission to copy, modify and redistribute | ||
| 15 : | ;; GNU Emacs, but only under the conditions described in the | ||
| 16 : | ;; GNU Emacs General Public License. A copy of this license is | ||
| 17 : | anton | 1.17 | ;; supposed to have been given to you along with Gforth so you |
| 18 : | anton | 1.1 | ;; can know your rights and responsibilities. It should be in a |
| 19 : | ;; file named COPYING. Among other things, the copyright notice | ||
| 20 : | ;; and this notice must be preserved on all copies. | ||
| 21 : | anton | 1.31 | |
| 22 : | pazsan | 1.48 | ;; Author: Goran Rydqvist <gorry@ida.liu.se> |
| 23 : | ;; Maintainer: David Kühling <dvdkhlng@gmx.de> | ||
| 24 : | ;; Created: 16 July 88 by Goran Rydqvist | ||
| 25 : | ;; Keywords: forth, gforth | ||
| 26 : | |||
| 27 : | anton | 1.31 | ;; Changes by anton |
| 28 : | ;; This is a variant of forth.el that came with TILE. | ||
| 29 : | ;; I left most of this stuff untouched and made just a few changes for | ||
| 30 : | ;; the things I use (mainly indentation and syntax tables). | ||
| 31 : | ;; So there is still a lot of work to do to adapt this to gforth. | ||
| 32 : | anton | 1.1 | |
| 33 : | pazsan | 1.48 | ;; Changes by David |
| 34 : | ;; Added a syntax-hilighting engine, rewrote auto-indentation engine. | ||
| 35 : | ;; Added support for block files. | ||
| 36 : | dvdkhlng | 1.66 | ;; Replaced forth-process code with comint-based implementation. |
| 37 : | |||
| 38 : | ;; Tested with Emacs 19.34, 20.5, 21 and XEmacs 21 | ||
| 39 : | pazsan | 1.48 | |
| 40 : | anton | 1.1 | ;;------------------------------------------------------------------- |
| 41 : | ;; A Forth indentation, documentation search and interaction library | ||
| 42 : | ;;------------------------------------------------------------------- | ||
| 43 : | ;; | ||
| 44 : | ;; Written by Goran Rydqvist, gorry@ida.liu.se, Summer 1988 | ||
| 45 : | ;; Started: 16 July 88 | ||
| 46 : | ;; Version: 2.10 | ||
| 47 : | ;; Last update: 5 December 1989 by Mikael Patel, mip@ida.liu.se | ||
| 48 : | ;; Last update: 25 June 1990 by Goran Rydqvist, gorry@ida.liu.se | ||
| 49 : | ;; | ||
| 50 : | ;; Documentation: See forth-mode (^HF forth-mode) | ||
| 51 : | ;;------------------------------------------------------------------- | ||
| 52 : | |||
| 53 : | pazsan | 1.48 | ;;; Code: |
| 54 : | |||
| 55 : | dvdkhlng | 1.59 | ;(setq debug-on-error t) |
| 56 : | dvdkhlng | 1.58 | |
| 57 : | dvdkhlng | 1.55 | ;; Code ripped from `version.el' for compatability with Emacs versions |
| 58 : | ;; prior to 19.23. | ||
| 59 : | dvdkhlng | 1.58 | (if (not (boundp 'emacs-major-version)) |
| 60 : | (defconst emacs-major-version | ||
| 61 : | (progn (string-match "^[0-9]+" emacs-version) | ||
| 62 : | (string-to-int (match-string 0 emacs-version))))) | ||
| 63 : | |||
| 64 : | (defun forth-emacs-older (major minor) | ||
| 65 : | (or (< emacs-major-version major) | ||
| 66 : | (and (= emacs-major-version major) (< emacs-minor-version minor)))) | ||
| 67 : | dvdkhlng | 1.55 | |
| 68 : | dvdkhlng | 1.58 | ;; Code ripped from `subr.el' for compatability with Emacs versions |
| 69 : | ;; prior to 20.1 | ||
| 70 : | (eval-when-compile | ||
| 71 : | (if (forth-emacs-older 20 1) | ||
| 72 : | (progn | ||
| 73 : | (defmacro when (cond &rest body) | ||
| 74 : | "If COND yields non-nil, do BODY, else return nil." | ||
| 75 : | (list 'if cond (cons 'progn body))) | ||
| 76 : | (defmacro unless (cond &rest body) | ||
| 77 : | "If COND yields nil, do BODY, else return nil." | ||
| 78 : | (cons 'if (cons cond (cons nil body))))))) | ||
| 79 : | |||
| 80 : | ;; `no-error' argument of require not supported in Emacs versions | ||
| 81 : | ;; prior to 20.4 :-( | ||
| 82 : | (defun forth-require (feature) | ||
| 83 : | (condition-case err (require feature) (error nil))) | ||
| 84 : | |||
| 85 : | (require 'font-lock) | ||
| 86 : | pazsan | 1.48 | |
| 87 : | dvdkhlng | 1.58 | ;; define `font-lock-warning-face' in emacs-versions prior to 20.1 |
| 88 : | ;; (ripped from `font-lock.el') | ||
| 89 : | (unless (boundp 'font-lock-warning-face) | ||
| 90 : | (message "defining font-lock-warning-face") | ||
| 91 : | (make-face 'font-lock-warning-face) | ||
| 92 : | (defvar font-lock-warning-face 'font-lock-warning-face) | ||
| 93 : | (set-face-foreground font-lock-warning-face "red") | ||
| 94 : | (make-face-bold font-lock-warning-face)) | ||
| 95 : | |||
| 96 : | dvdkhlng | 1.59 | ;; define `font-lock-constant-face' in XEmacs (just copy |
| 97 : | ;; `font-lock-preprocessor-face') | ||
| 98 : | (unless (boundp 'font-lock-constant-face) | ||
| 99 : | dvdkhlng | 1.61 | (copy-face font-lock-preprocessor-face 'font-lock-constant-face)) |
| 100 : | |||
| 101 : | dvdkhlng | 1.59 | |
| 102 : | dvdkhlng | 1.58 | ;; define `regexp-opt' in emacs versions prior to 20.1 |
| 103 : | ;; (this implementation is extremely inefficient, though) | ||
| 104 : | dvdkhlng | 1.59 | (eval-and-compile (forth-require 'regexp-opt)) |
| 105 : | (unless (memq 'regexp-opt features) | ||
| 106 : | dvdkhlng | 1.58 | (message (concat |
| 107 : | "Warning: your Emacs version doesn't support `regexp-opt'. " | ||
| 108 : | "Hilighting will be slow.")) | ||
| 109 : | (defun regexp-opt (STRINGS &optional PAREN) | ||
| 110 : | (let ((open (if PAREN "\\(" "")) (close (if PAREN "\\)" ""))) | ||
| 111 : | (concat open (mapconcat 'regexp-quote STRINGS "\\|") close))) | ||
| 112 : | (defun regexp-opt-depth (re) | ||
| 113 : | (if (string= (substring re 0 2) "\\(") 1 0))) | ||
| 114 : | |||
| 115 : | dvdkhlng | 1.57 | ; todo: |
| 116 : | ; | ||
| 117 : | |||
| 118 : | ; Wörter ordentlich hilighten, die nicht auf Whitespace beginnen ( ..)IF | ||
| 119 : | ; -- mit aktueller Konzeption nicht möglich?? | ||
| 120 : | ; | ||
| 121 : | ; Konfiguration über customization groups | ||
| 122 : | ; | ||
| 123 : | ; Bereich nur auf Wortanfang/ende ausweiten, wenn Anfang bzw Ende in einem | ||
| 124 : | ; Wort liegen (?) -- speed! | ||
| 125 : | ; | ||
| 126 : | ; 'forth-word' property muss eindeutig sein! | ||
| 127 : | ; | ||
| 128 : | ; Forth-Menu | ||
| 129 : | ; | ||
| 130 : | ; Interface zu GForth Prozessen (Patches von Michael Scholz) | ||
| 131 : | ; | ||
| 132 : | ; Byte-compile-Code rausschmeißen, Compilieren im Makefile über Emacs | ||
| 133 : | ; batch-Modus | ||
| 134 : | ; | ||
| 135 : | ; forth-help Kram rausschmeißen | ||
| 136 : | ; | ||
| 137 : | ; XEmacs Kompatibilität? imenu/speedbar -> fume? | ||
| 138 : | ; | ||
| 139 : | ; Folding neuschreiben (neue Parser-Informationen benutzen) | ||
| 140 : | |||
| 141 : | dvdkhlng | 1.62 | ;;; Motion-hooking (dk) |
| 142 : | ;;; | ||
| 143 : | (defun forth-idle-function () | ||
| 144 : | "Function that is called when Emacs is idle to detect cursor motion | ||
| 145 : | in forth-block-mode buffers (which is mainly used for screen number | ||
| 146 : | display in). Currently ignores forth-mode buffers but that may change | ||
| 147 : | in the future." | ||
| 148 : | (if (eq major-mode 'forth-block-mode) | ||
| 149 : | (forth-check-motion))) | ||
| 150 : | |||
| 151 : | (defvar forth-idle-function-timer nil | ||
| 152 : | "Timer that runs `forth-idle-function' or nil if no timer installed.") | ||
| 153 : | |||
| 154 : | (defun forth-install-motion-hook () | ||
| 155 : | "Install the motion-hooking mechanism. Currently uses idle timers | ||
| 156 : | but might be transparently changed in the future." | ||
| 157 : | (unless forth-idle-function-timer | ||
| 158 : | ;; install idle function only once (first time forth-mode is used) | ||
| 159 : | (setq forth-idle-function-timer | ||
| 160 : | (run-with-idle-timer .05 t 'forth-idle-function)))) | ||
| 161 : | |||
| 162 : | (defvar forth-was-point nil) | ||
| 163 : | |||
| 164 : | (defun forth-check-motion () | ||
| 165 : | "Run `forth-motion-hooks', if `point' changed since last call. This | ||
| 166 : | used to be called via `post-command-hook' but uses idle timers now as | ||
| 167 : | users complaint about lagging performance." | ||
| 168 : | (when (or (eq forth-was-point nil) (/= forth-was-point (point))) | ||
| 169 : | (setq forth-was-point (point)) | ||
| 170 : | (run-hooks 'forth-motion-hooks))) | ||
| 171 : | |||
| 172 : | |||
| 173 : | ;;; Hilighting and indentation engine (dk) | ||
| 174 : | pazsan | 1.48 | ;;; |
| 175 : | dvdkhlng | 1.55 | (defvar forth-disable-parser nil |
| 176 : | "*Non-nil means to disable on-the-fly parsing of Forth-code. | ||
| 177 : | |||
| 178 : | This will disable hilighting of forth-mode buffers and will decrease | ||
| 179 : | the smartness of the indentation engine. Only set it to non-nil, if | ||
| 180 : | your computer is very slow. To disable hilighting, set | ||
| 181 : | `forth-hilight-level' to zero.") | ||
| 182 : | |||
| 183 : | (defvar forth-jit-parser nil | ||
| 184 : | "*Non-nil means to parse Forth-code just-in-time. | ||
| 185 : | |||
| 186 : | This eliminates the need for initially parsing forth-mode buffers and | ||
| 187 : | thus speeds up loading of Forth files. That feature is only available | ||
| 188 : | in Emacs21 (and newer versions).") | ||
| 189 : | |||
| 190 : | pazsan | 1.48 | (defvar forth-words nil |
| 191 : | "List of words for hilighting and recognition of parsed text areas. | ||
| 192 : | dvdkhlng | 1.55 | |
| 193 : | Hilighting of object-oriented Forth code is achieved, by appending either | ||
| 194 : | `forth-objects-words' or `forth-oof-words' to the list, depending on the values of `forth-use-objects' or `forth-use-oof'. | ||
| 195 : | |||
| 196 : | After `forth-words' changed, `forth-compile-words' must be called to | ||
| 197 : | make the changes take effect. | ||
| 198 : | pazsan | 1.48 | |
| 199 : | Each item of `forth-words' has the form | ||
| 200 : | (MATCHER TYPE HILIGHT . &optional PARSED-TEXT ...) | ||
| 201 : | |||
| 202 : | MATCHER is either a list of strings to match, or a REGEXP. | ||
| 203 : | If it's a REGEXP, it should not be surrounded by '\\<' or '\\>', since | ||
| 204 : | that'll be done automatically by the search routines. | ||
| 205 : | |||
| 206 : | TYPE should be one of 'definiton-starter', 'definition-ender', 'compile-only', | ||
| 207 : | 'immediate' or 'non-immediate'. Those information are required to determine | ||
| 208 : | whether a word actually parses (and whether that parsed text needs to be | ||
| 209 : | hilighted). | ||
| 210 : | |||
| 211 : | HILIGHT is a cons cell of the form (FACE . MINIMUM-LEVEL) | ||
| 212 : | Where MINIMUM-LEVEL specifies the minimum value of `forth-hilight-level', | ||
| 213 : | that's required for matching text to be hilighted. | ||
| 214 : | |||
| 215 : | PARSED-TEXT specifies whether and how a word parses following text. You can | ||
| 216 : | specify as many subsequent PARSED-TEXT as you wish, but that shouldn't be | ||
| 217 : | necessary very often. It has the following form: | ||
| 218 : | (DELIM-REGEXP SKIP-LEADING-FLAG PARSED-TYPE HILIGHT) | ||
| 219 : | |||
| 220 : | DELIM-REGEXP is a regular expression that should match strings of length 1, | ||
| 221 : | which are delimiters for the parsed text. | ||
| 222 : | |||
| 223 : | A non-nil value for PARSE-LEADING-FLAG means, that leading delimiter strings | ||
| 224 : | before parsed text should be skipped. This is the parsing behaviour of the | ||
| 225 : | Forth word WORD. Set it to t for name-parsing words, nil for comments and | ||
| 226 : | strings. | ||
| 227 : | |||
| 228 : | PARSED-TYPE specifies what kind of text is parsed. It should be on of 'name', | ||
| 229 : | 'string' or 'comment'.") | ||
| 230 : | (setq forth-words | ||
| 231 : | '( | ||
| 232 : | (("[") definition-ender (font-lock-keyword-face . 1)) | ||
| 233 : | (("]" "]l") definition-starter (font-lock-keyword-face . 1)) | ||
| 234 : | ((":") definition-starter (font-lock-keyword-face . 1) | ||
| 235 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 236 : | (("immediate" "compile-only" "restrict") | ||
| 237 : | immediate (font-lock-keyword-face . 1)) | ||
| 238 : | (("does>") compile-only (font-lock-keyword-face . 1)) | ||
| 239 : | ((":noname") definition-starter (font-lock-keyword-face . 1)) | ||
| 240 : | ((";" ";code") definition-ender (font-lock-keyword-face . 1)) | ||
| 241 : | (("include" "require" "needs" "use") | ||
| 242 : | non-immediate (font-lock-keyword-face . 1) | ||
| 243 : | "[\n\t ]" t string (font-lock-string-face . 1)) | ||
| 244 : | (("included" "required" "thru" "load") | ||
| 245 : | non-immediate (font-lock-keyword-face . 1)) | ||
| 246 : | (("[char]") compile-only (font-lock-keyword-face . 1) | ||
| 247 : | "[ \t\n]" t string (font-lock-string-face . 1)) | ||
| 248 : | (("char") non-immediate (font-lock-keyword-face . 1) | ||
| 249 : | "[ \t\n]" t string (font-lock-string-face . 1)) | ||
| 250 : | (("s\"" "c\"") immediate (font-lock-string-face . 1) | ||
| 251 : | "[\"\n]" nil string (font-lock-string-face . 1)) | ||
| 252 : | ((".\"") compile-only (font-lock-string-face . 1) | ||
| 253 : | "[\"\n]" nil string (font-lock-string-face . 1)) | ||
| 254 : | (("abort\"") compile-only (font-lock-keyword-face . 1) | ||
| 255 : | "[\"\n]" nil string (font-lock-string-face . 1)) | ||
| 256 : | (("{") compile-only (font-lock-variable-name-face . 1) | ||
| 257 : | "[\n}]" nil name (font-lock-variable-name-face . 1)) | ||
| 258 : | ((".(" "(") immediate (font-lock-comment-face . 1) | ||
| 259 : | ")" nil comment (font-lock-comment-face . 1)) | ||
| 260 : | (("\\" "\\G") immediate (font-lock-comment-face . 1) | ||
| 261 : | "[\n]" nil comment (font-lock-comment-face . 1)) | ||
| 262 : | |||
| 263 : | (("[if]" "[?do]" "[do]" "[for]" "[begin]" | ||
| 264 : | "[endif]" "[then]" "[loop]" "[+loop]" "[next]" "[until]" "[repeat]" | ||
| 265 : | "[again]" "[while]" "[else]") | ||
| 266 : | immediate (font-lock-keyword-face . 2)) | ||
| 267 : | (("[ifdef]" "[ifundef]") immediate (font-lock-keyword-face . 2) | ||
| 268 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 269 : | (("if" "begin" "ahead" "do" "?do" "+do" "u+do" "-do" "u-do" "for" | ||
| 270 : | anton | 1.60 | "case" "of" "?dup-if" "?dup-0=-if" "then" "endif" "until" |
| 271 : | pazsan | 1.64 | "repeat" "again" "leave" "?leave" |
| 272 : | pazsan | 1.48 | "loop" "+loop" "-loop" "next" "endcase" "endof" "else" "while" "try" |
| 273 : | "recover" "endtry" "assert(" "assert0(" "assert1(" "assert2(" | ||
| 274 : | "assert3(" ")" "<interpretation" "<compilation" "interpretation>" | ||
| 275 : | "compilation>") | ||
| 276 : | compile-only (font-lock-keyword-face . 2)) | ||
| 277 : | |||
| 278 : | (("true" "false" "c/l" "bl" "cell" "pi" "w/o" "r/o" "r/w") | ||
| 279 : | non-immediate (font-lock-constant-face . 2)) | ||
| 280 : | dvdkhlng | 1.56 | (("~~" "break:" "dbg") compile-only (font-lock-warning-face . 2)) |
| 281 : | dvdkhlng | 1.55 | (("break\"") compile-only (font-lock-warning-face . 1) |
| 282 : | "[\"\n]" nil string (font-lock-string-face . 1)) | ||
| 283 : | pazsan | 1.48 | (("postpone" "[is]" "defers" "[']" "[compile]") |
| 284 : | compile-only (font-lock-keyword-face . 2) | ||
| 285 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 286 : | (("is" "what's") immediate (font-lock-keyword-face . 2) | ||
| 287 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 288 : | dvdkhlng | 1.56 | (("<is>" "'" "see") non-immediate (font-lock-keyword-face . 2) |
| 289 : | pazsan | 1.48 | "[ \t\n]" t name (font-lock-function-name-face . 3)) |
| 290 : | (("[to]") compile-only (font-lock-keyword-face . 2) | ||
| 291 : | "[ \t\n]" t name (font-lock-variable-name-face . 3)) | ||
| 292 : | (("to") immediate (font-lock-keyword-face . 2) | ||
| 293 : | "[ \t\n]" t name (font-lock-variable-name-face . 3)) | ||
| 294 : | (("<to>") non-immediate (font-lock-keyword-face . 2) | ||
| 295 : | "[ \t\n]" t name (font-lock-variable-name-face . 3)) | ||
| 296 : | |||
| 297 : | (("create" "variable" "constant" "2variable" "2constant" "fvariable" | ||
| 298 : | "fconstant" "value" "field" "user" "vocabulary" | ||
| 299 : | "create-interpret/compile") | ||
| 300 : | non-immediate (font-lock-type-face . 2) | ||
| 301 : | "[ \t\n]" t name (font-lock-variable-name-face . 3)) | ||
| 302 : | dvdkhlng | 1.54 | ("\\S-+%" non-immediate (font-lock-type-face . 2)) |
| 303 : | pazsan | 1.48 | (("defer" "alias" "create-interpret/compile:") |
| 304 : | non-immediate (font-lock-type-face . 1) | ||
| 305 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 306 : | (("end-struct") non-immediate (font-lock-keyword-face . 2) | ||
| 307 : | "[ \t\n]" t name (font-lock-type-face . 3)) | ||
| 308 : | (("struct") non-immediate (font-lock-keyword-face . 2)) | ||
| 309 : | ("-?[0-9]+\\(\\.[0-9]*e\\(-?[0-9]+\\)?\\|\\.?[0-9a-f]*\\)" | ||
| 310 : | immediate (font-lock-constant-face . 3)) | ||
| 311 : | )) | ||
| 312 : | |||
| 313 : | dvdkhlng | 1.51 | (defvar forth-use-objects nil |
| 314 : | "*Non-nil makes forth-mode also hilight words from the \"Objects\" package.") | ||
| 315 : | dvdkhlng | 1.57 | (defvar forth-objects-words |
| 316 : | '(((":m") definition-starter (font-lock-keyword-face . 1) | ||
| 317 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 318 : | (("m:") definition-starter (font-lock-keyword-face . 1)) | ||
| 319 : | ((";m") definition-ender (font-lock-keyword-face . 1)) | ||
| 320 : | (("[current]" "[parent]") compile-only (font-lock-keyword-face . 1) | ||
| 321 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 322 : | (("current" "overrides") non-immediate (font-lock-keyword-face . 2) | ||
| 323 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 324 : | (("[to-inst]") compile-only (font-lock-keyword-face . 2) | ||
| 325 : | "[ \t\n]" t name (font-lock-variable-name-face . 3)) | ||
| 326 : | (("[bind]") compile-only (font-lock-keyword-face . 2) | ||
| 327 : | "[ \t\n]" t name (font-lock-type-face . 3) | ||
| 328 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 329 : | (("bind") non-immediate (font-lock-keyword-face . 2) | ||
| 330 : | "[ \t\n]" t name (font-lock-type-face . 3) | ||
| 331 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 332 : | (("inst-var" "inst-value") non-immediate (font-lock-type-face . 2) | ||
| 333 : | "[ \t\n]" t name (font-lock-variable-name-face . 3)) | ||
| 334 : | (("method" "selector") | ||
| 335 : | non-immediate (font-lock-type-face . 1) | ||
| 336 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 337 : | (("end-class" "end-interface") | ||
| 338 : | non-immediate (font-lock-keyword-face . 2) | ||
| 339 : | "[ \t\n]" t name (font-lock-type-face . 3)) | ||
| 340 : | (("public" "protected" "class" "exitm" "implementation" "interface" | ||
| 341 : | "methods" "end-methods" "this") | ||
| 342 : | non-immediate (font-lock-keyword-face . 2)) | ||
| 343 : | (("object") non-immediate (font-lock-type-face . 2))) | ||
| 344 : | dvdkhlng | 1.51 | "Hilighting description for words of the \"Objects\" package") |
| 345 : | dvdkhlng | 1.57 | |
| 346 : | pazsan | 1.48 | |
| 347 : | dvdkhlng | 1.51 | (defvar forth-use-oof nil |
| 348 : | "*Non-nil makes forth-mode also hilight words from the \"OOF\" package.") | ||
| 349 : | dvdkhlng | 1.57 | (defvar forth-oof-words |
| 350 : | '((("class") non-immediate (font-lock-keyword-face . 2) | ||
| 351 : | "[ \t\n]" t name (font-lock-type-face . 3)) | ||
| 352 : | (("var") non-immediate (font-lock-type-face . 2) | ||
| 353 : | "[ \t\n]" t name (font-lock-variable-name-face . 3)) | ||
| 354 : | (("method" "early") non-immediate (font-lock-type-face . 2) | ||
| 355 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 356 : | (("::" "super" "bind" "bound" "link") | ||
| 357 : | immediate (font-lock-keyword-face . 2) | ||
| 358 : | "[ \t\n]" t name (font-lock-function-name-face . 3)) | ||
| 359 : | (("ptr" "asptr" "[]") | ||
| 360 : | immediate (font-lock-keyword-face . 2) | ||
| 361 : | "[ \t\n]" t name (font-lock-variable-name-face . 3)) | ||
| 362 : | (("class;" "how:" "self" "new" "new[]" "definitions" "class?" "with" | ||
| 363 : | "endwith") | ||
| 364 : | non-immediate (font-lock-keyword-face . 2)) | ||
| 365 : | (("object") non-immediate (font-lock-type-face . 2))) | ||
| 366 : | dvdkhlng | 1.51 | "Hilighting description for words of the \"OOF\" package") |
| 367 : | pazsan | 1.48 | |
| 368 : | dvdkhlng | 1.49 | (defvar forth-local-words nil |
| 369 : | "List of Forth words to prepend to `forth-words'. Should be set by a | ||
| 370 : | dvdkhlng | 1.51 | forth source, using a local variables list at the end of the file |
| 371 : | (\"Local Variables: ... forth-local-words: ... End:\" construct).") | ||
| 372 : | |||
| 373 : | (defvar forth-custom-words nil | ||
| 374 : | "List of Forth words to prepend to `forth-words'. Should be set in your | ||
| 375 : | .emacs.") | ||
| 376 : | dvdkhlng | 1.49 | |
| 377 : | pazsan | 1.48 | (defvar forth-hilight-level 3 "*Level of hilighting of Forth code.") |
| 378 : | dvdkhlng | 1.51 | |
| 379 : | pazsan | 1.48 | (defvar forth-compiled-words nil "Compiled representation of `forth-words'.") |
| 380 : | |||
| 381 : | dvdkhlng | 1.57 | (defvar forth-indent-words nil |
| 382 : | "List of words that have indentation behaviour. | ||
| 383 : | Each element of `forth-indent-words' should have the form | ||
| 384 : | (MATCHER INDENT1 INDENT2 &optional TYPE) | ||
| 385 : | |||
| 386 : | MATCHER is either a list of strings to match, or a REGEXP. | ||
| 387 : | If it's a REGEXP, it should not be surrounded by `\\<` or `\\>`, since | ||
| 388 : | that'll be done automatically by the search routines. | ||
| 389 : | |||
| 390 : | TYPE might be omitted. If it's specified, the only allowed value is | ||
| 391 : | currently the symbol `non-immediate', meaning that the word will not | ||
| 392 : | have any effect on indentation inside definitions. (:NONAME is a good | ||
| 393 : | example for this kind of word). | ||
| 394 : | |||
| 395 : | anton | 1.63 | INDENT1 specifies how to indent a word that's located at the beginning |
| 396 : | of a line, following any number of whitespaces. | ||
| 397 : | dvdkhlng | 1.57 | |
| 398 : | anton | 1.63 | INDENT2 specifies how to indent words that are not located at the |
| 399 : | beginning of a line. | ||
| 400 : | dvdkhlng | 1.57 | |
| 401 : | INDENT1 and INDENT2 are indentation specifications of the form | ||
| 402 : | (SELF-INDENT . NEXT-INDENT), where SELF-INDENT is a numerical value, | ||
| 403 : | specifying how the matching line and all following lines are to be | ||
| 404 : | indented, relative to previous lines. NEXT-INDENT specifies how to indent | ||
| 405 : | following lines, relative to the matching line. | ||
| 406 : | |||
| 407 : | Even values of SELF-INDENT and NEXT-INDENT correspond to multiples of | ||
| 408 : | `forth-indent-level'. Odd values get an additional | ||
| 409 : | `forth-minor-indent-level' added/substracted. Eg a value of -2 indents | ||
| 410 : | 1 * forth-indent-level to the left, wheras 3 indents | ||
| 411 : | 1 * forth-indent-level + forth-minor-indent-level columns to the right.") | ||
| 412 : | |||
| 413 : | (setq forth-indent-words | ||
| 414 : | '((("if" "begin" "do" "?do" "+do" "-do" "u+do" | ||
| 415 : | "u-do" "?dup-if" "?dup-0=-if" "case" "of" "try" | ||
| 416 : | "[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]") | ||
| 417 : | (0 . 2) (0 . 2)) | ||
| 418 : | ((":" ":noname" "code" "struct" "m:" ":m" "class" "interface") | ||
| 419 : | (0 . 2) (0 . 2) non-immediate) | ||
| 420 : | ("\\S-+%$" (0 . 2) (0 . 0) non-immediate) | ||
| 421 : | ((";" ";m") (-2 . 0) (0 . -2)) | ||
| 422 : | anton | 1.63 | (("again" "then" "endif" "endtry" "endcase" "endof" |
| 423 : | dvdkhlng | 1.57 | "[then]" "[endif]" "[loop]" "[+loop]" "[next]" |
| 424 : | anton | 1.63 | "[until]" "[again]" "loop") |
| 425 : | dvdkhlng | 1.57 | (-2 . 0) (0 . -2)) |
| 426 : | (("end-code" "end-class" "end-interface" "end-class-noname" | ||
| 427 : | "end-interface-noname" "end-struct" "class;") | ||
| 428 : | (-2 . 0) (0 . -2) non-immediate) | ||
| 429 : | (("protected" "public" "how:") (-1 . 1) (0 . 0) non-immediate) | ||
| 430 : | (("+loop" "-loop" "until") (-2 . 0) (-2 . 0)) | ||
| 431 : | (("else" "recover" "[else]") (-2 . 2) (0 . 0)) | ||
| 432 : | anton | 1.63 | (("does>") (-1 . 1) (0 . 0)) |
| 433 : | (("while" "[while]") (-2 . 4) (0 . 2)) | ||
| 434 : | (("repeat" "[repeat]") (-4 . 0) (0 . -4)) | ||
| 435 : | dvdkhlng | 1.57 | (("\\g") (-2 . 2) (0 . 0)))) |
| 436 : | |||
| 437 : | (defvar forth-local-indent-words nil | ||
| 438 : | "List of Forth words to prepend to `forth-indent-words', when a forth-mode | ||
| 439 : | buffer is created. Should be set by a Forth source, using a local variables | ||
| 440 : | list at the end of the file (\"Local Variables: ... forth-local-words: ... | ||
| 441 : | End:\" construct).") | ||
| 442 : | dvdkhlng | 1.51 | |
| 443 : | dvdkhlng | 1.57 | (defvar forth-custom-indent-words nil |
| 444 : | "List of Forth words to prepend to `forth-indent-words'. Should be set in | ||
| 445 : | your .emacs.") | ||
| 446 : | pazsan | 1.48 | |
| 447 : | dvdkhlng | 1.57 | (defvar forth-indent-level 4 |
| 448 : | "*Indentation of Forth statements.") | ||
| 449 : | (defvar forth-minor-indent-level 2 | ||
| 450 : | "*Minor indentation of Forth statements.") | ||
| 451 : | (defvar forth-compiled-indent-words nil) | ||
| 452 : | pazsan | 1.48 | |
| 453 : | dvdkhlng | 1.55 | ;(setq debug-on-error t) |
| 454 : | pazsan | 1.48 | |
| 455 : | dvdkhlng | 1.50 | ;; Filter list by predicate. This is a somewhat standard function for |
| 456 : | pazsan | 1.48 | ;; functional programming languages. So why isn't it already implemented |
| 457 : | ;; in Lisp?? | ||
| 458 : | dvdkhlng | 1.50 | (defun forth-filter (predicate list) |
| 459 : | pazsan | 1.48 | (let ((filtered nil)) |
| 460 : | (mapcar (lambda (item) | ||
| 461 : | dvdkhlng | 1.50 | (when (funcall predicate item) |
| 462 : | pazsan | 1.48 | (if filtered |
| 463 : | (nconc filtered (list item)) | ||
| 464 : | (setq filtered (cons item nil)))) | ||
| 465 : | nil) list) | ||
| 466 : | filtered)) | ||
| 467 : | |||
| 468 : | ;; Helper function for `forth-compile-word': return whether word has to be | ||
| 469 : | ;; added to the compiled word list, for syntactic parsing and hilighting. | ||
| 470 : | (defun forth-words-filter (word) | ||
| 471 : | (let* ((hilight (nth 2 word)) | ||
| 472 : | (level (cdr hilight)) | ||
| 473 : | (parsing-flag (nth 3 word))) | ||
| 474 : | (or parsing-flag | ||
| 475 : | (<= level forth-hilight-level)))) | ||
| 476 : | |||
| 477 : | ;; Helper function for `forth-compile-word': translate one entry from | ||
| 478 : | ;; `forth-words' into the form (regexp regexp-depth word-description) | ||
| 479 : | (defun forth-compile-words-mapper (word) | ||
| 480 : | dvdkhlng | 1.59 | ;; warning: we cannot rely on regexp-opt's PAREN argument, since |
| 481 : | ;; XEmacs will use shy parens by default :-( | ||
| 482 : | pazsan | 1.48 | (let* ((matcher (car word)) |
| 483 : | dvdkhlng | 1.59 | (regexp |
| 484 : | (concat "\\(" (cond ((stringp matcher) matcher) | ||
| 485 : | ((listp matcher) (regexp-opt matcher)) | ||
| 486 : | (t (error "Invalid matcher `%s'"))) | ||
| 487 : | "\\)")) | ||
| 488 : | pazsan | 1.48 | (depth (regexp-opt-depth regexp)) |
| 489 : | (description (cdr word))) | ||
| 490 : | (list regexp depth description))) | ||
| 491 : | |||
| 492 : | ;; Read `words' and create a compiled representation suitable for efficient | ||
| 493 : | ;; parsing of the form | ||
| 494 : | ;; (regexp (subexp-count word-description) (subexp-count2 word-description2) | ||
| 495 : | ;; ...) | ||
| 496 : | dvdkhlng | 1.49 | (defun forth-compile-wordlist (words) |
| 497 : | pazsan | 1.48 | (let* ((mapped (mapcar 'forth-compile-words-mapper words)) |
| 498 : | (regexp (concat "\\<\\(" | ||
| 499 : | (mapconcat 'car mapped "\\|") | ||
| 500 : | "\\)\\>")) | ||
| 501 : | (sub-count 2) | ||
| 502 : | (sub-list (mapcar | ||
| 503 : | (lambda (i) | ||
| 504 : | (let ((sub (cons sub-count (nth 2 i)))) | ||
| 505 : | (setq sub-count (+ sub-count (nth 1 i))) | ||
| 506 : | sub | ||
| 507 : | )) | ||
| 508 : | mapped))) | ||
| 509 : | (let ((result (cons regexp sub-list))) | ||
| 510 : | (byte-compile 'result) | ||
| 511 : | result))) | ||
| 512 : | |||
| 513 : | dvdkhlng | 1.49 | (defun forth-compile-words () |
| 514 : | "Compile the the words from `forth-words' and `forth-indent-words' into | ||
| 515 : | the format that's later used for doing the actual hilighting/indentation. | ||
| 516 : | dvdkhlng | 1.51 | Store the resulting compiled wordlists in `forth-compiled-words' and |
| 517 : | dvdkhlng | 1.49 | `forth-compiled-indent-words', respective" |
| 518 : | (setq forth-compiled-words | ||
| 519 : | (forth-compile-wordlist | ||
| 520 : | (forth-filter 'forth-words-filter forth-words))) | ||
| 521 : | (setq forth-compiled-indent-words | ||
| 522 : | (forth-compile-wordlist forth-indent-words))) | ||
| 523 : | |||
| 524 : | (defun forth-hack-local-variables () | ||
| 525 : | dvdkhlng | 1.51 | "Parse and bind local variables, set in the contents of the current |
| 526 : | forth-mode buffer. Prepend `forth-local-words' to `forth-words' and | ||
| 527 : | `forth-local-indent-words' to `forth-indent-words'." | ||
| 528 : | dvdkhlng | 1.49 | (hack-local-variables) |
| 529 : | (setq forth-words (append forth-local-words forth-words)) | ||
| 530 : | (setq forth-indent-words (append forth-local-indent-words | ||
| 531 : | forth-indent-words))) | ||
| 532 : | |||
| 533 : | dvdkhlng | 1.51 | (defun forth-customize-words () |
| 534 : | "Add the words from `forth-custom-words' and `forth-custom-indent-words' | ||
| 535 : | to `forth-words' and `forth-indent-words', respective. Add | ||
| 536 : | `forth-objects-words' and/or `forth-oof-words' to `forth-words', if | ||
| 537 : | `forth-use-objects' and/or `forth-use-oof', respective is set." | ||
| 538 : | (setq forth-words (append forth-custom-words forth-words | ||
| 539 : | (if forth-use-oof forth-oof-words nil) | ||
| 540 : | (if forth-use-objects forth-objects-words nil))) | ||
| 541 : | (setq forth-indent-words (append | ||
| 542 : | forth-custom-indent-words forth-indent-words))) | ||
| 543 : | |||
| 544 : | |||
| 545 : | |||
| 546 : | pazsan | 1.48 | ;; get location of first character of previous forth word that's got |
| 547 : | ;; properties | ||
| 548 : | (defun forth-previous-start (pos) | ||
| 549 : | (let* ((word (get-text-property pos 'forth-word)) | ||
| 550 : | (prev (previous-single-property-change | ||
| 551 : | (min (point-max) (1+ pos)) 'forth-word | ||
| 552 : | (current-buffer) (point-min)))) | ||
| 553 : | (if (or (= (point-min) prev) word) prev | ||
| 554 : | (if (get-text-property (1- prev) 'forth-word) | ||
| 555 : | (previous-single-property-change | ||
| 556 : | prev 'forth-word (current-buffer) (point-min)) | ||
| 557 : | (point-min))))) | ||
| 558 : | |||
| 559 : | ;; Get location of the last character of the current/next forth word that's | ||
| 560 : | ;; got properties, text that's parsed by the word is considered as parts of | ||
| 561 : | ;; the word. | ||
| 562 : | (defun forth-next-end (pos) | ||
| 563 : | (let* ((word (get-text-property pos 'forth-word)) | ||
| 564 : | (next (next-single-property-change pos 'forth-word | ||
| 565 : | (current-buffer) (point-max)))) | ||
| 566 : | (if word next | ||
| 567 : | (if (get-text-property next 'forth-word) | ||
| 568 : | (next-single-property-change | ||
| 569 : | next 'forth-word (current-buffer) (point-max)) | ||
| 570 : | (point-max))))) | ||
| 571 : | |||
| 572 : | (defun forth-next-whitespace (pos) | ||
| 573 : | (save-excursion | ||
| 574 : | (goto-char pos) | ||
| 575 : | (skip-syntax-forward "-" (point-max)) | ||
| 576 : | (point))) | ||
| 577 : | (defun forth-previous-word (pos) | ||
| 578 : | (save-excursion | ||
| 579 : | (goto-char pos) | ||
| 580 : | (re-search-backward "\\<" pos (point-min) 1) | ||
| 581 : | (point))) | ||
| 582 : | |||
| 583 : | ;; Delete all properties, used by Forth mode, from `from' to `to'. | ||
| 584 : | (defun forth-delete-properties (from to) | ||
| 585 : | (remove-text-properties | ||
| 586 : | dvdkhlng | 1.55 | from to '(face nil fontified nil |
| 587 : | forth-parsed nil forth-word nil forth-state nil))) | ||
| 588 : | pazsan | 1.48 | |
| 589 : | ;; Get the index of the branch of the most recently evaluated regular | ||
| 590 : | ;; expression that matched. (used for identifying branches "a\\|b\\|c...") | ||
| 591 : | (defun forth-get-regexp-branch () | ||
| 592 : | (let ((count 2)) | ||
| 593 : | dvdkhlng | 1.59 | (while (not (condition-case err (match-beginning count) |
| 594 : | (args-out-of-range t))) ; XEmacs requires error handling | ||
| 595 : | pazsan | 1.48 | (setq count (1+ count))) |
| 596 : | count)) | ||
| 597 : | |||
| 598 : | ;; seek to next forth-word and return its "word-description" | ||
| 599 : | (defun forth-next-known-forth-word (to) | ||
| 600 : | (if (<= (point) to) | ||
| 601 : | (progn | ||
| 602 : | (let* ((regexp (car forth-compiled-words)) | ||
| 603 : | (pos (re-search-forward regexp to t))) | ||
| 604 : | (if pos (let ((branch (forth-get-regexp-branch)) | ||
| 605 : | (descr (cdr forth-compiled-words))) | ||
| 606 : | (goto-char (match-beginning 0)) | ||
| 607 : | (cdr (assoc branch descr))) | ||
| 608 : | 'nil))) | ||
| 609 : | nil)) | ||
| 610 : | |||
| 611 : | ;; Set properties of forth word at `point', eventually parsing subsequent | ||
| 612 : | ;; words, and parsing all whitespaces. Set point to delimiter after word. | ||
| 613 : | ;; The word, including it's parsed text gets the `forth-word' property, whose | ||
| 614 : | ;; value is unique, and may be used for getting the word's start/end | ||
| 615 : | ;; positions. | ||
| 616 : | (defun forth-set-word-properties (state data) | ||
| 617 : | (let* ((start (point)) | ||
| 618 : | (end (progn (re-search-forward "[ \t]\\|$" (point-max) 1) | ||
| 619 : | (point))) | ||
| 620 : | (type (car data)) | ||
| 621 : | (hilight (nth 1 data)) | ||
| 622 : | (bad-word (and (not state) (eq type 'compile-only))) | ||
| 623 : | (hlface (if bad-word font-lock-warning-face | ||
| 624 : | (if (<= (cdr hilight) forth-hilight-level) | ||
| 625 : | (car hilight) nil)))) | ||
| 626 : | (when hlface (put-text-property start end 'face hlface)) | ||
| 627 : | ;; if word parses in current state, process parsed range of text | ||
| 628 : | (when (or (not state) (eq type 'compile-only) (eq type 'immediate)) | ||
| 629 : | (let ((parse-data (nthcdr 2 data))) | ||
| 630 : | (while parse-data | ||
| 631 : | (let ((delim (nth 0 parse-data)) | ||
| 632 : | (skip-leading (nth 1 parse-data)) | ||
| 633 : | (parse-type (nth 2 parse-data)) | ||
| 634 : | (parsed-hilight (nth 3 parse-data)) | ||
| 635 : | (parse-start (point)) | ||
| 636 : | (parse-end)) | ||
| 637 : | (when skip-leading | ||
| 638 : | (while (and (looking-at delim) (> (match-end 0) (point)) | ||
| 639 : | (not (looking-at "\n"))) | ||
| 640 : | (forward-char))) | ||
| 641 : | (re-search-forward delim (point-max) 1) | ||
| 642 : | (setq parse-end (point)) | ||
| 643 : | (forth-delete-properties end parse-end) | ||
| 644 : | (when (<= (cdr parsed-hilight) forth-hilight-level) | ||
| 645 : | (put-text-property | ||
| 646 : | parse-start parse-end 'face (car parsed-hilight))) | ||
| 647 : | (put-text-property | ||
| 648 : | parse-start parse-end 'forth-parsed parse-type) | ||
| 649 : | (setq end parse-end) | ||
| 650 : | (setq parse-data (nthcdr 4 parse-data)))))) | ||
| 651 : | (put-text-property start end 'forth-word start))) | ||
| 652 : | |||
| 653 : | ;; Search for known Forth words in the range `from' to `to', using | ||
| 654 : | ;; `forth-next-known-forth-word' and set their properties via | ||
| 655 : | ;; `forth-set-word-properties'. | ||
| 656 : | dvdkhlng | 1.51 | (defun forth-update-properties (from to &optional loudly) |
| 657 : | pazsan | 1.48 | (save-excursion |
| 658 : | dvdkhlng | 1.51 | (let ((msg-count 0) (state) (word-descr) (last-location)) |
| 659 : | pazsan | 1.48 | (goto-char (forth-previous-word (forth-previous-start |
| 660 : | (max (point-min) (1- from))))) | ||
| 661 : | (setq to (forth-next-end (min (point-max) (1+ to)))) | ||
| 662 : | ;; `to' must be on a space delimiter, if a parsing word was changed | ||
| 663 : | (setq to (forth-next-whitespace to)) | ||
| 664 : | (setq state (get-text-property (point) 'forth-state)) | ||
| 665 : | (setq last-location (point)) | ||
| 666 : | (forth-delete-properties (point) to) | ||
| 667 : | dvdkhlng | 1.55 | (put-text-property (point) to 'fontified t) |
| 668 : | pazsan | 1.48 | ;; hilight loop... |
| 669 : | (while (setq word-descr (forth-next-known-forth-word to)) | ||
| 670 : | dvdkhlng | 1.51 | (when loudly |
| 671 : | (when (equal 0 (% msg-count 100)) | ||
| 672 : | (message "Parsing Forth code...%s" | ||
| 673 : | (make-string (/ msg-count 100) ?.))) | ||
| 674 : | (setq msg-count (1+ msg-count))) | ||
| 675 : | pazsan | 1.48 | (forth-set-word-properties state word-descr) |
| 676 : | (when state (put-text-property last-location (point) 'forth-state t)) | ||
| 677 : | (let ((type (car word-descr))) | ||
| 678 : | (if (eq type 'definition-starter) (setq state t)) | ||
| 679 : | (if (eq type 'definition-ender) (setq state nil)) | ||
| 680 : | (setq last-location (point)))) | ||
| 681 : | ;; update state property up to `to' | ||
| 682 : | (if (and state (< (point) to)) | ||
| 683 : | (put-text-property last-location to 'forth-state t)) | ||
| 684 : | ;; extend search if following state properties differ from current state | ||
| 685 : | (if (< to (point-max)) | ||
| 686 : | (if (not (equal state (get-text-property (1+ to) 'forth-state))) | ||
| 687 : | (let ((extend-to (next-single-property-change | ||
| 688 : | to 'forth-state (current-buffer) (point-max)))) | ||
| 689 : | (forth-update-properties to extend-to)) | ||
| 690 : | )) | ||
| 691 : | ))) | ||
| 692 : | |||
| 693 : | ;; save-buffer-state borrowed from `font-lock.el' | ||
| 694 : | (eval-when-compile | ||
| 695 : | (defmacro forth-save-buffer-state (varlist &rest body) | ||
| 696 : | "Bind variables according to VARLIST and eval BODY restoring buffer state." | ||
| 697 : | (` (let* ((,@ (append varlist | ||
| 698 : | '((modified (buffer-modified-p)) (buffer-undo-list t) | ||
| 699 : | (inhibit-read-only t) (inhibit-point-motion-hooks t) | ||
| 700 : | before-change-functions after-change-functions | ||
| 701 : | deactivate-mark buffer-file-name buffer-file-truename)))) | ||
| 702 : | (,@ body) | ||
| 703 : | (when (and (not modified) (buffer-modified-p)) | ||
| 704 : | (set-buffer-modified-p nil)))))) | ||
| 705 : | |||
| 706 : | ;; Function that is added to the `change-functions' hook. Calls | ||
| 707 : | ;; `forth-update-properties' and keeps care of disabling undo information | ||
| 708 : | ;; and stuff like that. | ||
| 709 : | dvdkhlng | 1.51 | (defun forth-change-function (from to len &optional loudly) |
| 710 : | pazsan | 1.48 | (save-match-data |
| 711 : | dvdkhlng | 1.55 | (forth-save-buffer-state |
| 712 : | () | ||
| 713 : | (unless forth-disable-parser (forth-update-properties from to loudly)) | ||
| 714 : | (forth-update-warn-long-lines)))) | ||
| 715 : | |||
| 716 : | (defun forth-fontification-function (from) | ||
| 717 : | "Function to be called from `fontification-functions' of Emacs 21." | ||
| 718 : | (save-match-data | ||
| 719 : | (forth-save-buffer-state | ||
| 720 : | ((to (min (point-max) (+ from 100)))) | ||
| 721 : | (unless (or forth-disable-parser (not forth-jit-parser) | ||
| 722 : | (get-text-property from 'fontified)) | ||
| 723 : | (forth-update-properties from to))))) | ||
| 724 : | pazsan | 1.48 | |
| 725 : | (eval-when-compile | ||
| 726 : | (byte-compile 'forth-set-word-properties) | ||
| 727 : | (byte-compile 'forth-next-known-forth-word) | ||
| 728 : | (byte-compile 'forth-update-properties) | ||
| 729 : | (byte-compile 'forth-delete-properties) | ||
| 730 : | (byte-compile 'forth-get-regexp-branch)) | ||
| 731 : | |||
| 732 : | dvdkhlng | 1.51 | ;;; imenu support |
| 733 : | ;;; | ||
| 734 : | dvdkhlng | 1.52 | (defvar forth-defining-words |
| 735 : | '("VARIABLE" "CONSTANT" "2VARIABLE" "2CONSTANT" "FVARIABLE" "FCONSTANT" | ||
| 736 : | "USER" "VALUE" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE" | ||
| 737 : | "DEFER" "ALIAS") | ||
| 738 : | dvdkhlng | 1.53 | "List of words, that define the following word. |
| 739 : | dvdkhlng | 1.55 | Used for imenu index generation.") |
| 740 : | dvdkhlng | 1.52 | |
| 741 : | dvdkhlng | 1.57 | (defvar forth-defining-words-regexp nil |
| 742 : | "Regexp that's generated for matching `forth-defining-words'") | ||
| 743 : | dvdkhlng | 1.52 | |
| 744 : | dvdkhlng | 1.51 | (defun forth-next-definition-starter () |
| 745 : | (progn | ||
| 746 : | dvdkhlng | 1.52 | (let* ((pos (re-search-forward forth-defining-words-regexp (point-max) t))) |
| 747 : | dvdkhlng | 1.51 | (if pos |
| 748 : | (if (or (text-property-not-all (match-beginning 0) (match-end 0) | ||
| 749 : | dvdkhlng | 1.52 | 'forth-parsed nil) |
| 750 : | (text-property-not-all (match-beginning 0) (match-end 0) | ||
| 751 : | 'forth-state nil)) | ||
| 752 : | dvdkhlng | 1.51 | (forth-next-definition-starter) |
| 753 : | t) | ||
| 754 : | nil)))) | ||
| 755 : | |||
| 756 : | (defun forth-create-index () | ||
| 757 : | dvdkhlng | 1.52 | (let* ((forth-defining-words-regexp |
| 758 : | (concat "\\<\\(" (regexp-opt forth-defining-words) "\\)\\>")) | ||
| 759 : | dvdkhlng | 1.51 | (index nil)) |
| 760 : | (goto-char (point-min)) | ||
| 761 : | (while (forth-next-definition-starter) | ||
| 762 : | (if (looking-at "[ \t]*\\([^ \t\n]+\\)") | ||
| 763 : | (setq index (cons (cons (match-string 1) (point)) index)))) | ||
| 764 : | index)) | ||
| 765 : | |||
| 766 : | dvdkhlng | 1.57 | ;; top-level require is executed at byte-compile and load time |
| 767 : | dvdkhlng | 1.58 | (eval-and-compile (forth-require 'speedbar)) |
| 768 : | dvdkhlng | 1.57 | |
| 769 : | ;; this code is executed at load-time only | ||
| 770 : | dvdkhlng | 1.58 | (when (memq 'speedbar features) |
| 771 : | dvdkhlng | 1.57 | (speedbar-add-supported-extension ".fs") |
| 772 : | (speedbar-add-supported-extension ".fb")) | ||
| 773 : | dvdkhlng | 1.51 | |
| 774 : | pazsan | 1.48 | ;; (require 'profile) |
| 775 : | ;; (setq profile-functions-list '(forth-set-word-properties forth-next-known-forth-word forth-update-properties forth-delete-properties forth-get-regexp-branch)) | ||
| 776 : | |||
| 777 : | ;;; Indentation | ||
| 778 : | ;;; | ||
| 779 : | |||
| 780 : | ;; Return, whether `pos' is the first forth word on its line | ||
| 781 : | (defun forth-first-word-on-line-p (pos) | ||
| 782 : | (save-excursion | ||
| 783 : | (beginning-of-line) | ||
| 784 : | (skip-chars-forward " \t") | ||
| 785 : | (= pos (point)))) | ||
| 786 : | |||
| 787 : | ;; Return indentation data (SELF-INDENT . NEXT-INDENT) of next known | ||
| 788 : | ;; indentation word, or nil if there is no word up to `to'. | ||
| 789 : | ;; Position `point' at location just after found word, or at `to'. Parsed | ||
| 790 : | ;; ranges of text will not be taken into consideration! | ||
| 791 : | (defun forth-next-known-indent-word (to) | ||
| 792 : | (if (<= (point) to) | ||
| 793 : | (progn | ||
| 794 : | (let* ((regexp (car forth-compiled-indent-words)) | ||
| 795 : | (pos (re-search-forward regexp to t))) | ||
| 796 : | (if pos | ||
| 797 : | dvdkhlng | 1.54 | (let* ((start (match-beginning 0)) |
| 798 : | (end (match-end 0)) | ||
| 799 : | (branch (forth-get-regexp-branch)) | ||
| 800 : | (descr (cdr forth-compiled-indent-words)) | ||
| 801 : | (indent (cdr (assoc branch descr))) | ||
| 802 : | (type (nth 2 indent))) | ||
| 803 : | ;; skip words that are parsed (strings/comments) and | ||
| 804 : | ;; non-immediate words inside definitions | ||
| 805 : | (if (or (text-property-not-all start end 'forth-parsed nil) | ||
| 806 : | (and (eq type 'non-immediate) | ||
| 807 : | (text-property-not-all start end | ||
| 808 : | 'forth-state nil))) | ||
| 809 : | (forth-next-known-indent-word to) | ||
| 810 : | pazsan | 1.48 | (if (forth-first-word-on-line-p (match-beginning 0)) |
| 811 : | (nth 0 indent) (nth 1 indent)))) | ||
| 812 : | nil))) | ||
| 813 : | nil)) | ||
| 814 : | |||
| 815 : | ;; Translate indentation value `indent' to indentation column. Multiples of | ||
| 816 : | ;; 2 correspond to multiples of `forth-indent-level'. Odd numbers get an | ||
| 817 : | ;; additional `forth-minor-indent-level' added (or substracted). | ||
| 818 : | (defun forth-convert-to-column (indent) | ||
| 819 : | (let* ((sign (if (< indent 0) -1 1)) | ||
| 820 : | (value (abs indent)) | ||
| 821 : | (major (* (/ value 2) forth-indent-level)) | ||
| 822 : | (minor (* (% value 2) forth-minor-indent-level))) | ||
| 823 : | (* sign (+ major minor)))) | ||
| 824 : | |||
| 825 : | ;; Return the column increment, that the current line of forth code does to | ||
| 826 : | ;; the current or following lines. `which' specifies which indentation values | ||
| 827 : | ;; to use. 0 means the indentation of following lines relative to current | ||
| 828 : | ;; line, 1 means the indentation of the current line relative to the previous | ||
| 829 : | ;; line. Return `nil', if there are no indentation words on the current line. | ||
| 830 : | (defun forth-get-column-incr (which) | ||
| 831 : | (save-excursion | ||
| 832 : | (let ((regexp (car forth-compiled-indent-words)) | ||
| 833 : | (word-indent) | ||
| 834 : | (self-indent nil) | ||
| 835 : | (next-indent nil) | ||
| 836 : | (to (save-excursion (end-of-line) (point)))) | ||
| 837 : | (beginning-of-line) | ||
| 838 : | (while (setq word-indent (forth-next-known-indent-word to)) | ||
| 839 : | (let* ((self-incr (car word-indent)) | ||
| 840 : | (next-incr (cdr word-indent)) | ||
| 841 : | (self-column-incr (forth-convert-to-column self-incr)) | ||
| 842 : | (next-column-incr (forth-convert-to-column next-incr))) | ||
| 843 : | (setq next-indent (if next-indent next-indent 0)) | ||
| 844 : | (setq self-indent (if self-indent self-indent 0)) | ||
| 845 : | (if (or (and (> next-indent 0) (< self-column-incr 0)) | ||
| 846 : | (and (< next-indent 0) (> self-column-incr 0))) | ||
| 847 : | (setq next-indent (+ next-indent self-column-incr)) | ||
| 848 : | (setq self-indent (+ self-indent self-column-incr))) | ||
| 849 : | (setq next-indent (+ next-indent next-column-incr)))) | ||
| 850 : | (nth which (list self-indent next-indent))))) | ||
| 851 : | |||
| 852 : | ;; Find previous line that contains indentation words, return the column, | ||
| 853 : | ;; to which following text should be indented to. | ||
| 854 : | (defun forth-get-anchor-column () | ||
| 855 : | (save-excursion | ||
| 856 : | (if (/= 0 (forward-line -1)) 0 | ||
| 857 : | dvdkhlng | 1.54 | (let ((indent)) |
| 858 : | pazsan | 1.48 | (while (not (or (setq indent (forth-get-column-incr 1)) |
| 859 : | (<= (point) (point-min)))) | ||
| 860 : | (forward-line -1)) | ||
| 861 : | (+ (current-indentation) (if indent indent 0)))))) | ||
| 862 : | |||
| 863 : | (defun forth-indent-line (&optional flag) | ||
| 864 : | "Correct indentation of the current Forth line." | ||
| 865 : | (let* ((anchor (forth-get-anchor-column)) | ||
| 866 : | (column-incr (forth-get-column-incr 0))) | ||
| 867 : | (forth-indent-to (if column-incr (+ anchor column-incr) anchor)))) | ||
| 868 : | |||
| 869 : | dvdkhlng | 1.49 | (defun forth-current-column () |
| 870 : | (- (point) (save-excursion (beginning-of-line) (point)))) | ||
| 871 : | (defun forth-current-indentation () | ||
| 872 : | (- (save-excursion (beginning-of-line) (forward-to-indentation 0) (point)) | ||
| 873 : | (save-excursion (beginning-of-line) (point)))) | ||
| 874 : | |||
| 875 : | pazsan | 1.48 | (defun forth-indent-to (x) |
| 876 : | (let ((p nil)) | ||
| 877 : | dvdkhlng | 1.49 | (setq p (- (forth-current-column) (forth-current-indentation))) |
| 878 : | pazsan | 1.48 | (forth-delete-indentation) |
| 879 : | (beginning-of-line) | ||
| 880 : | (indent-to x) | ||
| 881 : | (if (> p 0) (forward-char p)))) | ||
| 882 : | |||
| 883 : | (defun forth-delete-indentation () | ||
| 884 : | (save-excursion | ||
| 885 : | (delete-region | ||
| 886 : | (progn (beginning-of-line) (point)) | ||
| 887 : | (progn (back-to-indentation) (point))))) | ||
| 888 : | |||
| 889 : | (defun forth-indent-command () | ||
| 890 : | (interactive) | ||
| 891 : | (forth-indent-line t)) | ||
| 892 : | |||
| 893 : | ;; remove trailing whitespaces in current line | ||
| 894 : | (defun forth-remove-trailing () | ||
| 895 : | (save-excursion | ||
| 896 : | (end-of-line) | ||
| 897 : | (delete-region (point) (progn (skip-chars-backward " \t") (point))))) | ||
| 898 : | |||
| 899 : | ;; insert newline, removing any trailing whitespaces in the current line | ||
| 900 : | (defun forth-newline-remove-trailing () | ||
| 901 : | (save-excursion | ||
| 902 : | dvdkhlng | 1.49 | (delete-region (point) (progn (skip-chars-backward " \t") (point)))) |
| 903 : | (newline)) | ||
| 904 : | ; (let ((was-point (point-marker))) | ||
| 905 : | ; (unwind-protect | ||
| 906 : | ; (progn (forward-line -1) (forth-remove-trailing)) | ||
| 907 : | ; (goto-char (was-point))))) | ||
| 908 : | pazsan | 1.48 | |
| 909 : | ;; workaround for bug in `reindent-then-newline-and-indent' | ||
| 910 : | (defun forth-reindent-then-newline-and-indent () | ||
| 911 : | (interactive "*") | ||
| 912 : | (indent-according-to-mode) | ||
| 913 : | (forth-newline-remove-trailing) | ||
| 914 : | (indent-according-to-mode)) | ||
| 915 : | |||
| 916 : | |||
| 917 : | ;;; Block file encoding/decoding (dk) | ||
| 918 : | ;;; | ||
| 919 : | |||
| 920 : | (defconst forth-c/l 64 "Number of characters per block line") | ||
| 921 : | (defconst forth-l/b 16 "Number of lines per block") | ||
| 922 : | |||
| 923 : | ;; Check whether the unconverted block file line, point is in, does not | ||
| 924 : | ;; contain `\n' and `\t' characters. | ||
| 925 : | (defun forth-check-block-line (line) | ||
| 926 : | (let ((end (save-excursion (beginning-of-line) (forward-char forth-c/l) | ||
| 927 : | (point)))) | ||
| 928 : | (save-excursion | ||
| 929 : | (beginning-of-line) | ||
| 930 : | (when (search-forward "\n" end t) | ||
| 931 : | (message "Warning: line %i contains newline character #10" line) | ||
| 932 : | (ding t)) | ||
| 933 : | (beginning-of-line) | ||
| 934 : | (when (search-forward "\t" end t) | ||
| 935 : | (message "Warning: line %i contains tab character #8" line) | ||
| 936 : | (ding t))))) | ||
| 937 : | |||
| 938 : | (defun forth-convert-from-block (from to) | ||
| 939 : | "Convert block file format to stream source in current buffer." | ||
| 940 : | (let ((line (count-lines (point-min) from))) | ||
| 941 : | (save-excursion | ||
| 942 : | (goto-char from) | ||
| 943 : | (set-mark to) | ||
| 944 : | (while (< (+ (point) forth-c/l) (mark t)) | ||
| 945 : | (setq line (1+ line)) | ||
| 946 : | (forth-check-block-line line) | ||
| 947 : | (forward-char forth-c/l) | ||
| 948 : | (forth-newline-remove-trailing)) | ||
| 949 : | (when (= (+ (point) forth-c/l) (mark t)) | ||
| 950 : | (forth-remove-trailing)) | ||
| 951 : | (mark t)))) | ||
| 952 : | |||
| 953 : | ;; Pad a line of a block file up to `forth-c/l' characters, positioning `point' | ||
| 954 : | ;; at the end of line. | ||
| 955 : | (defun forth-pad-block-line () | ||
| 956 : | (save-excursion | ||
| 957 : | (end-of-line) | ||
| 958 : | (if (<= (current-column) forth-c/l) | ||
| 959 : | (move-to-column forth-c/l t) | ||
| 960 : | (message "Line %i longer than %i characters, truncated" | ||
| 961 : | (count-lines (point-min) (point)) forth-c/l) | ||
| 962 : | (ding t) | ||
| 963 : | (move-to-column forth-c/l t) | ||
| 964 : | (delete-region (point) (progn (end-of-line) (point)))))) | ||
| 965 : | |||
| 966 : | ;; Replace tab characters in current line by spaces. | ||
| 967 : | (defun forth-convert-tabs-in-line () | ||
| 968 : | (save-excursion | ||
| 969 : | (beginning-of-line) | ||
| 970 : | (while (search-forward "\t" (save-excursion (end-of-line) (point)) t) | ||
| 971 : | (backward-char) | ||
| 972 : | (delete-region (point) (1+ (point))) | ||
| 973 : | (insert-char ?\ (- tab-width (% (current-column) tab-width)))))) | ||
| 974 : | |||
| 975 : | ;; Delete newline at end of current line, concatenating it with the following | ||
| 976 : | ;; line. Place `point' at end of newly formed line. | ||
| 977 : | (defun forth-delete-newline () | ||
| 978 : | (end-of-line) | ||
| 979 : | (delete-region (point) (progn (beginning-of-line 2) (point)))) | ||
| 980 : | |||
| 981 : | (defun forth-convert-to-block (from to &optional original-buffer) | ||
| 982 : | "Convert range of text to block file format in current buffer." | ||
| 983 : | (let* ((lines 0)) ; I have to count lines myself, since `count-lines' has | ||
| 984 : | ; problems with trailing newlines... | ||
| 985 : | (save-excursion | ||
| 986 : | (goto-char from) | ||
| 987 : | (set-mark to) | ||
| 988 : | ;; pad lines to full length (`forth-c/l' characters per line) | ||
| 989 : | (while (< (save-excursion (end-of-line) (point)) (mark t)) | ||
| 990 : | (setq lines (1+ lines)) | ||
| 991 : | (forth-pad-block-line) | ||
| 992 : | (forth-convert-tabs-in-line) | ||
| 993 : | (forward-line)) | ||
| 994 : | ;; also make sure the last line is padded, if `to' is at its end | ||
| 995 : | (end-of-line) | ||
| 996 : | (when (= (point) (mark t)) | ||
| 997 : | (setq lines (1+ lines)) | ||
| 998 : | (forth-pad-block-line) | ||
| 999 : | (forth-convert-tabs-in-line)) | ||
| 1000 : | ;; remove newlines between lines | ||
| 1001 : | (goto-char from) | ||
| 1002 : | (while (< (save-excursion (end-of-line) (point)) (mark t)) | ||
| 1003 : | (forth-delete-newline)) | ||
| 1004 : | ;; append empty lines, until last block is complete | ||
| 1005 : | (goto-char (mark t)) | ||
| 1006 : | (let* ((required (* (/ (+ lines (1- forth-l/b)) forth-l/b) forth-l/b)) | ||
| 1007 : | (pad-lines (- required lines))) | ||
| 1008 : | (while (> pad-lines 0) | ||
| 1009 : | (insert-char ?\ forth-c/l) | ||
| 1010 : | (setq pad-lines (1- pad-lines)))) | ||
| 1011 : | (point)))) | ||
| 1012 : | |||
| 1013 : | (defun forth-detect-block-file-p () | ||
| 1014 : | "Return non-nil if the current buffer is in block file format. Detection is | ||
| 1015 : | done by checking whether the first line has 1024 characters or more." | ||
| 1016 : | (save-restriction | ||
| 1017 : | (widen) | ||
| 1018 : | (save-excursion | ||
| 1019 : | dvdkhlng | 1.54 | (goto-char (point-min)) |
| 1020 : | pazsan | 1.48 | (end-of-line) |
| 1021 : | (>= (current-column) 1024)))) | ||
| 1022 : | |||
| 1023 : | ;; add block file conversion routines to `format-alist' | ||
| 1024 : | (defconst forth-block-format-description | ||
| 1025 : | '(forth-blocks "Forth block source file" nil | ||
| 1026 : | forth-convert-from-block forth-convert-to-block | ||
| 1027 : | t normal-mode)) | ||
| 1028 : | (unless (memq forth-block-format-description format-alist) | ||
| 1029 : | (setq format-alist (cons forth-block-format-description format-alist))) | ||
| 1030 : | |||
| 1031 : | ;;; End block file encoding/decoding | ||
| 1032 : | |||
| 1033 : | ;;; Block file editing | ||
| 1034 : | ;;; | ||
| 1035 : | (defvar forth-overlay-arrow-string ">>") | ||
| 1036 : | (defvar forth-block-base 1 "Number of first block in block file") | ||
| 1037 : | (defvar forth-show-screen nil | ||
| 1038 : | "Non-nil means to show screen starts and numbers (for block files)") | ||
| 1039 : | (defvar forth-warn-long-lines nil | ||
| 1040 : | "Non-nil means to warn about lines that are longer than 64 characters") | ||
| 1041 : | |||
| 1042 : | (defvar forth-screen-marker nil) | ||
| 1043 : | dvdkhlng | 1.57 | (defvar forth-screen-number-string nil) |
| 1044 : | pazsan | 1.48 | |
| 1045 : | (defun forth-update-show-screen () | ||
| 1046 : | "If `forth-show-screen' is non-nil, put overlay arrow to start of screen, | ||
| 1047 : | `point' is in. If arrow now points to different screen than before, display | ||
| 1048 : | screen number." | ||
| 1049 : | (if (not forth-show-screen) | ||
| 1050 : | (setq overlay-arrow-string nil) | ||
| 1051 : | (save-excursion | ||
| 1052 : | (let* ((line (count-lines (point-min) (min (point-max) (1+ (point))))) | ||
| 1053 : | (first-line (1+ (* (/ (1- line) forth-l/b) forth-l/b))) | ||
| 1054 : | (scr (+ forth-block-base (/ first-line forth-l/b)))) | ||
| 1055 : | (setq overlay-arrow-string forth-overlay-arrow-string) | ||
| 1056 : | (goto-line first-line) | ||
| 1057 : | (setq overlay-arrow-position forth-screen-marker) | ||
| 1058 : | dvdkhlng | 1.50 | (set-marker forth-screen-marker |
| 1059 : | (save-excursion (goto-line first-line) (point))) | ||
| 1060 : | (setq forth-screen-number-string (format "%d" scr)))))) | ||
| 1061 : | pazsan | 1.48 | |
| 1062 : | (add-hook 'forth-motion-hooks 'forth-update-show-screen) | ||
| 1063 : | |||
| 1064 : | (defun forth-update-warn-long-lines () | ||
| 1065 : | "If `forth-warn-long-lines' is non-nil, display a warning whenever a line | ||
| 1066 : | exceeds 64 characters." | ||
| 1067 : | (when forth-warn-long-lines | ||
| 1068 : | (when (> (save-excursion (end-of-line) (current-column)) forth-c/l) | ||
| 1069 : | (message "Warning: current line exceeds %i characters" | ||
| 1070 : | forth-c/l)))) | ||
| 1071 : | |||
| 1072 : | (add-hook 'forth-motion-hooks 'forth-update-warn-long-lines) | ||
| 1073 : | dvdkhlng | 1.55 | |
| 1074 : | pazsan | 1.48 | ;;; End block file editing |
| 1075 : | anton | 1.1 | |
| 1076 : | anton | 1.6 | |
| 1077 : | anton | 1.1 | (defvar forth-mode-abbrev-table nil |
| 1078 : | "Abbrev table in use in Forth-mode buffers.") | ||
| 1079 : | |||
| 1080 : | (define-abbrev-table 'forth-mode-abbrev-table ()) | ||
| 1081 : | |||
| 1082 : | (defvar forth-mode-map nil | ||
| 1083 : | "Keymap used in Forth mode.") | ||
| 1084 : | |||
| 1085 : | (if (not forth-mode-map) | ||
| 1086 : | (setq forth-mode-map (make-sparse-keymap))) | ||
| 1087 : | |||
| 1088 : | anton | 1.9 | ;(define-key forth-mode-map "\M-\C-x" 'compile) |
| 1089 : | anton | 1.7 | (define-key forth-mode-map "\C-x\\" 'comment-region) |
| 1090 : | (define-key forth-mode-map "\C-x~" 'forth-remove-tracers) | ||
| 1091 : | anton | 1.1 | (define-key forth-mode-map "\C-x\C-m" 'forth-split) |
| 1092 : | (define-key forth-mode-map "\e " 'forth-reload) | ||
| 1093 : | (define-key forth-mode-map "\t" 'forth-indent-command) | ||
| 1094 : | pazsan | 1.48 | (define-key forth-mode-map "\C-m" 'forth-reindent-then-newline-and-indent) |
| 1095 : | anton | 1.7 | (define-key forth-mode-map "\M-q" 'forth-fill-paragraph) |
| 1096 : | pazsan | 1.13 | (define-key forth-mode-map "\e." 'forth-find-tag) |
| 1097 : | anton | 1.1 | |
| 1098 : | dvdkhlng | 1.61 | ;; setup for C-h C-i to work |
| 1099 : | dvdkhlng | 1.58 | (eval-and-compile (forth-require 'info-look)) |
| 1100 : | (when (memq 'info-look features) | ||
| 1101 : | dvdkhlng | 1.61 | (defvar forth-info-lookup '(symbol (forth-mode "\\S-+" t |
| 1102 : | dvdkhlng | 1.59 | (("(gforth)Word Index")) |
| 1103 : | dvdkhlng | 1.61 | "\\S-+"))) |
| 1104 : | dvdkhlng | 1.59 | (unless (memq forth-info-lookup info-lookup-alist) |
| 1105 : | dvdkhlng | 1.61 | (setq info-lookup-alist (cons forth-info-lookup info-lookup-alist))) |
| 1106 : | ;; in X-Emacs C-h C-i is by default bound to Info-query | ||
| 1107 : | (define-key forth-mode-map "\C-h\C-i" 'info-lookup-symbol)) | ||
| 1108 : | |||
| 1109 : | dvdkhlng | 1.59 | |
| 1110 : | ;; (info-lookup-add-help | ||
| 1111 : | ;; :topic 'symbol | ||
| 1112 : | ;; :mode 'forth-mode | ||
| 1113 : | ;; :regexp "[^ | ||
| 1114 : | ;; ]+" | ||
| 1115 : | ;; :ignore-case t | ||
| 1116 : | ;; :doc-spec '(("(gforth)Name Index" nil "`" "' ")))) | ||
| 1117 : | anton | 1.35 | |
| 1118 : | dvdkhlng | 1.57 | (require 'etags) |
| 1119 : | pazsan | 1.13 | |
| 1120 : | (defun forth-find-tag (tagname &optional next-p regexp-p) | ||
| 1121 : | (interactive (find-tag-interactive "Find tag: ")) | ||
| 1122 : | dvdkhlng | 1.53 | (unless (or regexp-p next-p) |
| 1123 : | (setq tagname (concat "\\(^\\|\\s-\\)\\(" (regexp-quote tagname) | ||
| 1124 : | "\\)\\(\\s-\\|$\\)"))) | ||
| 1125 : | pazsan | 1.13 | (switch-to-buffer |
| 1126 : | dvdkhlng | 1.53 | (find-tag-noselect tagname next-p t))) |
| 1127 : | pazsan | 1.13 | |
| 1128 : | anton | 1.1 | (defvar forth-mode-syntax-table nil |
| 1129 : | "Syntax table in use in Forth-mode buffers.") | ||
| 1130 : | |||
| 1131 : | pazsan | 1.48 | ;; Important: hilighting/indentation now depends on a correct syntax table. |
| 1132 : | ;; All characters, except whitespace *must* belong to the "word constituent" | ||
| 1133 : | ;; syntax class. If different behaviour is required, use of Categories might | ||
| 1134 : | ;; help. | ||
| 1135 : | (if (not forth-mode-syntax-table) | ||
| 1136 : | anton | 1.1 | (progn |
| 1137 : | (setq forth-mode-syntax-table (make-syntax-table)) | ||
| 1138 : | anton | 1.6 | (let ((char 0)) |
| 1139 : | (while (< char ?!) | ||
| 1140 : | (modify-syntax-entry char " " forth-mode-syntax-table) | ||
| 1141 : | (setq char (1+ char))) | ||
| 1142 : | (while (< char 256) | ||
| 1143 : | (modify-syntax-entry char "w" forth-mode-syntax-table) | ||
| 1144 : | (setq char (1+ char)))) | ||
| 1145 : | )) | ||
| 1146 : | anton | 1.1 | |
| 1147 : | (defun forth-mode-variables () | ||
| 1148 : | (set-syntax-table forth-mode-syntax-table) | ||
| 1149 : | (setq local-abbrev-table forth-mode-abbrev-table) | ||
| 1150 : | (make-local-variable 'paragraph-start) | ||
| 1151 : | (setq paragraph-start (concat "^$\\|" page-delimiter)) | ||
| 1152 : | (make-local-variable 'paragraph-separate) | ||
| 1153 : | (setq paragraph-separate paragraph-start) | ||
| 1154 : | (make-local-variable 'indent-line-function) | ||
| 1155 : | (setq indent-line-function 'forth-indent-line) | ||
| 1156 : | anton | 1.6 | ; (make-local-variable 'require-final-newline) |
| 1157 : | ; (setq require-final-newline t) | ||
| 1158 : | anton | 1.1 | (make-local-variable 'comment-start) |
| 1159 : | anton | 1.3 | (setq comment-start "\\ ") |
| 1160 : | ;(make-local-variable 'comment-end) | ||
| 1161 : | ;(setq comment-end " )") | ||
| 1162 : | anton | 1.1 | (make-local-variable 'comment-column) |
| 1163 : | (setq comment-column 40) | ||
| 1164 : | (make-local-variable 'comment-start-skip) | ||
| 1165 : | dvdkhlng | 1.65 | (setq comment-start-skip "\\\\ ") |
| 1166 : | dvdkhlng | 1.57 | (make-local-variable 'comment-indent-function) |
| 1167 : | (setq comment-indent-function 'forth-comment-indent) | ||
| 1168 : | anton | 1.1 | (make-local-variable 'parse-sexp-ignore-comments) |
| 1169 : | pazsan | 1.47 | (setq parse-sexp-ignore-comments t) |
| 1170 : | pazsan | 1.48 | (setq case-fold-search t) |
| 1171 : | dvdkhlng | 1.55 | (make-local-variable 'forth-was-point) |
| 1172 : | (setq forth-was-point -1) | ||
| 1173 : | pazsan | 1.48 | (make-local-variable 'forth-words) |
| 1174 : | (make-local-variable 'forth-compiled-words) | ||
| 1175 : | (make-local-variable 'forth-compiled-indent-words) | ||
| 1176 : | (make-local-variable 'forth-hilight-level) | ||
| 1177 : | (make-local-variable 'after-change-functions) | ||
| 1178 : | (make-local-variable 'forth-show-screen) | ||
| 1179 : | (make-local-variable 'forth-screen-marker) | ||
| 1180 : | (make-local-variable 'forth-warn-long-lines) | ||
| 1181 : | dvdkhlng | 1.50 | (make-local-variable 'forth-screen-number-string) |
| 1182 : | dvdkhlng | 1.51 | (make-local-variable 'forth-use-oof) |
| 1183 : | (make-local-variable 'forth-use-objects) | ||
| 1184 : | pazsan | 1.48 | (setq forth-screen-marker (copy-marker 0)) |
| 1185 : | dvdkhlng | 1.51 | (add-hook 'after-change-functions 'forth-change-function) |
| 1186 : | dvdkhlng | 1.62 | (if (and forth-jit-parser (>= emacs-major-version 21)) |
| 1187 : | dvdkhlng | 1.55 | (add-hook 'fontification-functions 'forth-fontification-function)) |
| 1188 : | dvdkhlng | 1.51 | (setq imenu-create-index-function 'forth-create-index)) |
| 1189 : | pazsan | 1.47 | |
| 1190 : | anton | 1.2 | ;;;###autoload |
| 1191 : | anton | 1.1 | (defun forth-mode () |
| 1192 : | " | ||
| 1193 : | Major mode for editing Forth code. Tab indents for Forth code. Comments | ||
| 1194 : | anton | 1.9 | are delimited with \\ and newline. Paragraphs are separated by blank lines |
| 1195 : | dvdkhlng | 1.49 | only. Block files are autodetected, when read, and converted to normal |
| 1196 : | stream source format. See also `forth-block-mode'. | ||
| 1197 : | anton | 1.1 | \\{forth-mode-map} |
| 1198 : | |||
| 1199 : | pazsan | 1.48 | Variables controlling syntax hilighting/recognition of parsed text: |
| 1200 : | `forth-words' | ||
| 1201 : | List of words that have a special parsing behaviour and/or should be | ||
| 1202 : | dvdkhlng | 1.51 | hilighted. Add custom words by setting forth-custom-words in your |
| 1203 : | .emacs, or by setting forth-local-words, in source-files' local | ||
| 1204 : | variables lists. | ||
| 1205 : | forth-use-objects | ||
| 1206 : | dvdkhlng | 1.55 | Set this variable to non-nil in your .emacs, or in a local variables |
| 1207 : | dvdkhlng | 1.51 | list, to hilight and recognize the words from the \"Objects\" package |
| 1208 : | for object-oriented programming. | ||
| 1209 : | forth-use-oof | ||
| 1210 : | Same as above, just for the \"OOF\" package. | ||
| 1211 : | forth-custom-words | ||
| 1212 : | List of custom Forth words to prepend to `forth-words'. Should be set | ||
| 1213 : | in your .emacs. | ||
| 1214 : | dvdkhlng | 1.49 | forth-local-words |
| 1215 : | List of words to prepend to `forth-words', whenever a forth-mode | ||
| 1216 : | buffer is created. That variable should be set by Forth sources, using | ||
| 1217 : | a local variables list at the end of file, to get file-specific | ||
| 1218 : | hilighting. | ||
| 1219 : | 0 [IF] | ||
| 1220 : | Local Variables: ... | ||
| 1221 : | forth-local-words: ... | ||
| 1222 : | End: | ||
| 1223 : | [THEN] | ||
| 1224 : | pazsan | 1.48 | forth-hilight-level |
| 1225 : | Controls how much syntax hilighting is done. Should be in the range | ||
| 1226 : | dvdkhlng | 1.51 | 0..3 |
| 1227 : | pazsan | 1.48 | |
| 1228 : | anton | 1.1 | Variables controlling indentation style: |
| 1229 : | pazsan | 1.48 | `forth-indent-words' |
| 1230 : | List of words that influence indentation. | ||
| 1231 : | dvdkhlng | 1.51 | forth-local-indent-words |
| 1232 : | dvdkhlng | 1.49 | List of words to prepend to `forth-indent-words', similar to |
| 1233 : | dvdkhlng | 1.51 | forth-local-words. Should be used for specifying file-specific |
| 1234 : | dvdkhlng | 1.49 | indentation, using a local variables list. |
| 1235 : | dvdkhlng | 1.51 | forth-custom-indent-words |
| 1236 : | List of words to prepend to `forth-indent-words'. Should be set in your | ||
| 1237 : | .emacs. | ||
| 1238 : | anton | 1.1 | forth-indent-level |
| 1239 : | Indentation increment/decrement of Forth statements. | ||
| 1240 : | pazsan | 1.48 | forth-minor-indent-level |
| 1241 : | Minor indentation increment/decrement of Forth statemens. | ||
| 1242 : | anton | 1.1 | |
| 1243 : | pazsan | 1.48 | Variables controlling block-file editing: |
| 1244 : | dvdkhlng | 1.51 | forth-show-screen |
| 1245 : | pazsan | 1.48 | Non-nil means, that the start of the current screen is marked by an |
| 1246 : | dvdkhlng | 1.50 | overlay arrow, and screen numbers are displayed in the mode line. |
| 1247 : | This variable is by default nil for `forth-mode' and t for | ||
| 1248 : | `forth-block-mode'. | ||
| 1249 : | dvdkhlng | 1.51 | forth-overlay-arrow-string |
| 1250 : | pazsan | 1.48 | String to display as the overlay arrow, when `forth-show-screen' is t. |
| 1251 : | Setting this variable to nil disables the overlay arrow. | ||
| 1252 : | dvdkhlng | 1.51 | forth-block-base |
| 1253 : | pazsan | 1.48 | Screen number of the first block in a block file. Defaults to 1. |
| 1254 : | dvdkhlng | 1.51 | forth-warn-long-lines |
| 1255 : | pazsan | 1.48 | Non-nil means that a warning message is displayed whenever you edit or |
| 1256 : | move over a line that is longer than 64 characters (the maximum line | ||
| 1257 : | length that can be stored into a block file). This variable defaults to | ||
| 1258 : | t for `forth-block-mode' and to nil for `forth-mode'. | ||
| 1259 : | anton | 1.1 | |
| 1260 : | dvdkhlng | 1.66 | Variables controlling interaction with the Forth-process (also see |
| 1261 : | `run-forth'): | ||
| 1262 : | forth-program-name | ||
| 1263 : | Program invoked by the `run-forth' command (including arguments). | ||
| 1264 : | inferior-forth-mode-hook | ||
| 1265 : | Hook for customising inferior-forth-mode. | ||
| 1266 : | forth-compile-command | ||
| 1267 : | Default command to execute on `compile'. | ||
| 1268 : | " | ||
| 1269 : | anton | 1.1 | (interactive) |
| 1270 : | (kill-all-local-variables) | ||
| 1271 : | (use-local-map forth-mode-map) | ||
| 1272 : | (setq mode-name "Forth") | ||
| 1273 : | (setq major-mode 'forth-mode) | ||
| 1274 : | dvdkhlng | 1.62 | (forth-install-motion-hook) |
| 1275 : | pazsan | 1.48 | ;; convert buffer contents from block file format, if necessary |
| 1276 : | (when (forth-detect-block-file-p) | ||
| 1277 : | (widen) | ||
| 1278 : | (message "Converting from Forth block source...") | ||
| 1279 : | (forth-convert-from-block (point-min) (point-max)) | ||
| 1280 : | (message "Converting from Forth block source...done")) | ||
| 1281 : | ;; if user switched from forth-block-mode to forth-mode, make sure the file | ||
| 1282 : | ;; is now stored as normal strem source | ||
| 1283 : | (when (equal buffer-file-format '(forth-blocks)) | ||
| 1284 : | (setq buffer-file-format nil)) | ||
| 1285 : | anton | 1.1 | (forth-mode-variables) |
| 1286 : | ; (if (not (forth-process-running-p)) | ||
| 1287 : | ; (run-forth forth-program-name)) | ||
| 1288 : | dvdkhlng | 1.49 | (run-hooks 'forth-mode-hook)) |
| 1289 : | pazsan | 1.48 | |
| 1290 : | dvdkhlng | 1.50 | ;;;###autoload |
| 1291 : | pazsan | 1.48 | (define-derived-mode forth-block-mode forth-mode "Forth Block Source" |
| 1292 : | "Major mode for editing Forth block source files, derived from | ||
| 1293 : | `forth-mode'. Differences to `forth-mode' are: | ||
| 1294 : | * files are converted to block format, when written (`buffer-file-format' | ||
| 1295 : | is set to `(forth-blocks)') | ||
| 1296 : | * `forth-show-screen' and `forth-warn-long-lines' are t by default | ||
| 1297 : | |||
| 1298 : | Note that the length of lines in block files is limited to 64 characters. | ||
| 1299 : | When writing longer lines to a block file, a warning is displayed in the | ||
| 1300 : | echo area and the line is truncated. | ||
| 1301 : | |||
| 1302 : | Another problem is imposed by block files that contain newline or tab | ||
| 1303 : | characters. When Emacs converts such files back to block file format, | ||
| 1304 : | dvdkhlng | 1.50 | it'll translate those characters to a number of spaces. However, when |
| 1305 : | pazsan | 1.48 | you read such a file, a warning message is displayed in the echo area, |
| 1306 : | including a line number that may help you to locate and fix the problem. | ||
| 1307 : | |||
| 1308 : | So have a look at the *Messages* buffer, whenever you hear (or see) Emacs' | ||
| 1309 : | bell during block file read/write operations." | ||
| 1310 : | (setq buffer-file-format '(forth-blocks)) | ||
| 1311 : | (setq forth-show-screen t) | ||
| 1312 : | dvdkhlng | 1.50 | (setq forth-warn-long-lines t) |
| 1313 : | (setq forth-screen-number-string (format "%d" forth-block-base)) | ||
| 1314 : | (setq mode-line-format (append (reverse (cdr (reverse mode-line-format))) | ||
| 1315 : | '("--S" forth-screen-number-string "-%-")))) | ||
| 1316 : | anton | 1.1 | |
| 1317 : | anton | 1.44 | (add-hook 'forth-mode-hook |
| 1318 : | anton | 1.9 | '(lambda () |
| 1319 : | (make-local-variable 'compile-command) | ||
| 1320 : | dvdkhlng | 1.49 | (setq compile-command "gforth ") |
| 1321 : | (forth-hack-local-variables) | ||
| 1322 : | dvdkhlng | 1.51 | (forth-customize-words) |
| 1323 : | dvdkhlng | 1.49 | (forth-compile-words) |
| 1324 : | dvdkhlng | 1.55 | (unless (and forth-jit-parser (>= emacs-major-version 21)) |
| 1325 : | (forth-change-function (point-min) (point-max) nil t)))) | ||
| 1326 : | anton | 1.6 | |
| 1327 : | anton | 1.7 | (defun forth-fill-paragraph () |
| 1328 : | "Fill comments (starting with '\'; do not fill code (block style | ||
| 1329 : | programmers who tend to fill code won't use emacs anyway:-)." | ||
| 1330 : | anton | 1.9 | ; Currently only comments at the start of the line are filled. |
| 1331 : | ; Something like lisp-fill-paragraph may be better. We cannot use | ||
| 1332 : | ; fill-paragraph, because it removes the \ from the first comment | ||
| 1333 : | ; line. Therefore we have to look for the first line of the comment | ||
| 1334 : | ; and use fill-region. | ||
| 1335 : | anton | 1.7 | (interactive) |
| 1336 : | (save-excursion | ||
| 1337 : | (beginning-of-line) | ||
| 1338 : | anton | 1.9 | (while (and |
| 1339 : | (= (forward-line -1) 0) | ||
| 1340 : | anton | 1.14 | (looking-at "[ \t]*\\\\g?[ \t]+"))) |
| 1341 : | (if (not (looking-at "[ \t]*\\\\g?[ \t]+")) | ||
| 1342 : | anton | 1.9 | (forward-line 1)) |
| 1343 : | (let ((from (point)) | ||
| 1344 : | (to (save-excursion (forward-paragraph) (point)))) | ||
| 1345 : | anton | 1.14 | (if (looking-at "[ \t]*\\\\g?[ \t]+") |
| 1346 : | anton | 1.9 | (progn (goto-char (match-end 0)) |
| 1347 : | (set-fill-prefix) | ||
| 1348 : | (fill-region from to nil)))))) | ||
| 1349 : | anton | 1.7 | |
| 1350 : | anton | 1.1 | (defun forth-comment-indent () |
| 1351 : | (save-excursion | ||
| 1352 : | (beginning-of-line) | ||
| 1353 : | (if (looking-at ":[ \t]*") | ||
| 1354 : | (progn | ||
| 1355 : | (end-of-line) | ||
| 1356 : | (skip-chars-backward " \t\n") | ||
| 1357 : | (1+ (current-column))) | ||
| 1358 : | comment-column))) | ||
| 1359 : | |||
| 1360 : | |||
| 1361 : | ;; Forth commands | ||
| 1362 : | |||
| 1363 : | anton | 1.7 | (defun forth-remove-tracers () |
| 1364 : | "Remove tracers of the form `~~ '. Queries the user for each occurrence." | ||
| 1365 : | (interactive) | ||
| 1366 : | anton | 1.16 | (query-replace-regexp "\\(~~ \\| ~~$\\)" "" nil)) |
| 1367 : | anton | 1.7 | |
| 1368 : | dvdkhlng | 1.66 | (define-key forth-mode-map "\C-x\C-e" 'compile) |
| 1369 : | (define-key forth-mode-map "\C-x\C-n" 'next-error) | ||
| 1370 : | (require 'compile) | ||
| 1371 : | anton | 1.1 | |
| 1372 : | dvdkhlng | 1.66 | (defvar forth-compile-command "gforth ") |
| 1373 : | ;(defvar forth-compilation-window-percent-height 30) | ||
| 1374 : | anton | 1.1 | |
| 1375 : | (defun forth-split () | ||
| 1376 : | (interactive) | ||
| 1377 : | (forth-split-1 "*forth*")) | ||
| 1378 : | |||
| 1379 : | (defun forth-split-1 (buffer) | ||
| 1380 : | (if (not (eq (window-buffer) (get-buffer buffer))) | ||
| 1381 : | (progn | ||
| 1382 : | (delete-other-windows) | ||
| 1383 : | (split-window-vertically | ||
| 1384 : | (/ (* (screen-height) forth-percent-height) 100)) | ||
| 1385 : | (other-window 1) | ||
| 1386 : | (switch-to-buffer buffer) | ||
| 1387 : | (goto-char (point-max)) | ||
| 1388 : | (other-window 1)))) | ||
| 1389 : | |||
| 1390 : | (defun forth-compile (command) | ||
| 1391 : | (interactive (list (setq forth-compile-command (read-string "Compile command: " forth-compile-command)))) | ||
| 1392 : | (forth-split-1 "*compilation*") | ||
| 1393 : | (setq ctools-compile-command command) | ||
| 1394 : | (compile1 ctools-compile-command "No more errors")) | ||
| 1395 : | |||
| 1396 : | pazsan | 1.12 | ;;; Forth menu |
| 1397 : | ;;; Mikael Karlsson <qramika@eras70.ericsson.se> | ||
| 1398 : | |||
| 1399 : | dvdkhlng | 1.61 | ;; (dk) code commented out due to complaints of XEmacs users. After |
| 1400 : | ;; all, there's imenu/speedbar, which uses much smarter scanning | ||
| 1401 : | ;; rules. | ||
| 1402 : | |||
| 1403 : | ;; (cond ((string-match "XEmacs\\|Lucid" emacs-version) | ||
| 1404 : | ;; (require 'func-menu) | ||
| 1405 : | |||
| 1406 : | ;; (defconst fume-function-name-regexp-forth | ||
| 1407 : | ;; "^\\(:\\)[ \t]+\\([^ \t]*\\)" | ||
| 1408 : | ;; "Expression to get word definitions in Forth.") | ||
| 1409 : | |||
| 1410 : | ;; (setq fume-function-name-regexp-alist | ||
| 1411 : | ;; (append '((forth-mode . fume-function-name-regexp-forth) | ||
| 1412 : | ;; ) fume-function-name-regexp-alist)) | ||
| 1413 : | |||
| 1414 : | ;; ;; Find next forth word in the buffer | ||
| 1415 : | ;; (defun fume-find-next-forth-function-name (buffer) | ||
| 1416 : | ;; "Searches for the next forth word in BUFFER." | ||
| 1417 : | ;; (set-buffer buffer) | ||
| 1418 : | ;; (if (re-search-forward fume-function-name-regexp nil t) | ||
| 1419 : | ;; (let ((beg (match-beginning 2)) | ||
| 1420 : | ;; (end (match-end 2))) | ||
| 1421 : | ;; (cons (buffer-substring beg end) beg)))) | ||
| 1422 : | pazsan | 1.12 | |
| 1423 : | dvdkhlng | 1.61 | ;; (setq fume-find-function-name-method-alist |
| 1424 : | ;; (append '((forth-mode . fume-find-next-forth-function-name)))) | ||
| 1425 : | pazsan | 1.12 | |
| 1426 : | dvdkhlng | 1.61 | ;; )) |
| 1427 : | pazsan | 1.12 | ;;; End Forth menu |
| 1428 : | |||
| 1429 : | ;;; File folding of forth-files | ||
| 1430 : | ;;; uses outline | ||
| 1431 : | ;;; Toggle activation with M-x fold-f (when editing a forth-file) | ||
| 1432 : | ;;; Use f9 to expand, f10 to hide, Or the menubar in xemacs | ||
| 1433 : | ;;; | ||
| 1434 : | ;;; Works most of the times but loses sync with the cursor occasionally | ||
| 1435 : | ;;; Could be improved by also folding on comments | ||
| 1436 : | |||
| 1437 : | dvdkhlng | 1.61 | ;; (dk) This code needs a rewrite; just too ugly and doesn't use the |
| 1438 : | ;; newer and smarter scanning rules of `imenu'. Who needs it anyway?? | ||
| 1439 : | pazsan | 1.12 | |
| 1440 : | dvdkhlng | 1.61 | ;; (require 'outline) |
| 1441 : | |||
| 1442 : | ;; (defun f-outline-level () | ||
| 1443 : | ;; (cond ((looking-at "\\`\\\\") | ||
| 1444 : | ;; 0) | ||
| 1445 : | ;; ((looking-at "\\\\ SEC") | ||
| 1446 : | ;; 0) | ||
| 1447 : | ;; ((looking-at "\\\\ \\\\ .*") | ||
| 1448 : | ;; 0) | ||
| 1449 : | ;; ((looking-at "\\\\ DEFS") | ||
| 1450 : | ;; 1) | ||
| 1451 : | ;; ((looking-at "\\/\\* ") | ||
| 1452 : | ;; 1) | ||
| 1453 : | ;; ((looking-at ": .*") | ||
| 1454 : | ;; 1) | ||
| 1455 : | ;; ((looking-at "\\\\G") | ||
| 1456 : | ;; 2) | ||
| 1457 : | ;; ((looking-at "[ \t]+\\\\") | ||
| 1458 : | ;; 3))) | ||
| 1459 : | dvdkhlng | 1.57 | |
| 1460 : | dvdkhlng | 1.61 | ;; (defun fold-f () |
| 1461 : | ;; (interactive) | ||
| 1462 : | ;; (add-hook 'outline-minor-mode-hook 'hide-body) | ||
| 1463 : | |||
| 1464 : | ;; ; outline mode header start, i.e. find word definitions | ||
| 1465 : | ;; ;;; (setq outline-regexp "^\\(:\\)[ \t]+\\([^ \t]*\\)") | ||
| 1466 : | ;; (setq outline-regexp "\\`\\\\\\|:\\|\\\\ SEC\\|\\\\G\\|[ \t]+\\\\\\|\\\\ DEFS\\|\\/\\*\\|\\\\ \\\\ .*") | ||
| 1467 : | ;; (setq outline-level 'f-outline-level) | ||
| 1468 : | |||
| 1469 : | ;; (outline-minor-mode) | ||
| 1470 : | ;; (define-key outline-minor-mode-map '(shift up) 'hide-sublevels) | ||
| 1471 : | ;; (define-key outline-minor-mode-map '(shift right) 'show-children) | ||
| 1472 : | ;; (define-key outline-minor-mode-map '(shift left) 'hide-subtree) | ||
| 1473 : | ;; (define-key outline-minor-mode-map '(shift down) 'show-subtree)) | ||
| 1474 : | |||
| 1475 : | pazsan | 1.29 | |
| 1476 : | ;;(define-key global-map '(shift up) 'fold-f) | ||
| 1477 : | |||
| 1478 : | pazsan | 1.12 | ;;; end file folding |
| 1479 : | |||
| 1480 : | ;;; func-menu is a package that scans your source file for function definitions | ||
| 1481 : | ;;; and makes a menubar entry that lets you jump to any particular function | ||
| 1482 : | ;;; definition by selecting it from the menu. The following code turns this on | ||
| 1483 : | ;;; for all of the recognized languages. Scanning the buffer takes some time, | ||
| 1484 : | ;;; but not much. | ||
| 1485 : | ;;; | ||
| 1486 : | dvdkhlng | 1.61 | ;; (cond ((string-match "XEmacs\\|Lucid" emacs-version) |
| 1487 : | ;; (require 'func-menu) | ||
| 1488 : | ;; ;; (define-key global-map 'f8 'function-menu) | ||
| 1489 : | ;; (add-hook 'find-fible-hooks 'fume-add-menubar-entry) | ||
| 1490 : | ;; ; (define-key global-map "\C-cg" 'fume-prompt-function-goto) | ||
| 1491 : | ;; ; (define-key global-map '(shift button3) 'mouse-function-menu) | ||
| 1492 : | ;; )) | ||
| 1493 : | dvdkhlng | 1.66 | |
| 1494 : | ;;; | ||
| 1495 : | ;;; Inferior Forth interpreter | ||
| 1496 : | ;;; -- mostly copied from `cmuscheme.el' of Emacs 21.2 | ||
| 1497 : | ;;; | ||
| 1498 : | |||
| 1499 : | (eval-and-compile (forth-require 'comint)) | ||
| 1500 : | |||
| 1501 : | (when (memq 'comint features) | ||
| 1502 : | |||
| 1503 : | (defvar forth-program-name "gforth" | ||
| 1504 : | "*Program invoked by the `run-forth' command, including program arguments") | ||
| 1505 : | |||
| 1506 : | (defcustom inferior-forth-mode-hook nil | ||
| 1507 : | "*Hook for customising inferior-forth-mode." | ||
| 1508 : | :type 'hook | ||
| 1509 : | :group 'forth) | ||
| 1510 : | |||
| 1511 : | (defvar inferior-forth-mode-map | ||
| 1512 : | (let ((m (make-sparse-keymap))) | ||
| 1513 : | (define-key m "\r" 'comint-send-input) | ||
| 1514 : | (define-key m "\M-\C-x" 'forth-send-paragraph-and-go) | ||
| 1515 : | (define-key m "\C-c\C-l" 'forth-load-file) | ||
| 1516 : | m)) | ||
| 1517 : | ;; Install the process communication commands in the forth-mode keymap. | ||
| 1518 : | (define-key forth-mode-map "\e\C-m" 'forth-send-paragraph-and-go) | ||
| 1519 : | (define-key forth-mode-map "\eo" 'forth-send-buffer-and-go) | ||
| 1520 : | |||
| 1521 : | (define-key forth-mode-map "\M-\C-x" 'forth-send-paragraph-and-go) | ||
| 1522 : | (define-key forth-mode-map "\C-c\C-r" 'forth-send-region) | ||
| 1523 : | (define-key forth-mode-map "\C-c\M-r" 'forth-send-region-and-go) | ||
| 1524 : | (define-key forth-mode-map "\C-c\C-z" 'forth-switch-to-interactive) | ||
| 1525 : | (define-key forth-mode-map "\C-c\C-l" 'forth-load-file) | ||
| 1526 : | |||
| 1527 : | (defvar forth-process-buffer) | ||
| 1528 : | |||
| 1529 : | (define-derived-mode inferior-forth-mode comint-mode "Inferior Forth" | ||
| 1530 : | "Major mode for interacting with an inferior Forth process. | ||
| 1531 : | |||
| 1532 : | The following commands are available: | ||
| 1533 : | \\{inferior-forth-mode-map} | ||
| 1534 : | |||
| 1535 : | A Forth process can be fired up with M-x run-forth. | ||
| 1536 : | |||
| 1537 : | Customisation: Entry to this mode runs the hooks on comint-mode-hook and | ||
| 1538 : | inferior-forth-mode-hook (in that order). | ||
| 1539 : | |||
| 1540 : | You can send text to the inferior Forth process from other buffers containing | ||
| 1541 : | Forth source. | ||
| 1542 : | forth-switch-to-interactive switches the current buffer to the Forth | ||
| 1543 : | process buffer. | ||
| 1544 : | forth-send-paragraph sends the current paragraph to the Forth process. | ||
| 1545 : | forth-send-region sends the current region to the Forth process. | ||
| 1546 : | forth-send-buffer sends the current buffer to the Forth process. | ||
| 1547 : | |||
| 1548 : | forth-send-paragraph-and-go, forth-send-region-and-go, | ||
| 1549 : | forth-send-buffer-and-go switch to the Forth process buffer after | ||
| 1550 : | sending their text. | ||
| 1551 : | For information on running multiple processes in multiple buffers, see | ||
| 1552 : | documentation for variable `forth-process-buffer'. | ||
| 1553 : | |||
| 1554 : | Commands: | ||
| 1555 : | Return after the end of the process' output sends the text from the | ||
| 1556 : | end of process to point. If you accidentally suspend your process, use | ||
| 1557 : | \\[comint-continue-subjob] to continue it. " | ||
| 1558 : | ;; Customise in inferior-forth-mode-hook | ||
| 1559 : | (setq comint-prompt-regexp "^") | ||
| 1560 : | (setq mode-line-process '(":%s"))) | ||
| 1561 : | |||
| 1562 : | (defun forth-args-to-list (string) | ||
| 1563 : | (let ((where (string-match "[ \t]" string))) | ||
| 1564 : | (cond ((null where) (list string)) | ||
| 1565 : | ((not (= where 0)) | ||
| 1566 : | (cons (substring string 0 where) | ||
| 1567 : | (forth-args-to-list (substring string (+ 1 where) | ||
| 1568 : | (length string))))) | ||
| 1569 : | (t (let ((pos (string-match "[^ \t]" string))) | ||
| 1570 : | (if (null pos) | ||
| 1571 : | nil | ||
| 1572 : | (forth-args-to-list (substring string pos | ||
| 1573 : | (length string))))))))) | ||
| 1574 : | |||
| 1575 : | ;;;###autoload | ||
| 1576 : | (defun run-forth (cmd) | ||
| 1577 : | "Run an inferior Forth process, input and output via buffer *forth*. | ||
| 1578 : | If there is a process already running in `*forth*', switch to that buffer. | ||
| 1579 : | With argument, allows you to edit the command line (default is value | ||
| 1580 : | of `forth-program-name'). Runs the hooks `inferior-forth-mode-hook' | ||
| 1581 : | \(after the `comint-mode-hook' is run). | ||
| 1582 : | \(Type \\[describe-mode] in the process buffer for a list of commands.)" | ||
| 1583 : | |||
| 1584 : | (interactive (list (if current-prefix-arg | ||
| 1585 : | (read-string "Run Forth: " forth-program-name) | ||
| 1586 : | forth-program-name))) | ||
| 1587 : | (if (not (comint-check-proc "*forth*")) | ||
| 1588 : | (let ((cmdlist (forth-args-to-list cmd))) | ||
| 1589 : | (set-buffer (apply 'make-comint "forth" (car cmdlist) | ||
| 1590 : | nil (cdr cmdlist))) | ||
| 1591 : | (inferior-forth-mode))) | ||
| 1592 : | (setq forth-program-name cmd) | ||
| 1593 : | (setq forth-process-buffer "*forth*") | ||
| 1594 : | (pop-to-buffer "*forth*")) | ||
| 1595 : | |||
| 1596 : | (defun forth-send-region (start end) | ||
| 1597 : | "Send the current region to the inferior Forth process." | ||
| 1598 : | (interactive "r") | ||
| 1599 : | (comint-send-region (forth-proc) start end) | ||
| 1600 : | (comint-send-string (forth-proc) "\n")) | ||
| 1601 : | |||
| 1602 : | (defun forth-end-of-paragraph () | ||
| 1603 : | (if (looking-at "[\t\n ]+") (skip-chars-backward "\t\n ")) | ||
| 1604 : | (if (not (re-search-forward "\n[ \t]*\n" nil t)) | ||
| 1605 : | (goto-char (point-max)))) | ||
| 1606 : | |||
| 1607 : | (defun forth-send-paragraph () | ||
| 1608 : | "Send the current or the previous paragraph to the Forth process" | ||
| 1609 : | (interactive) | ||
| 1610 : | (let (end) | ||
| 1611 : | (save-excursion | ||
| 1612 : | (forth-end-of-paragraph) | ||
| 1613 : | (skip-chars-backward "\t\n ") | ||
| 1614 : | (setq end (point)) | ||
| 1615 : | (if (re-search-backward "\n[ \t]*\n" nil t) | ||
| 1616 : | (setq start (point)) | ||
| 1617 : | (goto-char (point-min))) | ||
| 1618 : | (skip-chars-forward "\t\n ") | ||
| 1619 : | (forth-send-region (point) end)))) | ||
| 1620 : | |||
| 1621 : | (defun forth-send-paragraph-and-go () | ||
| 1622 : | "Send the current or the previous paragraph to the Forth process. | ||
| 1623 : | Then switch to the process buffer." | ||
| 1624 : | (interactive) | ||
| 1625 : | (forth-send-paragraph) | ||
| 1626 : | (forth-switch-to-interactive t)) | ||
| 1627 : | |||
| 1628 : | (defun forth-send-buffer () | ||
| 1629 : | "Send the current buffer to the Forth process." | ||
| 1630 : | (interactive) | ||
| 1631 : | (if (eq (current-buffer) forth-process-buffer) | ||
| 1632 : | (error "Not allowed to send this buffer's contents to Forth")) | ||
| 1633 : | (forth-send-region (point-min) (point-max))) | ||
| 1634 : | |||
| 1635 : | (defun forth-send-buffer-and-go () | ||
| 1636 : | "Send the current buffer to the Forth process. | ||
| 1637 : | Then switch to the process buffer." | ||
| 1638 : | (interactive) | ||
| 1639 : | (forth-send-buffer) | ||
| 1640 : | (forth-switch-to-interactive t)) | ||
| 1641 : | |||
| 1642 : | |||
| 1643 : | (defun forth-switch-to-interactive (eob-p) | ||
| 1644 : | "Switch to the Forth process buffer. | ||
| 1645 : | With argument, position cursor at end of buffer." | ||
| 1646 : | (interactive "P") | ||
| 1647 : | (if (get-buffer forth-process-buffer) | ||
| 1648 : | (pop-to-buffer forth-process-buffer) | ||
| 1649 : | (error "No current process buffer. See variable `forth-process-buffer'")) | ||
| 1650 : | (cond (eob-p | ||
| 1651 : | (push-mark) | ||
| 1652 : | (goto-char (point-max))))) | ||
| 1653 : | |||
| 1654 : | (defun forth-send-region-and-go (start end) | ||
| 1655 : | "Send the current region to the inferior Forth process. | ||
| 1656 : | Then switch to the process buffer." | ||
| 1657 : | (interactive "r") | ||
| 1658 : | (forth-send-region start end) | ||
| 1659 : | (forth-switch-to-interactive t)) | ||
| 1660 : | |||
| 1661 : | (defcustom forth-source-modes '(forth-mode forth-block-mode) | ||
| 1662 : | "*Used to determine if a buffer contains Forth source code. | ||
| 1663 : | If it's loaded into a buffer that is in one of these major modes, it's | ||
| 1664 : | considered a Forth source file by `forth-load-file' and `forth-compile-file'. | ||
| 1665 : | Used by these commands to determine defaults." | ||
| 1666 : | :type '(repeat function) | ||
| 1667 : | :group 'forth) | ||
| 1668 : | |||
| 1669 : | (defvar forth-prev-l/c-dir/file nil | ||
| 1670 : | "Caches the last (directory . file) pair. | ||
| 1671 : | Caches the last pair used in the last `forth-load-file' or | ||
| 1672 : | `forth-compile-file' command. Used for determining the default in the | ||
| 1673 : | next one.") | ||
| 1674 : | |||
| 1675 : | (defun forth-load-file (file-name) | ||
| 1676 : | "Load a Forth file FILE-NAME into the inferior Forth process." | ||
| 1677 : | (interactive (comint-get-source "Load Forth file: " forth-prev-l/c-dir/file | ||
| 1678 : | forth-source-modes t)) ; T because LOAD | ||
| 1679 : | ; needs an exact name | ||
| 1680 : | (comint-check-source file-name) ; Check to see if buffer needs saved. | ||
| 1681 : | (setq forth-prev-l/c-dir/file (cons (file-name-directory file-name) | ||
| 1682 : | (file-name-nondirectory file-name))) | ||
| 1683 : | (comint-send-string (forth-proc) (concat "(load \"" | ||
| 1684 : | file-name | ||
| 1685 : | "\"\)\n"))) | ||
| 1686 : | |||
| 1687 : | |||
| 1688 : | |||
| 1689 : | (defvar forth-process-buffer nil "*The current Forth process buffer. | ||
| 1690 : | |||
| 1691 : | See `scheme-buffer' for an explanation on how to run multiple Forth | ||
| 1692 : | processes.") | ||
| 1693 : | |||
| 1694 : | (defun forth-proc () | ||
| 1695 : | "Return the current Forth process. See variable `forth-process-buffer'." | ||
| 1696 : | (let ((proc (get-buffer-process (if (eq major-mode 'inferior-forth-mode) | ||
| 1697 : | (current-buffer) | ||
| 1698 : | forth-process-buffer)))) | ||
| 1699 : | (or proc | ||
| 1700 : | (error "No current process. See variable `forth-process-buffer'")))) | ||
| 1701 : | ) ; (memq 'comint features) | ||
| 1702 : | dvdkhlng | 1.57 | |
| 1703 : | (provide 'forth-mode) | ||
| 1704 : | pazsan | 1.29 | |
| 1705 : | pazsan | 1.48 | ;;; gforth.el ends here |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |