gforth/gforth.el - view

File: [gforth] / gforth / gforth.el
Revision 1.12: download - view: text, annotated - select for diffs
Sun Aug 27 19:56:30 1995 UTC (28 years, 7 months ago) by pazsan
Branches: MAIN
CVS tags: HEAD

Made kernal generation saver
added automatic creation of makefile.dos
newer version texinfo.tex
fixed some inconsistencies (don't know, what happend with model?)

1: ;; This file is part of GNU Emacs. 2: ;; Changes by anton 3: ;; This is a variant of forth.el that came with TILE. 4: ;; I left most of this stuff untouched and made just a few changes for 5: ;; the things I use (mainly indentation and syntax tables). 6: ;; So there is still a lot of work to do to adapt this to gforth. 7: 8: ;; GNU Emacs is distributed in the hope that it will be useful, 9: ;; but WITHOUT ANY WARRANTY. No author or distributor 10: ;; accepts responsibility to anyone for the consequences of using it 11: ;; or for whether it serves any particular purpose or works at all, 12: ;; unless he says so in writing. Refer to the GNU Emacs General Public 13: ;; License for full details. 14: 15: ;; Everyone is granted permission to copy, modify and redistribute 16: ;; GNU Emacs, but only under the conditions described in the 17: ;; GNU Emacs General Public License. A copy of this license is 18: ;; supposed to have been given to you along with GNU Emacs so you 19: ;; can know your rights and responsibilities. It should be in a 20: ;; file named COPYING. Among other things, the copyright notice 21: ;; and this notice must be preserved on all copies. 22: 23: ;;; $Header: /nfs/unsafe/cvs-repository/src-master/gforth/gforth.el,v 1.12 1995/08/27 19:56:30 pazsan Exp $ 24: 25: ;;------------------------------------------------------------------- 26: ;; A Forth indentation, documentation search and interaction library 27: ;;------------------------------------------------------------------- 28: ;; 29: ;; Written by Goran Rydqvist, gorry@ida.liu.se, Summer 1988 30: ;; Started: 16 July 88 31: ;; Version: 2.10 32: ;; Last update: 5 December 1989 by Mikael Patel, mip@ida.liu.se 33: ;; Last update: 25 June 1990 by Goran Rydqvist, gorry@ida.liu.se 34: ;; 35: ;; Documentation: See forth-mode (^HF forth-mode) 36: ;;------------------------------------------------------------------- 37: 38: 39: (defvar forth-positives 40: " : :noname begin do ?do while if ?dup-if ?dup-not-if else case create does> exception> struct [if] [else] " 41: "Contains all words which will cause the indent-level to be incremented 42: on the next line. 43: OBS! All words in forth-positives must be surrounded by spaces.") 44: 45: (defvar forth-negatives 46: " ; until repeat while +loop loop s+loop else then endif again endcase does> end-struct [then] [else] [endif]" 47: "Contains all words which will cause the indent-level to be decremented 48: on the current line. 49: OBS! All words in forth-negatives must be surrounded by spaces.") 50: 51: (defvar forth-zeroes 52: " : :noname " 53: "Contains all words which causes the indent to go to zero") 54: 55: (defvar forth-prefixes 56: " postpone [compile] ['] [char] " 57: "words that prefix and escape other words") 58: 59: (defvar forth-mode-abbrev-table nil 60: "Abbrev table in use in Forth-mode buffers.") 61: 62: (define-abbrev-table 'forth-mode-abbrev-table ()) 63: 64: (defvar forth-mode-map nil 65: "Keymap used in Forth mode.") 66: 67: (if (not forth-mode-map) 68: (setq forth-mode-map (make-sparse-keymap))) 69: 70: (global-set-key "\e\C-m" 'forth-send-paragraph) 71: (global-set-key "\C-x\C-m" 'forth-split) 72: (global-set-key "\e " 'forth-reload) 73: 74: ;(define-key forth-mode-map "\M-\C-x" 'compile) 75: (define-key forth-mode-map "\C-x\\" 'comment-region) 76: (define-key forth-mode-map "\C-x~" 'forth-remove-tracers) 77: (define-key forth-mode-map "\e\C-m" 'forth-send-paragraph) 78: (define-key forth-mode-map "\eo" 'forth-send-buffer) 79: (define-key forth-mode-map "\C-x\C-m" 'forth-split) 80: (define-key forth-mode-map "\e " 'forth-reload) 81: (define-key forth-mode-map "\t" 'forth-indent-command) 82: (define-key forth-mode-map "\C-m" 'reindent-then-newline-and-indent) 83: (define-key forth-mode-map "\M-q" 'forth-fill-paragraph) 84: 85: (defvar forth-mode-syntax-table nil 86: "Syntax table in use in Forth-mode buffers.") 87: 88: (if (not forth-mode-syntax-table) 89: (progn 90: (setq forth-mode-syntax-table (make-syntax-table)) 91: (let ((char 0)) 92: (while (< char ?!) 93: (modify-syntax-entry char " " forth-mode-syntax-table) 94: (setq char (1+ char))) 95: (while (< char 256) 96: (modify-syntax-entry char "w" forth-mode-syntax-table) 97: (setq char (1+ char)))) 98: (modify-syntax-entry ?\" "\"" forth-mode-syntax-table) 99: (modify-syntax-entry ?\\ "<" forth-mode-syntax-table) 100: (modify-syntax-entry ?\n ">" forth-mode-syntax-table) 101: )) 102: ;I do not define '(' and ')' as comment delimiters, because emacs 103: ;only supports one comment syntax (and a hack to accomodate C++); I 104: ;use '\' for natural language comments and '(' for formal comments 105: ;like stack comments, so for me it's better to have emacs treat '\' 106: ;comments as comments. I you want it different, make the appropriate 107: ;changes (best in your .emacs file). 108: ; 109: ;Hmm, the C++ hack could be used to support both comment syntaxes: we 110: ;can have different comment styles, if both comments start with the 111: ;same character. we could use ' ' as first and '(' and '\' as second 112: ;character. However this would fail for G\ comments. 113: 114: (defconst forth-indent-level 4 115: "Indentation of Forth statements.") 116: 117: (defun forth-mode-variables () 118: (set-syntax-table forth-mode-syntax-table) 119: (setq local-abbrev-table forth-mode-abbrev-table) 120: (make-local-variable 'paragraph-start) 121: (setq paragraph-start (concat "^$\\|" page-delimiter)) 122: (make-local-variable 'paragraph-separate) 123: (setq paragraph-separate paragraph-start) 124: (make-local-variable 'indent-line-function) 125: (setq indent-line-function 'forth-indent-line) 126: ; (make-local-variable 'require-final-newline) 127: ; (setq require-final-newline t) 128: (make-local-variable 'comment-start) 129: (setq comment-start "\\ ") 130: ;(make-local-variable 'comment-end) 131: ;(setq comment-end " )") 132: (make-local-variable 'comment-column) 133: (setq comment-column 40) 134: (make-local-variable 'comment-start-skip) 135: (setq comment-start-skip "\\ ") 136: (make-local-variable 'comment-indent-hook) 137: (setq comment-indent-hook 'forth-comment-indent) 138: (make-local-variable 'parse-sexp-ignore-comments) 139: (setq parse-sexp-ignore-comments t)) 140: 141: ;;;###autoload 142: (defun forth-mode () 143: " 144: Major mode for editing Forth code. Tab indents for Forth code. Comments 145: are delimited with \\ and newline. Paragraphs are separated by blank lines 146: only. Delete converts tabs to spaces as it moves back. 147: \\{forth-mode-map} 148: Forth-split 149: Positions the current buffer on top and a forth-interaction window 150: below. The window size is controlled by the forth-percent-height 151: variable (see below). 152: Forth-reload 153: Reloads the forth library and restarts the forth process. 154: Forth-send-buffer 155: Sends the current buffer, in text representation, as input to the 156: forth process. 157: Forth-send-paragraph 158: Sends the previous or the current paragraph to the forth-process. 159: Note that the cursor only need to be with in the paragraph to be sent. 160: forth-documentation 161: Search for documentation of forward adjacent to cursor. Note! To use 162: this mode you have to add a line, to your .emacs file, defining the 163: directories to search through for documentation files (se variable 164: forth-help-load-path below) e.g. (setq forth-help-load-path '(nil)). 165: 166: Variables controlling interaction and startup 167: forth-percent-height 168: Tells split how high to make the edit portion, in percent of the 169: current screen height. 170: forth-program-name 171: Tells the library which program name to execute in the interation 172: window. 173: 174: Variables controlling indentation style: 175: forth-positives 176: A string containing all words which causes the indent-level of the 177: following line to be incremented. 178: OBS! Each word must be surronded by spaces. 179: forth-negatives 180: A string containing all words which causes the indentation of the 181: current line to be decremented, if the word begin the line. These 182: words also has a cancelling effect on the indent-level of the 183: following line, independent of position. 184: OBS! Each word must be surronded by spaces. 185: forth-zeroes 186: A string containing all words which causes the indentation of the 187: current line to go to zero, if the word begin the line. 188: OBS! Each word must be surronded by spaces. 189: forth-indent-level 190: Indentation increment/decrement of Forth statements. 191: 192: Note! A word which decrements the indentation of the current line, may 193: also be mentioned in forth-positives to cause the indentation to 194: resume the previous level. 195: 196: Variables controling documentation search 197: forth-help-load-path 198: List of directories to search through to find *.doc 199: (forth-help-file-suffix) files. Nil means current default directory. 200: The specified directories must contain at least one .doc file. If it 201: does not and you still want the load-path to scan that directory, create 202: an empty file dummy.doc. 203: forth-help-file-suffix 204: The file names to search for in each directory specified by 205: forth-help-load-path. Defaulted to '*.doc'. 206: " 207: (interactive) 208: (kill-all-local-variables) 209: (use-local-map forth-mode-map) 210: (setq mode-name "Forth") 211: (setq major-mode 'forth-mode) 212: (forth-mode-variables) 213: ; (if (not (forth-process-running-p)) 214: ; (run-forth forth-program-name)) 215: (run-hooks 'forth-mode-hook)) 216: 217: (setq forth-mode-hook 218: '(lambda () 219: (make-local-variable 'compile-command) 220: (setq compile-command "gforth "))) 221: 222: (defun forth-fill-paragraph () 223: "Fill comments (starting with '\'; do not fill code (block style 224: programmers who tend to fill code won't use emacs anyway:-)." 225: ; Currently only comments at the start of the line are filled. 226: ; Something like lisp-fill-paragraph may be better. We cannot use 227: ; fill-paragraph, because it removes the \ from the first comment 228: ; line. Therefore we have to look for the first line of the comment 229: ; and use fill-region. 230: (interactive) 231: (save-excursion 232: (beginning-of-line) 233: (while (and 234: (= (forward-line -1) 0) 235: (looking-at "[ \t]*\\\\[ \t]+"))) 236: (if (not (looking-at "[ \t]*\\\\[ \t]+")) 237: (forward-line 1)) 238: (let ((from (point)) 239: (to (save-excursion (forward-paragraph) (point)))) 240: (if (looking-at "[ \t]*\\\\[ \t]+") 241: (progn (goto-char (match-end 0)) 242: (set-fill-prefix) 243: (fill-region from to nil)))))) 244: 245: (defun forth-comment-indent () 246: (save-excursion 247: (beginning-of-line) 248: (if (looking-at ":[ \t]*") 249: (progn 250: (end-of-line) 251: (skip-chars-backward " \t\n") 252: (1+ (current-column))) 253: comment-column))) 254: 255: (defun forth-current-indentation () 256: (save-excursion 257: (beginning-of-line) 258: (back-to-indentation) 259: (current-column))) 260: 261: (defun forth-delete-indentation () 262: (let ((b nil) (m nil)) 263: (save-excursion 264: (beginning-of-line) 265: (setq b (point)) 266: (back-to-indentation) 267: (setq m (point))) 268: (delete-region b m))) 269: 270: (defun forth-indent-line (&optional flag) 271: "Correct indentation of the current Forth line." 272: (let ((x (forth-calculate-indent))) 273: (forth-indent-to x))) 274: 275: (defun forth-indent-command () 276: (interactive) 277: (forth-indent-line t)) 278: 279: (defun forth-indent-to (x) 280: (let ((p nil)) 281: (setq p (- (current-column) (forth-current-indentation))) 282: (forth-delete-indentation) 283: (beginning-of-line) 284: (indent-to x) 285: (if (> p 0) (forward-char p)))) 286: 287: ;;Calculate indent 288: (defun forth-calculate-indent () 289: (let ((w1 nil) (indent 0) (centre 0)) 290: (save-excursion 291: (beginning-of-line) 292: (skip-chars-backward " \t\n") 293: (beginning-of-line) 294: (back-to-indentation) 295: (setq indent (current-column)) 296: (setq centre indent) 297: (setq indent (+ indent (forth-sum-line-indentation)))) 298: (save-excursion 299: (beginning-of-line) 300: (back-to-indentation) 301: (let ((p (point))) 302: (skip-chars-forward "^ \t\n") 303: (setq w1 (buffer-substring p (point))))) 304: (if (> (- indent centre) forth-indent-level) 305: (setq indent (+ centre forth-indent-level))) 306: (if (> (- centre indent) forth-indent-level) 307: (setq indent (- centre forth-indent-level))) 308: (if (< indent 0) (setq indent 0)) 309: (setq indent (- indent 310: (if (string-match 311: (regexp-quote (concat " " w1 " ")) 312: forth-negatives) 313: forth-indent-level 0))) 314: (if (string-match (regexp-quote (concat " " w1 " ")) forth-zeroes) 315: (setq indent 0)) 316: indent)) 317: 318: (defun forth-sum-line-indentation () 319: "Add upp the positive and negative weights of all words on the current line." 320: (let ((b (point)) (e nil) (sum 0) (w nil) (t1 nil) (t2 nil) (first t)) 321: (end-of-line) (setq e (point)) 322: (goto-char b) 323: (while (< (point) e) 324: (setq w (forth-next-word)) 325: (setq t1 (string-match (regexp-quote (concat " " w " ")) 326: forth-positives)) 327: (setq t2 (string-match (regexp-quote (concat " " w " ")) 328: forth-negatives)) 329: (if t1 330: (setq sum (+ sum forth-indent-level))) 331: (if (and t2 (not first)) 332: (setq sum (- sum forth-indent-level))) 333: (skip-chars-forward " \t") 334: (setq first nil)) 335: sum)) 336: 337: 338: (defun forth-next-word () 339: "Return the next forth-word. Skip anything that the forth-word takes from 340: the input stream (comments, arguments, etc.)" 341: ;actually, it would be better to use commands based on the 342: ;syntax-table or comment-start etc. 343: (let ((w1 nil)) 344: (while (not w1) 345: (skip-chars-forward " \t\n") 346: (let ((p (point))) 347: (skip-chars-forward "^ \t\n") 348: (setq w1 (buffer-substring p (point)))) 349: (cond ((string-match "\"" w1) 350: (progn 351: (skip-chars-forward "^\"\n") 352: (forward-char))) 353: ((string-match "\\\\" w1) 354: (progn 355: (end-of-line) 356: )) 357: ((or (equal "(" w1) (equal ".(" w1)) 358: (progn 359: (skip-chars-forward "^)\n") 360: (forward-char))) 361: ((string-match (regexp-quote (concat " " w1 " ")) forth-prefixes) 362: (progn (skip-chars-forward " \t\n") 363: (skip-chars-forward "^ \t\n"))) 364: (t nil))) 365: w1)) 366: 367: 368: ;; Forth commands 369: 370: (defun forth-remove-tracers () 371: "Remove tracers of the form `~~ '. Queries the user for each occurrence." 372: (interactive) 373: (query-replace "~~ " "")) 374: 375: (defvar forth-program-name "gforth" 376: "*Program invoked by the `run-forth' command.") 377: 378: (defvar forth-band-name nil 379: "*Band loaded by the `run-forth' command.") 380: 381: (defvar forth-program-arguments nil 382: "*Arguments passed to the Forth program by the `run-forth' command.") 383: 384: (defun run-forth (command-line) 385: "Run an inferior Forth process. Output goes to the buffer `*forth*'. 386: With argument, asks for a command line. Split up screen and run forth 387: in the lower portion. The current-buffer when called will stay in the 388: upper portion of the screen, and all other windows are deleted. 389: Call run-forth again to make the *forth* buffer appear in the lower 390: part of the screen." 391: (interactive 392: (list (let ((default 393: (or forth-process-command-line 394: (forth-default-command-line)))) 395: (if current-prefix-arg 396: (read-string "Run Forth: " default) 397: default)))) 398: (setq forth-process-command-line command-line) 399: (forth-start-process command-line) 400: (forth-split) 401: (forth-set-runlight forth-runlight:input)) 402: 403: (defun reset-forth () 404: "Reset the Forth process." 405: (interactive) 406: (let ((process (get-process forth-program-name))) 407: (cond ((or (not process) 408: (not (eq (process-status process) 'run)) 409: (yes-or-no-p 410: "The Forth process is running, are you SURE you want to reset it? ")) 411: (message "Resetting Forth process...") 412: (forth-reload) 413: (message "Resetting Forth process...done"))))) 414: 415: (defun forth-default-command-line () 416: (concat forth-program-name " -emacs" 417: (if forth-program-arguments 418: (concat " " forth-program-arguments) 419: "") 420: (if forth-band-name 421: (concat " -band " forth-band-name) 422: ""))) 423: 424: ;;;; Internal Variables 425: 426: (defvar forth-process-command-line nil 427: "Command used to start the most recent Forth process.") 428: 429: (defvar forth-previous-send "" 430: "Most recent expression transmitted to the Forth process.") 431: 432: (defvar forth-process-filter-queue '() 433: "Queue used to synchronize filter actions properly.") 434: 435: (defvar forth-prompt "ok" 436: "The current forth prompt string.") 437: 438: (defvar forth-start-hook nil 439: "If non-nil, a procedure to call when the Forth process is started. 440: When called, the current buffer will be the Forth process-buffer.") 441: 442: (defvar forth-signal-death-message nil 443: "If non-nil, causes a message to be generated when the Forth process dies.") 444: 445: (defvar forth-percent-height 50 446: "Tells run-forth how high the upper window should be in percent.") 447: 448: (defconst forth-runlight:input ?I 449: "The character displayed when the Forth process is waiting for input.") 450: 451: (defvar forth-mode-string "" 452: "String displayed in the mode line when the Forth process is running.") 453: 454: ;;;; Evaluation Commands 455: 456: (defun forth-send-string (&rest strings) 457: "Send the string arguments to the Forth process. 458: The strings are concatenated and terminated by a newline." 459: (cond ((forth-process-running-p) 460: (forth-send-string-1 strings)) 461: ((yes-or-no-p "The Forth process has died. Reset it? ") 462: (reset-forth) 463: (goto-char (point-max)) 464: (forth-send-string-1 strings)))) 465: 466: (defun forth-send-string-1 (strings) 467: (let ((string (apply 'concat strings))) 468: (forth-send-string-2 string))) 469: 470: (defun forth-send-string-2 (string) 471: (let ((process (get-process forth-program-name))) 472: (if (not (eq (current-buffer) (get-buffer forth-program-name))) 473: (progn 474: (forth-process-filter-output string) 475: (forth-process-filter:finish))) 476: (send-string process (concat string "\n")) 477: (if (eq (current-buffer) (process-buffer process)) 478: (set-marker (process-mark process) (point))))) 479: 480: 481: (defun forth-send-region (start end) 482: "Send the current region to the Forth process. 483: The region is sent terminated by a newline." 484: (interactive "r") 485: (let ((process (get-process forth-program-name))) 486: (if (and process (eq (current-buffer) (process-buffer process))) 487: (progn (goto-char end) 488: (set-marker (process-mark process) end)))) 489: (forth-send-string "\n" (buffer-substring start end) "\n")) 490: 491: (defun forth-end-of-paragraph () 492: (if (looking-at "[\t\n ]+") (skip-chars-backward "\t\n ")) 493: (if (not (re-search-forward "\n[ \t]*\n" nil t)) 494: (goto-char (point-max)))) 495: 496: (defun forth-send-paragraph () 497: "Send the current or the previous paragraph to the Forth process" 498: (interactive) 499: (let (end) 500: (save-excursion 501: (forth-end-of-paragraph) 502: (skip-chars-backward "\t\n ") 503: (setq end (point)) 504: (if (re-search-backward "\n[ \t]*\n" nil t) 505: (setq start (point)) 506: (goto-char (point-min))) 507: (skip-chars-forward "\t\n ") 508: (forth-send-region (point) end)))) 509: 510: (defun forth-send-buffer () 511: "Send the current buffer to the Forth process." 512: (interactive) 513: (if (eq (current-buffer) (forth-process-buffer)) 514: (error "Not allowed to send this buffer's contents to Forth")) 515: (forth-send-region (point-min) (point-max))) 516: 517: 518: ;;;; Basic Process Control 519: 520: (defun forth-start-process (command-line) 521: (let ((buffer (get-buffer-create "*forth*"))) 522: (let ((process (get-buffer-process buffer))) 523: (save-excursion 524: (set-buffer buffer) 525: (progn (if process (delete-process process)) 526: (goto-char (point-max)) 527: (setq mode-line-process '(": %s")) 528: (add-to-global-mode-string 'forth-mode-string) 529: (setq process 530: (apply 'start-process 531: (cons forth-program-name 532: (cons buffer 533: (forth-parse-command-line 534: command-line))))) 535: (set-marker (process-mark process) (point-max)) 536: (forth-process-filter-initialize t) 537: (forth-modeline-initialize) 538: (set-process-sentinel process 'forth-process-sentinel) 539: (set-process-filter process 'forth-process-filter) 540: (run-hooks 'forth-start-hook))) 541: buffer))) 542: 543: (defun forth-parse-command-line (string) 544: (setq string (substitute-in-file-name string)) 545: (let ((start 0) 546: (result '())) 547: (while start 548: (let ((index (string-match "[ \t]" string start))) 549: (setq start 550: (cond ((not index) 551: (setq result 552: (cons (substring string start) 553: result)) 554: nil) 555: ((= index start) 556: (string-match "[^ \t]" string start)) 557: (t 558: (setq result 559: (cons (substring string start index) 560: result)) 561: (1+ index)))))) 562: (nreverse result))) 563: 564: 565: (defun forth-process-running-p () 566: "True iff there is a Forth process whose status is `run'." 567: (let ((process (get-process forth-program-name))) 568: (and process 569: (eq (process-status process) 'run)))) 570: 571: (defun forth-process-buffer () 572: (let ((process (get-process forth-program-name))) 573: (and process (process-buffer process)))) 574: 575: ;;;; Process Filter 576: 577: (defun forth-process-sentinel (proc reason) 578: (let ((inhibit-quit nil)) 579: (forth-process-filter-initialize (eq reason 'run)) 580: (if (eq reason 'run) 581: (forth-modeline-initialize) 582: (setq forth-mode-string ""))) 583: (if (and (not (memq reason '(run stop))) 584: forth-signal-death-message) 585: (progn (beep) 586: (message 587: "The Forth process has died! Do M-x reset-forth to restart it")))) 588: 589: (defun forth-process-filter-initialize (running-p) 590: (setq forth-process-filter-queue (cons '() '())) 591: (setq forth-prompt "ok")) 592: 593: 594: (defun forth-process-filter (proc string) 595: (forth-process-filter-output string) 596: (forth-process-filter:finish)) 597: 598: (defun forth-process-filter:enqueue (action) 599: (let ((next (cons action '()))) 600: (if (cdr forth-process-filter-queue) 601: (setcdr (cdr forth-process-filter-queue) next) 602: (setcar forth-process-filter-queue next)) 603: (setcdr forth-process-filter-queue next))) 604: 605: (defun forth-process-filter:finish () 606: (while (car forth-process-filter-queue) 607: (let ((next (car forth-process-filter-queue))) 608: (setcar forth-process-filter-queue (cdr next)) 609: (if (not (cdr next)) 610: (setcdr forth-process-filter-queue '())) 611: (apply (car (car next)) (cdr (car next)))))) 612: 613: ;;;; Process Filter Output 614: 615: (defun forth-process-filter-output (&rest args) 616: (if (not (and args 617: (null (cdr args)) 618: (stringp (car args)) 619: (string-equal "" (car args)))) 620: (forth-process-filter:enqueue 621: (cons 'forth-process-filter-output-1 args)))) 622: 623: (defun forth-process-filter-output-1 (&rest args) 624: (save-excursion 625: (forth-goto-output-point) 626: (apply 'insert-before-markers args))) 627: 628: (defun forth-guarantee-newlines (n) 629: (save-excursion 630: (forth-goto-output-point) 631: (let ((stop nil)) 632: (while (and (not stop) 633: (bolp)) 634: (setq n (1- n)) 635: (if (bobp) 636: (setq stop t) 637: (backward-char)))) 638: (forth-goto-output-point) 639: (while (> n 0) 640: (insert-before-markers ?\n) 641: (setq n (1- n))))) 642: 643: (defun forth-goto-output-point () 644: (let ((process (get-process forth-program-name))) 645: (set-buffer (process-buffer process)) 646: (goto-char (process-mark process)))) 647: 648: (defun forth-modeline-initialize () 649: (setq forth-mode-string " ")) 650: 651: (defun forth-set-runlight (runlight) 652: (aset forth-mode-string 0 runlight) 653: (forth-modeline-redisplay)) 654: 655: (defun forth-modeline-redisplay () 656: (save-excursion (set-buffer (other-buffer))) 657: (set-buffer-modified-p (buffer-modified-p)) 658: (sit-for 0)) 659: 660: ;;;; Process Filter Operations 661: 662: (defun add-to-global-mode-string (x) 663: (cond ((null global-mode-string) 664: (setq global-mode-string (list "" x " "))) 665: ((not (memq x global-mode-string)) 666: (setq global-mode-string 667: (cons "" 668: (cons x 669: (cons " " 670: (if (equal "" (car global-mode-string)) 671: (cdr global-mode-string) 672: global-mode-string)))))))) 673: 674: 675: ;; Misc 676: 677: (setq auto-mode-alist (append auto-mode-alist 678: '(("\\.fs$" . forth-mode)))) 679: 680: (defun forth-split () 681: (interactive) 682: (forth-split-1 "*forth*")) 683: 684: (defun forth-split-1 (buffer) 685: (if (not (eq (window-buffer) (get-buffer buffer))) 686: (progn 687: (delete-other-windows) 688: (split-window-vertically 689: (/ (* (screen-height) forth-percent-height) 100)) 690: (other-window 1) 691: (switch-to-buffer buffer) 692: (goto-char (point-max)) 693: (other-window 1)))) 694: 695: (defun forth-reload () 696: (interactive) 697: (let ((process (get-process forth-program-name))) 698: (if process (kill-process process t))) 699: (sleep-for-millisecs 100) 700: (forth-mode)) 701: 702: 703: ;; Special section for forth-help 704: 705: (defvar forth-help-buffer "*Forth-help*" 706: "Buffer used to display the requested documentation.") 707: 708: (defvar forth-help-load-path nil 709: "List of directories to search through to find *.doc 710: (forth-help-file-suffix) files. Nil means current default directory. 711: The specified directories must contain at least one .doc file. If it 712: does not and you still want the load-path to scan that directory, create 713: an empty file dummy.doc.") 714: 715: (defvar forth-help-file-suffix "*.doc" 716: "The file names to search for in each directory.") 717: 718: (setq forth-search-command-prefix "grep -n \"^ [^(]* ") 719: (defvar forth-search-command-suffix "/dev/null") 720: (defvar forth-grep-error-regexp ": No such file or directory") 721: 722: (defun forth-function-called-at-point () 723: "Return the space delimited word a point." 724: (save-excursion 725: (save-restriction 726: (narrow-to-region (max (point-min) (- (point) 1000)) (point-max)) 727: (skip-chars-backward "^ \t\n" (point-min)) 728: (if (looking-at "[ \t\n]") 729: (forward-char 1)) 730: (let (obj (p (point))) 731: (skip-chars-forward "^ \t\n") 732: (buffer-substring p (point)))))) 733: 734: (defun forth-help-names-extend-comp (path-list result) 735: (cond ((null path-list) result) 736: ((null (car path-list)) 737: (forth-help-names-extend-comp (cdr path-list) 738: (concat result forth-help-file-suffix " "))) 739: (t (forth-help-names-extend-comp 740: (cdr path-list) (concat result 741: (expand-file-name (car path-list)) "/" 742: forth-help-file-suffix " "))))) 743: 744: (defun forth-help-names-extended () 745: (if forth-help-load-path 746: (forth-help-names-extend-comp forth-help-load-path "") 747: (error "forth-help-load-path not specified"))) 748: 749: 750: ;(define-key forth-mode-map "\C-hf" 'forth-documentation) 751: 752: (defun forth-documentation (function) 753: "Display the full documentation of FORTH word." 754: (interactive 755: (let ((fn (forth-function-called-at-point)) 756: (enable-recursive-minibuffers t) 757: search-list 758: val) 759: (setq val (read-string (format "Describe forth word (default %s): " fn))) 760: (list (if (equal val "") fn val)))) 761: (forth-get-doc (concat forth-search-command-prefix 762: (grep-regexp-quote (concat function " (")) 763: "[^)]*\-\-\" " (forth-help-names-extended) 764: forth-search-command-suffix)) 765: (message "C-x C-m switches back to the forth interaction window")) 766: 767: (defun forth-get-doc (command) 768: "Display the full documentation of command." 769: (let ((curwin (get-buffer-window (window-buffer))) 770: reswin 771: pointmax) 772: (with-output-to-temp-buffer forth-help-buffer 773: (progn 774: (call-process "sh" nil forth-help-buffer t "-c" command) 775: (setq reswin (get-buffer-window forth-help-buffer)))) 776: (setq reswin (get-buffer-window forth-help-buffer)) 777: (select-window reswin) 778: (save-excursion 779: (goto-char (setq pointmax (point-max))) 780: (insert "--------------------\n\n")) 781: (let (fd doc) 782: (while (setq fd (forth-get-file-data pointmax)) 783: (setq doc (forth-get-doc-string fd)) 784: (save-excursion 785: (goto-char (point-max)) 786: (insert (substring (car fd) (string-match "[^/]*$" (car fd))) 787: ":\n\n" doc "\n"))) 788: (if (not doc) 789: (progn (goto-char (point-max)) (insert "Not found")))) 790: (select-window curwin))) 791: 792: (defun forth-skip-error-lines () 793: (let ((lines 0)) 794: (save-excursion 795: (while (re-search-forward forth-grep-error-regexp nil t) 796: (beginning-of-line) 797: (forward-line 1) 798: (setq lines (1+ lines)))) 799: (forward-line lines))) 800: 801: (defun forth-get-doc-string (fd) 802: "Find file (car fd) and extract documentation from line (nth 1 fd)." 803: (let (result) 804: (save-window-excursion 805: (find-file (car fd)) 806: (goto-line (nth 1 fd)) 807: (if (not (eq (nth 1 fd) (1+ (count-lines (point-min) (point))))) 808: (error "forth-get-doc-string: serious error")) 809: (if (not (re-search-backward "\n[\t ]*\n" nil t)) 810: (goto-char (point-min)) 811: (goto-char (match-end 0))) 812: (let ((p (point))) 813: (if (not (re-search-forward "\n[\t ]*\n" nil t)) 814: (goto-char (point-max))) 815: (setq result (buffer-substring p (point)))) 816: (bury-buffer (current-buffer))) 817: result)) 818: 819: (defun forth-get-file-data (limit) 820: "Parse grep output and return '(filename line#) list. Return nil when 821: passing limit." 822: (forth-skip-error-lines) 823: (if (< (point) limit) 824: (let ((result (forth-get-file-data-cont limit))) 825: (forward-line 1) 826: (beginning-of-line) 827: result))) 828: 829: (defun forth-get-file-data-cont (limit) 830: (let (result) 831: (let ((p (point))) 832: (skip-chars-forward "^:") 833: (setq result (buffer-substring p (point)))) 834: (if (< (point) limit) 835: (let ((p (1+ (point)))) 836: (forward-char 1) 837: (skip-chars-forward "^:") 838: (list result (string-to-int (buffer-substring p (point)))))))) 839: 840: (defun grep-regexp-quote (str) 841: (let ((i 0) (m 1) (res "")) 842: (while (/= m 0) 843: (setq m (string-to-char (substring str i))) 844: (if (/= m 0) 845: (progn 846: (setq i (1+ i)) 847: (if (string-match (regexp-quote (char-to-string m)) 848: ".*\\^$[]") 849: (setq res (concat res "\\"))) 850: (setq res (concat res (char-to-string m)))))) 851: res)) 852: 853: 854: (define-key forth-mode-map "\C-x\C-e" 'compile) 855: (define-key forth-mode-map "\C-x\C-n" 'next-error) 856: (require 'compile "compile") 857: 858: (defvar forth-compile-command "gforth ") 859: ;(defvar forth-compilation-window-percent-height 30) 860: 861: (defun forth-compile (command) 862: (interactive (list (setq forth-compile-command (read-string "Compile command: " forth-compile-command)))) 863: (forth-split-1 "*compilation*") 864: (setq ctools-compile-command command) 865: (compile1 ctools-compile-command "No more errors")) 866: 867: 868: ;;; Forth menu 869: ;;; Mikael Karlsson <qramika@eras70.ericsson.se> 870: 871: (cond ((string-match "XEmacs\\|Lucid" emacs-version) 872: (require 'func-menu) 873: 874: (defconst fume-function-name-regexp-forth 875: "^\$:\$[ \t]+\$[^ \t]*\$" 876: "Expression to get word definitions in Forth.") 877: 878: (setq fume-function-name-regexp-alist 879: (append '((forth-mode . fume-function-name-regexp-forth) 880: ) fume-function-name-regexp-alist)) 881: 882: ;; Find next forth word in the buffer 883: (defun fume-find-next-forth-function-name (buffer) 884: "Searches for the next forth word in BUFFER." 885: (set-buffer buffer) 886: (if (re-search-forward fume-function-name-regexp nil t) 887: (let ((beg (match-beginning 2)) 888: (end (match-end 2))) 889: (cons (buffer-substring beg end) beg)))) 890: 891: (setq fume-find-function-name-method-alist 892: (append '((forth-mode . fume-find-next-forth-function-name)))) 893: 894: )) 895: ;;; End Forth menu 896: 897: ;;; File folding of forth-files 898: ;;; uses outline 899: ;;; Toggle activation with M-x fold-f (when editing a forth-file) 900: ;;; Use f9 to expand, f10 to hide, Or the menubar in xemacs 901: ;;; 902: ;;; Works most of the times but loses sync with the cursor occasionally 903: ;;; Could be improved by also folding on comments 904: 905: (require 'outline) 906: 907: ;;(define-key outline-minor-mode-map 'f9 'show-entry) 908: ;;(define-key outline-minor-mode-map 'f10 'hide-entry) 909: 910: (defun fold-f () 911: (interactive) 912: (add-hook 'outline-minor-mode-hook 'hide-body) 913: 914: ; outline mode header start, i.e. find word definitions 915: (setq outline-regexp "^\$:\$[ \t]+\$[^ \t]*\$") 916: 917: (outline-minor-mode) 918: ) 919: ;;; end file folding 920: 921: ;;; func-menu is a package that scans your source file for function definitions 922: ;;; and makes a menubar entry that lets you jump to any particular function 923: ;;; definition by selecting it from the menu. The following code turns this on 924: ;;; for all of the recognized languages. Scanning the buffer takes some time, 925: ;;; but not much. 926: ;;; 927: (cond ((string-match "XEmacs\\|Lucid" emacs-version) 928: (require 'func-menu) 929: ;; (define-key global-map 'f8 'function-menu) 930: (add-hook 'find-fible-hooks 'fume-add-menubar-entry) 931: (define-key global-map "\C-cg" 'fume-prompt-function-goto) 932: (define-key global-map '(shift button3) 'mouse-function-menu) 933: ))