home *** CD-ROM | disk | FTP | other *** search
/ OpenStep 4.2 / Openstep-4.2-Intel-User.iso / usr / lib / emacs / lisp / simula.el < prev    next >
Text File  |  1991-01-09  |  29KB  |  828 lines
  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, hhe@ifi.uio.no 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 obh@ifi.uio.no 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)))))
  828.