mim-mode.el

早期freebsd实现

	(c2 (following-char)))
    (and (or (= (char-syntax c1) ?w) (= (char-syntax c1) ?_) (= c1 ?!))
	 (or (= (char-syntax c2) ?w) (= (char-syntax c2) ?_) (= c2 ?!)))))

(defun forward-mim-objects (arg &optional skip-bracket-p)
  ;; Move over arg objects ignoring ADECLs and trailers.  If
  ;; skip-bracket-p is non-nil, then move over one bracket on error.
  (let ((direction (sign arg)))
    (condition-case conditions
	(while (/= arg 0)
	  (forward-sexp direction)
	  (if (not (inside-adecl-or-trailer-p direction))
	      (setq arg (- arg direction))))
      (error (if (not skip-bracket-p)
		 (signal 'error (cdr conditions))
	       (skip-mim-whitespace direction)
	       (goto-char (+ (point) direction)))))
    ;; If we moved too far move back to first interesting character.
    (if (= (point) (buffer-end direction)) (skip-mim-whitespace (- direction)))))
				    
(defun backward-mim-object (&optional arg)
  "Move backward across Mim object.
With ARG, move backward that many objects."
  (interactive "p")
  (forward-mim-object (if arg (- arg) -1)))

(defun mark-mim-object (&optional arg)
  "Mark following Mim object.
With ARG, mark that many following (preceding, ARG < 0) objects."
  (interactive "p")
  (push-mark (save-excursion (forward-mim-object (or arg 1)) (point))))

(defun forward-kill-mim-object (&optional arg)
  "Kill following Mim object.
With ARG, kill that many objects."
  (interactive "*p")
  (kill-region (point) (progn (forward-mim-object (or arg 1)) (point))))

(defun backward-kill-mim-object (&optional arg)
  "Kill preceding Mim object.
With ARG, kill that many objects."
  (interactive "*p")
  (forward-kill-mim-object (- (or arg 1))))

(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")
  (let* ((increment (sign (or arg (setq arg 1))))
	 (direction (if (> arg 0) 1 0)))
    (save-excursion
      (while (/= arg 0)
	;; move over eol and kill it
	(forward-line direction)
	(delete-region (point) (1- (point)))
	(fixup-whitespace)
	(setq arg (- arg increment))))))

(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")
  ;; another wierdo - going down `inside' an ADECL or ATOM trailer
  ;; depends on the value of mim-down-parens-only.  if nil, treat
  ;; ADECLs and trailers as structured objects.
  (let ((direction (sign (or arg (setq arg 1)))))
    (if (and (= (abs arg) 1) (not mim-down-parens-only))
	(goto-char
	  (save-excursion
	    (skip-mim-whitespace direction)
	    (if (> direction 0) (re-search-forward "\\s'*"))
	    (or (and (let ((c (next-char direction)))
		       (or (= (char-syntax c) ?_)
			   (= (char-syntax c) ?w)))
		     (progn (forward-sexp direction)
			    (if (inside-adecl-or-trailer-p direction)
				(point))))
		(scan-lists (point) direction -1)
		(buffer-end direction))))
      (while (/= arg 0)
	(goto-char (or (scan-lists (point) direction -1) (buffer-end direction)))
	(setq arg (- arg direction))))))

(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")
  (forward-down-mim-object (if arg (- arg) -1)))

(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")
  (let ((direction (sign (or arg (setq arg 1)))))
    (while (/= arg 0)
      (goto-char (or (scan-lists (point) direction 1) (buffer-end arg)))
      (setq arg (- arg direction)))
    (if (< direction 0) (backward-prefix-chars))))

(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")
  (forward-up-mim-object (if arg (- arg) -1)))

(defun replace-in-mim-object (old new)
  "Replace string in following Mim object."
  (interactive "*sReplace in object: \nsReplace %s with: ")
  (save-restriction
    (narrow-to-region (point) (save-excursion (forward-mim-object 1) (point)))
    (replace-string old new)))
  
(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")
  (transpose-subr 'forward-mim-object (or arg 1)))

(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")
  (let ((direction (sign (or arg (setq arg 1)))))
    (if (not move) (setq move t))
    (if (< direction 0) (goto-char (1+ (point))))
    (while (and (/= arg 0) (re-search-backward "^<" nil move direction))
      (setq arg (- arg direction)))
    (if (< direction 0)
	(goto-char (1- (point))))))

(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")
  (if (not arg) (setq arg 1))
  (if (< arg 0)
      (beginning-of-DEFINE (- (1- arg)))
    (if (not (looking-at "^<")) (setq arg (1+ arg)))
    (beginning-of-DEFINE (- arg) 'move)
    (beginning-of-DEFINE 1))
  (forward-mim-object 1)
  (forward-line 1))

(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")
  (let ((search-string (if mim-stop-for-slop "^\\S " "^\\s("))
	(direction (sign (or arg (setq arg 1)))))
    (if (> direction 0)
	(goto-char (1+ (point))))		; no error if end of buffer
    (while (and (/= arg 0)
		(re-search-forward search-string nil t direction))
      (setq arg (- arg direction)))
    (if (> direction 0)
	(goto-char (1- (point))))		; no error if beginning of buffer
    ;; scroll to top of window if moving forward and end not visible.
    (if (not (or (< direction 0)
		 (save-excursion (forward-mim-object 1)
				 (pos-visible-in-window-p (point)))))
	(recenter 0))))

(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")
  (next-mim-object (- (or arg 1))))

(defun calculate-mim-indent (&optional parse-start)
  "Calculate indentation for Mim line.  Returns column."
  (save-excursion			; some excursion, huh, toto?
    (beginning-of-line)
    (let ((indent-point (point)) retry state containing-sexp last-sexp
	  desired-indent start peek where paren-depth)
      (if parse-start
	  (goto-char parse-start)	; should be containing environment
	(catch 'from-the-top
	  ;; find a place to start parsing.  going backwards is fastest.
	  ;; forward-sexp signals error on encountering unmatched open.
	  (setq retry t)
	  (while retry
	    (condition-case nil (forward-sexp -1) (error (setq retry nil)))
	    (if (looking-at ".?[ \t]*\"")
		;; cant parse backward in presence of strings, go forward.
		(progn
		  (goto-char indent-point)
		  (re-search-backward "^\\s(" nil 'move 1)  ; to top of object
		  (throw 'from-the-top nil)))
	    (setq retry (and retry (/= (current-column) 0))))
	  (skip-chars-backward mim-whitespace)
	  (if (not (bobp)) (forward-char -1))     ; onto unclosed open
	  (backward-prefix-chars)))
      ;; find outermost containing sexp if we started inside an sexp.
      (while (< (point) indent-point)    
	(setq state (parse-partial-sexp (point) indent-point 0)))
      ;; find usual column to indent under (not in string or toplevel).
      ;; on termination, state will correspond to containing environment
      ;; (if retry is nil), where will be position of character to indent
      ;; under normally, and desired-indent will be the column to indent to
      ;; except if inside form, string, or at toplevel.  point will be in
      ;; in column to indent to unless inside string.
      (setq retry t)
      (while (and retry (setq paren-depth (car state)) (> paren-depth 0))
	;; find innermost containing sexp.
	(setq retry nil)
	(setq last-sexp (car (nthcdr 2 state)))
	(setq containing-sexp (car (cdr state)))
	(goto-char (1+ containing-sexp))	  ; to last unclosed open
	(if (and last-sexp (> last-sexp (point)))
	    ;; is the last sexp a containing sexp?
	    (progn (setq peek (parse-partial-sexp last-sexp indent-point 0))
		   (if (setq retry (car (cdr peek))) (setq state peek))))
	(if retry
	    nil
	  (setq where (1+ containing-sexp))   ; innermost containing sexp
	  (goto-char where)
	  (cond
	   ((not last-sexp)		      ; indent-point after bracket
	    (setq desired-indent (current-column)))
	   ((= (preceding-char) ?\<)	      ; it's a form
	    (cond ((> (progn (forward-sexp 1) (point)) last-sexp)
		   (goto-char where))	      ; only one frob
		  ((> (save-excursion (forward-line 1) (point)) last-sexp)
		   (skip-chars-forward " \t") ; last-sexp is on same line
		   (setq where (point)))	      ; as containing-sexp
		  ((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
	   ((and indent-mim-arglist	      ; maybe hack arglist    
		 (= (preceding-char) ?\()     ; its a list
		 (save-excursion	      ; look for magic atoms
		   (setq peek 0)	      ; using peek as counter
		   (forward-char -1)	      ; back over containing paren
		   (while (and (< (setq peek (1+ peek)) 6)
			       (condition-case nil
				   (progn (forward-sexp -1) t)
				 (error nil))))
		   (and (< peek 6) (looking-at "DEFINE\\|DEFMAC\\|FUNCTION"))))
	    ;; frobs stack under strings they belong to or under first
	    ;; frob to right of strings they belong to unless luser has
	    ;; frob (non-string) on preceding line with different
	    ;; indentation.  strings stack under start of arglist unless
	    ;; mim-indent-arglist is not t, in which case they stack
	    ;; under the last string, if any, else the start of the arglist.
	    (let ((eol 0) last-string)
	      (while (< (point) last-sexp)      ; find out where the strings are
		(skip-chars-forward mim-whitespace last-sexp)		
		(if (> (setq start (point)) eol)
		    (progn                    ; simultaneously keeping track
		      (setq where (min where start))
		      (end-of-line)	      ; of indentation of first frob
		      (setq eol (point))	      ; on each line
		      (goto-char start)))
		(if (= (following-char) ?\")
		    (progn (setq last-string (point))
			   (forward-sexp 1)
			   (if (= last-string last-sexp)
			       (setq where last-sexp)
			     (skip-chars-forward mim-whitespace last-sexp)
			     (setq where (point))))
		  (forward-sexp 1)))
	      (goto-char indent-point)	           ; if string is first on
	      (skip-chars-forward " \t" (point-max)) ; line we are indenting, it 
	      (if (= (following-char) ?\")         ; goes under arglist start
		  (if (and last-string (not (equal indent-mim-arglist t)))
		      (setq where last-string)     ; or under last string.
		    (setq where (1+ containing-sexp)))))
	    (goto-char where)
	    (setq desired-indent (current-column)))
	   (t				      ; plain vanilla structure
	    (cond ((> (save-excursion (forward-line 1) (point)) last-sexp)
		   (skip-chars-forward " \t") ; last-sexp is on same line
		   (setq where (point)))	      ; as containing-sexp