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