![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to simula.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to simula.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;; --- Simula Mode for GNU Emacs
2: ;; Copyright (C) 1988 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is free software; you can redistribute it and/or modify
7: ;; it under the terms of the GNU General Public License as published by
8: ;; the Free Software Foundation; either version 1, or (at your option)
9: ;; any later version.
10:
11: ;; GNU Emacs is distributed in the hope that it will be useful,
12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: ;; GNU General Public License for more details.
15:
16: ;; You should have received a copy of the GNU General Public License
17: ;; along with GNU Emacs; see the file COPYING. If not, write to
18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19:
20: ;; Written by Ole Bj|rn Hessen.
21: ;; Disclaimer: This is my first lisp program > 10 lines, and -- most of
22: ;; all an experiment using reg-exp to represent forms on the screen.
23: ;; The parser parses simula backward, an impossible job.
24: ;; Well, I nearly lost!! Luckily, [email protected] plan to make a better one.
25:
26: (defvar simula-label "^[A-Za-z_{|}]+:")
27: (defvar simula-CE "else\\b\\|when\\b\\|otherwise\\b")
28: (defvar simula-CB "end\\b\\|!\\|comment\\b")
29: (defvar simula-BE "end\\b")
30: (defvar simula-BB "begin\\b")
31: (defvar simula-FB "if\\b\\|while\\b\\|inspect\\b\\|for\\b")
32: (defvar simula-eol "\n")
33: (defvar simula-eof "@") ;the form is postfixed by this string
34:
35: (defvar simula-extended-form nil
36: "non-nil if want non-standard slowly (extended) form checking")
37:
38: (defvar simula-mode-syntax-table nil
39: "Syntax table in simula-mode buffers.")
40:
41: (defvar simula-mode-abbrev-table nil
42: "abbrev table in simula-mode buffers")
43:
44: (defvar simula-indent-mode 'simula-Nice-indent-mode)
45: ;;most users want this feature...
46:
47: (defvar Read-Simula-Keywords nil
48: "non-nil if read keywords already")
49:
50: (define-abbrev-table 'simula-mode-abbrev-table ())
51:
52: (defvar Simula-Keyword-Abbrev-File "simula.defns"
53: "nil if not to load the Capitalize Keywords feature")
54:
55: (defvar simula-mode-ignore-directives t
56: "Set to non nil if doesn't use % comment type lines.")
57:
58: (if simula-mode-syntax-table
59: ()
60: (let ((table (make-syntax-table)))
61: (modify-syntax-entry ?\n "." table)
62: (modify-syntax-entry ?\f "." table)
63: (modify-syntax-entry ?\" "\"" table)
64: (modify-syntax-entry ?' "\"" table)
65: (modify-syntax-entry ?( "()" table)
66: (modify-syntax-entry ?) ")(" table)
67: (modify-syntax-entry ?* "." table)
68: (modify-syntax-entry ?+ "." table)
69: (modify-syntax-entry ?, "." table)
70: (modify-syntax-entry ?- "." table)
71: (modify-syntax-entry ?. "_" table)
72: (modify-syntax-entry ?_ "w" table)
73: (modify-syntax-entry ?/ "." table)
74: (modify-syntax-entry ?: "." table)
75: (modify-syntax-entry ?; ">" table)
76: (modify-syntax-entry ?< "." table)
77: (modify-syntax-entry ?= "." table)
78: (modify-syntax-entry ?> "." table)
79: (modify-syntax-entry ?[ "(]" table)
80: (modify-syntax-entry ?\\ "." table)
81: (modify-syntax-entry ?] ")[" table)
82: (modify-syntax-entry ?^ "." table)
83: (modify-syntax-entry ?\| "w" table)
84: (modify-syntax-entry ?\{ "w" table)
85: (modify-syntax-entry ?\} "w" table)
86: (modify-syntax-entry ?! "<" table)
87: (setq simula-mode-syntax-table table)))
88:
89: (defvar simula-mode-map ()
90: "Keymap used in simula mode.")
91:
92: (if simula-mode-map
93: ()
94: (setq simula-mode-map (make-sparse-keymap))
95: (define-key simula-mode-map "\t" 'simula-indent)
96: (define-key simula-mode-map "\r" 'simula-abbrev-expand-and-lf)
97: (define-key simula-mode-map "" 'backward-delete-char-untabify))
98:
99:
100: (defun simula-mode ()
101: "This is a mode intended to support program development in Simula.."
102: (interactive)
103: (kill-all-local-variables)
104: (use-local-map simula-mode-map)
105: (setq major-mode 'simula-mode)
106: (setq mode-name "Simula")
107: (make-local-variable 'comment-column)
108: (setq comment-column 40)
109: (make-local-variable 'end-comment-column)
110: (setq end-comment-column 75)
111: (set-syntax-table simula-mode-syntax-table)
112: (make-local-variable 'paragraph-start)
113: (setq paragraph-start "^[ \t]*$\\|\\f")
114: (make-local-variable 'paragraph-separate)
115: (setq paragraph-separate paragraph-start)
116: (make-local-variable 'indent-line-function)
117: (setq indent-line-function 'simula-null-indent)
118: (make-local-variable 'require-final-newline)
119: (setq require-final-newline t) ;put a newline at end!
120: (make-local-variable 'comment-start)
121: (setq comment-start "! ")
122: (make-local-variable 'comment-end)
123: (setq comment-end " ;")
124: (make-local-variable 'comment-start-skip)
125: (setq comment-start-skip "!+ *")
126: (make-local-variable 'comment-column)
127: (setq comment-start-skip "! *") ;not quite right, but..
128: (make-local-variable 'parse-sexp-ignore-comments)
129: (setq parse-sexp-ignore-comments nil)
130: (make-local-variable 'comment-multi-line)
131: (setq comment-multi-line t)
132: (setq local-abbrev-table simula-mode-abbrev-table)
133: ;;Capitalize-Simula-Keywords ought to run a hook!!!
134: (if Simula-Keyword-Abbrev-File
135: (progn
136: (setq abbrev-mode t)
137: (if Read-Simula-Keywords
138: ()
139: (condition-case err
140: (read-abbrev-file Simula-Keyword-Abbrev-File)
141: (file-error
142: (with-output-to-temp-buffer "*Help*"
143: (princ "Simula Mode can't load the Capitalize Simula ")
144: (princ "Keyword abbrev file\n\n")
145: (princ "Please do one of the following:\n")
146: (princ "1. Include this line in your .emacs file:\n")
147: (princ " (setq Simula-Keyword-Abbrev-File nil)\n")
148: (princ "2. Make a decent abbrev file by your self\n")
149: (princ "3. Mail [email protected] requesting the abbrev file\n"))))
150: (setq Read-Simula-Keywords t))))
151: (funcall simula-indent-mode) ;set indentation
152: (run-hooks 'simula-mode-hook))
153:
154: (defun simula-null-indent ()
155: (interactive))
156:
157: (setq simula-seen-FE nil) ;if seen FE during parsing; non-nil
158: (setq simula-form-starter nil) ;string, the FB.
159: (setq simula-form nil) ;string, the assembled form
160: (setq simula-FB-hpos nil) ;FB's Hpos
161: (setq simula-BB-hpos nil) ;BB's Hpos
162: (setq simula-hpos nil) ;Hpos of preceeding simula form
163: (setq simula-lf-count nil) ;A count of lf seen during parsing
164: (setq simula-stack nil) ;A stack of regions representing form
165: (setq simula-assemble nil) ;non-nil if assembling forms on stack
166: (setq simula-debug nil) ;t if debugging forms
167:
168:
169: ;; some simple stack routines.
170: (defun simula-push (v)
171: (if simula-assemble (setq simula-stack (cons v simula-stack))))
172:
173: (defun simula-pop ()
174: (prog1 (car simula-stack)
175: (setq simula-stack (cdr simula-stack))))
176: ;;The concepts of a stack is now obsolete...
177: ;;Major rewrite is wanted..
178:
179: (defun simula-inside-simple-string ()
180: ;returns t if inside a simulask simple string
181: (save-excursion
182: (skip-chars-backward "^\"\n'")
183: (if (bolp) nil
184: (let ((count 1))
185: (while (not (bolp))
186: (forward-char -1)
187: (skip-chars-backward "^\"\n'")
188: (setq count (1+ count)))
189: (= (% count 2) 0)))))
190:
191:
192: ;;ignore line starting with a %.
193: ;;form is evaled until line is not a compiler directive
194: ;;way is t if going forward
195: ;;returns with value of form
196: ;;didn't found how to use the right kind of scoping, so shit!!!
197: ;; -- HELP --
198:
199: (defun ignore-simula-directives (pedohejform &optional pedohejway)
200: (interactive)
201: (if simula-mode-ignore-directives (funcall pedohejform)
202: (let ((pedohejval (funcall pedohejform)) (pedohejhere (point)))
203: (beginning-of-line)
204: (while ;while directive line
205: (cond
206: ((not (= (following-char) ?%)) nil)
207: ((or (bobp) (eobp)) nil) ;and not beginning(end) of buffer
208: (t))
209: (if pedohejway (forward-line) (forward-char -1))
210: (setq pedohejval (funcall pedohejform)) ;execute form once more
211: (setq pedohejhere (point)) ;and goto beginning of that line.
212: (beginning-of-line))
213: (if (not (= (following-char) ?%)) (goto-char pedohejhere))
214: pedohejval))) ;return FROM if skipped something
215: ;Have you seen anybody prefixing a variable with my special password?
216: ;No? Good!
217:
218:
219: ;We are on a line which is _not_ a '%'-line directive,
220: ;and inside or _just_ after a '! blabla ;' or a 'end blabla ;' comment.
221: ;Our job is to skip that comment, returning position skipping from or
222: ;just nil if this is no comment
223:
224: (defun maybe-skip-simula-comment ()
225: (let ((here (point)) last-end tmp tmp1)
226: (ignore-simula-directives
227: (function
228: (lambda ()
229: (search-backward ";" (point-min) 0)
230: (while (simula-inside-simple-string)
231: (search-backward "\"")
232: (search-backward ";" (point-min) 0)))))
233: (re-search-forward
234: "^%\\|\"\\|!\\|\\bcomment\\b\\|\\bend\\b" here 0)
235: (while (or (= (setq tmp (preceding-char)) ?%)
236: (= tmp ?\"))
237: (if (= tmp ?\") (search-forward "\"" here 0)
238: (forward-line 1)
239: (if (> (point) here) (goto-char here)))
240: (re-search-forward
241: "^%\\|\"\\|!\\|\\bcomment\\b\\|\\bend\\b" here 0))
242: (if (= here (point)) nil ;no comment between "; blabla "
243: (if (= (preceding-char) ?!)
244: (progn ;a "; ! blabla " commentt
245: (forward-char -1)
246: here) ;ignore semicolon.
247: (forward-word -1)
248: (if (looking-at "comment")
249: here ;a "; comment blabla " string
250: ;; this is a end-comment
251: (setq last-end (point)) ;remember where end started
252: (while
253: (and ;skip directive lines
254: (progn ;and strings.
255: (setq tmp1
256: (re-search-forward
257: "^%\\|\"\\|!\\|\\bcomment\\b\\|\\bend\\b\\|\\bwhen\\b\\|\\belse\\b\\|\\botherwise\\b" here 0))
258: (while (and tmp1
259: (or (= (setq tmp (preceding-char)) ?%)
260: (= tmp ?\")))
261: (if (= tmp ?\") (search-forward "\"" here 0)
262: (forward-line 1))
263: (setq tmp1 (re-search-forward
264: "^%\\|\"\\|!\\|\\bcomment\\b\\|\\bend\\b\\|\\bwhen\\b\\|\\belse\\b\\|\\botherwise\\b" here 0)))
265: tmp1)
266: (cond
267: ((= (preceding-char) ?!) ;a "end ! " is part of end-comment
268: (if last-end ;skip it.
269: t
270: (forward-char -1) nil)) ;seen e.g. "end else !"
271: ;skip back over word
272: ((progn (forward-word -1) nil))
273: ((looking-at "comment")
274: (if (not last-end)
275: nil
276: (forward-word 1) t))
277: (t (setq last-end (if (looking-at "end") (point) nil))
278: (forward-word 1) t))))
279: (if (looking-at "!\\|\\bcomment")
280: here
281: (if last-end
282: (progn (goto-char last-end) here)
283: (goto-char here)
284: nil)))))))
285:
286:
287: ;;save this block form
288: (defun save-simula-BB-BE()
289: (let ((end (point)) (beg nil))
290: (simula-push end)
291: (simula-back-level) ;goto before the begin at this level
292: (if (not simula-BB-hpos) ;save column number if this the first
293: (setq simula-BB-hpos (current-column)))
294: (setq beg (point))
295: (end-of-line)
296: (simula-push ;save unto stack a block level.
297: (concat
298: "BEGIN"
299: (if (> (point) end) ()
300: (setq simula-lf-count (1+ simula-lf-count))
301: simula-eol) ;there is a lf after the begin
302: " o "
303: (progn
304: (forward-line 2)
305: (if (> (point) end) ()
306: (setq simula-lf-count (1+ simula-lf-count))
307: simula-eol)))) ;and before the end.
308: (simula-push beg)
309: (goto-char beg)))
310:
311:
312:
313:
314: ;;assumes we are inside a begin blabla end sentence.
315: ;;returns _before_ the begin
316: (defun simula-back-level()
317: (interactive)
318: (let ((end-comment))
319: (while
320: (and
321: (not (bobp))
322: (ignore-simula-directives
323: (function
324: (lambda ()
325: (re-search-backward "\\bend\\b\\|\\bbegin\\b" (point-min) 0)
326: (while (simula-inside-simple-string)
327: (search-backward "\"")
328: (re-search-backward "\\bend\\b\\|\\bbegin\\b" (point-min) 0))
329: t)))
330: (if (looking-at "begin")
331: (if (maybe-skip-simula-comment) ;ignore begin in (end)comments
332: (progn (if (looking-at "end") (forward-word 1)) t)
333: nil) ;else exit while.
334: (if (setq end-comment (maybe-skip-simula-comment))
335: (if (looking-at "comment\\|!") t ;then not an end-comment
336: (goto-char end-comment)
337: (simula-back-level)
338: t)
339: (simula-back-level)
340: t)))))
341: (if (not (looking-at "begin"))
342: (error "No matching BEGIN !!!")))
343:
344:
345:
346: ;on entry cursor is on the line we should indent. It indent this line and
347: ;predicts the next line's hpos at return value!!
348: (defun simula-find-indent (&optional predict-next)
349: (interactive)
350: (let
351: ((not-stop t) ;set to nil if stop parsing, 0 at bolp
352: (simexp 0) ;simexp= simula-lf-count, + simula exp.
353: tmp ch ;last read character
354: indent) ;hpos to indent lines line to.
355: (end-of-line)
356: (ignore-simula-directives ;ignore if this is a directive line
357: (function (lambda () (skip-chars-backward " \t"))))
358: (if (maybe-skip-simula-comment)
359: (if (looking-at "end") (forward-word 1)))
360: (setq simula-lf-count 0
361: simula-assemble t
362: simula-BB-hpos nil
363: simula-FB-hpos nil
364: simula-hpos nil
365: simula-seen-FE nil
366: simula-form nil
367: simula-form-starter nil ;string representing the form-starter
368: simula-stack (list (point) ;a stack of regions or strings.
369: simula-eof))
370: (while not-stop
371: (setq simexp (1+ simexp)) ;count up simula expressions seen.
372: (skip-chars-backward " \t") ;skip ignoring whitespace
373: (if (bobp)
374: (setq not-stop nil) ;stop at start og buffer
375: (if (= (char-syntax (setq ch (preceding-char))) ?w)
376: (forward-word -1) ;back over item (ie. word or char.)
377: (forward-char -1))
378: (cond
379: ((eolp) ;passed a new-line
380: (cond
381: ((numberp not-stop) ;if zero, then stop parsing.
382: (setq not-stop nil)
383: (forward-char 1))
384: (t ;else count up lf's
385: (if (/= simula-lf-count (1- simexp))
386: (setq simula-lf-count (1+ simula-lf-count)))
387: (setq simexp simula-lf-count) ;reset simexp.
388: (simula-push (1+ (point))) ;don't assemble newlines in
389: (ignore-simula-directives ;simula-form
390: (function (lambda () (skip-chars-backward " \t\n"))))
391: (simula-push simula-eol) ;save the newline
392: (simula-push (point))))) ;ignore region skipped
393:
394: ((= ch ?\")
395: (save-simula-string)) ;skip the string
396:
397: ((= ch ?\')
398: (forward-char -1)
399: (if (search-backward "'" (point-min) t)
400: (forward-char -1) ;skip to before '
401: (error "Unbalanced Character Quote")))
402:
403: ((= ch ?:) (forward-word -1))
404:
405: ((= ch ?\;) ;semicolon
406: (setq tmp (maybe-skip-simula-comment)) ;is this a comment?
407: (if (and tmp (looking-at "!\\|comment"))
408: (simula-parsed-over (1+ tmp)) ;ignore comments
409: (cond
410: ((and (> simula-lf-count 1) ;abort parsing if FE last exp in
411: (= simula-lf-count (1- simexp))) ;line only
412: (setq not-stop nil) ;stop parsing
413: (simula-stack-trick)) ;goto "next-line"
414: ((if (not tmp) nil ;do more parsing, but forget
415: (forward-word 1) ;the end-comment
416: (simula-parsed-over tmp)
417: nil))
418: ((= simexp 1) (setq simula-seen-FE t))
419: ((> simula-lf-count 0)
420: (simula-push (1+ (point)))
421: (setq simula-assemble nil))))) ;assemble only the last form
422:
423: ((looking-at simula-BB)
424: (setq simula-seen-FE nil) ;forget the past
425: (if (> simula-lf-count 1)
426: (setq not-stop (simula-stack-trick)) ;stop here!!
427: (if (not simula-assemble)
428: (progn
429: (setq simula-stack (list (point)
430: (concat "/n o " simula-eof))
431: simula-assemble t)))
432: (if (not simula-BB-hpos)
433: (setq simula-BB-hpos (current-column)))))
434:
435: ((and (looking-at simula-CE)
436: (setq tmp (maybe-skip-simula-comment)))
437: (forward-word 1) ;skip past end.
438: (simula-parsed-over tmp))
439:
440: ((looking-at simula-BE) (save-simula-BB-BE))
441:
442: ((and (not indent) ;if already found, skip this FB
443: (looking-at simula-FB))
444: (setq simula-form-starter
445: (buffer-substring (point) (match-end 0)))
446: (setq simula-FB-hpos (current-column))
447: (if (not (setq indent (Simula-Form-Handler)))
448: (setq simula-FB-hpos nil simula-form nil))
449: (if simula-seen-FE () ;if not seen FE, stop parsing
450: (setq not-stop nil) ;and indent from this line
451: (beginning-of-line))))))
452:
453: (setq simula-hpos (current-simula-indentation)) ;save indentation
454: (if simula-form
455: (if (and predict-next simula-seen-FE)
456: (setcdr indent (cdr (Simula-Default-Handler))))
457: (setq indent (Simula-Default-Handler)))
458: indent))
459:
460:
461: (defun simula-parsed-over (from)
462: (skip-chars-backward "\t") ;skip whitespace before comment.
463: (simula-push from) ;forget from
464: (save-excursion
465: (end-of-line) ;if passed newline don't forget
466: (if (< (point) from) ;that
467: (progn
468: (simula-push simula-eol)
469: (setq simula-lf-count (1+ simula-lf-count)))))
470: (simula-push (point))) ;mark region to be skipped past
471:
472:
473: ;;some better names wanted.
474: (defun simula-stack-trick ()
475: ;;axiom: if skipped back over 2-* lines, then use the indentation
476: ;;of the line after the line where the BB was found. Or if skipped past
477: ;;at least two lines and see ";" + newline. Use next lines indentation.
478: ;;that means one must fix the stack..
479: (forward-line 1)
480: (ignore-simula-directives
481: (function
482: (lambda () (skip-chars-forward " \t\n")
483: (while (= (following-char) ?\!)
484: (search-forward ";" (point-max) 0)
485: (skip-chars-forward " \t\n"))))
486: t)
487: (let ((pointer simula-stack))
488: (while pointer
489: (if (and (numberp (car pointer))
490: (> (point) (car pointer)))
491: (setq simula-stack pointer pointer nil)
492: (setq pointer (cdr pointer))))) nil)
493:
494:
495: (defun save-simula-string ()
496: (simula-push (point)) ;skip string contents
497: (skip-chars-backward "^\"\n" (point-min))
498: (if (= (preceding-char) ?\") nil
499: (error "UnBalanced String Quote \". "))
500: (simula-push (point))
501: (forward-char -1)) ;save the "" unto stack.
502:
503:
504: (defun Simula-Form-Handler ()
505: (let ((handler (intern-soft
506: (concat "Simula-" (capitalize simula-form-starter)
507: "-Handler"))))
508: (if handler (funcall handler) nil)))
509:
510:
511: (defun Simula-Default-Handler ()
512: (prog1
513: (if (and simula-seen-FE
514: (not simula-extended-form)
515: (not (or simula-BB-hpos simula-form)))
516: (list simula-hpos '(0 0))
517: (Simula-Default-Form-Handler Simula-Default-Form))
518: (setq simula-form nil)))
519:
520:
521:
522: (defun Simula-Default-Form-Handler (form)
523: (simula-collapse-stack) ;get assembled form
524: (let ((indentation (get-indent-amount form)))
525: (if (not indentation) nil
526: (setq simula-hpos
527: (if (not (bolp))
528: (save-excursion
529: (beginning-of-line)
530: (current-simula-indentation))
531: (current-simula-indentation))
532: indentation (cons (simula-indent-calc (car indentation))
533: (cdr indentation)))
534: indentation))) ;return (hpos (abs relhpos))
535:
536: (defun simula-collapse-stack ()
537: (let ((last-beg (if simula-assemble (point) (simula-pop)))
538: (pointer simula-stack))
539: (while pointer
540: (if (stringp (car pointer)) (setq pointer (cdr pointer))
541: (if last-beg
542: (progn
543: (setcar pointer (buffer-substring last-beg (car pointer)))
544: (setq last-beg nil pointer (cdr pointer)))
545: (setq last-beg (car pointer))
546: (setcar pointer (car (cdr pointer))) ;delete cons-cell
547: (setcdr pointer (cdr (cdr pointer))))))
548: (setq simula-form (apply 'concat simula-stack)
549: simula-stack (list (point) simula-form))))
550:
551: (defun get-indent-amount (indent-form-list)
552: (if indent-form-list
553: (if (string-match (car (car indent-form-list)) simula-form)
554: (progn
555: (if simula-debug
556: (with-output-to-temp-buffer "* forms *"
557: (print
558: (concat (car (car indent-form-list))"<---->" simula-form))))
559: (cdr (car indent-form-list)))
560: (get-indent-amount (cdr indent-form-list)))
561: nil))
562:
563:
564:
565: ;axiom: (bolp) eq t
566: (defun current-simula-indentation ()
567: (if (looking-at simula-label) ;skip labels
568: (re-search-forward simula-label)) ;ignore labels
569: (skip-chars-forward " \t") ;skip to first non-blank
570: (current-column)) ;and return with column nubmer
571:
572:
573: (defun simula-indent-calc (amount)
574: (if amount
575: (let ((from (car amount)))
576: (+ (car (cdr amount))
577: (cond
578: ((= 0 from) simula-hpos) ;axiom: exists
579: ((and simula-FB-hpos (= 1 from)) simula-FB-hpos)
580: ((and simula-BB-hpos (= 2 from)) simula-BB-hpos)
581: (simula-hpos))))
582: simula-hpos))
583:
584:
585: (defun simula-indent-line (to)
586: (beginning-of-line)
587: (if (= (following-char) ?\%) ()
588: (let ((space (% to tab-width)) (tabs (/ to tab-width)))
589: (if (looking-at simula-label) ;indent line after label
590: (progn
591: (re-search-forward simula-label) ;ignore labels
592: (if (> (current-column) to)
593: (setq tabs 0 space 1)
594: (insert-char ?\t 1) ;try fill to nearest tab position
595: (if (> (current-column) to) ;else fill blanks.
596: (backward-delete-char 1))
597: (setq to (- to (current-column)))
598: (setq tabs (/ to tab-width) space (% to tab-width)))))
599: (insert-char ?\t tabs) ;insert all the necessary tabs and
600: (insert-char ?\ space) ;spaces to indent line
601: (delete-region
602: (point) (progn (skip-chars-forward " \t" (point-max)) (point))))))
603:
604:
605: (defun simula-abbrev-expand-and-lf (arg)
606: (interactive "p")
607: (expand-abbrev)
608: (insert-char ?\n 1)
609: (forward-char -1)
610: (let ((indent (save-excursion (simula-find-indent t))))
611: (if (progn (beginning-of-line)
612: (skip-chars-forward " \t")
613: (/= (following-char) ?!)) ;Only indent lines not starting with
614: ;a comment or something like it..
615: (simula-indent-line (car indent)))
616: (forward-line 1)
617: (simula-indent-line (simula-indent-calc (car (cdr indent))))))
618:
619: (defun simula-indent ()
620: (interactive)
621: (simula-indent-line (car (save-excursion (simula-find-indent)))))
622:
623: (defun Simula-While-Handler ()
624: (Simula-Default-Form-Handler Simula-While-Form))
625:
626: (defun Simula-If-Handler ()
627: (Simula-Default-Form-Handler Simula-If-Form))
628:
629: (defun Simula-Inspect-Handler ()
630: (Simula-Default-Form-Handler Simula-Inspect-Form))
631:
632: (defun Simula-For-Handler ()
633: (Simula-Default-Form-Handler Simula-For-Form))
634:
635:
636: ;;;;;; Nice Mode..
637: (defun simula-Nice-indent-mode ()
638: (interactive)
639: (setq Simula-While-Form
640: '( ("while.*begin.*end;@" (0 0) (1 0))
641: ("while .*do.*begin\n.*\n.*end;@" (1 0) (0 0))
642: ("while .*do.*begin\n.*@" (1 3) (1 3))
643: ("while .*do.*begin.*@" (0 0) (1 3))
644: ("while .*do\n.*begin\n.*\n.*end;@" (2 0) (0 0))
645: ("while .*do\n.*begin\n.*@" (2 3) (2 3))
646: ("while .*do\n.*begin@" (1 3) (2 3))
647: ("while .*do\n.*;@" (1 3) (0 0))
648: ("while .*do\n.*@" (1 3) (1 3))
649: ("while .*do@" (0 0) (1 3))))
650: (setq Simula-Default-Form
651: '( ("begin.*end;@" (0 0) (0 0))
652: ("while .*do.*begin\n.*\n.*end;@" (0 0) (0 0))
653: ("begin.*@" (0 0) (2 3))
654: ("begin\n.*\n.*end.*@" (0 0) (0 0))
655: ("begin\n.*end;@" (2 3) (0 0))
656: ("begin\n.*\n.*end;@" (2 0) (0 0))
657: ("begin\n.*@" (2 3) (2 3))
658: ("begin\n.*\n@" (2 3) (2 3))
659: ("begin\n*.*\n*.*@" (2 3) (2 3))
660: (".*;@" (0 0) (0 0))
661: ("\n.*;@" (0 0) (0 0))
662: ("\n.*@" (0 0) (0 0))
663: ("." (0 0) (0 3))))
664: (setq Simula-If-Form
665: '( ("if.*begin.*end;@" (0 0) (1 0))
666: ("if .*begin.*@" (0 0) (2 3))
667: ("if .*else@" (0 0) (0 0))
668: ("if .*;@" (0 0) (0 0))
669: ("if .*@" (0 0) (0 3))
670: ("if .*begin.*\n.*@" (2 3) (2 3))
671: ("if .*\n.*;@" (0 3) (0 0))
672: ("if .*\n.*begin.*end.*@" (0 3) (0 0))
673: ("if .*\n.*begin.*@" (0 3) (2 3))
674: ("if .*else\n.*@" (0 3) (0 0))
675: ("if .*\n.*begin.*\n.*@" (2 3) (2 3))
676: ("if .*\n.*begin.*\n.*\n.*end.*@" (2 0) (0 0))
677: ("if .*begin.*\n.*\n.*end;.*@" (0 0) (0 0))
678: ("if .*begin.*\n.*\n.*end@" (2 0) (0 0))
679: ("else if.*@" (0 0) (0 3))
680: ("else@" (0 0) (0 3))
681: ("else.*begin.*@" (0 0) (2 3))
682: ("else.*begin.*\n.*@" (2 3) (2 3))
683: ("else.*begin.*\n.*\n.*end;@" (2 0) (0 0))
684: ("else .*;@" (0 0) (0 0))
685: ("else\n.*begin@" (0 3) (2 3))
686: ("else\n.*begin\n.*@" (2 3) (2 3))
687: ("else\n.*begin\n.*\n.*end.*@" (2 0) (0 0))))
688: (setq Simula-For-Form
689: '( ("for .*begin.*end;@" (0 0) (1 0))
690: ("for .*do.*;@" (0 0) (0 0))
691: ("for .*do@" (0 0) (1 3))
692: ("for .*do\n.*begin@" (1 3) (2 3))
693: ("for .*do\n.*begin\n.*@" (2 3) (2 3))
694: ("for .*do\n.*begin\n.*\n.*end.*@" (1 3) (0 0))
695: ("for .*do\n.*;@" (1 3) (0 0))
696: ("for .*do\n.*begin.*\n.*end.*@" (1 3) (0 0))
697: ("for .*do.*begin@" (0 0) (1 3))
698: ("for .*do.*begin\n.*end.*@" (1 3) (0 0))
699: ("for .*do.*begin\n.*@" (1 3) (1 3))
700: ("for .*do.*begin\n.*\n.*end.*@" (1 0) (0 0))))
701: (setq Simula-Inspect-Form
702: '( ("inspect .*do.*;@" (0 0) (0 0))
703: ("inspect .*do@" (0 0) (1 3))
704: ("inspect .*do\n.*begin.*end.*@" (1 3) (0 0))
705: ("inspect .*do\n.*begin.*@" (1 3) (2 3))
706: ("inspect .*do\n.*begin\n.*end.*@" (2 3) (0 0))
707: ("inspect .*do\n.*begin\n.*\n.*end.*@" (2 0) (0 0))
708: ("inspect .*do.*begin@" (0 0) (2 3))
709: ("inspect .*do.*begin\n.*end.*@" (2 3) (0 0))
710: ("inspect .*do.*begin\n.*@" (2 3) (2 3))
711: ("inspect .*do.*begin\n.*\n.*end.*;@" (2 0) (0 0))
712: ("inspect .*;@" (0 0) (0 0))
713: ("inspect .*@" (0 0) (0 3))
714: ("otherwise@" (0 0) (0 3))
715: ("otherwise\n.*begin@" (0 3) (2 3))
716: ("otherwise\n.*begin\n.*end.*@" (2 3) (0 0))
717: ("otherwise\n.*begin\n.*@" (2 3) (2 3))
718: ("otherwise\n.*begin\n.*\n.*end.*@" (2 0) (0 0))
719: ("otherwise .*begin .*end.*@" (0 0) (0 0))
720: ("otherwise .*begin.*@" (0 0) (2 3))
721: ("otherwise .*begin\n.*end.*@" (2 3) (0 0))
722: ("otherwise .*begin\n.*@" (2 3) (2 3))
723: ("otherwise .*begin\n.*\n.*end.*@" (2 0) (0 0))
724: ("when .*do@" (0 3) (0 6))
725: ("when .*do.*;@" (0 3) (0 0))
726: ("when .*do.*@" (0 3) (0 3))
727: ("when .*do\n.*begin@" (0 6) (2 3))
728: ("when .*do\n.*begin\n.*end;@" (2 3) (0 0))
729: ("when .*do\n.*begin\n.*@" (2 3) (2 3))
730: ("when .*do\n.*begin\n.*\n.*end;@" (2 0) (0 0))
731: ("when .*do\n.*begin\n.*\n.*end@" (2 0) (0 3))
732: ("when .*do\n.*begin .*end;@" (0 6) (0 0))
733: ("when .*do\n.*begin .*end@" (0 6) (0 3)))))
734:
735: (defun simula-Simed-indent-mode ()
736: ;;Should only indent after begin, so this is a overkill
737: ;;Hopefully, I'll do better when I care for it.
738: (interactive)
739: (setq Simula-While-Form
740: '( ("while .*do.*begin\n.*\nend;@" (1 0) (0 0))
741: ("while .*do.*begin\n.*@" (1 3) (1 3))
742: ("while .*do.*begin.*@" (0 0) (1 3))
743: ("while .*do\n.*begin\n.*\n.*end;@" (1 0) (0 0))
744: ("while .*do\n.*begin\n.*@" (2 3) (2 3))
745: ("while .*do\n.*begin@" (1 0) (1 3))
746: ("while .*do\n.*;@" (1 3) (0 0))
747: ("while .*do\n.*@" (1 3) (1 3))
748: ("while .*do@" (0 0) (1 0))))
749: (setq Simula-Default-Form
750: '( ("begin.*end;@" (0 0) (0 0))
751: ("begin.*@" (0 0) (2 3))
752: ("begin\n.*\nend" (0 0) (0 0))
753: ("begin\n.*end;@" (2 3) (0 0))
754: ("begin\n.*@" (2 3) (2 3))
755: ("begin\n*.*\n*.*@" (2 3) (2 3))
756: (".*;@" (0 0) (0 0))
757: ("\n.*;@" (0 0) (0 0))
758: ("\n.*@" (0 0) (0 0))
759: ("." (0 0) (0 3))))
760: (setq Simula-If-Form
761: '( ("if .*begin.*@" (0 0) (0 3))
762: ("if .*else@" (0 0) (0 0))
763: ("if .*;@" (0 0) (0 0))
764: ("if .*@" (0 0) (0 0))
765: ("if .*begin.*\n.*@" (0 3) (0 3))
766: ("if .*\n.*;@" (0 3) (0 0))
767: ("if .*\n.*begin.*end.*@" (0 0) (0 0))
768: ("if .*\n.*begin.*@" (0 0) (0 3))
769: ("if .*else\n.*@" (0 0) (0 0))
770: ("if .*\n.*begin.*\n.*@" (0 3) (0 3))
771: ("if .*\n.*begin.*\n.*\n.*end.*@" (0 0) (0 0))
772: ("if .*begin.*\n.*\n.*end;.*@" (0 0) (0 0))
773: ("if .*begin.*\n.*\n.*end@" (0 0) (0 0))
774: ("else if.*@" (0 0) (0 0))
775: ("else@" (0 0) (0 0))
776: ("else.*begin.*@" (0 0) (0 3))
777: ("else.*begin.*\n.*@" (0 3) (0 3))
778: ("else.*begin.*\n.*\n.*end;@" (0 0) (0 0))
779: ("else .*;@" (0 0) (0 0))
780: ("else\n.*begin@" (0 0) (0 3))
781: ("else\n.*begin\n.*@" (0 3) (0 3))
782: ("else\n.*begin\n.*\n.*end.*@" (0 0) (0 0))))
783: (setq Simula-For-Form
784: '( ("for .*do.*;@" (0 0) (0 0))
785: ("for .*do@" (0 0) (0 0))
786: ("for .*do\n.*begin@" (0 0) (0 3))
787: ("for .*do\n.*begin\n.*@" (0 3) (0 3))
788: ("for .*do\n.*begin\n.*\n.*end.*@" (0 0) (0 0))
789: ("for .*do\n.*;@" (0 3) (0 0))
790: ("for .*do\n.*begin.*\n.*end.*@" (0 0) (0 0))
791: ("for .*do.*begin@" (0 0) (0 3))
792: ("for .*do.*begin\n.*end.*@" (0 3) (0 0))
793: ("for .*do.*begin\n.*@" (0 3) (0 3))
794: ("for .*do.*begin\n.*\n.*end.*@" (0 0) (0 0))))
795: (setq Simula-Inspect-Form
796: '( ("inspect .*do.*;@" (0 0) (0 0))
797: ("inspect .*do@" (0 0) (0 0))
798: ("inspect .*do\n.*begin.*end.*@" (0 3) (0 0))
799: ("inspect .*do\n.*begin.*@" (0 0) (0 3))
800: ("inspect .*do\n.*begin\n.*end.*@" (0 0) (0 0))
801: ("inspect .*do\n.*begin\n.*\n.*end.*@" (0 0) (0 0))
802: ("inspect .*do.*begin@" (0 0) (0 3))
803: ("inspect .*do.*begin\n.*end.*@" (0 3) (0 0))
804: ("inspect .*do.*begin\n.*@" (0 3) (0 3))
805: ("inspect .*do.*begin\n.*\n.*end.*;@" (0 0) (0 0))
806: ("inspect .*;@" (0 0) (0 0))
807: ("inspect .*@" (0 0) (0 0))
808: ("otherwise@" (0 0) (0 0))
809: ("otherwise\n.*begin@" (0 0) (0 3))
810: ("otherwise\n.*begin\n.*end.*@" (0 3) (0 0))
811: ("otherwise\n.*begin\n.*@" (0 3) (0 3))
812: ("otherwise\n.*begin\n.*\n.*end.*@" (0 0) (0 0))
813: ("otherwise .*begin .*end.*@" (0 0) (0 0))
814: ("otherwise .*begin.*@" (0 0) (0 3))
815: ("otherwise .*begin\n.*end.*@" (0 3) (0 0))
816: ("otherwise .*begin\n.*@" (0 3) (0 3))
817: ("otherwise .*begin\n.*\n.*end.*@" (0 0) (0 0))
818: ("when .*do@" (0 0) (0 0))
819: ("when .*do.*;@" (0 0) (0 0))
820: ("when .*do.*@" (0 0) (0 0))
821: ("when .*do\n.*begin@" (0 0) (0 3))
822: ("when .*do\n.*begin\n.*end;@" (0 3) (0 0))
823: ("when .*do\n.*begin\n.*@" (0 3) (0 3))
824: ("when .*do\n.*begin\n.*\n.*end;@" (0 0) (0 0))
825: ("when .*do\n.*begin\n.*\n.*end@" (0 0) (0 0))
826: ("when .*do\n.*begin .*end;@" (0 3) (0 0))
827: ("when .*do\n.*begin .*end@" (0 3) (0 0)))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.