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