![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mim-mode.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp|
Return to mim-mode.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 ! root 1: ;; Mim (MDL in MDL) mode. ! 2: ;; Copyright (C) 1985 Richard M. Stallman and K. Shane Hartman. ! 3: ;; Bugs to shane@mit-xx (or bug-gnu-emacs@mit-prep) ! 4: ! 5: ;; This file is part of GNU Emacs. ! 6: ! 7: ;; GNU Emacs is distributed in the hope that it will be useful, ! 8: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 9: ;; accepts responsibility to anyone for the consequences of using it ! 10: ;; or for whether it serves any particular purpose or works at all, ! 11: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 12: ;; License for full details. ! 13: ! 14: ;; Everyone is granted permission to copy, modify and redistribute ! 15: ;; GNU Emacs, but only under the conditions described in the ! 16: ;; GNU Emacs General Public License. A copy of this license is ! 17: ;; supposed to have been given to you along with GNU Emacs so you ! 18: ;; can know your rights and responsibilities. It should be in a ! 19: ;; file named COPYING. Among other things, the copyright notice ! 20: ;; and this notice must be preserved on all copies. ! 21: ! 22: ! 23: (provide 'mim-mode) ! 24: ! 25: (autoload 'fast-syntax-check-mim "mim-syntax" ! 26: "Checks Mim syntax quickly. ! 27: Answers correct or incorrect, cannot point out the error context." ! 28: t) ! 29: ! 30: (autoload 'slow-syntax-check-mim "mim-syntax" ! 31: "Check Mim syntax slowly. ! 32: Points out the context of the error, if the syntax is incorrect." ! 33: t) ! 34: ! 35: (defvar mim-mode-hysterical-bindings t ! 36: "*Non-nil means bind list manipulation commands to Meta keys as well as ! 37: Control-Meta keys for historical reasons. Otherwise, only the latter keys ! 38: are bound.") ! 39: ! 40: (defvar mim-mode-map nil) ! 41: ! 42: (defvar mim-mode-syntax-table nil) ! 43: ! 44: (if (not mim-mode-syntax-table) ! 45: (let ((i -1) ! 46: (old-syntax-table (syntax-table))) ! 47: (setq mim-mode-syntax-table (make-syntax-table)) ! 48: (set-syntax-table mim-mode-syntax-table) ! 49: (while (< i ?\ ) ! 50: (modify-syntax-entry (setq i (1+ i)) " ")) ! 51: (while (< i 127) ! 52: (modify-syntax-entry (setq i (1+ i)) "_ ")) ! 53: (setq i (1- ?a)) ! 54: (while (< i ?z) ! 55: (modify-syntax-entry (setq i (1+ i)) "w ")) ! 56: (setq i (1- ?A)) ! 57: (while (< i ?Z) ! 58: (modify-syntax-entry (setq i (1+ i)) "w ")) ! 59: (setq i (1- ?0)) ! 60: (while (< i ?9) ! 61: (modify-syntax-entry (setq i (1+ i)) "w ")) ! 62: (modify-syntax-entry ?: " ") ; make : symbol delimiter ! 63: (modify-syntax-entry ?, "' ") ! 64: (modify-syntax-entry ?. "' ") ! 65: (modify-syntax-entry ?' "' ") ! 66: (modify-syntax-entry ?` "' ") ! 67: (modify-syntax-entry ?~ "' ") ! 68: (modify-syntax-entry ?; "' ") ; comments are prefixed objects ! 69: (modify-syntax-entry ?# "' ") ! 70: (modify-syntax-entry ?% "' ") ! 71: (modify-syntax-entry ?! "' ") ! 72: (modify-syntax-entry ?\" "\" ") ! 73: (modify-syntax-entry ?\\ "\\ ") ! 74: (modify-syntax-entry ?\( "\() ") ! 75: (modify-syntax-entry ?\< "\(> ") ! 76: (modify-syntax-entry ?\{ "\(} ") ! 77: (modify-syntax-entry ?\[ "\(] ") ! 78: (modify-syntax-entry ?\) "\)( ") ! 79: (modify-syntax-entry ?\> "\)< ") ! 80: (modify-syntax-entry ?\} "\){ ") ! 81: (modify-syntax-entry ?\] "\)[ ") ! 82: (set-syntax-table old-syntax-table))) ! 83: ! 84: (defconst mim-whitespace "\000- ") ! 85: ! 86: (defvar mim-mode-hook nil ! 87: "*User function run after mim mode initialization. Usage: ! 88: \(setq mim-mode-hook '(lambda () ... your init forms ...)).") ! 89: ! 90: (define-abbrev-table 'mim-mode-abbrev-table nil) ! 91: ! 92: (defconst indent-mim-hook 'indent-mim-hook ! 93: "Controls (via properties) indenting of special forms. ! 94: \(put 'FOO 'indent-mim-hook n\), integer n, means lines inside ! 95: <FOO ...> will be indented n spaces from start of form. ! 96: \(put 'FOO 'indent-mim-hook 'DEFINE\) is like above but means use ! 97: value of mim-body-indent as offset from start of form. ! 98: \(put 'FOO 'indent-mim-hook <cons>\) where <cons> is a list or pointted list ! 99: of integers, means indent each form in <FOO ...> by the amount specified ! 100: in <cons>. When <cons> is exhausted, indent remaining forms by ! 101: mim-body-indent unless <cons> is a pointted list, in which case the last ! 102: cdr is used. Confused? Here is an example: ! 103: \(put 'FROBIT 'indent-mim-hook '\(4 2 . 1\)\) ! 104: <FROBIT ! 105: <CHOMP-IT> ! 106: <CHOMP-SOME-MORE> ! 107: <DIGEST> ! 108: <BELCH> ! 109: ...> ! 110: Finally, the property can be a function name (read the code).") ! 111: ! 112: (defvar indent-mim-comment t ! 113: "*Non-nil means indent string comments.") ! 114: ! 115: (defvar mim-body-indent 2 ! 116: "*Amount to indent in special forms which have DEFINE property on ! 117: indent-mim-hook.") ! 118: ! 119: (defvar indent-mim-arglist t ! 120: "*nil means indent arglists like ordinary lists. ! 121: t means strings stack under start of arglist and variables stack to ! 122: right of them. Otherwise, strings stack under last string (or start ! 123: of arglist if none) and variables stack to right of them. ! 124: Examples (for values 'stack, t, nil): ! 125: ! 126: \(FOO \"OPT\" BAR \(FOO \"OPT\" BAR \(FOO \"OPT\" BAR ! 127: BAZ MUMBLE BAZ MUMBLE BAZ MUMBLE ! 128: \"AUX\" \"AUX\" \"AUX\" ! 129: BLETCH ... BLETCH ... BLETCH ...") ! 130: ! 131: (put 'DEFINE 'indent-mim-hook 'DEFINE) ! 132: (put 'DEFMAC 'indent-mim-hook 'DEFINE) ! 133: (put 'BIND 'indent-mim-hook 'DEFINE) ! 134: (put 'PROG 'indent-mim-hook 'DEFINE) ! 135: (put 'REPEAT 'indent-mim-hook 'DEFINE) ! 136: (put 'CASE 'indent-mim-hook 'DEFINE) ! 137: (put 'FUNCTION 'indent-mim-hook 'DEFINE) ! 138: (put 'MAPF 'indent-mim-hook 'DEFINE) ! 139: (put 'MAPR 'indent-mim-hook 'DEFINE) ! 140: (put 'UNWIND 'indent-mim-hook (cons (* 2 mim-body-indent) mim-body-indent)) ! 141: ! 142: (defvar mim-down-parens-only t ! 143: "*nil means treat ADECLs and ATOM trailers like structures when ! 144: moving down a level of structure.") ! 145: ! 146: (defvar mim-stop-for-slop t ! 147: "*Non-nil means {next previous}-mim-object consider any ! 148: non-whitespace character in column 0 to be a toplevel object, otherwise ! 149: only open paren syntax characters will be considered.") ! 150: ! 151: (fset 'mdl-mode 'mim-mode) ! 152: ! 153: (defun mim-mode () ! 154: "Major mode for editing Mim (MDL in MDL) code. ! 155: Commands: ! 156: If value of mim-mode-hysterical-bindings is non-nil, then following ! 157: commands are assigned to escape keys as well (e.g. M-f = M-C-f). ! 158: The default action is bind the escape keys. ! 159: Tab Indents the current line as MDL code. ! 160: Delete Converts tabs to spaces as it moves back. ! 161: M-C-f Move forward over next mim object. ! 162: M-C-b Move backward over previous mim object. ! 163: M-C-p Move to beginning of previous toplevel mim object. ! 164: M-C-n Move to the beginning of the next toplevel mim object. ! 165: M-C-a Move to the top of surrounding toplevel mim form. ! 166: M-C-e Move to the end of surrounding toplevel mim form. ! 167: M-C-u Move up a level of mim structure backwards. ! 168: M-C-d Move down a level of mim structure forwards. ! 169: M-C-t Transpose mim objects on either side of point. ! 170: M-C-k Kill next mim object. ! 171: M-C-h Place mark at end of next mim object. ! 172: M-C-o Insert a newline before current line and indent. ! 173: M-Delete Kill previous mim object. ! 174: M-^ Join current line to previous line. ! 175: M-\\ Delete whitespace around point. ! 176: M-; Move to existing comment or insert empty comment if none. ! 177: M-Tab Indent following mim object and all contained lines. ! 178: Other Commands: ! 179: Use \\[describe-function] to obtain documentation. ! 180: replace-in-mim-object find-mim-definition fast-syntax-check-mim ! 181: slow-syntax-check-mim backward-down-mim-object forward-up-mim-object ! 182: Variables: ! 183: Use \\[describe-variable] to obtain documentation. ! 184: mim-mode-hook indent-mim-comment indent-mim-arglist indent-mim-hook ! 185: mim-body-indent mim-down-parens-only mim-stop-for-slop ! 186: mim-mode-hysterical-bindings ! 187: Entry to this mode calls the value of mim-mode-hook if non-nil." ! 188: (interactive) ! 189: (kill-all-local-variables) ! 190: (if (not mim-mode-map) ! 191: (progn ! 192: (setq mim-mode-map (make-sparse-keymap)) ! 193: (define-key mim-mode-map "\e\^o" 'open-mim-line) ! 194: (define-key mim-mode-map "\e\^q" 'indent-mim-object) ! 195: (define-key mim-mode-map "\e\^p" 'previous-mim-object) ! 196: (define-key mim-mode-map "\e\^n" 'next-mim-object) ! 197: (define-key mim-mode-map "\e\^a" 'beginning-of-DEFINE) ! 198: (define-key mim-mode-map "\e\^e" 'end-of-DEFINE) ! 199: (define-key mim-mode-map "\e\^t" 'transpose-mim-objects) ! 200: (define-key mim-mode-map "\e\^u" 'backward-up-mim-object) ! 201: (define-key mim-mode-map "\e\^d" 'forward-down-mim-object) ! 202: (define-key mim-mode-map "\e\^h" 'mark-mim-object) ! 203: (define-key mim-mode-map "\e\^k" 'forward-kill-mim-object) ! 204: (define-key mim-mode-map "\e\^f" 'forward-mim-object) ! 205: (define-key mim-mode-map "\e\^b" 'backward-mim-object) ! 206: (define-key mim-mode-map "\e^" 'raise-mim-line) ! 207: (define-key mim-mode-map "\e\\" 'fixup-whitespace) ! 208: (define-key mim-mode-map "\177" 'backward-delete-char-untabify) ! 209: (define-key mim-mode-map "\e\177" 'backward-kill-mim-object) ! 210: (define-key mim-mode-map "\^j" 'newline-and-mim-indent) ! 211: (define-key mim-mode-map "\e;" 'begin-mim-comment) ! 212: (define-key mim-mode-map "\t" 'indent-mim-line) ! 213: (define-key mim-mode-map "\e\t" 'indent-mim-object) ! 214: (if (not mim-mode-hysterical-bindings) ! 215: nil ! 216: ;; i really hate this but too many people are accustomed to these. ! 217: (define-key mim-mode-map "\e!" 'line-to-top-of-window) ! 218: (define-key mim-mode-map "\eo" 'open-mim-line) ! 219: (define-key mim-mode-map "\ep" 'previous-mim-object) ! 220: (define-key mim-mode-map "\en" 'next-mim-object) ! 221: (define-key mim-mode-map "\ea" 'beginning-of-DEFINE) ! 222: (define-key mim-mode-map "\ee" 'end-of-DEFINE) ! 223: (define-key mim-mode-map "\et" 'transpose-mim-objects) ! 224: (define-key mim-mode-map "\eu" 'backward-up-mim-object) ! 225: (define-key mim-mode-map "\ed" 'forward-down-mim-object) ! 226: (define-key mim-mode-map "\ek" 'forward-kill-mim-object) ! 227: (define-key mim-mode-map "\ef" 'forward-mim-object) ! 228: (define-key mim-mode-map "\eb" 'backward-mim-object)))) ! 229: (use-local-map mim-mode-map) ! 230: (set-syntax-table mim-mode-syntax-table) ! 231: (make-local-variable 'paragraph-start) ! 232: (setq paragraph-start (concat "^$\\|" page-delimiter)) ! 233: (make-local-variable 'paragraph-separate) ! 234: (setq paragraph-separate paragraph-start) ! 235: ;; Most people use string comments. ! 236: (make-local-variable 'comment-start) ! 237: (setq comment-start ";\"") ! 238: (make-local-variable 'comment-start-skip) ! 239: (setq comment-start-skip ";\"") ! 240: (make-local-variable 'comment-end) ! 241: (setq comment-end "\"") ! 242: (make-local-variable 'comment-column) ! 243: (setq comment-column 40) ! 244: (make-local-variable 'comment-indent-hook) ! 245: (setq comment-indent-hook 'indent-mim-comment) ! 246: ;; tell generic indenter how to indent. ! 247: (make-local-variable 'indent-line-function) ! 248: (setq indent-line-function 'indent-mim-line) ! 249: ;; look for that paren ! 250: (make-local-variable 'blink-matching-paren-distance) ! 251: (setq blink-matching-paren-distance nil) ! 252: ;; so people who dont like tabs can turn them off locally in indenter. ! 253: (make-local-variable 'indent-tabs-mode) ! 254: (setq indent-tabs-mode t) ! 255: (setq local-abbrev-table mim-mode-abbrev-table) ! 256: (setq major-mode 'mim-mode) ! 257: (setq mode-name "Mim") ! 258: (run-hooks 'mim-mode-hook)) ! 259: ! 260: (defun line-to-top-of-window () ! 261: "Move current line to top of window." ! 262: (interactive) ; for lazy people ! 263: (recenter 0)) ! 264: ! 265: (defun forward-mim-object (arg) ! 266: "Move forward across Mim object. ! 267: With ARG, move forward that many objects." ! 268: (interactive "p") ! 269: ;; this function is wierd because it emulates the behavior of the old ! 270: ;; (gosling) mim-mode - if the arg is 1 and we are `inside' an ADECL, ! 271: ;; more than one character into the ATOM part and not sitting on the ! 272: ;; colon, then we move to the DECL part (just past colon) instead of ! 273: ;; the end of the object (the entire ADECL). otherwise, ADECL's are ! 274: ;; atomic objects. likewise for ATOM trailers. ! 275: (if (= (abs arg) 1) ! 276: (if (inside-atom-p) ! 277: ;; Move to end of ATOM or to trailer (!) or to ADECL (:). ! 278: (forward-sexp arg) ! 279: ;; Either scan an sexp or move over one bracket. ! 280: (forward-mim-objects arg t)) ! 281: ;; in the multi-object case, don't perform any magic. ! 282: ;; treats ATOM trailers and ADECLs atomically, stops at unmatched ! 283: ;; brackets with error. ! 284: (forward-mim-objects arg))) ! 285: ! 286: (defun inside-atom-p () ! 287: ;; Returns t iff inside an atom (takes account of trailers) ! 288: (let ((c1 (preceding-char)) ! 289: (c2 (following-char))) ! 290: (and (or (= (char-syntax c1) ?w) (= (char-syntax c1) ?_) (= c1 ?!)) ! 291: (or (= (char-syntax c2) ?w) (= (char-syntax c2) ?_) (= c2 ?!))))) ! 292: ! 293: (defun forward-mim-objects (arg &optional skip-bracket-p) ! 294: ;; Move over arg objects ignoring ADECLs and trailers. If ! 295: ;; skip-bracket-p is non-nil, then move over one bracket on error. ! 296: (let ((direction (sign arg))) ! 297: (condition-case conditions ! 298: (while (/= arg 0) ! 299: (forward-sexp direction) ! 300: (if (not (inside-adecl-or-trailer-p direction)) ! 301: (setq arg (- arg direction)))) ! 302: (error (if (not skip-bracket-p) ! 303: (signal 'error (cdr conditions)) ! 304: (skip-mim-whitespace direction) ! 305: (goto-char (+ (point) direction))))) ! 306: ;; If we moved too far move back to first interesting character. ! 307: (if (= (point) (buffer-end direction)) (skip-mim-whitespace (- direction))))) ! 308: ! 309: (defun backward-mim-object (&optional arg) ! 310: "Move backward across Mim object. ! 311: With ARG, move backward that many objects." ! 312: (interactive "p") ! 313: (forward-mim-object (if arg (- arg) -1))) ! 314: ! 315: (defun mark-mim-object (&optional arg) ! 316: "Mark following Mim object. ! 317: With ARG, mark that many following (preceding, ARG < 0) objects." ! 318: (interactive "p") ! 319: (push-mark (save-excursion (forward-mim-object (or arg 1)) (point)))) ! 320: ! 321: (defun forward-kill-mim-object (&optional arg) ! 322: "Kill following Mim object. ! 323: With ARG, kill that many objects." ! 324: (interactive "*p") ! 325: (kill-region (point) (progn (forward-mim-object (or arg 1)) (point)))) ! 326: ! 327: (defun backward-kill-mim-object (&optional arg) ! 328: "Kill preceding Mim object. ! 329: With ARG, kill that many objects." ! 330: (interactive "*p") ! 331: (forward-kill-mim-object (- (or arg 1)))) ! 332: ! 333: (defun raise-mim-line (&optional arg) ! 334: "Raise following line, fixing up whitespace at join. ! 335: With ARG raise that many following lines. ! 336: A negative ARG will raise current line and previous lines." ! 337: (interactive "*p") ! 338: (let* ((increment (sign (or arg (setq arg 1)))) ! 339: (direction (if (> arg 0) 1 0))) ! 340: (save-excursion ! 341: (while (/= arg 0) ! 342: ;; move over eol and kill it ! 343: (forward-line direction) ! 344: (delete-region (point) (1- (point))) ! 345: (fixup-whitespace) ! 346: (setq arg (- arg increment)))))) ! 347: ! 348: (defun forward-down-mim-object (&optional arg) ! 349: "Move down a level of Mim structure forwards. ! 350: With ARG, move down that many levels forwards (backwards, ARG < 0)." ! 351: (interactive "p") ! 352: ;; another wierdo - going down `inside' an ADECL or ATOM trailer ! 353: ;; depends on the value of mim-down-parens-only. if nil, treat ! 354: ;; ADECLs and trailers as structured objects. ! 355: (let ((direction (sign (or arg (setq arg 1))))) ! 356: (if (and (= (abs arg) 1) (not mim-down-parens-only)) ! 357: (goto-char ! 358: (save-excursion ! 359: (skip-mim-whitespace direction) ! 360: (if (> direction 0) (re-search-forward "\\s'*")) ! 361: (or (and (let ((c (next-char direction))) ! 362: (or (= (char-syntax c) ?_) ! 363: (= (char-syntax c) ?w))) ! 364: (progn (forward-sexp direction) ! 365: (if (inside-adecl-or-trailer-p direction) ! 366: (point)))) ! 367: (scan-lists (point) direction -1) ! 368: (buffer-end direction)))) ! 369: (while (/= arg 0) ! 370: (goto-char (or (scan-lists (point) direction -1) (buffer-end direction))) ! 371: (setq arg (- arg direction)))))) ! 372: ! 373: (defun backward-down-mim-object (&optional arg) ! 374: "Move down a level of Mim structure backwards. ! 375: With ARG, move down that many levels backwards (forwards, ARG < 0)." ! 376: (interactive "p") ! 377: (forward-down-mim-object (if arg (- arg) -1))) ! 378: ! 379: (defun forward-up-mim-object (&optional arg) ! 380: "Move up a level of Mim structure forwards ! 381: With ARG, move up that many levels forwards (backwards, ARG < 0)." ! 382: (interactive "p") ! 383: (let ((direction (sign (or arg (setq arg 1))))) ! 384: (while (/= arg 0) ! 385: (goto-char (or (scan-lists (point) direction 1) (buffer-end arg))) ! 386: (setq arg (- arg direction))) ! 387: (if (< direction 0) (backward-prefix-chars)))) ! 388: ! 389: (defun backward-up-mim-object (&optional arg) ! 390: "Move up a level of Mim structure backwards ! 391: With ARG, move up that many levels backwards (forwards, ARG > 0)." ! 392: (interactive "p") ! 393: (forward-up-mim-object (if arg (- arg) -1))) ! 394: ! 395: (defun replace-in-mim-object (old new) ! 396: "Replace string in following Mim object." ! 397: (interactive "*sReplace in object: \nsReplace %s with: ") ! 398: (save-restriction ! 399: (narrow-to-region (point) (save-excursion (forward-mim-object 1) (point))) ! 400: (replace-string old new))) ! 401: ! 402: (defun transpose-mim-objects (&optional arg) ! 403: "Transpose Mim objects around point. ! 404: With ARG, transpose preceding object that many times with following objects. ! 405: A negative ARG will transpose backwards." ! 406: (interactive "*p") ! 407: (transpose-subr 'forward-mim-object (or arg 1))) ! 408: ! 409: (defun beginning-of-DEFINE (&optional arg move) ! 410: "Move backward to beginning of surrounding or previous toplevel Mim form. ! 411: With ARG, do it that many times. Stops at last toplevel form seen if buffer ! 412: end is reached." ! 413: (interactive "p") ! 414: (let ((direction (sign (or arg (setq arg 1))))) ! 415: (if (not move) (setq move t)) ! 416: (if (< direction 0) (goto-char (1+ (point)))) ! 417: (while (and (/= arg 0) (re-search-backward "^<" nil move direction)) ! 418: (setq arg (- arg direction))) ! 419: (if (< direction 0) ! 420: (goto-char (1- (point)))))) ! 421: ! 422: (defun end-of-DEFINE (&optional arg) ! 423: "Move forward to end of surrounding or next toplevel mim form. ! 424: With ARG, do it that many times. Stops at end of last toplevel form seen ! 425: if buffer end is reached." ! 426: (interactive "p") ! 427: (if (not arg) (setq arg 1)) ! 428: (if (< arg 0) ! 429: (beginning-of-DEFINE (- (1- arg))) ! 430: (if (not (looking-at "^<")) (setq arg (1+ arg))) ! 431: (beginning-of-DEFINE (- arg) 'move) ! 432: (beginning-of-DEFINE 1)) ! 433: (forward-mim-object 1) ! 434: (forward-line 1)) ! 435: ! 436: (defun next-mim-object (&optional arg) ! 437: "Move to beginning of next toplevel Mim object. ! 438: With ARG, do it that many times. Stops at last object seen if buffer end ! 439: is reached." ! 440: (interactive "p") ! 441: (let ((search-string (if mim-stop-for-slop "^\\S " "^\\s(")) ! 442: (direction (sign (or arg (setq arg 1))))) ! 443: (if (> direction 0) ! 444: (goto-char (1+ (point)))) ; no error if end of buffer ! 445: (while (and (/= arg 0) ! 446: (re-search-forward search-string nil t direction)) ! 447: (setq arg (- arg direction))) ! 448: (if (> direction 0) ! 449: (goto-char (1- (point)))) ; no error if beginning of buffer ! 450: ;; scroll to top of window if moving forward and end not visible. ! 451: (if (not (or (< direction 0) ! 452: (save-excursion (forward-mim-object 1) ! 453: (pos-visible-in-window-p (point))))) ! 454: (recenter 0)))) ! 455: ! 456: (defun previous-mim-object (&optional arg) ! 457: "Move to beginning of previous toplevel Mim object. ! 458: With ARG do it that many times. Stops at last object seen if buffer end ! 459: is reached." ! 460: (interactive "p") ! 461: (next-mim-object (- (or arg 1)))) ! 462: ! 463: (defun calculate-mim-indent (&optional parse-start) ! 464: "Calculate indentation for Mim line. Returns column." ! 465: (save-excursion ; some excursion, huh, toto? ! 466: (beginning-of-line) ! 467: (let ((indent-point (point)) retry state containing-sexp last-sexp ! 468: desired-indent start peek where paren-depth) ! 469: (if parse-start ! 470: (goto-char parse-start) ; should be containing environment ! 471: (catch 'from-the-top ! 472: ;; find a place to start parsing. going backwards is fastest. ! 473: ;; forward-sexp signals error on encountering unmatched open. ! 474: (setq retry t) ! 475: (while retry ! 476: (condition-case nil (forward-sexp -1) (error (setq retry nil))) ! 477: (if (looking-at ".?[ \t]*\"") ! 478: ;; cant parse backward in presence of strings, go forward. ! 479: (progn ! 480: (goto-char indent-point) ! 481: (re-search-backward "^\\s(" nil 'move 1) ; to top of object ! 482: (throw 'from-the-top nil))) ! 483: (setq retry (and retry (/= (current-column) 0)))) ! 484: (skip-chars-backward mim-whitespace) ! 485: (if (not (bobp)) (forward-char -1)) ; onto unclosed open ! 486: (backward-prefix-chars))) ! 487: ;; find outermost containing sexp if we started inside an sexp. ! 488: (while (< (point) indent-point) ! 489: (setq state (parse-partial-sexp (point) indent-point 0))) ! 490: ;; find usual column to indent under (not in string or toplevel). ! 491: ;; on termination, state will correspond to containing environment ! 492: ;; (if retry is nil), where will be position of character to indent ! 493: ;; under normally, and desired-indent will be the column to indent to ! 494: ;; except if inside form, string, or at toplevel. point will be in ! 495: ;; in column to indent to unless inside string. ! 496: (setq retry t) ! 497: (while (and retry (setq paren-depth (car state)) (> paren-depth 0)) ! 498: ;; find innermost containing sexp. ! 499: (setq retry nil) ! 500: (setq last-sexp (car (nthcdr 2 state))) ! 501: (setq containing-sexp (car (cdr state))) ! 502: (goto-char (1+ containing-sexp)) ; to last unclosed open ! 503: (if (and last-sexp (> last-sexp (point))) ! 504: ;; is the last sexp a containing sexp? ! 505: (progn (setq peek (parse-partial-sexp last-sexp indent-point 0)) ! 506: (if (setq retry (car (cdr peek))) (setq state peek)))) ! 507: (if retry ! 508: nil ! 509: (setq where (1+ containing-sexp)) ; innermost containing sexp ! 510: (goto-char where) ! 511: (cond ! 512: ((not last-sexp) ; indent-point after bracket ! 513: (setq desired-indent (current-column))) ! 514: ((= (preceding-char) ?\<) ; it's a form ! 515: (cond ((> (progn (forward-sexp 1) (point)) last-sexp) ! 516: (goto-char where)) ; only one frob ! 517: ((> (save-excursion (forward-line 1) (point)) last-sexp) ! 518: (skip-chars-forward " \t") ; last-sexp is on same line ! 519: (setq where (point))) ; as containing-sexp ! 520: ((progn ! 521: (goto-char last-sexp) ! 522: (beginning-of-line) ! 523: (parse-partial-sexp (point) last-sexp 0 t) ! 524: (or (= (point) last-sexp) ! 525: (save-excursion ! 526: (= (car (parse-partial-sexp (point) last-sexp 0)) ! 527: 0)))) ! 528: (backward-prefix-chars) ; last-sexp 1st on line or 1st ! 529: (setq where (point))) ; frob on that line level 0 ! 530: (t (goto-char where)))) ; punt, should never occur ! 531: ((and indent-mim-arglist ; maybe hack arglist ! 532: (= (preceding-char) ?\() ; its a list ! 533: (save-excursion ; look for magic atoms ! 534: (setq peek 0) ; using peek as counter ! 535: (forward-char -1) ; back over containing paren ! 536: (while (and (< (setq peek (1+ peek)) 6) ! 537: (condition-case nil ! 538: (progn (forward-sexp -1) t) ! 539: (error nil)))) ! 540: (and (< peek 6) (looking-at "DEFINE\\|DEFMAC\\|FUNCTION")))) ! 541: ;; frobs stack under strings they belong to or under first ! 542: ;; frob to right of strings they belong to unless luser has ! 543: ;; frob (non-string) on preceding line with different ! 544: ;; indentation. strings stack under start of arglist unless ! 545: ;; mim-indent-arglist is not t, in which case they stack ! 546: ;; under the last string, if any, else the start of the arglist. ! 547: (let ((eol 0) last-string) ! 548: (while (< (point) last-sexp) ; find out where the strings are ! 549: (skip-chars-forward mim-whitespace last-sexp) ! 550: (if (> (setq start (point)) eol) ! 551: (progn ; simultaneously keeping track ! 552: (setq where (min where start)) ! 553: (end-of-line) ; of indentation of first frob ! 554: (setq eol (point)) ; on each line ! 555: (goto-char start))) ! 556: (if (= (following-char) ?\") ! 557: (progn (setq last-string (point)) ! 558: (forward-sexp 1) ! 559: (if (= last-string last-sexp) ! 560: (setq where last-sexp) ! 561: (skip-chars-forward mim-whitespace last-sexp) ! 562: (setq where (point)))) ! 563: (forward-sexp 1))) ! 564: (goto-char indent-point) ; if string is first on ! 565: (skip-chars-forward " \t" (point-max)) ; line we are indenting, it ! 566: (if (= (following-char) ?\") ; goes under arglist start ! 567: (if (and last-string (not (equal indent-mim-arglist t))) ! 568: (setq where last-string) ; or under last string. ! 569: (setq where (1+ containing-sexp))))) ! 570: (goto-char where) ! 571: (setq desired-indent (current-column))) ! 572: (t ; plain vanilla structure ! 573: (cond ((> (save-excursion (forward-line 1) (point)) last-sexp) ! 574: (skip-chars-forward " \t") ; last-sexp is on same line ! 575: (setq where (point))) ; as containing-sexp ! 576: ((progn ! 577: (goto-char last-sexp) ! 578: (beginning-of-line) ! 579: (parse-partial-sexp (point) last-sexp 0 t) ! 580: (or (= (point) last-sexp) ! 581: (save-excursion ! 582: (= (car (parse-partial-sexp (point) last-sexp 0)) ! 583: 0)))) ! 584: (backward-prefix-chars) ; last-sexp 1st on line or 1st ! 585: (setq where (point))) ; frob on that line level 0 ! 586: (t (goto-char where))) ; punt, should never occur ! 587: (setq desired-indent (current-column)))))) ! 588: ;; state is innermost containing environment unless toplevel or string. ! 589: (if (car (nthcdr 3 state)) ; inside string ! 590: (progn ! 591: (if last-sexp ; string must be next ! 592: (progn (goto-char last-sexp) ! 593: (forward-sexp 1) ! 594: (search-forward "\"") ! 595: (forward-char -1)) ! 596: (goto-char indent-point) ; toplevel string, look for it ! 597: (re-search-backward "[^\\]\"") ! 598: (forward-char 1)) ! 599: (setq start (point)) ; opening double quote ! 600: (skip-chars-backward " \t") ! 601: (backward-prefix-chars) ! 602: ;; see if the string is really a comment. ! 603: (if (and (looking-at ";[ \t]*\"") indent-mim-comment) ! 604: ;; it's a comment, line up under the start unless disabled. ! 605: (goto-char (1+ start)) ! 606: ;; it's a string, dont mung the indentation. ! 607: (goto-char indent-point) ! 608: (skip-chars-forward " \t")) ! 609: (setq desired-indent (current-column)))) ! 610: ;; point is sitting in usual column to indent to and if retry is nil ! 611: ;; then state corresponds to containing environment. if desired ! 612: ;; indentation not determined, we are inside a form, so call hook. ! 613: (or desired-indent ! 614: (and indent-mim-hook ! 615: (not retry) ! 616: (setq desired-indent ! 617: (funcall indent-mim-hook state indent-point))) ! 618: (setq desired-indent (current-column))) ! 619: (goto-char indent-point) ; back to where we started ! 620: desired-indent))) ; return column to indent to ! 621: ! 622: (defun indent-mim-hook (state indent-point) ! 623: "Compute indentation for Mim special forms. Returns column or nil." ! 624: (let ((containing-sexp (car (cdr state))) (current-indent (point))) ! 625: (save-excursion ! 626: (goto-char (1+ containing-sexp)) ! 627: (backward-prefix-chars) ! 628: ;; make sure we are looking at a symbol. if so, see if it is a special ! 629: ;; symbol. if so, add the special indentation to the indentation of ! 630: ;; the start of the special symbol, unless the property is not ! 631: ;; an integer and not nil (in this case, call the property, it must ! 632: ;; be a function which returns the appropriate indentation or nil and ! 633: ;; does not change the buffer). ! 634: (if (looking-at "\\sw\\|\\s_") ! 635: (let* ((start (current-column)) ! 636: (function ! 637: (intern-soft (buffer-substring (point) ! 638: (progn (forward-sexp 1) ! 639: (point))))) ! 640: (method (get function 'indent-mim-hook))) ! 641: (if (or (if (equal method 'DEFINE) (setq method mim-body-indent)) ! 642: (integerp method)) ! 643: ;; only use method if its first line after containing-sexp. ! 644: ;; we could have done this in calculate-mim-indent, but someday ! 645: ;; someone might want to format frobs in a special form based ! 646: ;; on position instead of indenting uniformly (like lisp if), ! 647: ;; so preserve right for posterity. if not first line, ! 648: ;; calculate-mim-indent already knows right indentation - ! 649: ;; give luser chance to change indentation manually by changing ! 650: ;; 1st line after containing-sexp. ! 651: (if (> (progn (forward-line 1) (point)) (car (nthcdr 2 state))) ! 652: (+ method start)) ! 653: (goto-char current-indent) ! 654: (if (consp method) ! 655: ;; list or pointted list of explicit indentations ! 656: (indent-mim-offset state indent-point) ! 657: (if (and (symbolp method) (fboundp method)) ! 658: ;; luser function - s/he better know what's going on. ! 659: ;; should take state and indent-point as arguments - for ! 660: ;; description of state, see parse-partial-sexp ! 661: ;; documentation the function is guaranteed the following: ! 662: ;; (1) state describes the closest surrounding form, ! 663: ;; (2) indent-point is the beginning of the line being ! 664: ;; indented, (3) point points to char in column that would ! 665: ;; normally be used for indentation, (4) function is bound ! 666: ;; to the special ATOM. See indent-mim-offset for example ! 667: ;; of a special function. ! 668: (funcall method state indent-point))))))))) ! 669: ! 670: (defun indent-mim-offset (state indent-point) ! 671: ;; offset forms explicitly according to list of indentations. ! 672: (let ((mim-body-indent mim-body-indent) ! 673: (indentations (get function 'indent-mim-hook)) ! 674: (containing-sexp (car (cdr state))) ! 675: (last-sexp (car (nthcdr 2 state))) ! 676: indentation) ! 677: (goto-char (1+ containing-sexp)) ! 678: ;; determine wheich of the indentations to use. ! 679: (while (and (< (point) indent-point) ! 680: (condition-case nil ! 681: (progn (forward-sexp 1) ! 682: (parse-partial-sexp (point) indent-point 1 t)) ! 683: (error nil))) ! 684: (skip-chars-backward " \t") ! 685: (backward-prefix-chars) ! 686: (if (= (following-char) ?\;) ! 687: nil ; ignore comments ! 688: (setq indentation (car indentations)) ! 689: (if (integerp (setq indentations (cdr indentations))) ! 690: ;; if last cdr is integer, that is indentation to use for all ! 691: ;; all the rest of the forms. ! 692: (progn (setq mim-body-indent indentations) ! 693: (setq indentations nil))))) ! 694: (goto-char (1+ containing-sexp)) ! 695: (+ (current-column) (or indentation mim-body-indent)))) ! 696: ! 697: (defun indent-mim-comment (&optional start) ! 698: "Indent a one line (string) Mim comment following object, if any." ! 699: (let* ((old-point (point)) (eol (progn (end-of-line) (point))) state last-sexp) ! 700: ;; this function assumes that comment indenting is enabled. it is caller's ! 701: ;; responsibility to check the indent-mim-comment flag before calling. ! 702: (beginning-of-line) ! 703: (catch 'no-comment ! 704: (setq state (parse-partial-sexp (point) eol)) ! 705: ;; determine if there is an existing regular comment. a `regular' ! 706: ;; comment is defined as a commented string which is the last thing ! 707: ;; on the line and does not extend beyond the end of the line. ! 708: (if (or (not (setq last-sexp (car (nthcdr 2 state)))) ! 709: (car (nthcdr 3 state))) ! 710: ;; empty line or inside string (multiple line). ! 711: (throw 'no-comment nil)) ! 712: ;; could be a comment, but make sure its not the only object. ! 713: (beginning-of-line) ! 714: (parse-partial-sexp (point) eol 0 t) ! 715: (if (= (point) last-sexp) ! 716: ;; only one object on line ! 717: (throw 'no-comment t)) ! 718: (goto-char last-sexp) ! 719: (skip-chars-backward " \t") ! 720: (backward-prefix-chars) ! 721: (if (not (looking-at ";[ \t]*\"")) ! 722: ;; aint no comment ! 723: (throw 'no-comment nil)) ! 724: ;; there is an existing regular comment ! 725: (delete-horizontal-space) ! 726: ;; move it to comment-column if possible else to tab-stop ! 727: (if (< (current-column) comment-column) ! 728: (indent-to comment-column) ! 729: (tab-to-tab-stop))) ! 730: (goto-char old-point))) ! 731: ! 732: (defun indent-mim-line () ! 733: "Indent line of Mim code." ! 734: (interactive "*") ! 735: (let* ((position (- (point-max) (point))) ! 736: (bol (progn (beginning-of-line) (point))) ! 737: (indent (calculate-mim-indent))) ! 738: (skip-chars-forward " \t") ! 739: (if (/= (current-column) indent) ! 740: (progn (delete-region bol (point)) (indent-to indent))) ! 741: (if (> (- (point-max) position) (point)) (goto-char (- (point-max) position))))) ! 742: ! 743: (defun newline-and-mim-indent () ! 744: "Insert newline at point and indent." ! 745: (interactive "*") ! 746: ;; commented code would correct indentation of line in arglist which ! 747: ;; starts with string, but it would indent every line twice. luser can ! 748: ;; just say tab after typing string to get same effect. ! 749: ;(if indent-mim-arglist (indent-mim-line)) ! 750: (newline) ! 751: (indent-mim-line)) ! 752: ! 753: (defun open-mim-line (&optional lines) ! 754: "Insert newline before point and indent. ! 755: With ARG insert that many newlines." ! 756: (interactive "*p") ! 757: (beginning-of-line) ! 758: (let ((indent (calculate-mim-indent))) ! 759: (while (> lines 0) ! 760: (newline) ! 761: (forward-line -1) ! 762: (indent-to indent) ! 763: (setq lines (1- lines))))) ! 764: ! 765: (defun indent-mim-object (&optional dont-indent-first-line) ! 766: "Indent object following point and all lines contained inside it. ! 767: With ARG, idents only contained lines (skips first line)." ! 768: (interactive "*P") ! 769: (let (end bol indent start) ! 770: (save-excursion (parse-partial-sexp (point) (point-max) 0 t) ! 771: (setq start (point)) ! 772: (forward-sexp 1) ! 773: (setq end (- (point-max) (point)))) ! 774: (save-excursion ! 775: (if (not dont-indent-first-line) (indent-mim-line)) ! 776: (while (progn (forward-line 1) (> (- (point-max) (point)) end)) ! 777: (setq indent (calculate-mim-indent start)) ! 778: (setq bol (point)) ! 779: (skip-chars-forward " \t") ! 780: (if (/= indent (current-column)) ! 781: (progn (delete-region bol (point)) (indent-to indent))) ! 782: (if indent-mim-comment (indent-mim-comment)))))) ! 783: ! 784: (defun find-mim-definition (name) ! 785: "Search for definition of function, macro, or gfcn. ! 786: You need type only enough of the name to be unambiguous." ! 787: (interactive "sName: ") ! 788: (let (where) ! 789: (save-excursion ! 790: (goto-char (point-min)) ! 791: (condition-case nil ! 792: (progn ! 793: (re-search-forward ! 794: (concat "^<\\(DEFINE\\|\\DEFMAC\\|FCN\\|GFCN\\)\\([ \t]*\\)" ! 795: name)) ! 796: (setq where (point))) ! 797: (error (error "Can't find %s" name)))) ! 798: (if where ! 799: (progn (push-mark) ! 800: (goto-char where) ! 801: (beginning-of-line) ! 802: (recenter 0))))) ! 803: ! 804: (defun begin-mim-comment () ! 805: "Move to existing comment or insert empty comment." ! 806: (interactive "*") ! 807: (let* ((eol (progn (end-of-line) (point))) ! 808: (bol (progn (beginning-of-line) (point)))) ! 809: ;; check for existing comment first. ! 810: (if (re-search-forward ";[ \t]*\"" eol t) ! 811: ;; found it. indent if desired and go there. ! 812: (if indent-mim-comment ! 813: (let ((where (- (point-max) (point)))) ! 814: (indent-mim-comment) ! 815: (goto-char (- (point-max) where)))) ! 816: ;; nothing there, make a comment. ! 817: (let (state last-sexp) ! 818: ;; skip past all the sexps on the line ! 819: (goto-char bol) ! 820: (while (and (equal (car (setq state (parse-partial-sexp (point) eol 0))) ! 821: 0) ! 822: (car (nthcdr 2 state))) ! 823: (setq last-sexp (car (nthcdr 2 state)))) ! 824: (if (car (nthcdr 3 state)) ! 825: nil ; inside a string, punt ! 826: (delete-region (point) eol) ; flush trailing whitespace ! 827: (if (and (not last-sexp) (equal (car state) 0)) ! 828: (indent-to (calculate-mim-indent)) ; empty, indent like code ! 829: (if (> (current-column) comment-column) ; indent to comment column ! 830: (tab-to-tab-stop) ; unless past it, else to ! 831: (indent-to comment-column))) ; tab-stop ! 832: ;; if luser changes comment-{start end} to something besides semi ! 833: ;; followed by zero or more whitespace characters followed by string ! 834: ;; delimiters, the code above fails to find existing comments, but as ! 835: ;; taa says, `let the losers lose'. ! 836: (insert comment-start) ! 837: (save-excursion (insert comment-end))))))) ! 838: ! 839: (defun skip-mim-whitespace (direction) ! 840: (if (>= direction 0) ! 841: (skip-chars-forward mim-whitespace (point-max)) ! 842: (skip-chars-backward mim-whitespace (point-min)))) ! 843: ! 844: (defun inside-adecl-or-trailer-p (direction) ! 845: (if (>= direction 0) ! 846: (looking-at ":\\|!-") ! 847: (or (= (preceding-char) ?:) ! 848: (looking-at "!-")))) ! 849: ! 850: (defun sign (n) ! 851: "Returns -1 if N < 0, else 1." ! 852: (if (>= n 0) 1 -1)) ! 853: ! 854: (defun abs (n) ! 855: "Returns the absolute value of N." ! 856: (if (>= n 0) n (- n))) ! 857: ! 858: (defun next-char (direction) ! 859: "Returns preceding-char if DIRECTION < 0, otherwise following-char." ! 860: (if (>= direction 0) (following-char) (preceding-char)))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.