Annotation of gforth/gforth.el, revision 1.1

1.1     ! anton       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: forth.el,v 2.10 89/12/05 mip@ida.liu.se 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: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>