mim-mode.el

早期freebsd实现

		  ((progn
		     (goto-char last-sexp)
		     (beginning-of-line)
		     (parse-partial-sexp (point) last-sexp 0 t)
		     (or (= (point) last-sexp)
			 (save-excursion
			   (= (car (parse-partial-sexp (point) last-sexp 0))
			      0))))
		     (backward-prefix-chars)  ; last-sexp 1st on line or 1st
		     (setq where (point)))      ; frob on that line level 0
		  (t (goto-char where)))      ; punt, should never occur
	    (setq desired-indent (current-column))))))
      ;; state is innermost containing environment unless toplevel or string.
      (if (car (nthcdr 3 state))	      ; inside string
	  (progn
	    (if last-sexp		      ; string must be next
		(progn (goto-char last-sexp)
		       (forward-sexp 1)
		       (search-forward "\"")
		       (forward-char -1))
	      (goto-char indent-point)	      ; toplevel string, look for it
	      (re-search-backward "[^\\]\"")
	      (forward-char 1))
	    (setq start (point))		      ; opening double quote
	    (skip-chars-backward " \t")
	    (backward-prefix-chars)
	    ;; see if the string is really a comment.
       	    (if (and (looking-at ";[ \t]*\"") indent-mim-comment)
		;; it's a comment, line up under the start unless disabled.
		(goto-char (1+ start))
	      ;; it's a string, dont mung the indentation.
	      (goto-char indent-point)
	      (skip-chars-forward " \t"))
	    (setq desired-indent (current-column))))
      ;; point is sitting in usual column to indent to and if retry is nil
      ;; then state corresponds to containing environment.  if desired
      ;; indentation not determined, we are inside a form, so call hook.
      (or desired-indent
	  (and indent-mim-hook
	       (not retry)
	       (setq desired-indent
		     (funcall indent-mim-hook state indent-point)))
	  (setq desired-indent (current-column)))
      (goto-char indent-point)		; back to where we started
      desired-indent)))			; return column to indent to

