4.4BSD/usr/src/contrib/emacs-18.57/lisp/mim-mode.elc


(provide (quote mim-mode))

(autoload (quote fast-syntax-check-mim) "mim-syntax" "\
Checks Mim syntax quickly.
Answers correct or incorrect, cannot point out the error context." t)

(autoload (quote slow-syntax-check-mim) "mim-syntax" "\
Check Mim syntax slowly.
Points out the context of the error, if the syntax is incorrect." t)

(defvar mim-mode-hysterical-bindings t "\
*Non-nil means bind list manipulation commands to Meta keys as well as
Control-Meta keys for historical reasons.  Otherwise, only the latter keys
are bound.")

(defvar mim-mode-map nil)

(defvar mim-mode-syntax-table nil)

(if mim-mode-syntax-table nil (let ((i -1)) (setq mim-mode-syntax-table (make-syntax-table)) (while (< i 32) (modify-syntax-entry (setq i (1+ i)) "    " mim-mode-syntax-table)) (while (< i 127) (modify-syntax-entry (setq i (1+ i)) "_   " mim-mode-syntax-table)) (setq i (1- 97)) (while (< i 122) (modify-syntax-entry (setq i (1+ i)) "w   " mim-mode-syntax-table)) (setq i (1- 65)) (while (< i 90) (modify-syntax-entry (setq i (1+ i)) "w   " mim-mode-syntax-table)) (setq i (1- 48)) (while (< i 57) (modify-syntax-entry (setq i (1+ i)) "w   " mim-mode-syntax-table)) (modify-syntax-entry 58 "     " mim-mode-syntax-table) (modify-syntax-entry 44 "'    " mim-mode-syntax-table) (modify-syntax-entry 46 "'    " mim-mode-syntax-table) (modify-syntax-entry 39 "'    " mim-mode-syntax-table) (modify-syntax-entry 96 "'    " mim-mode-syntax-table) (modify-syntax-entry 126 "'    " mim-mode-syntax-table) (modify-syntax-entry 59 "'    " mim-mode-syntax-table) (modify-syntax-entry 35 "'    " mim-mode-syntax-table) (modify-syntax-entry 37 "'    " mim-mode-syntax-table) (modify-syntax-entry 33 "'    " mim-mode-syntax-table) (modify-syntax-entry 34 "\"   " mim-mode-syntax-table) (modify-syntax-entry 92 "\\   " mim-mode-syntax-table) (modify-syntax-entry 40 "()  " mim-mode-syntax-table) (modify-syntax-entry 60 "(>  " mim-mode-syntax-table) (modify-syntax-entry 123 "(}  " mim-mode-syntax-table) (modify-syntax-entry 91 "(]  " mim-mode-syntax-table) (modify-syntax-entry 41 ")(  " mim-mode-syntax-table) (modify-syntax-entry 62 ")<  " mim-mode-syntax-table) (modify-syntax-entry 125 "){  " mim-mode-syntax-table) (modify-syntax-entry 93 ")[  " mim-mode-syntax-table)))

(defconst mim-whitespace "- ")

(defvar mim-mode-hook nil "\
*User function run after mim mode initialization.  Usage:
(setq mim-mode-hook '(lambda () ... your init forms ...)).")

(define-abbrev-table (quote mim-mode-abbrev-table) nil)

(defconst indent-mim-hook (quote indent-mim-hook) "\
Controls (via properties) indenting of special forms.
(put 'FOO 'indent-mim-hook n), integer n, means lines inside
<FOO ...> will be indented n spaces from start of form.
(put 'FOO 'indent-mim-hook 'DEFINE) is like above but means use
value of mim-body-indent as offset from start of form.
(put 'FOO 'indent-mim-hook <cons>) where <cons> is a list or pointted list
of integers, means indent each form in <FOO ...> by the amount specified
in <cons>.  When <cons> is exhausted, indent remaining forms by
mim-body-indent unless <cons> is a pointted list, in which case the last
cdr is used.  Confused? Here is an example:
(put 'FROBIT 'indent-mim-hook '(4 2 . 1))
<FROBIT
     <CHOMP-IT>
   <CHOMP-SOME-MORE>
  <DIGEST>
  <BELCH>
  ...>
Finally, the property can be a function name (read the code).")

(defvar indent-mim-comment t "\
*Non-nil means indent string comments.")

(defvar mim-body-indent 2 "\
*Amount to indent in special forms which have DEFINE property on
indent-mim-hook.")

(defvar indent-mim-arglist t "\
*nil means indent arglists like ordinary lists.
t means strings stack under start of arglist and variables stack to
right of them.  Otherwise, strings stack under last string (or start
of arglist if none) and variables stack to right of them.
Examples (for values 'stack, t, nil):

(FOO \"OPT\" BAR             (FOO \"OPT\" BAR            (FOO \"OPT\" BAR
           BAZ MUMBLE                 BAZ MUMBLE      BAZ MUMBLE
     \"AUX\"                  \"AUX\"                     \"AUX\"
     BLETCH ...             BLETCH ...                BLETCH ...")

(put (quote DEFINE) (quote indent-mim-hook) (quote DEFINE))

(put (quote DEFMAC) (quote indent-mim-hook) (quote DEFINE))

(put (quote BIND) (quote indent-mim-hook) (quote DEFINE))

(put (quote PROG) (quote indent-mim-hook) (quote DEFINE))

(put (quote REPEAT) (quote indent-mim-hook) (quote DEFINE))

(put (quote CASE) (quote indent-mim-hook) (quote DEFINE))

(put (quote FUNCTION) (quote indent-mim-hook) (quote DEFINE))

(put (quote MAPF) (quote indent-mim-hook) (quote DEFINE))

(put (quote MAPR) (quote indent-mim-hook) (quote DEFINE))

(put (quote UNWIND) (quote indent-mim-hook) (cons (* 2 mim-body-indent) mim-body-indent))

(defvar mim-down-parens-only t "\
*nil means treat ADECLs and ATOM trailers like structures when
moving down a level of structure.")

(defvar mim-stop-for-slop t "\
*Non-nil means {next previous}-mim-object consider any
non-whitespace character in column 0 to be a toplevel object, otherwise
only open paren syntax characters will be considered.")

(fset (quote mdl-mode) (quote mim-mode))

(defun mim-mode nil "\
Major mode for editing Mim (MDL in MDL) code.
Commands:
    If value of mim-mode-hysterical-bindings is non-nil, then following
commands are assigned to escape keys as well (e.g. M-f = M-C-f).
The default action is bind the escape keys.
  Tab        Indents the current line as MDL code.
  Delete     Converts tabs to spaces as it moves back.
  M-C-f      Move forward over next mim object.
  M-C-b      Move backward over previous mim object.
  M-C-p      Move to beginning of previous toplevel mim object.
  M-C-n      Move to the beginning of the next toplevel mim object.
  M-C-a      Move to the top of surrounding toplevel mim form.
  M-C-e      Move to the end of surrounding toplevel mim form.
  M-C-u      Move up a level of mim structure backwards.
  M-C-d      Move down a level of mim structure forwards.
  M-C-t      Transpose mim objects on either side of point.
  M-C-k      Kill next mim object.
  M-C-h      Place mark at end of next mim object.
  M-C-o      Insert a newline before current line and indent.
  M-Delete   Kill previous mim object.
  M-^        Join current line to previous line.
  M-\\        Delete whitespace around point.
  M-;        Move to existing comment or insert empty comment if none.
  M-Tab      Indent following mim object and all contained lines.
Other Commands:
  Use \\[describe-function] to obtain documentation.
  replace-in-mim-object  find-mim-definition  fast-syntax-check-mim
  slow-syntax-check-mim  backward-down-mim-object  forward-up-mim-object
Variables:
  Use \\[describe-variable] to obtain documentation.
  mim-mode-hook  indent-mim-comment  indent-mim-arglist  indent-mim-hook
  mim-body-indent  mim-down-parens-only  mim-stop-for-slop
  mim-mode-hysterical-bindings
Entry to this mode calls the value of mim-mode-hook if non-nil." (interactive) (byte-code "ˆ ? ####################@#	?‚AB#C#D#E#F#G#H#I#J#K#L#M#N!O!P!Q
PP!P!ȉP!R	P!R
P!SP!TP!U
P!P!‰P!ȉVWXY!" [mim-mode-map mim-mode-hysterical-bindings nil mim-mode-syntax-table paragraph-start page-delimiter paragraph-separate paragraph-ignore-fill-prefix t comment-start comment-start-skip comment-end comment-column comment-indent-hook indent-line-function blink-matching-paren-distance indent-tabs-mode local-abbrev-table mim-mode-abbrev-table major-mode mode-name kill-all-local-variables make-sparse-keymap define-key "" open-mim-line "" indent-mim-object "" previous-mim-object "" next-mim-object "" beginning-of-DEFINE "" end-of-DEFINE "" transpose-mim-objects "" backward-up-mim-object "" forward-down-mim-object "" mark-mim-object "" forward-kill-mim-object "" forward-mim-object "" backward-mim-object "^" raise-mim-line "\\" fixup-whitespace "" backward-delete-char-untabify "" backward-kill-mim-object "
" newline-and-mim-indent ";" begin-mim-comment "	" indent-mim-line "	" "!" line-to-top-of-window "o" "p" "n" "a" "e" "t" "u" "d" "k" "f" "b" use-local-map set-syntax-table make-local-variable "^$\\|" ";\"" "\"" 40 indent-mim-comment mim-mode "Mim" run-hooks mim-mode-hook] 50))

(defun line-to-top-of-window nil "\
Move current line to top of window." (interactive) (byte-code "!" [nil recenter 0] 2))

(defun forward-mim-object (arg) "\
Move forward across Mim object.
With ARG, move forward that many objects." (interactive "p") (byte-code "ˆ!U !\"!" [arg t nil abs 1 inside-atom-p forward-sexp forward-mim-objects] 6))

(defun inside-atom-p nil (byte-code "hg!U!UU-	!U-	!U-	U*" [c1 c2 char-syntax 119 95 33] 6))

(defun forward-mim-objects (arg &optional skip-bracket-p) (byte-code "	!ŏ`!U[!)" [direction arg sign conditions (byte-code "\"	!	!?	Z" [arg direction /= 0 forward-sexp inside-adecl-or-trailer-p] 6) ((error (byte-code "?
	A\"
!`
\\b" [skip-bracket-p conditions direction signal error skip-mim-whitespace] 4))) buffer-end skip-mim-whitespace] 4))

(defun backward-mim-object (&optional arg) "\
Move backward across Mim object.
With ARG, move backward that many objects." (interactive "p") (byte-code "[
!" [arg nil forward-mim-object -1] 2))

(defun mark-mim-object (&optional arg) "\
Mark following Mim object.
With ARG, mark that many following (preceding, ARG < 0) objects." (interactive "p") (byte-code "Š
!`)!" [arg nil push-mark forward-mim-object 1] 3))

(defun forward-kill-mim-object (&optional arg) "\
Kill following Mim object.
With ARG, kill that many objects." (interactive "*p") (byte-code "`
!`\"" [arg nil kill-region forward-mim-object 1] 4))

(defun backward-kill-mim-object (&optional arg) "\
Kill preceding Mim object.
With ARG, kill that many objects." (interactive "*p") (byte-code "[!" [arg nil forward-kill-mim-object 1] 2))

(defun raise-mim-line (&optional arg) "\
Raise following line, fixing up whitespace at join.
With ARG raise that many following lines.
A negative ARG will raise current line and previous lines." (interactive "*p") (byte-code "È	
ʼn!	Vł	\"6
!``S\" 	Z)*" [increment arg direction nil sign 1 0 /= forward-line delete-region fixup-whitespace] 8))

(defun forward-down-mim-object (&optional arg) "\
Move down a level of Mim structure forwards.
With ARG, move down that many levels forwards (backwards, ARG < 0)." (interactive "p") (byte-code "Ĉ	
Ɖ!	!U
?[!V'!!!U9!U)H!!H`V`#V!)bx	\"x`#m!b	Z[)" [direction arg mim-down-parens-only c nil sign 1 abs skip-mim-whitespace 0 re-search-forward "\\s'*" next-char char-syntax 95 119 forward-sexp inside-adecl-or-trailer-p scan-lists -1 buffer-end /=] 17))

(defun backward-down-mim-object (&optional arg) "\
Move down a level of Mim structure backwards.
With ARG, move down that many levels backwards (forwards, ARG < 0)." (interactive "p") (byte-code "[
!" [arg nil forward-down-mim-object -1] 2))

(defun forward-up-mim-object (&optional arg) "\
Move up a level of Mim structure forwards
With ARG, move up that many levels forwards (backwards, ARG < 0)." (interactive "p") (byte-code "ˆ	
ĉ!	\")`#	!b	ZW2 )" [direction arg nil sign 1 /= 0 scan-lists buffer-end backward-prefix-chars] 7))

(defun backward-up-mim-object (&optional arg) "\
Move up a level of Mim structure backwards
With ARG, move up that many levels backwards (forwards, ARG > 0)." (interactive "p") (byte-code "[
!" [arg nil forward-up-mim-object -1] 2))

(defun replace-in-mim-object (old new) "\
Replace string in following Mim object." (interactive "*sReplace in object: 
sReplace %s with: ") (byte-code "ˆ`!`)\"	\")" [old new nil narrow-to-region forward-mim-object 1 replace-string] 5))

(defun transpose-mim-objects (&optional arg) "\
Transpose Mim objects around point.
With ARG, transpose preceding object that many times with following objects.
A negative ARG will transpose backwards." (interactive "*p") (byte-code "	\"" [arg nil transpose-subr forward-mim-object 1] 3))

(defun beginning-of-DEFINE (&optional arg move) "\
Move backward to beginning of surrounding or previous toplevel Mim form.
With ARG, do it that many times.  Stops at last toplevel form seen if buffer
end is reached." (interactive "p") (byte-code "Ĉ	
Ɖ!
?ÉW`Tb	\",
$8	ZWB`Sb)" [direction arg move t nil sign 1 0 /= re-search-backward "^<"] 7))

(defun end-of-DEFINE (&optional arg) "\
Move forward to end of surrounding or next toplevel mim form.
With ARG, do it that many times.  Stops at end of last toplevel form seen
if buffer end is reached." (interactive "p") (byte-code "?
‰WS[!.!?$T[\"!!!" [arg nil 1 0 beginning-of-DEFINE looking-at "^<" move forward-mim-object forward-line] 7))

(defun next-mim-object (&optional arg) "\
Move to beginning of next toplevel Mim object.
With ARG, do it that many times.  Stops at last object seen if buffer end
is reached." (interactive "p") (byte-code "Ĉ	
Ƃɉ!
V`Tb\"-
$9
Z 
VC`Sb
WS!`!)?Z!*" [search-string mim-stop-for-slop direction arg nil t "^\\S " "^\\s(" sign 1 0 /= re-search-forward forward-mim-object pos-visible-in-window-p recenter] 7))

(defun previous-mim-object (&optional arg) "\
Move to beginning of previous toplevel Mim object.
With ARG do it that many times.  Stops at last object seen if buffer end
is reached." (interactive "p") (byte-code "[!" [arg nil next-mim-object 1] 2))

(defun calculate-mim-indent (&optional parse-start) "\
Calculate indentation for Mim line.  Returns column." (byte-code " `	
'
b*Ս`W<`#+ˉ	Q
@	Q	V$̉
\"@
A@Tbq`V#A@	̂ Tb?i hU!`Vb!`)V!`b `$`U`#@U) `b 
=hU=׉!TW)揅1̈W<!)`W\"`Vp^ `bgU`!U\"`!Fbd\"gU
\"?T*bi !`)V!`b `$`U`#@U) `biA
\"@uBb!!!Lb!!`! !akTbqb!i
	?
#ib
.
)" [indent-point retry state containing-sexp last-sexp desired-indent start peek where paren-depth parse-start t nil indent-mim-arglist eol last-string mim-whitespace indent-mim-comment indent-mim-hook beginning-of-line from-the-top (byte-code "0Ə!!
b$\"*i\"!o?=! " [retry t indent-point nil mim-whitespace (byte-code "!" [forward-sexp -1] 2) ((error (byte-code "" [retry nil] 2))) looking-at ".?[ 	]*\"" re-search-backward "^\\s(" move 1 throw from-the-top /= 0 skip-chars-backward forward-char -1 backward-prefix-chars] 8) parse-partial-sexp 0 nthcdr 2 60 forward-sexp 1 forward-line skip-chars-forward " 	" backward-prefix-chars 40 forward-char -1 6 (byte-code "!" [t forward-sexp -1] 2) ((error (byte-code "" [nil] 1))) looking-at "DEFINE\\|DEFMAC\\|FUNCTION" end-of-line 34 equal 3 search-forward "\"" re-search-backward "[^\\]\"" skip-chars-backward ";[ 	]*\"" funcall] 40))

(defun indent-mim-hook (state indent-point) "\
Compute indentation for Mim special forms.  Returns column or nil." (byte-code "	A@`Tb !oi`!`\"!N
\"06
!M!`	\"@VJ
\\n
b
:]	\"n
9e
!n
	#+)*" [containing-sexp state current-indent start function method mim-body-indent indent-point backward-prefix-chars looking-at "\\sw\\|\\s_" intern-soft buffer-substring forward-sexp 1 indent-mim-hook equal DEFINE integerp forward-line nthcdr 2 indent-mim-offset fboundp funcall] 15))

(defun indent-mim-offset (state indent-point) (byte-code "
NA@\"@Tb`W\"͏P! gU6ȂL	@	A!L	ȉTbi\\\\-" [mim-body-indent indentations function containing-sexp state last-sexp indentation indent-point nil indent-mim-hook nthcdr 2 (byte-code "!`$" [indent-point t forward-sexp 1 parse-partial-sexp] 6) ((error (byte-code "" [nil] 1))) skip-chars-backward " 	" backward-prefix-chars 59 integerp] 7))

(defun indent-mim-comment (&optional start) "\
Indent a one line (string) Mim comment following object, if any." (byte-code "` ` ȍb," [old-point eol state last-sexp end-of-line nil beginning-of-line no-comment (byte-code "`	\"\"@?\"@\" `	$`
U3\"
b! !?I\" i
WX
jZ " [state eol last-sexp nil t comment-column parse-partial-sexp nthcdr 2 3 throw no-comment beginning-of-line 0 skip-chars-backward " 	" backward-prefix-chars looking-at ";[ 	]*\"" delete-horizontal-space tab-to-tab-stop] 14)] 4))

(defun indent-mim-line nil "\
Indent line of Mim code." (interactive "*") (byte-code "Èd`Z ` !i
\" 	`\"
jdZ`V-dZb+" [position bol indent nil beginning-of-line calculate-mim-indent skip-chars-forward " 	" /= delete-region] 7))

(defun newline-and-mim-indent nil "\
Insert newline at point and indent." (interactive "*") (byte-code "  " [nil newline indent-mim-line] 3))

(defun open-mim-line (&optional lines) "\
Insert newline before point and indent.
With ARG insert that many newlines." (interactive "*p") (byte-code "ˆ  	V  !j	S)" [indent lines nil beginning-of-line calculate-mim-indent 0 newline forward-line -1] 7))

(defun indent-mim-object (&optional dont-indent-first-line) "\
Indent object following point and all lines contained inside it.
With ARG, idents only contained lines (skips first line)." (interactive "*P") (byte-code "Lj`d$`!d`Z)
?) !d`ZV^!`!
i\"R	`\"
jZ *)," [end bol indent start t dont-indent-first-line indent-mim-comment nil parse-partial-sexp 0 forward-sexp 1 indent-mim-line forward-line calculate-mim-indent skip-chars-forward " 	" /= delete-region] 11))

(defun find-mim-definition (name) "\
Search for definition of function, macro, or gfcn.
You need type only enough of the name to be unambiguous." (interactive "sName: ") (byte-code "ebÏ) b !)" [where nil (byte-code "P!`" [name where re-search-forward "^<\\(DEFINE\\|\\DEFMAC\\|FCN\\|GFCN\\)\\([ 	]*\\)"] 3) ((error (byte-code "\"" [name error "Can't find %s"] 3))) push-mark beginning-of-line recenter 0] 4))

(defun begin-mim-comment nil "\
Move to existing comment or insert empty comment." (interactive "*") (byte-code "Lj ` `#'$d`Z dZb)	b`#@\"B
\"@Q
\"@/
\"@^ǂ`\"?n
@\"w jiV j	c
c)**" [eol bol t indent-mim-comment where state last-sexp nil comment-column comment-start comment-end end-of-line beginning-of-line re-search-forward ";[ 	]*\"" equal parse-partial-sexp 0 nthcdr 2 3 delete-region calculate-mim-indent tab-to-tab-stop] 14))

(defun skip-mim-whitespace (direction) (byte-code "Y
	d\"	e\"" [direction mim-whitespace 0 skip-chars-forward skip-chars-backward] 4))

(defun inside-adecl-or-trailer-p (direction) (byte-code "Y!hU!" [direction 0 looking-at ":\\|!-" 58 "!-"] 3))

(defun sign (n) "\
Returns -1 if N < 0, else 1." (byte-code "Y
‚Ç" [n 0 1 -1] 2))

(defun abs (n) "\
Returns the absolute value of N." (byte-code "Y
[" [n 0] 2))

(defun next-char (direction) "\
Returns preceding-char if DIRECTION < 0, otherwise following-char." (byte-code "Y
gh" [direction 0] 2))