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