mim-mode.el

早期freebsd实现

;; Mim (MDL in MDL) mode.
;; Copyright (C) 1985 Free Software Foundation, Inc.
;; Principal author K. Shane Hartman

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.


(provide 'mim-mode)

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

(autoload '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
    ()
  (let ((i -1))
    (setq mim-mode-syntax-table (make-syntax-table))
    (while (< i ?\ )
      (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- ?a))
    (while (< i ?z)
      (modify-syntax-entry (setq i (1+ i)) "w   " mim-mode-syntax-table))
    (setq i (1- ?A))
    (while (< i ?Z)
      (modify-syntax-entry (setq i (1+ i)) "w   " mim-mode-syntax-table))
    (setq i (1- ?0))
    (while (< i ?9)
      (modify-syntax-entry (setq i (1+ i)) "w   " mim-mode-syntax-table))
    (modify-syntax-entry ?:  "     " mim-mode-syntax-table) ; make : symbol delimiter
    (modify-syntax-entry ?,  "'    " mim-mode-syntax-table)
    (modify-syntax-entry ?.  "'    " mim-mode-syntax-table)
    (modify-syntax-entry ?'  "'    " mim-mode-syntax-table)
    (modify-syntax-entry ?`  "'    " mim-mode-syntax-table)
    (modify-syntax-entry ?~  "'    " mim-mode-syntax-table)
    (modify-syntax-entry ?\; "'    " mim-mode-syntax-table) ; comments are prefixed objects
    (modify-syntax-entry ?#  "'    " mim-mode-syntax-table)
    (modify-syntax-entry ?%  "'    " mim-mode-syntax-table)
    (modify-syntax-entry ?!  "'    " mim-mode-syntax-table)
    (modify-syntax-entry ?\" "\"   " mim-mode-syntax-table)
    (modify-syntax-entry ?\\ "\\   " mim-mode-syntax-table)
    (modify-syntax-entry ?\( "\()  " mim-mode-syntax-table)
    (modify-syntax-entry ?\< "\(>  " mim-mode-syntax-table)
    (modify-syntax-entry ?\{ "\(}  " mim-mode-syntax-table)
    (modify-syntax-entry ?\[ "\(]  " mim-mode-syntax-table)
    (modify-syntax-entry ?\) "\)(  " mim-mode-syntax-table)
    (modify-syntax-entry ?\> "\)<  " mim-mode-syntax-table)
    (modify-syntax-entry ?\} "\){  " mim-mode-syntax-table)
    (modify-syntax-entry ?\] "\)[  " mim-mode-syntax-table)))

(defconst mim-whitespace "\000- ")

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

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

(defconst indent-mim-hook '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 'DEFINE 'indent-mim-hook 'DEFINE)
(put 'DEFMAC 'indent-mim-hook 'DEFINE)
(put 'BIND 'indent-mim-hook 'DEFINE)
(put 'PROG 'indent-mim-hook 'DEFINE)
(put 'REPEAT 'indent-mim-hook 'DEFINE)
(put 'CASE 'indent-mim-hook 'DEFINE)
(put 'FUNCTION 'indent-mim-hook 'DEFINE)
(put 'MAPF 'indent-mim-hook 'DEFINE)
(put 'MAPR 'indent-mim-hook 'DEFINE)
(put 'UNWIND '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 'mdl-mode 'mim-mode)

(defun mim-mode ()
  "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)
  (kill-all-local-variables)
  (if (not mim-mode-map)
      (progn
	(setq mim-mode-map (make-sparse-keymap))
	(define-key mim-mode-map "\e\^o" 'open-mim-line)
	(define-key mim-mode-map "\e\^q" 'indent-mim-object)
	(define-key mim-mode-map "\e\^p" 'previous-mim-object)
	(define-key mim-mode-map "\e\^n" 'next-mim-object)
	(define-key mim-mode-map "\e\^a" 'beginning-of-DEFINE)
	(define-key mim-mode-map "\e\^e" 'end-of-DEFINE)
	(define-key mim-mode-map "\e\^t" 'transpose-mim-objects)
	(define-key mim-mode-map "\e\^u" 'backward-up-mim-object)	
	(define-key mim-mode-map "\e\^d" 'forward-down-mim-object)	 
	(define-key mim-mode-map "\e\^h" 'mark-mim-object)
	(define-key mim-mode-map "\e\^k" 'forward-kill-mim-object)	
	(define-key mim-mode-map "\e\^f" 'forward-mim-object)	   
	(define-key mim-mode-map "\e\^b" 'backward-mim-object)
	(define-key mim-mode-map "\e^" 'raise-mim-line)
	(define-key mim-mode-map "\e\\" 'fixup-whitespace)
	(define-key mim-mode-map "\177" 'backward-delete-char-untabify)
	(define-key mim-mode-map "\e\177" 'backward-kill-mim-object)
	(define-key mim-mode-map "\^j" 'newline-and-mim-indent)
	(define-key mim-mode-map "\e;" 'begin-mim-comment)
	(define-key mim-mode-map "\t" 'indent-mim-line)
	(define-key mim-mode-map "\e\t" 'indent-mim-object)
	(if (not mim-mode-hysterical-bindings)
	    nil
	  ;; i really hate this but too many people are accustomed to these.
	  (define-key mim-mode-map "\e!" 'line-to-top-of-window)
	  (define-key mim-mode-map "\eo" 'open-mim-line)
	  (define-key mim-mode-map "\ep" 'previous-mim-object)
	  (define-key mim-mode-map "\en" 'next-mim-object)
	  (define-key mim-mode-map "\ea" 'beginning-of-DEFINE)
	  (define-key mim-mode-map "\ee" 'end-of-DEFINE)
	  (define-key mim-mode-map "\et" 'transpose-mim-objects)
	  (define-key mim-mode-map "\eu" 'backward-up-mim-object)
	  (define-key mim-mode-map "\ed" 'forward-down-mim-object)
	  (define-key mim-mode-map "\ek" 'forward-kill-mim-object)
	  (define-key mim-mode-map "\ef" 'forward-mim-object)
	  (define-key mim-mode-map "\eb" 'backward-mim-object))))
  (use-local-map mim-mode-map)
  (set-syntax-table mim-mode-syntax-table)
  (make-local-variable 'paragraph-start)
  (setq paragraph-start (concat "^$\\|" page-delimiter))
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate paragraph-start)
  (make-local-variable 'paragraph-ignore-fill-prefix)
  (setq paragraph-ignore-fill-prefix t)
  ;; Most people use string comments.
  (make-local-variable 'comment-start)
  (setq comment-start ";\"")
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip ";\"")
  (make-local-variable 'comment-end)
  (setq comment-end "\"")
  (make-local-variable 'comment-column)
  (setq comment-column 40)
  (make-local-variable 'comment-indent-hook)
  (setq comment-indent-hook 'indent-mim-comment)
  ;; tell generic indenter how to indent.
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'indent-mim-line)
  ;; look for that paren
  (make-local-variable 'blink-matching-paren-distance)
  (setq blink-matching-paren-distance nil)
  ;; so people who dont like tabs can turn them off locally in indenter.
  (make-local-variable 'indent-tabs-mode)
  (setq indent-tabs-mode t)
  (setq local-abbrev-table mim-mode-abbrev-table)
  (setq major-mode 'mim-mode)
  (setq mode-name "Mim")
  (run-hooks 'mim-mode-hook))

(defun line-to-top-of-window ()
  "Move current line to top of window."
  (interactive)				; for lazy people
  (recenter 0))

(defun forward-mim-object (arg)
  "Move forward across Mim object.
With ARG, move forward that many objects."
  (interactive "p")
  ;; this function is wierd because it emulates the behavior of the old
  ;; (gosling) mim-mode - if the arg is 1 and we are `inside' an ADECL,
  ;; more than one character into the ATOM part and not sitting on the
  ;; colon, then we move to the DECL part (just past colon) instead of
  ;; the end of the object (the entire ADECL).  otherwise, ADECL's are
  ;; atomic objects.  likewise for ATOM trailers.
  (if (= (abs arg) 1)
      (if (inside-atom-p)
	  ;; Move to end of ATOM or to trailer (!) or to ADECL (:).
	  (forward-sexp arg)
	;; Either scan an sexp or move over one bracket.
	(forward-mim-objects arg t))
    ;; in the multi-object case, don't perform any magic.
    ;; treats ATOM trailers and ADECLs atomically, stops at unmatched
    ;; brackets with error.
    (forward-mim-objects arg)))

(defun inside-atom-p ()
  ;; Returns t iff inside an atom (takes account of trailers)
  (let ((c1 (preceding-char))