gforth/gforth.el - view

File: [gforth] / gforth / gforth.el
Revision 1.1: download - view: text, annotated - select for diffs
Sat May 7 14:55:53 1994 UTC (29 years, 11 months ago) by anton
Branches: MAIN
CVS tags: HEAD

local variables
rewrote primitives2c.el in Forth (prims2x.el)
various small changes
Added Files:
 	from-cut-here gforth.el gforth.texi glocals.fs gray.fs
 	locals-test.fs prims2x.fs

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