![[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.