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