(defun indent-mim-hook (state indent-point)
  "Compute indentation for Mim special forms.  Returns column or nil."
  (let ((containing-sexp (car (cdr state))) (current-indent (point)))
    (save-excursion
      (goto-char (1+ containing-sexp))
      (backward-prefix-chars)
      ;; make sure we are looking at a symbol.  if so, see if it is a special
      ;; symbol.  if so, add the special indentation to the indentation of
      ;; the start of the special symbol, unless the property is not
      ;; an integer and not nil (in this case, call the property, it must
      ;; be a function which returns the appropriate indentation or nil and
      ;; does not change the buffer).
      (if (looking-at "\\sw\\|\\s_")
	  (let* ((start (current-column))
		 (function
		  (intern-soft (buffer-substring (point)
						 (progn (forward-sexp 1)
							(point)))))
		 (method (get function 'indent-mim-hook)))
	    (if (or (if (equal method 'DEFINE) (setq method mim-body-indent))
		    (integerp method))
		;; only use method if its first line after containing-sexp.
		;; we could have done this in calculate-mim-indent, but someday
		;; someone might want to format frobs in a special form based
		;; on position instead of indenting uniformly (like lisp if),
		;; so preserve right for posterity.  if not first line,
		;; calculate-mim-indent already knows right indentation -
		;; give luser chance to change indentation manually by changing
		;; 1st line after containing-sexp.
		(if (> (progn (forward-line 1) (point)) (car (nthcdr 2 state)))
		    (+ method start))
	      (goto-char current-indent)
	      (if (consp method)
		  ;; list or pointted list of explicit indentations
		  (indent-mim-offset state indent-point)
		(if (and (symbolp method) (fboundp method))
		    ;; luser function - s/he better know what's going on.
		    ;; should take state and indent-point as arguments - for
		    ;; description of state, see parse-partial-sexp
		    ;; documentation the function is guaranteed the following:
		    ;; (1) state describes the closest surrounding form,
		    ;; (2) indent-point is the beginning of the line being
		    ;; indented, (3) point points to char in column that would
		    ;; normally be used for indentation, (4) function is bound
		    ;; to the special ATOM.  See indent-mim-offset for example
		    ;; of a special function.
		    (funcall method state indent-point)))))))))

(defun indent-mim-offset (state indent-point)
  ;; offset forms explicitly according to list of indentations.
  (let ((mim-body-indent mim-body-indent)
	(indentations (get function 'indent-mim-hook))
	(containing-sexp (car (cdr state)))
	(last-sexp (car (nthcdr 2 state)))
	indentation)
    (goto-char (1+ containing-sexp))
    ;; determine wheich of the indentations to use.
    (while (and (< (point) indent-point)
		(condition-case nil
		    (progn (forward-sexp 1)
			   (parse-partial-sexp (point) indent-point 1 t))
		  (error nil)))
      (skip-chars-backward " \t")
      (backward-prefix-chars)
      (if (= (following-char) ?\;)
	  nil					    ; ignore comments
	(setq indentation (car indentations))
	(if (integerp (setq indentations (cdr indentations)))
	    ;; if last cdr is integer, that is indentation to use for all
	    ;; all the rest of the forms.
	    (progn (setq mim-body-indent indentations)
		   (setq indentations nil)))))
    (goto-char (1+ containing-sexp))
    (+ (current-column) (or indentation mim-body-indent))))

(defun indent-mim-comment (&optional start)
  "Indent a one line (string) Mim comment following object, if any."
  (let* ((old-point (point)) (eol (progn (end-of-line) (point))) state last-sexp)
    ;; this function assumes that comment indenting is enabled.  it is caller's
    ;; responsibility to check the indent-mim-comment flag before calling.
    (beginning-of-line)
    (catch 'no-comment
      (setq state (parse-partial-sexp (point) eol))
      ;; determine if there is an existing regular comment.  a `regular'
      ;; comment is defined as a commented string which is the last thing
      ;; on the line and does not extend beyond the end of the line.
      (if (or (not (setq last-sexp (car (nthcdr 2 state))))
	      (car (nthcdr 3 state)))
	  ;; empty line or inside string (multiple line).
	  (throw 'no-comment nil))	
      ;; could be a comment, but make sure its not the only object.
      (beginning-of-line)
      (parse-partial-sexp (point) eol 0 t)
      (if (= (point) last-sexp)
	  ;; only one object on line
	  (throw 'no-comment t))
      (goto-char last-sexp)
      (skip-chars-backward " \t")
      (backward-prefix-chars)
      (if (not (looking-at ";[ \t]*\""))
	  ;; aint no comment
	  (throw 'no-comment nil))
      ;; there is an existing regular comment
      (delete-horizontal-space)
      ;; move it to comment-column if possible else to tab-stop
      (if (< (current-column) comment-column)
	  (indent-to comment-column)
	(tab-to-tab-stop)))
    (goto-char old-point)))
	
(defun indent-mim-line ()
  "Indent line of Mim code."
  (interactive "*")
  (let* ((position (- (point-max) (point)))
	 (bol (progn (beginning-of-line) (point)))
	 (indent (calculate-mim-indent)))
    (skip-chars-forward " \t")
    (if (/= (current-column) indent)
	(progn (delete-region bol (point)) (indent-to indent)))
    (if (> (- (point-max) position) (point)) (goto-char (- (point-max) position)))))

(defun newline-and-mim-indent ()
  "Insert newline at point and indent."
  (interactive "*")
  ;; commented code would correct indentation of line in arglist which
  ;; starts with string, but it would indent every line twice.  luser can
  ;; just say tab after typing string to get same effect.
  ;(if indent-mim-arglist (indent-mim-line))
  (newline)
  (indent-mim-line))

(defun open-mim-line (&optional lines)
  "Insert newline before point and indent.
With ARG insert that many newlines."
  (interactive "*p")
  (beginning-of-line)
  (let ((indent (calculate-mim-indent)))
    (while (> lines 0)
      (newline)
      (forward-line -1)
      (indent-to indent)
      (setq lines (1- lines)))))

(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")
  (let (end bol indent start)
    (save-excursion (parse-partial-sexp (point) (point-max) 0 t)
		    (setq start (point))
		    (forward-sexp 1)
		    (setq end (- (point-max) (point))))
    (save-excursion
      (if (not dont-indent-first-line) (indent-mim-line))
      (while (progn (forward-line 1) (> (- (point-max) (point)) end))
	(setq indent (calculate-mim-indent start))
	(setq bol (point))
	(skip-chars-forward " \t")
	(if (/= indent (current-column))
	    (progn (delete-region bol (point)) (indent-to indent)))
	(if indent-mim-comment (indent-mim-comment))))))
  
(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: ")
  (let (where)
    (save-excursion
      (goto-char (point-min))
      (condition-case nil
	  (progn
	    (re-search-forward
	     (concat "^<\\(DEFINE\\|\\DEFMAC\\|FCN\\|GFCN\\)\\([ \t]*\\)"
		     name))
	    (setq where (point)))
	(error (error "Can't find %s" name))))
    (if where
	(progn (push-mark)
	       (goto-char where)
	       (beginning-of-line)
	       (recenter 0)))))
    
(defun begin-mim-comment ()
  "Move to existing comment or insert empty comment."
  (interactive "*")
  (let* ((eol (progn (end-of-line) (point)))
	 (bol (progn (beginning-of-line) (point))))
    ;; check for existing comment first.
    (if (re-search-forward ";[ \t]*\"" eol t)
	;; found it.  indent if desired and go there.
	(if indent-mim-comment
	    (let ((where (- (point-max) (point))))
	      (indent-mim-comment)
	      (goto-char (- (point-max) where))))
      ;; nothing there, make a comment.
      (let (state last-sexp)
	;; skip past all the sexps on the line
	(goto-char bol)
	(while (and (equal (car (setq state (parse-partial-sexp (point) eol 0)))
			   0)
		    (car (nthcdr 2 state)))
	  (setq last-sexp (car (nthcdr 2 state))))
	(if (car (nthcdr 3 state))
	    nil					    ; inside a string, punt
      (delete-region (point) eol)			    ; flush trailing whitespace
      (if (and (not last-sexp) (equal (car state) 0))
	  (indent-to (calculate-mim-indent))	    ; empty, indent like code
	(if (> (current-column) comment-column)	    ; indent to comment column
	    (tab-to-tab-stop)			    ; unless past it, else to
	  (indent-to comment-column)))		    ; tab-stop
      ;; if luser changes comment-{start end} to something besides semi
      ;; followed by zero or more whitespace characters followed by string
      ;; delimiters, the code above fails to find existing comments, but as
      ;; taa says, `let the losers lose'.
      (insert comment-start)
      (save-excursion (insert comment-end)))))))

(defun skip-mim-whitespace (direction)
  (if (>= direction 0)
      (skip-chars-forward mim-whitespace (point-max))
    (skip-chars-backward mim-whitespace (point-min))))

(defun inside-adecl-or-trailer-p (direction)
  (if (>= direction 0)
      (looking-at ":\\|!-")
    (or (= (preceding-char) ?:)
	(looking-at "!-"))))
		  
(defun sign (n)
  "Returns -1 if N < 0, else 1."
  (if (>= n 0) 1 -1))

(defun abs (n)
  "Returns the absolute value of N."
  (if (>= n 0) n (- n)))

(defun next-char (direction)
  "Returns preceding-char if DIRECTION < 0, otherwise following-char."
  (if (>= direction 0) (following-char) (preceding-char)))