/[ascend]/trunk/emacsMode/ascend-mode.el
ViewVC logotype

Contents of /trunk/emacsMode/ascend-mode.el

Parent Directory Parent Directory | Revision Log Revision Log


Revision 229 - (show annotations) (download)
Sat Jan 28 16:29:08 2006 UTC (14 years, 7 months ago) by aw0a
File size: 50824 byte(s)
committed files that add ASCEND mode to the emacs editor
1 ;;; ascend-mode.el, a mode for editing ASCEND code in emacs
2 ;;;
3 ;;; This file is part of the Ascend modeling library.
4 ;;;
5 ;;; Copyright (C) 1994,1995,1996,1997,1998
6 ;;;
7 ;;; Carnegie Mellon University
8 ;;;
9 ;;; The Ascend modeling library is free software; you can redistribute it
10 ;;; and/or modify it under the terms of the GNU General Public License as
11 ;;; published by the Free Software Foundation; either version 2 of the
12 ;;; License, or (at your option) any later version.
13 ;;;
14 ;;; The Ascend Language Interpreter is distributed in hope that it will
15 ;;; be useful, but WITHOUT ANY WARRANTY; without even the implied
16 ;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See
17 ;;; the GNU General Public License for more details.
18 ;;;
19 ;;; You should have received a copy of the GNU General Public License
20 ;;; along with the program; if not, write to the Free Software
21 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the
22 ;;; file named COPYING.
23 ;;;
24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25 ;;;
26 ;;; 1994 Aug 26 Mark Thomas <mthomas+@cmu.edu>
27 ;;; - Initial version created in Lucid Emacs 19.10
28 ;;;
29 ;;; 1995 Sep 13 Mark Thomas <mthomas+@cmu.edu>
30 ;;; - Updated for use with XEmacs 19.12
31 ;;; - Added functions to support Gnu Emacs Menus
32 ;;;
33 ;;; 1996 May 29 Mark Thomas <mthomas+@cmu.edu>
34 ;;; - Changing keywords:
35 ;;; * INITIALIZATION --> METHODS
36 ;;; * PROCEDURE --> METHOD
37 ;;;
38 ;;; 1997 Nov Mark Thomas <mthomas+@cmu.edu>
39 ;;; - Major rewrite to make ascend-mode compatible with the
40 ;;; latest releases of
41 ;;; * ASCEND IV (0.8)
42 ;;; * XEmacs (19.16)
43 ;;; * FSF Emacs (19.34)
44 ;;; - Most of the code was made more general to be easily
45 ;;; expandable as ASCEND IV grows
46 ;;;
47 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 ;;;
49 ;;; Make sure we get the 'cl package
50 ;;;
51 (require 'cl)
52 ;;;
53 ;;; User Friendly Constants -------------------------------------------------
54 ;;;
55
56 (defvar ascend-block-indent-level 4
57 "*Indentation of ASCEND statements in a block with respect to the
58 statement that starts the block.")
59
60 (defvar ascend-continuation-indent-level 4
61 "*Indentation of ASCEND statement continuations with respect to
62 statement start. CURRENTLY NOT SUPPORTED.")
63
64 (defvar ascend-auto-newline nil
65 "*If nonnil, a newline is automatically inserted when semicolon(;)
66 is entered. Implies ascend-semicolon-auto-indent.")
67
68 (defvar ascend-semicolon-auto-indent t
69 "*If nonnil, entering a semicolon(;) will always indent the current
70 line.")
71
72 (defvar ascend-auto-add-end-statement t
73 "*If nonnil, pressing RETURN \(or semicolon if ascend-auto-newline
74 is nonnil\) on a line that starts a block will cause the matching end
75 statement to be automatically added to the buffer.")
76
77 (defvar ascend-tab-always-indent nil
78 "*If nonnil, pressing TAB will always indent the current line;
79 otherwise, TAB will only indent if in the left margin.")
80
81 (defvar ascend-expand-abbrevs-in-comments nil
82 "If nil, abbrevs are not expanded in comments, strings, and
83 notes.")
84
85 (defvar ascend-mode-hook nil
86 "*Mode hook for ASCEND mode buffers.")
87
88 ;;;
89 ;;; Internal Variables ------------------------------------------------------
90 ;;;
91
92 (defvar ascend-abbrev-table nil
93 "Abbrev table for use in ascend-mode buffers")
94
95 (defvar ascend-mode-map nil
96 "Keymap for use in ascend-mode buffers")
97
98 (defvar ascend-mode-syntax-table nil
99 "Syntax table for use in ascend-mode buffers")
100
101 (defvar ascend-font-lock-keywords nil
102 "ASCEND keywords for font-lock mode.
103 See the documentation for font-lock-keywords.")
104
105 (defvar ascend-menu nil
106 "A menu for ASCEND mode buffers.")
107
108 (defconst ascend-mode-version "1.14"
109 "Version number for this release of ASCEND mode.")
110
111 ;;;
112 ;;; Do the actual dirty deed ------------------------------------------------
113 ;;;
114
115 ;;; ABBREV TABLE
116 ;;; abbrev-list is a list of sub-lists; the car of each sublist is
117 ;;; the expansion text; the cdr are the strings that expand into
118 ;;; that text.
119 (if (not ascend-abbrev-table)
120 (let ((abbrev-list '(("ADD" "add")
121 ("ALIASES" "aliases" "alii" "al")
122 ("AND" "and")
123 ("ANY" "any")
124 ("ARE_ALIKE" "are_alike" "arealike" "aa")
125 ("ARE_THE_SAME" "are_the_same" "arethesame" "ats")
126 ("ARRAY" "array")
127 ("ATOM" "atom")
128 ("BREAK" "break")
129 ("CALL" "call")
130 ("CARD" "card")
131 ("CASE" "case")
132 ("CHOICE" "choice")
133 ("CONDITIONAL" "conditional")
134 ("CONSTANT" "constant" "const")
135 ("CONTINUE" "continue")
136 ("CREATE" "create")
137 ("DATA" "data")
138 ("DECREASING" "descreasing")
139 ("DEFAULT" "default")
140 ("DEFINITION" "definition")
141 ("DIMENSION" "dimension")
142 ("DIMENSIONLESS" "dimensionless")
143 ("DO" "do")
144 ("ELSE" "else")
145 ("END" "end")
146 ("EXTERNAL" "external")
147 ("FALSE" "false")
148 ("FALL_THROUGH" "fall_through" "fallthrough" "fall")
149 ("FOR" "for")
150 ("FROM" "from")
151 ("GLOBAL" "global")
152 ("IF" "if")
153 ("IMPORT" "import")
154 ("IN" "in")
155 ("INCREASING" "increasing")
156 ("INPUT" "input")
157 ("INTERACTIVE" "interactive")
158 ("INTERSECTION" "intersection")
159 ("IS_A" "is_a" "isa")
160 ("IS_REFINED_TO" "is_refined_to" "isrefinedto" "irt")
161 ("MAXIMIZE" "maximize" "max")
162 ("MAX_INTEGER" "max_integer" "maxinteger" "maxint")
163 ("MAX_REAL" "max_real" "maxreal")
164 ("METHOD" "method")
165 ("METHODS" "methods")
166 ("MINIMIZE" "minimize" "min")
167 ("MODEL" "model")
168 ("NOT" "not")
169 ("NOTES" "notes")
170 ("OF" "of")
171 ("OR" "or")
172 ("OTHERWISE" "otherwise")
173 ("OUTPUT" "output")
174 ("PROD" "prod")
175 ("PROVIDE" "provide")
176 ("REFINES" "refines")
177 ("REPLACE" "replace")
178 ("REQUIRE" "require")
179 ("RETURN" "return")
180 ("RUN" "run")
181 ("SATISFIED" "satisfied")
182 ("SELECT" "select")
183 ("SIZE" "size")
184 ("STOP" "stop")
185 ("SUCH_THAT" "such_that" "suchthat")
186 ("SUM" "sum")
187 ("SWITCH" "switch")
188 ("THEN" "then")
189 ("TRUE" "true")
190 ("UNION" "union")
191 ("UNITS" "units")
192 ("UNIVERSAL" "universal")
193 ("USE" "use")
194 ("VALUE" "value")
195 ("WHEN" "when")
196 ("WHERE" "where")
197 ("WHILE" "while")
198 ("WILL_BE" "will_be" "willbe" "wb")
199 ("WILL_BE_THE_SAME" "willbethesame" "wbts")
200 ("WILL_NOT_BE_THE_SAME" "willnotbethesame" "wnbts")
201 ("WITH" "with")
202 ("WITH_VALUE" "with_value" "withvalue" "wv"))
203 ))
204 (define-abbrev-table 'ascend-abbrev-table ())
205 (mapcar '(lambda (abbrev)
206 (let ((expansion (car abbrev)))
207 (mapcar '(lambda (name)
208 (define-abbrev ascend-abbrev-table
209 name
210 expansion
211 'ascend-undo-abbrev-in-comment))
212 (cdr abbrev))))
213 abbrev-list)))
214
215
216
217 ;;; MODE MAP
218 ;;; The ascend-mode-map is minimal.
219 (if (not ascend-mode-map)
220 (progn
221 (setq ascend-mode-map (make-sparse-keymap))
222 (define-key ascend-mode-map "\t" 'electric-ascend-tab)
223 (define-key ascend-mode-map "\C-m" 'electric-ascend-newline-indent)
224 (define-key ascend-mode-map "\C-j" 'electric-ascend-newline)
225 (define-key ascend-mode-map ";" 'electric-ascend-semicolon)
226 (define-key ascend-mode-map "\M-\C-b" 'ascend-backward-block)
227 (define-key ascend-mode-map "\M-\C-f" 'ascend-forward-block)
228 (define-key ascend-mode-map "\M-\C-a" 'ascend-beginning-of-block)
229 (define-key ascend-mode-map "\M-\C-e" 'ascend-end-of-block)
230 (define-key ascend-mode-map "\M-\C-h" 'ascend-mark-block)
231 ))
232
233
234
235 ;;; SYNTAX TABLE
236 ;;; For the syntax table, we have to make the math characters into
237 ;;; punctuation and define the comment characters. We make braces
238 ;;; into matching string delimiters when running under XEmacs
239 (if (not ascend-mode-syntax-table)
240 (progn
241 (setq ascend-mode-syntax-table (make-syntax-table))
242 ;; the following are the same as the (standard-syntax-table)
243 ;;(modify-syntax-entry ?\\ "\\" ascend-mode-syntax-table)
244 ;;(modify-syntax-entry ?\" "\"" ascend-mode-syntax-table)
245 ;;(modify-syntax-entry ?\t " " ascend-mode-syntax-table)
246 ;;(modify-syntax-entry ?\n " " ascend-mode-syntax-table)
247 ;;(modify-syntax-entry ?\r " " ascend-mode-syntax-table)
248 ;;(modify-syntax-entry ?\f " " ascend-mode-syntax-table)
249 ;;(modify-syntax-entry ?\v " " ascend-mode-syntax-table)
250 ;;(modify-syntax-entry ?\[ "(]" ascend-mode-syntax-table)
251 ;;(modify-syntax-entry ?\] ")[" ascend-mode-syntax-table)
252 ;;(modify-syntax-entry ?\{ "<}" ascend-mode-syntax-table)
253 ;;(modify-syntax-entry ?\} ">{" ascend-mode-syntax-table)
254 ;;
255 ;; the following differ from the (standard-syntax-table)
256 (modify-syntax-entry ?\( "()1" ascend-mode-syntax-table)
257 (modify-syntax-entry ?\) ")(4" ascend-mode-syntax-table)
258 (modify-syntax-entry ?* ". 23" ascend-mode-syntax-table)
259 (modify-syntax-entry ?+ "." ascend-mode-syntax-table)
260 (modify-syntax-entry ?- "." ascend-mode-syntax-table)
261 (modify-syntax-entry ?= "." ascend-mode-syntax-table)
262 (modify-syntax-entry ?% "." ascend-mode-syntax-table)
263 (modify-syntax-entry ?\/ "." ascend-mode-syntax-table)
264 (modify-syntax-entry ?^ "." ascend-mode-syntax-table)
265 (modify-syntax-entry ?< "." ascend-mode-syntax-table)
266 (modify-syntax-entry ?> "." ascend-mode-syntax-table)
267 (modify-syntax-entry ?& "." ascend-mode-syntax-table)
268 (modify-syntax-entry ?| "." ascend-mode-syntax-table)
269 (modify-syntax-entry ?. "." ascend-mode-syntax-table)
270 (modify-syntax-entry ?, "." ascend-mode-syntax-table)
271 ;; treat _ as a word for abbrev mode and for search strings. If
272 ;; _ is not a word char, then when sitting on the b in foo_bar
273 ;; (looking-at "\\<") returns t
274 (modify-syntax-entry ?_ "w" ascend-mode-syntax-table)
275 (modify-syntax-entry ?' "\"" ascend-mode-syntax-table)
276 ;; treat braces as matching string delimters in XEmacs
277 (if (string-match "XEmacs" emacs-version)
278 (progn
279 (modify-syntax-entry ?\{ "\"}" ascend-mode-syntax-table)
280 (modify-syntax-entry ?\} "\"{" ascend-mode-syntax-table)))
281 ))
282
283
284 ;;; FONT LOCK
285 ;;; The font lock stuff looks a lot worse than it is...
286 (if ascend-font-lock-keywords
287 ()
288 (let* ((keywords '("ADD"
289 "ALIASES"
290 "AND"
291 "ANY"
292 "ARE_ALIKE"
293 "ARE_THE_SAME"
294 "ARRAY"
295 "ATOM"
296 "BREAK"
297 "CALL"
298 "CARD"
299 "CASE"
300 "CHOICE"
301 "CONDITIONAL"
302 "CONSTANT"
303 "CONTINUE"
304 "CREATE"
305 "DATA"
306 "DECREASING"
307 "DEFAULT"
308 "DEFINITION"
309 "DIMENSION"
310 "DIMENSIONLESS"
311 "DO"
312 "ELSE"
313 "END"
314 "EXTERNAL"
315 "FALSE"
316 "FALL_THROUGH"
317 "FOR"
318 "FROM"
319 "GLOBAL"
320 "IF"
321 "IMPORT"
322 "IN"
323 "INCREASING"
324 "INPUT"
325 "INTERACTIVE"
326 "INTERSECTION"
327 "IS_A"
328 "IS_REFINED_TO"
329 "MAXIMIZE"
330 "MAX_INTEGER"
331 "MAX_REAL"
332 "METHOD"
333 "METHODS"
334 "MINIMIZE"
335 "MODEL"
336 "NOT"
337 "NOTES"
338 "OF"
339 "OR"
340 "OTHERWISE"
341 "OUTPUT"
342 "PROD"
343 "PROVIDE"
344 "REFINES"
345 "REPLACE"
346 "REQUIRE"
347 "RETURN"
348 "RUN"
349 "SATISFIED"
350 "SELECT"
351 "SIZE"
352 "STOP"
353 "SUCH_THAT"
354 "SUM"
355 "SWITCH"
356 "THEN"
357 "TRUE"
358 "UNION"
359 "UNITS"
360 "UNIVERSAL"
361 "USE"
362 "VALUE"
363 "WHEN"
364 "WHERE"
365 "WHILE"
366 "WILL_BE"
367 "WILL_BE_THE_SAME"
368 "WILL_NOT_BE_THE_SAME"
369 "WITH"
370 "WITH_VALUE"))
371 (keyword-regexp
372 (if (fboundp 'make-regexp)
373 (concat "\\<" (make-regexp keywords t) "\\>")
374 (concat "\\<\\(A\\(DD\\|LIASES\\|N[DY]\\|R\\(E_\\(ALIKE\\|"
375 "THE_SAME\\)\\|RAY\\)\\|TOM\\)\\|BREAK\\|C\\(A\\(LL"
376 "\\|RD\\|SE\\)\\|HOICE\\|ON\\(DITIONAL\\|STANT\\|"
377 "TINUE\\)\\|REATE\\)\\|D\\(ATA\\|E\\(CREASING\\|F"
378 "\\(AULT\\|INITION\\)\\)\\|IMENSION\\(\\|LESS\\)\\|O"
379 "\\)\\|E\\(LSE\\|ND\\|XTERNAL\\)\\|F\\(AL\\(L_THROUGH"
380 "\\|SE\\)\\|OR\\|ROM\\)\\|GLOBAL\\|I\\([FN]\\|MPORT"
381 "\\|N\\(CREASING\\|PUT\\|TER\\(ACTIVE\\|SECTION\\)\\)"
382 "\\|S_\\(A\\|REFINED_TO\\)\\)\\|M\\(AX\\(IMIZE\\|_"
383 "\\(INTEGER\\|REAL\\)\\)\\|ETHODS?\\|INIMIZE\\|ODEL"
384 "\\)\\|NOT\\(\\|ES\\)\\|O\\([FR]\\|THERWISE\\|UTPUT\\)"
385 "\\|PRO\\(D\\|VIDE\\)\\|R\\(E\\(FINES\\|PLACE\\|QUIRE"
386 "\\|TURN\\)\\|UN\\)\\|S\\(ATISFIED\\|ELECT\\|IZE\\|TOP"
387 "\\|U\\(CH_THAT\\|M\\)\\|WITCH\\)\\|T\\(HEN\\|RUE\\)"
388 "\\|U\\(NI\\(ON\\|TS\\|VERSAL\\)\\|SE\\)\\|VALUE\\|W"
389 "\\(H\\(E\\(N\\|RE\\)\\|ILE\\)\\|I\\(LL_\\(BE\\(\\|"
390 "_THE_SAME\\)\\|NOT_BE_THE_SAME\\)\\|TH\\(\\|_VALUE"
391 "\\)\\)\\)\\)\\>")))
392 (method-regexp "\\<METHOD[ \t]+\\(\w+\\)")
393 (type-regexp
394 (concat "\\<\\(CONSTANT\\|DEFINITION\\|ATOM\\|MODEL\\)[ \t]+"
395 "\\(\w+\\)"))
396 )
397 (setq ascend-font-lock-keywords
398 (purecopy
399 (list keyword-regexp
400 (list method-regexp 1 'font-lock-function-name-face)
401 (list type-regexp 2 'font-lock-type-face)
402 )))))
403
404 (put 'ascend-mode 'font-lock-defaults '(ascend-font-lock-keywords))
405
406
407 ;;; MENU
408 ;;; The only tricky thing about the menu is using either
409 ;;; zmacs-regions in XEmacs or mark-active in FSF Emacs
410 (if ascend-menu
411 ()
412 (setq ascend-menu
413 (list
414 '["Goto Block Start"
415 (ascend-beginning-of-block)
416 t]
417 '["Mark Current Block"
418 (ascend-mark-block 1)
419 t]
420 "---"
421 (vector
422 "Comment Out Region"
423 'comment-region
424 (if (boundp 'mark-active)
425 '(identity mark-active)
426 '(or (not zmacs-regions) (mark))))
427 (vector
428 "Indent Region"
429 'indent-region
430 (if (boundp 'mark-active)
431 '(identity mark-active)
432 '(or (not zmacs-regions) (mark))))
433 '["Indent Line"
434 ascend-indent-line
435 t]
436 "---"
437 '["Auto Newline On ;"
438 (setq ascend-auto-newline (not ascend-auto-newline))
439 :style toggle
440 :selected ascend-auto-newline]
441 '["Auto Indent On ;"
442 (setq ascend-semicolon-auto-indent
443 (not ascend-semicolon-auto-indent))
444 :active (not ascend-auto-newline)
445 :style toggle
446 :selected ascend-semicolon-auto-indent]
447 '["Auto Add Matching END"
448 (setq ascend-auto-add-end-statement
449 (not ascend-auto-add-end-statement))
450 :style toggle
451 :selected ascend-auto-add-end-statement]
452 '["Always Indent On TAB"
453 (setq ascend-tab-always-indent (not ascend-tab-always-indent))
454 :style toggle
455 :selected ascend-tab-always-indent]
456 '["Auto Indent On RETURN"
457 ascend-toggle-newline-linefeed
458 :style toggle
459 :selected (eq (key-binding "\C-m") 'electric-ascend-newline-indent)]
460 '["Auto Expand Abbreviations"
461 (setq abbrev-mode (not abbrev-mode))
462 :style toggle
463 :selected abbrev-mode]
464 '["Expand Abbrevs in Comments"
465 (setq ascend-expand-abbrevs-in-comments
466 (not ascend-expand-abbrevs-in-comments))
467 :active abbrev-mode
468 :style toggle
469 :selected ascend-expand-abbrevs-in-comments]
470 '"---"
471 '["Describe ASCEND mode"
472 describe-mode
473 t]
474 )))
475
476
477 ;;; ASCEND MODE
478 ;;;###autoload
479 (defun ascend-mode ()
480 "Major mode for editing ASCEND Code.
481 TAB indents for ASCEND code.
482 DELETE converts tabs to spaces as it moves back.
483 \\{ascend-mode-map}
484 Variables controlling indentation style:
485 ascend-auto-newline (default nil)
486 If nonnil, a newline is automatically inserted when
487 semicolon(;) is entered. Implies ascend-semicolon-auto-indent.
488 ascend-semicolon-auto-indent (default t)
489 If nonnil, entering a semicolon(;) will always indent
490 the current line.
491 ascend-tab-always-indent (default nil)
492 If nonnil, pressing TAB will always indent the current line;
493 otherwise, TAB will only indent if in the left margin.
494 ascend-block-indent-level (default 4)
495 Indentation of ASCEND statements in an block with
496 respect to the statement that starts the block.
497 ascend-continuation-indent-level (default 4)
498 Indentation of ASCEND statement continuations with respect
499 to statement start.
500
501 Comments delimited by (* .. *). The statement separator is the semicolon.
502
503 Turning on ASCEND-mode calls the value of the variable ascend-mode-hook
504 with no args, if that value is non-nil."
505 (interactive)
506 ;;
507 (kill-all-local-variables)
508 (use-local-map ascend-mode-map)
509 (setq major-mode 'ascend-mode)
510 (setq mode-name "ASCEND")
511 (setq local-abbrev-table ascend-abbrev-table)
512 (set-syntax-table ascend-mode-syntax-table)
513 ;;
514 (make-local-variable 'indent-line-function)
515 (setq indent-line-function 'ascend-indent-line)
516 ;;
517 (make-local-variable 'comment-start)
518 (setq comment-start "(*")
519 (make-local-variable 'comment-end)
520 (setq comment-end "*)")
521 (make-local-variable 'ascend-comment-start)
522 (setq ascend-comment-start (regexp-quote comment-start))
523 (make-local-variable 'ascend-comment-end)
524 (setq ascend-comment-end (regexp-quote comment-end))
525 (make-local-variable 'ascend-comment-start-end)
526 (setq ascend-comment-start-end (concat ascend-comment-start "\\|"
527 ascend-comment-end))
528 ;;
529 (make-local-variable 'ascend-notes-start)
530 (setq ascend-notes-start "{")
531 (make-local-variable 'ascend-notes-end)
532 (setq ascend-notes-end "}")
533 ;;
534 (make-local-variable 'ascend-block-start-regexp-list)
535 (setq ascend-block-start-regexp-list '("FOR"
536 "METHOD"
537 "\\(UNIVERSAL[ \t]+\\)?MODEL"
538 "\\(UNIVERSAL[ \t]+\\)?ATOM"
539 "IF"
540 "NOTES"
541 "SELECT"
542 "WHEN"
543 "SWITCH"
544 "WHILE"
545 "DEFINITION"
546 "UNITS"
547 "CONDITIONAL"
548 "DATA"
549 ))
550 (make-local-variable 'ascend-block-start-regexp)
551 (setq ascend-block-start-regexp
552 (concat "\\<\\("
553 (mapconcat 'identity ascend-block-start-regexp-list "\\|")
554 "\\)\\>"))
555 (make-local-variable 'ascend-block-end-regexp-list)
556 (setq ascend-block-end-regexp-list '("END"))
557 (make-local-variable 'ascend-block-end-regexp)
558 (setq ascend-block-end-regexp
559 (concat "\\<\\("
560 (mapconcat 'identity ascend-block-end-regexp-list "\\|")
561 "\\)\\>"))
562 (make-local-variable 'ascend-outdent-regexp-list)
563 (setq ascend-outdent-regexp-list '("\\<CASE\\>"
564 "\\<OTHERWISE\\>"
565 ")[ \t]*REFINES\\>"
566 "\\(\)[ \t]*\\)?WHERE[ \t\n]*\("
567 "\\<ELSE\\>"))
568 (make-local-variable 'ascend-outdent-regexp)
569 (setq ascend-outdent-regexp
570 (concat "\\("
571 (mapconcat 'identity ascend-outdent-regexp-list "\\|")
572 "\\)"))
573 (make-local-variable 'ascend-no-semi-regexp-list)
574 (setq ascend-no-semi-regexp-list '("METHODS"))
575 (make-local-variable 'ascend-no-semi-regexp)
576 (setq ascend-no-semi-regexp
577 (concat "\\<\\("
578 (mapconcat 'identity ascend-no-semi-regexp-list "\\|")
579 "\\)\\>"))
580 ;;
581 (ascend-create-menu)
582 (if (null (string-match "XEmacs" emacs-version))
583 (progn
584 ;; Do the font magic for FSF Emacs
585 (make-local-variable 'font-lock-keywords)
586 (setq font-lock-keywords
587 (append (list (list (car ascend-font-lock-keywords)
588 '(0 font-lock-keyword-face)))
589 (mapcar '(lambda (x) (list (car x) (cdr x)))
590 (cdr ascend-font-lock-keywords))))))
591 (run-hooks 'ascend-mode-hook))
592
593
594 ;;;
595 ;;; Electric functions ------------------------------------------------------
596 ;;;
597
598 (defun electric-ascend-newline (count)
599 "Insert COUNT newlines."
600 (interactive "P")
601 (delete-horizontal-space)
602 (ascend-indent-line)
603 (if ascend-auto-add-end-statement
604 (ascend-add-matching-end-block))
605 (newline (prefix-numeric-value count)))
606
607
608 (defun electric-ascend-newline-indent (count)
609 "Insert COUNT newlines then indent final line."
610 (interactive "P")
611 (electric-ascend-newline count)
612 (indent-to (ascend-calculate-indentation)))
613
614
615 (defun electric-ascend-tab (count)
616 "Called when TAB is pressed. If COUNT is specified,
617 insert COUNT tabs; if ascend-tab-always-indent is t, indent line;
618 otherwise, only indent if before first character on line."
619 (interactive "P")
620 (cond (count
621 (self-insert-command (prefix-numeric-value count)))
622 (ascend-tab-always-indent
623 (ascend-indent-line))
624 ((ascend-point-in-left-margin-p)
625 (ascend-indent-line))
626 ((ascend-point-in-string-p)
627 ())
628 (t
629 (self-insert-command 1))))
630
631
632 (defun electric-ascend-semicolon (count)
633 "Called when semicolon(;) is pressed. If COUNT is
634 specified, insert COUNT semicolons; otherwise insert a semicolon and
635 correct line's indentation. If ascend-auto-newline is t, insert newline."
636 (interactive "P")
637 (cond (count
638 (self-insert-command (prefix-numeric-value count)))
639 ((ascend-point-in-comment-p)
640 (self-insert-command 1))
641 ((ascend-point-in-string-p)
642 ())
643 (ascend-auto-newline
644 (self-insert-command 1)
645 (ascend-indent-line)
646 (if ascend-auto-add-end-statement
647 (ascend-add-matching-end-block))
648 (newline-and-indent))
649 (ascend-semicolon-auto-indent
650 (self-insert-command 1)
651 (ascend-indent-line))
652 (t
653 (self-insert-command 1))))
654
655
656 ;;;
657 ;;; Interactive functions ---------------------------------------------------
658 ;;;
659
660
661 (defun ascend-toggle-newline-linefeed (arg)
662 "Toggle the meanings of newline (C-m) and linefeed (C-j).
663 By default in ASCEND-mode, NEWLINE runs 'electric-ascend-newline-indent
664 ---which inserts a newline and indents---and LINEFEED calls
665 'electric-ascend-newline---which inserts a newline but does not indent).
666 Calling this function without an argument toggles the meanings; if ARG is
667 specified and is positive, newline is set to 'electric-ascend-newline;
668 otherwise newline is set to 'electric-ascend-newline-indent."
669 (interactive "P")
670 (if (or (and (not arg)
671 (eq (key-binding "\C-m") 'electric-ascend-newline-indent))
672 (< 0 (prefix-numeric-value arg)))
673 (progn
674 (define-key ascend-mode-map "\C-m" 'electric-ascend-newline)
675 (define-key ascend-mode-map "\C-j" 'electric-ascend-newline-indent))
676 (define-key ascend-mode-map "\C-m" 'electric-ascend-newline-indent)
677 (define-key ascend-mode-map "\C-j" 'electric-ascend-newline)))
678
679
680 ;;;
681 ;;; Indenting functions (interactive) ---------------------------------------
682 ;;;
683
684
685 (defun ascend-calculate-indentation ()
686 "Calculate the indentation of the current ASCEND line without
687 modifying the buffer."
688 (let ((case-fold-search nil)
689 tmp
690 ;; tmp is the point where the current comment starts--when we
691 ;; are in a comment; if we are not in a comment, it is nil
692 )
693 (save-excursion
694 ;; The next two lines put us on the first nonwhitespace character on
695 ;; the line---if we've been called from indent-line, then this
696 ;; should have already been done.
697 (beginning-of-line)
698 (skip-chars-forward " \t")
699 (cond (;; handle comments
700 (setq tmp (ascend-point-in-comment-p))
701 (let (;; count-stars is the number of asterisks that start the
702 ;; current line--ignoring any leading whitespace
703 (count-stars (if (looking-at "\\*+")
704 (apply '- (match-data))
705 0)))
706 ;; The next line searches for the previous nonblank line
707 ;; within the current comment; if there isn't one, it
708 ;; leaves point on the comment start character
709 (re-search-backward "^[ \t]*\\S-" tmp 1)
710 (if (looking-at ascend-comment-start)
711 (progn
712 ;; There was no nonblank line--we are current looking
713 ;; at "(" followed be one or more "*"s. Set the
714 ;; indentation to the column after the last asterisk,
715 ;; except any asterisks that start the line we are
716 ;; indenting should fall under asterisks in the
717 ;; previous line. For example
718 ;; (******
719 ;; ** foo
720 (forward-char 1) ;; skip the "("
721 (skip-chars-forward "\\*") ;; skip the "*"s
722 (max 0 (+ count-stars (current-column))))
723 (progn
724 ;; We found a nonblank line. Set the indentation to
725 ;; the column containing the first nonblank character.
726 ;; Ignore asterisks in the previous and current lines.
727 (skip-syntax-forward " ")
728 (current-column)))))
729 (;; handle notes
730 (ascend-point-in-note-p)
731 (current-column))
732 (;; handle the end of a block
733 (looking-at ascend-block-end-regexp)
734 (if (setq tmp (ascend-get-matching-block-start))
735 (goto-char tmp))
736 (current-column))
737 (;; handle outdented keywords like ELSE or CASE
738 (remove-if-not 'looking-at ascend-outdent-regexp-list)
739 (if (setq tmp (ascend-pos-beginning-of-block 1))
740 (goto-char tmp))
741 (current-column))
742 (;; Lines that begin with a close-paren should indent to the
743 ;; column of the first nonblank character on the line
744 ;; containing the matching open-paren.
745 (looking-at ")")
746 (forward-char 1)
747 (backward-sexp)
748 (beginning-of-line)
749 (skip-syntax-forward " ")
750 (current-column))
751 (;; This statement puts us on the previous nonblank line. If
752 ;; this branch fires, then no previous nonblank line exists,
753 ;; and we should set the indentation to 0.
754 (null (re-search-backward "^[ \t]*\\S-" nil t))
755 0)
756 (;; Going backward may have put us in a comment; if so, go to
757 ;; the beginning of the comment and start the process all
758 ;; over again.
759 (setq tmp (ascend-point-in-comment-p))
760 (goto-char tmp)
761 (ascend-calculate-indentation))
762 (;; This statement puts us on the first nonblank character on
763 ;; the previous nonblank line. We then check to see if it is
764 ;; a block-start statement; if so, we need to indent by the
765 ;; block-indent-level.
766 (and (progn
767 (beginning-of-line)
768 (skip-chars-forward " \t"))
769 (looking-at ascend-block-start-regexp))
770 (+ (current-column) ascend-block-indent-level))
771 (;; check if it is an outdented statement
772 (looking-at ascend-outdent-regexp)
773 (+ (current-column) ascend-block-indent-level))
774 (;; just return the current column
775 t
776 (current-column))
777 ;; The following will not get invoked because of the
778 ;; t on the previous condition. We need to do something
779 ;; here to get continuation lines to work.
780 ;;;;;;;;;;;;;;;;;;;;;;;;;;
781 ((looking-at ascend-comment-start)
782 ;; Code should line up with comments
783 (looking-at ascend-comment-start)
784 (current-column))
785 (;; This line does not require a semicolon, so it should be
786 ;; considered complete, and the next line should NOT be
787 ;; considered a continuation line.
788 (remove-if-not 'looking-at ascend-no-semi-regexp-list)
789 (current-column))
790 ((save-excursion
791 (end-of-line)
792 (if (setq tmp (ascend-point-in-comment-p))
793 (goto-char tmp))
794 (skip-syntax-backward " ")
795 (forward-char -1)
796 (looking-at ";"))
797 ;; This line ends in a semicolon, so the next line should NOT
798 ;; be considered a continuation line.
799 (current-column))
800 (t
801 ;; Consider the line to be a continuation line
802 (+ (current-column) ascend-continuation-indent-level)))
803 )))
804
805
806 (defun ascend-indent-line ()
807 "Indent the current line relative to the current block."
808 (interactive)
809 (let ((m (point-marker)))
810 (beginning-of-line)
811 (if (ascend-point-in-note-p)
812 nil
813 (delete-horizontal-space)
814 (indent-to (ascend-calculate-indentation)))
815 (if (> m (point))
816 (goto-char m))))
817
818
819 ;;;
820 ;;; Marking functions (interactive) -----------------------------------------
821 ;;;
822
823
824 (defun ascend-mark-block (count)
825 "If point is inside a block, mark the current block by putting mark
826 at the beginning and point at the end. If point is outside a block,
827 mark the first complete block we find \(designated by the first END
828 statement\). With argument COUNT, mark COUNT blocks outward or
829 forward."
830 (interactive "p")
831 (if (re-search-forward ascend-block-end-regexp nil t count)
832 ;; if this fails, we haven't moved. if it succeeds, we are
833 ;; sitting just after END. Go backward one word to the start of
834 ;; END, then get the position where of the matching block start.
835 ;; Go to the end of the line, push the mark to the beginning of
836 ;; the block, and then activate the region.
837 (let (beg-defun)
838 (skip-syntax-backward "w_")
839 (setq beg-defun (ascend-get-matching-block-start))
840 (end-of-line)
841 (push-mark beg-defun nil t))))
842
843
844 ;;;
845 ;;; Movement functions (interactive) ---------------------------------------
846 ;;;
847
848
849 (defun ascend-backward-block (count)
850 "Move backward to the next statement that begins an ASCEND block.
851 With argument COUNT, move backward COUNT begin statements. Treats
852 comments and NOTES as whitespace."
853 (interactive "p")
854 (goto-char (or (ascend-pos-block-backward count) (point-min))))
855
856
857 (defun ascend-forward-block (count)
858 "Move forward to the next statement that ends an ASCEND block. With
859 argument COUNT, move forward COUNT end statements. Treats comments
860 and NOTES as whitespace."
861 (interactive "p")
862 (goto-char (or (ascend-pos-block-forward count) (point-min)))
863 (end-of-line))
864
865
866 (defun ascend-beginning-of-block (count)
867 "Go to the beginning of the current block. With argument COUNT,
868 move outward COUNT blocks. Treats comments and NOTES as whitespace.
869
870 This function differs from ascend-backward-block in that matching
871 begin-block/end-block pairs are skipped, so that point moves to the
872 beginning of the block that contains point, not to the beginning of
873 the first begin-block statement we find."
874 (interactive "p")
875 (goto-char (or (ascend-pos-beginning-of-block count) (point-min))))
876
877
878 (defun ascend-end-of-block (count)
879 "Go to the end of the current block. With argument COUNT, move
880 outward COUNT blocks. Treats comments and NOTES as whitespace.
881
882 This function differs from ascend-forward-block in that matching
883 begin-block/end-block pairs are skipped, so that point moves to the
884 end of the block that contains point, not to the end of the first
885 end-block statement we find."
886 (interactive "p")
887 (goto-char (or (ascend-pos-end-of-block count) (point-max)))
888 (end-of-line))
889
890 ;;;
891 ;;; Is point here? ----------------------------------------------------------
892 ;;;
893
894
895 (defun ascend-point-in-comment-p ()
896 "If point is in an ASCEND comment, return the character
897 position where the comment begins; otherwise return nil."
898 ;; Search backward for the first ascend-comment-start or
899 ;; ascend-comment-end expression we see; if we find a
900 ;; ascend-comment-start, we are in a comment and return point;
901 ;; otherwise, we are not in a comment and return nil. NOTE: Does
902 ;; not handle nested comments; does not handle "(*)" correctly; does
903 ;; not process ascend-comment-start/ascend-comment-end characters in
904 ;; symbols and notes correctly.
905 (save-match-data
906 (save-excursion
907 (and (re-search-backward ascend-comment-start-end nil t)
908 (looking-at ascend-comment-start)
909 (point)))))
910
911
912 ;;;(defun ascend-point-in-nested-comment-p ()
913 ;;; "Return t if point is in a nested ASCEND comment."
914 ;;; ;; Set c to zero; search backward for ascend-comment-start and
915 ;;; ;; ascend-comment-end expressions; increment/decrement c for each
916 ;;; ;; ascend-comment-start/-end; if c is > 0 when we reach the
917 ;;; ;; beginning of the buffer, we are in a comment. NOTE: Handles
918 ;;; ;; nested comments, but does not handle "(*)" correctly; does not
919 ;;; ;; process ascend-comment-start/ascend-comment-end characters in
920 ;;; ;; symbols and notes correctly.
921 ;;; (let ((c 0))
922 ;;; (save-excursion
923 ;;; (while (re-search-backward ascend-comment-start-end
924 ;;; nil t)
925 ;;; (setq c (if (looking-at ascend-comment-start) (1+ c) (1- c)))))
926 ;;; (> c 0)))
927
928
929 (defun ascend-point-in-note-p ()
930 "Return the position of the starting character if point
931 is in an ASCEND notes block."
932 (save-match-data
933 (save-excursion
934 (and (re-search-backward (concat ascend-notes-start "\\|"
935 ascend-notes-end)
936 nil t)
937 (looking-at ascend-notes-start)
938 (point)))))
939
940
941 (defun ascend-point-in-string-p ()
942 "Return the position of the starting character if point
943 is within an ASCEND string.
944 Assumes strings never contain newlines."
945 (save-match-data
946 (save-excursion
947 (let (;; parse from the beginning-of-line to point
948 (p (point))
949 ;; the character that begins the string
950 c)
951 (beginning-of-line)
952 ;; since {} are treated as string delimiters in XEmacs, we
953 ;; have to watch for them in the call to parse-partial-sexp.
954 ;; If we get \} as a close string character, pretend we are
955 ;; not in a string
956 (if (and (setq c (nth 3 (parse-partial-sexp (point) p)))
957 (null (eq c ?\})))
958 (progn
959 (search-backward (char-to-string c))
960 (point)))))))
961
962
963 (defun ascend-point-in-left-margin-p ()
964 "Return t if point is in left margin; the left margin is
965 the whitespace between the left edge of the page and the start of text
966 on the line."
967 (save-excursion
968 (skip-chars-backward " \t")
969 (bolp)))
970
971
972 ;;;
973 ;;; Where is some text? -----------------------------------------------------
974 ;;;
975
976
977 (defun ascend-pos-block-backward (count)
978 "Return the position of the next unprotected
979 ascend-block-start-statement. Return nil if we do not find a block
980 start statement."
981 (save-excursion
982 (let (;; match case inside of this function
983 (case-fold-search nil)
984 ;; tmp holds the beginning of the current comment, string,
985 ;; or note
986 tmp)
987 (while (and (> count 0)
988 (re-search-backward ascend-block-start-regexp nil t))
989 (cond (;; ignore strings, comments, and notes
990 (setq tmp (or (ascend-point-in-string-p)
991 (ascend-point-in-comment-p)
992 (ascend-point-in-note-p)))
993 (goto-char tmp))
994 (;; ignore block-starts that following block-ends: go
995 ;; backward one token to make sure we are not sitting
996 ;; on the "FOR" of an "END FOR" statement
997 (progn (skip-syntax-backward " ")
998 (skip-syntax-backward "w_")
999 (looking-at ascend-block-end-regexp)))
1000 (t
1001 (setq count (1- count)))))
1002 (match-beginning 0))))
1003
1004
1005 (defun ascend-pos-block-forward (count)
1006 "Return the position of the next unprotected
1007 ascend-block-end-statement. Return nil if we do not find a block end
1008 statement."
1009 (save-excursion
1010 (let (;; match case inside of this function
1011 (case-fold-search nil))
1012 (while (and (> count 0)
1013 (re-search-forward ascend-block-end-regexp nil t))
1014 (if (not (or (ascend-point-in-string-p)
1015 (ascend-point-in-comment-p)
1016 (ascend-point-in-note-p)))
1017 (setq count (1- count))))
1018 (match-beginning 0))))
1019
1020
1021 (defun ascend-pos-beginning-of-block (count)
1022 "Return the position of the start of the block that currently
1023 contains point. Return nil if we do not find a block-start statement.
1024 Comments and notes are treated as whitespace.
1025
1026 This function searches backward for ascend-block-start-regexp. This
1027 function differs from ascend-pos-block-backward in that matching
1028 block-end/block-start statements are ignored."
1029 (let (;; match case inside of this function
1030 (case-fold-search nil)
1031 ;; level is used to keep track of the begin-blocks and end-blocks;
1032 ;; it is initially count, indicating we are inside count
1033 ;; levels of nested blocks
1034 (level count)
1035 ;; tmp is used for random values, such as the start of a comment,
1036 ;; the current value of point, etc.
1037 tmp
1038 ;; the regexp to match the begins and ends of blocks
1039 (regex (concat "\\(" ascend-block-start-regexp "\\|"
1040 ascend-block-end-regexp "\\)")))
1041 (save-excursion
1042 ;; ;; move to the beginning of the line and see if we are looking
1043 ;; ;; at a block-start, if so adjust the level. we have to do
1044 ;; ;; this, otherwise sitting just after the END keyword will
1045 ;; ;; behave as if we're not in that block.
1046 ;; (skip-syntax-backward " ")
1047 ;; (beginning-of-line)
1048 ;; (skip-chars-forward " \t")
1049 ;; (if (and (looking-at ascend-block-start-regexp)
1050 ;; (not (or (ascend-point-in-string-p)
1051 ;; (ascend-point-in-comment-p)
1052 ;; (ascend-point-in-note-p))))
1053 ;; (setq level (1- level)))
1054 (while (and (> level 0)
1055 (re-search-backward regex nil t))
1056 (cond (;; get out of the string, comment, or not
1057 (setq tmp (or (ascend-point-in-string-p)
1058 (ascend-point-in-comment-p)
1059 (ascend-point-in-note-p)))
1060 (goto-char tmp))
1061 (;; we're at block-end position; increase the level
1062 (looking-at ascend-block-end-regexp)
1063 (setq level (1+ level)))
1064 ;; at this point we know we are on a block-start. go
1065 ;; backward one token to make sure we are not sitting on the
1066 ;; "FOR" of an "END FOR" statement
1067 ((progn (setq tmp (- 0 (skip-syntax-backward " ")
1068 (skip-syntax-backward "w_")))
1069 (looking-at ascend-block-end-regexp))
1070 (setq level (1+ level)))
1071 (t
1072 (forward-char tmp)
1073 (setq level (1- level)))))
1074 (if (zerop level)
1075 (point)
1076 nil))))
1077
1078
1079 (defun ascend-pos-end-of-block (count)
1080 "Return the position of the end of the block that currently contains
1081 point. Return nil if we do not find a block-end statement. Comments
1082 and notes are treated as whitespace.
1083
1084 This function searches forward for ascend-block-end-regexp. This
1085 function differs from ascend-pos-block-forward in that matching
1086 block-end/block-start statements are ignored."
1087 (let (;; match case inside of this function
1088 (case-fold-search nil)
1089 ;; level is used to keep track of the begin-blocks and end-blocks;
1090 ;; it is initially count, indicating we are inside coun
1091 ;; levels of nested blocks
1092 (level count)
1093 ;; tmp is used for random values, such as the start of a comment,
1094 ;; the current value of point, etc.
1095 tmp
1096 ;; the regexp to match the begins and ends of blocks
1097 (regex (concat "\\(" ascend-block-start-regexp "\\|"
1098 ascend-block-end-regexp "\\)")))
1099 (save-excursion
1100 ;; ;; move to the first non-whitespace character on the line and
1101 ;; ;; see if we are looking at a block-end, if so adjust the level.
1102 ;; ;; we have to do this, otherwise sitting just before a
1103 ;; ;; block-start keyword will behave as if we're not in that
1104 ;; ;; block.
1105 ;; (skip-syntax-forward " ")
1106 ;; (if (and (looking-at ascend-block-end-regexp)
1107 ;; (not (or (ascend-point-in-string-p)
1108 ;; (ascend-point-in-comment-p)
1109 ;; (ascend-point-in-note-p))))
1110 ;; (setq level (1- level)))
1111 (while (and (> level 0)
1112 (re-search-forward regex nil t))
1113 ;; save point: since we move backward below, we need to return
1114 ;; here before our next time through the loop so we don't
1115 ;; match the same regexp again
1116 (setq tmp (point))
1117 ;; we're at the end of the regexp, move to the front
1118 (goto-char (match-beginning 0))
1119 (cond (;; if we are in a string, comment, or note, we need to
1120 ;; keep searching. unfortunately, there is no quick
1121 ;; way to jump out the end of a string, comment, or
1122 ;; note like there is for the beginning. Move to tmp
1123 ;; before we continue.
1124 (or (ascend-point-in-string-p)
1125 (ascend-point-in-comment-p)
1126 (ascend-point-in-note-p))
1127 (goto-char tmp))
1128 (;; we're at block-end position; decrease the level and
1129 ;; move to the end of the line, otherwise, if sitting
1130 ;; on ``END FOR;'' we will match the FOR as a
1131 ;; block-start
1132 (looking-at ascend-block-end-regexp)
1133 (setq level (1- level))
1134 (end-of-line))
1135 (;; at this point we know we are on a block-start. go
1136 ;; backward one token to make sure we are not sitting
1137 ;; on the "FOR" of an "END FOR" statement. If we are
1138 ;; on END FOR, decrease the level and move to the end
1139 ;; of the line
1140 (progn (skip-syntax-backward " ")
1141 (skip-syntax-backward "w_")
1142 (looking-at ascend-block-end-regexp))
1143 (setq level (1- level))
1144 (end-of-line))
1145 (;; we know we are on a block start that is really a
1146 ;; block start. increase the level and move to the end
1147 ;; of our orignial match
1148 t
1149 (setq level (1+ level))
1150 (goto-char tmp))))
1151 (if (zerop level)
1152 (point)
1153 nil))))
1154
1155
1156 (defun ascend-get-matching-block-start ()
1157 "Return the position of the start of the block which the
1158 current token ends. Signals an error if the matching block
1159 start is not found.
1160
1161 This function expects to point to be sitting on an entry in the
1162 ascend-block-end-regexp-list. To find the beginning of the current
1163 block from inside the block, call ascend-pos-beginning-of-block."
1164 (let (;; match case inside of this function
1165 (case-fold-search nil)
1166 ;; end-line is the line number where we are; it is used
1167 ;; when signaling an error.
1168 (end-line (1+ (count-lines (point-min) (point))))
1169 ;; level is used to keep track of the begin-blocks and end-blocks;
1170 ;; it is initially 1, indicating we are inside a block
1171 (level 1)
1172 ;; blocktype holds the token after the END
1173 blocktype
1174 ;; tmp is used for random values, such as the start of a comment,
1175 ;; the current value of point, etc.
1176 tmp)
1177 (save-excursion
1178 ;; Signal an error if we are not where we expect to be
1179 (if (null (looking-at ascend-block-end-regexp))
1180 (error "%s" "Not on an block-end-line"))
1181 ;; Skip over the block-end-regexp and any whitespace
1182 (goto-char (match-end 0))
1183 (skip-syntax-forward " ")
1184 ;; The next token is the type of the block
1185 (setq blocktype (buffer-substring (point) (progn
1186 (skip-syntax-forward "w_")
1187 (point))))
1188 ;; Signal an error if no token follows END
1189 (if (string= blocktype "")
1190 (error "%s" "Missing token after END"))
1191 ;; See if we recognize the token after "END"
1192 (if (string-match (concat "\\`" ascend-block-start-regexp "\\'")
1193 blocktype)
1194 (progn
1195 ;; The word after "END"---blocktype---is a block-start
1196 ;; keyword, so search backward for blocktype, adding a level
1197 ;; if it is preceeded by "END" and subtracting a level if not.
1198 ;; Return when the level is zero.
1199 (beginning-of-line)
1200 (while (and (> level 0)
1201 (re-search-backward (concat "\\b" blocktype "\\b")
1202 nil t))
1203 (if (setq tmp (or (ascend-point-in-string-p)
1204 (ascend-point-in-comment-p)
1205 (ascend-point-in-note-p)))
1206 (goto-char tmp)
1207 ;(forward-char 1)
1208 (setq tmp (point))
1209 (skip-syntax-backward " ")
1210 (skip-syntax-backward "w_")
1211 (if (looking-at ascend-block-end-regexp)
1212 (setq level (1+ level))
1213 (setq level (1- level)))))
1214 (if (zerop level)
1215 tmp
1216 (error "%s%s%s%d" "Cannot find beginning of " blocktype
1217 " block that ends on line " end-line)))
1218 (progn
1219 ;; We do not recognize the word after "END"---blocktype---as a
1220 ;; block-start, so look for a block-start followed by
1221 ;; blocktype.
1222 (while (and (re-search-backward (concat ascend-block-start-regexp
1223 "\\s-+" blocktype
1224 "\\>")
1225 nil t)
1226 (setq tmp (or (ascend-point-in-string-p)
1227 (ascend-point-in-comment-p)
1228 (ascend-point-in-note-p))))
1229 (goto-char tmp))
1230 (if (looking-at (concat ascend-block-start-regexp "\\s-+"
1231 blocktype "\\>"))
1232 (point)
1233 (error "%s%s%s%d" "Cannot find beginning of block " blocktype
1234 " that ends on line " end-line)))))))
1235
1236
1237 ;;;
1238 ;;; Misc functions ----------------------------------------------------------
1239 ;;;
1240
1241
1242 (defun ascend-undo-abbrev-in-comment ()
1243 "If point is in an ascend comment,
1244 undo the previous abbrev expansion."
1245 (if (and (not ascend-expand-abbrevs-in-comments)
1246 (or (ascend-point-in-string-p)
1247 (ascend-point-in-comment-p)
1248 (ascend-point-in-note-p)))
1249 (unexpand-abbrev)))
1250
1251
1252 (defun ascend-version ()
1253 "Print the version number of ASCEND mode in the minibuffer"
1254 (interactive)
1255 (message "ASCEND mode version %s Ident: $Id$" ascend-mode-version))
1256
1257
1258 (defun ascend-add-matching-end-block ()
1259 "Add the matching end"
1260 (let ((case-fold-search nil) block indentation)
1261 (save-excursion
1262 (beginning-of-line)
1263 (setq indentation (skip-chars-forward " \t"))
1264 (if (or (not (looking-at ascend-block-start-regexp))
1265 (looking-at "\\<ELSE\\>"))
1266 ;; nothing to do
1267 ()
1268 (if (looking-at "\\bUNIVERSAL\\b")
1269 (progn
1270 (skip-syntax-forward "w_")
1271 (skip-syntax-forward " ")))
1272 (if (looking-at "\\<\\(METHOD\\|ATOM\\|MODEL\\|DEFINITON\\)\\>")
1273 (progn
1274 (skip-syntax-forward "w_")
1275 (skip-syntax-forward " ")))
1276 (setq block (buffer-substring (point) (progn (skip-syntax-forward "w_")
1277 (point))))
1278 (end-of-line)
1279 (insert "\nEND " block ";")
1280 (beginning-of-line)
1281 (indent-to indentation)))))
1282
1283
1284 ;;;
1285 ;;; Menus -------------------------------------------------------------------
1286 ;;;
1287
1288
1289 (defun ascend-create-menu ()
1290 "Modify this buffer's menubar to include the ASCEND menu.
1291 Won't create the menubar if one doesn't already exist."
1292 (interactive)
1293 (cond ((not ascend-menu)
1294 ;; do nothing
1295 )
1296 ((and (string-match "XEmacs" emacs-version) current-menubar)
1297 (set-buffer-menubar current-menubar)
1298 (add-submenu nil (append '("ASCEND") ascend-menu)))
1299 ((and (string-match "Lucid" emacs-version) current-menubar)
1300 (set-buffer-menubar current-menubar)
1301 (add-menu nil "ASCEND" (copy-tree ascend-menu)))
1302 ((string-match "^[.0-9]+$" emacs-version)
1303 (load "easymenu")
1304 (easy-menu-define ascend ascend-mode-map "Ascend mode menu"
1305 (cons "Ascend" ascend-menu)))))
1306
1307
1308 ;;;
1309 ;;; Done --------------------------------------------------------------------
1310 ;;;
1311
1312 (provide 'ascend-mode)
1313
1314 ;; ascend-mode.el ends here

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22