vi.el

早期freebsd实现

(defun vi-scroll-down-window (count)
  "Scrolls down window COUNT lines.  If COUNT is nil (actually, non-integer),
scrolls default amount.  The given COUNT is remembered for future scrollings."
  (interactive "P")
  (if (integerp count)
      (setq vi-scroll-amount count))
  (scroll-up vi-scroll-amount))

(defun vi-expose-line-below (count)
  "Expose COUNT more lines below the current window.  Default COUNT is 1."
  (interactive "p")
  (scroll-up count))

(defun vi-forward-windowfull (count)
  "Forward COUNT windowfulls. Default is one."
  (interactive "p")
; (set-mark-command nil)
  (while (> count 0)
    (scroll-up nil)
    (setq count (1- count))))

(defun vi-next-line (count)
  "Go down count lines, try to keep at the same column."
  (interactive "p")
  (setq this-command 'next-line)	; this is a needed trick
  (if (= (point) (or (next-line-internal count) (point)))
      (ding)				; no moving, already at end of buffer
    (setq last-command 'next-line)))

(defun vi-next-line-first-nonwhite (count)
  "Go down COUNT lines.  Stop at first non-white."
  (interactive "p")
  (if (= (point) (progn (forward-line count) (back-to-indentation) (point)))
      (ding)))				; no moving, already at end of buffer

(defun vi-previous-line-first-nonwhite (count)
  "Go up COUNT lines.  Stop at first non-white."
  (interactive "p")
  (previous-line count)
  (back-to-indentation))

(defun vi-scroll-up-window (count)
  "Scrolls up window COUNT lines.  If COUNT is nil (actually, non-integer),
scrolls default amount.  The given COUNT is remembered for future scrollings."
  (interactive "P")
  (if (integerp count)
      (setq vi-scroll-amount count))
  (scroll-down vi-scroll-amount))

(defun vi-expose-line-above (count)
  "Expose COUNT more lines above the current window.  Default COUNT is 1."
  (interactive "p")
  (scroll-down count))

(defun vi-char-argument (arg)
  "Get following character (could be any CHAR) as part of the prefix argument.
Possible perfix-arg cases are NIL, INTEGER, (NIL . CHAR) or (INTEGER . CHAR)."
  (interactive "P")
  (let ((char (read-char)))
    (cond ((null arg) (setq prefix-arg (cons nil char)))
	  ((integerp arg) (setq prefix-arg (cons arg char)))
	  ; This can happen only if the user changed his/her mind for CHAR,
	  ; Or there are some leading "universal-argument"s
	  (t (setq prefix-arg (cons (car arg) char))))))

(defun vi-goto-mark (mark-char &optional line-flag)
  "Go to marked position or line (if line-flag is given). Goto mark '@' means
jump into and pop the top mark on the mark ring."
  (cond ((char-equal mark-char last-command-char)	; `` or ''
	 (exchange-point-and-mark) (if line-flag (back-to-indentation)))
	((char-equal mark-char ?@)	; jump and pop mark
	 (set-mark-command t) (if line-flag (back-to-indentation)))
	(t
	 (let ((mark (vi-get-mark mark-char)))
	   (if (null mark)
	       (message "Mark register undefined." (vi-ding))
	     (set-mark-command nil)
	     (goto-char mark)
	     (if line-flag (back-to-indentation)))))))
		     
(defun vi-goto-line-mark (char)
  "Go to the line (at first non-white) marked by next char."
  (interactive "c")
  (vi-goto-mark char t))

(defun vi-goto-char-mark (char)
  "Go to the char position marked by next mark-char."
  (interactive "c")
  (vi-goto-mark char))

(defun vi-digit-argument (arg)
  "Set numeric prefix argument."
  (interactive "P")
  (cond ((null arg) (digit-argument arg))
	((integerp arg) (digit-argument nil)
	                 (setq prefix-arg (* prefix-arg arg)))
	(t (digit-argument nil)		; in (NIL . CHAR) or (NUM . CHAR) form
	   (setq prefix-arg (cons (* prefix-arg
				     (if (null (car arg)) 1 (car arg)))
				  (cdr arg))))))

(defun vi-raw-numeric-prefix (arg)
  "Return the raw value of numeric part prefix argument."
  (if (consp arg) (car arg) arg))

(defun vi-prefix-numeric-value (arg)
  "Return numeric meaning of the raw prefix argument.  This is a modification
to the standard one provided in `callint.c' to handle (_ . CHAR) cases."
  (cond ((null arg) 1)
	((integerp arg) arg)
	((consp arg) (if (car arg) (car arg) 1))))

(defun vi-reverse-last-find-char (count &optional find-arg)
  "Reverse last f F t T operation COUNT times.  If the optional FIND-ARG
is given, it is used instead of the saved one."
  (interactive "p")
  (if (null find-arg) (setq find-arg vi-last-find-char))
  (if (null find-arg)
      (message "No last find char to repeat." (ding))
    (vi-find-char (cons (* (car find-arg) -1) (cdr find-arg)) count))) ;6/13/86

(defun vi-find-char (arg count)
  "Find in DIRECTION (1/-1) for CHAR of COUNT'th times on current line.
If UPTO-FLAG is T, stop before the char. ARG = (DIRECTION.CHAR.UPTO-FLAG."
  (let* ((direction (car arg)) (char (car (cdr arg)))
	 (upto-flag (cdr (cdr arg))) (pos (+ (point) direction)))
    (if (catch 'exit-find-char
	  (while t
	    (cond ((null (char-after pos)) (throw 'exit-find-char nil))
		  ((char-equal (char-after pos) ?\n) (throw 'exit-find-char nil))
		  ((char-equal char (char-after pos)) (setq count (1- count))
		   (if (= count 0)
		       (throw 'exit-find-char
			      (if upto-flag
				  (setq pos (- pos direction))
				pos)))))
	    (setq pos (+ pos direction))))
      (goto-char pos)
    (ding))))

(defun vi-repeat-last-find-char (count &optional find-arg)
  "Repeat last f F t T operation COUNT times.  If optional FIND-ARG is given,
it is used instead of the saved one."
  (interactive "p")
  (if (null find-arg) (setq find-arg vi-last-find-char))
  (if (null find-arg)
      (message "No last find char to repeat." (ding))
    (vi-find-char find-arg count)))

(defun vi-backward-find-char (count char)
  "Find the COUNT'th CHAR backward on current line."
  (interactive "p\nc")
  (setq vi-last-find-char (cons -1 (cons char nil)))
  (vi-repeat-last-find-char count))

(defun vi-forward-find-char (count char)
  "Find the COUNT'th CHAR forward on current line."
  (interactive "p\nc")
  (setq vi-last-find-char (cons 1 (cons char nil)))
  (vi-repeat-last-find-char count))

(defun vi-backward-upto-char (count char)
  "Find upto the COUNT'th CHAR backward on current line."
  (interactive "p\nc")
  (setq vi-last-find-char (cons -1 (cons char t)))
  (vi-repeat-last-find-char count))

(defun vi-forward-upto-char (count char)
  "Find upto the COUNT'th CHAR forward on current line."
  (interactive "p\nc")
  (setq vi-last-find-char (cons 1 (cons char t)))
  (vi-repeat-last-find-char count))

(defun vi-end-of-word (count)
  "Move forward until encountering the end of a word.
With argument, do this that many times."
  (interactive "p")
  (if (not (eobp)) (forward-char))
  (if (re-search-forward "\\W*\\w+\\>" nil t count)
      (backward-char)))

(defun vi-replace-1-char (count char)
  "Replace char after point by CHAR.  Repeat COUNT times."
  (interactive "p\nc")
  (delete-char count nil)       ; don't save in kill ring
  (setq last-command-char char)
  (self-insert-command count)
  (vi-set-last-change-command 'vi-replace-1-char count char))

(defun vi-replace-chars (arg)
  "Replace chars over old ones."
  (interactive "*p")
  (overwrite-mode 1)
  (vi-goto-insert-state arg))

(defun vi-substitute-chars (count)
  "Substitute COUNT chars by the input chars, enter insert state."
  (interactive "*p")
  (vi-goto-insert-state 1 (list (function (lambda (c) ; this is a bit tricky
					    (delete-region (point)
							   (+ (point) c))))
				count) t))

(defun vi-substitute-lines (count)
  "Substitute COUNT lines by the input chars. (=cc in vi)"
  (interactive "*p")
  (vi-goto-insert-state 1 (list 'vi-delete-op 'next-line (1- count)) t))

(defun vi-prefix-char-value (arg)
  "Get the char part of the current prefix argument."
  (cond ((null arg) nil)
	((integerp arg) nil)
	((consp arg) (cdr arg))
	(t nil)))

(defun vi-operator (arg)
  "Handling vi operators (d/c/</>/!/=/y).  Current implementation requires
the key bindings of the operators being fixed."
  (interactive "P")
  (catch 'vi-exit-op
    (let ((this-op-char last-command-char))
      (setq last-command-char (read-char))
      (setq this-command (lookup-key vi-com-map (char-to-string last-command-char)))
      (if (not (eq this-command 'vi-digit-argument))
	  (setq prefix-arg arg)
	(vi-digit-argument arg)
	(setq last-command-char (read-char))
	(setq this-command (lookup-key vi-com-map (char-to-string last-command-char))))
      (cond ((char-equal this-op-char last-command-char) ; line op
	     (vi-execute-op this-op-char 'next-line
			    (cons (1- (vi-prefix-numeric-value prefix-arg))
				  (vi-prefix-char-value prefix-arg))))
	    ;; We assume any command that has no property 'point-moving-unit'
	    ;; as having that property with the value 'CHAR'.  3/12/86
	    (t   ;;  (get this-command 'point-moving-unit)
	     (vi-execute-op this-op-char this-command prefix-arg))))))
	    ;;   (t (throw 'vi-exit-op (ding)))))))

(defun vi-execute-op (op-char motion-command arg)
  "Execute vi edit operator as specified by OP-CHAR, the operand is the region
determined by the MOTION-COMMAND with ARG."
  (cond ((= op-char ?d)
	 (if (vi-delete-op motion-command arg)
	     (vi-set-last-change-command 'vi-delete-op (vi-repeat-command-of motion-command) arg)))
	 ((= op-char ?c)
	  (if (vi-delete-op motion-command arg)
	      (vi-goto-insert-state 1 (list 'vi-delete-op
			      (vi-repeat-command-of motion-command) arg) nil)))
	 ((= op-char ?y)
	  (if (vi-yank-op motion-command arg)
	      (vi-set-last-change-command 'vi-yank-op (vi-repeat-command-of motion-command) arg)))
	 ((= op-char ?!)
	  (if (vi-shell-op motion-command arg)
	      (vi-set-last-change-command 'vi-shell-op (vi-repeat-command-of motion-command) arg vi-last-shell-command)))
	 ((= op-char ?<)
	  (if (vi-shift-op motion-command arg (- vi-shift-width))
	      (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg (- vi-shift-width))))
	 ((= op-char ?>)
	  (if (vi-shift-op motion-command arg vi-shift-width)
	      (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg vi-shift-width)))
	 ((= op-char ?=)
	  (if (vi-indent-op motion-command arg)
	      (vi-set-last-change-command 'vi-indent-op (vi-repeat-command-of motion-command) arg)))
	 ((= op-char ?\\)
	  (vi-narrow-op motion-command arg))))

(defun vi-repeat-command-of (command)
  "Return the command for redo the given command."
  (let ((cmd-type (get command 'point-moving-unit)))
    (cond ((eq cmd-type 'search) 'vi-repeat-last-search)
	  ((eq cmd-type 'find) 'vi-repeat-last-find-char)
	  (t command))))

(defun vi-effective-range (motion-command arg)
  "Return (begin . end) of the range spanned by executing the given
MOTION-COMMAND with ARG.
   MOTION-COMMAND in ready-to-eval list form is not yet supported."
  (save-excursion
    (let ((begin (point)) end opoint
	  (moving-unit (get motion-command 'point-moving-unit)))
      (setq prefix-arg arg)
      (setq opoint (point))
      (command-execute motion-command nil)
;; Check if there is any effective motion. Note that for single line operation
;; the motion-command causes no effective point movement (since it moves up or
;; down zero lines), but it should be counted as effectively moved.
      (if (and (= (point) opoint) (not (eq moving-unit 'line)))
	  (cons opoint opoint)		; no effective motion
	(if (eq moving-unit 'region)
	    (setq begin (or (mark) (point))))
	(if (<= begin (point))
	    (setq end (point))
	  (setq end begin)
	  (setq begin (point)))
	(cond ((or (eq moving-unit 'match) (eq moving-unit 'find))
	       (setq end (1+ end)))
	      ((eq moving-unit 'line)
	       (goto-char begin) (beginning-of-line) (setq begin (point))
	       (goto-char end) (next-line 1) (beginning-of-line) (setq end (point))))
	(if (> end (point-max)) (setq end (point-max))) ; force in buffer region 
	(cons begin end)))))

(defun vi-delete-op (motion-command arg)
  "Delete range specified by MOTION-COMMAND with ARG."
  (let* ((range (vi-effective-range motion-command arg))
	 (begin (car range)) (end (cdr range)) reg)
    (if (= begin end)
	nil				; point not moved, abort op
      (setq reg (vi-prefix-char-value arg))
      (if (null reg)
	  (kill-region begin end)	; kill ring as unnamed registers
	(if (and (>= reg ?A) (<= reg ?Z))
	    (append-to-register (downcase reg) begin end t)
	  (copy-to-register reg begin end t)))
      t)))

(defun vi-yank-op (motion-command arg)
  "Yank (in vi sense) range specified by MOTION-COMMAND with ARG."
  (let* ((range (vi-effective-range motion-command arg))
	 (begin (car range)) (end (cdr range)) reg)
    (if (= begin end)
	nil				; point not moved, abort op
      (setq reg (vi-prefix-char-value arg))
      (if (null reg)
	  (copy-region-as-kill begin end); kill ring as unnamed registers
	(if (and (>= reg ?A) (<= reg ?Z))
	    (append-to-register (downcase reg) begin end nil)
	  (copy-to-register reg begin end nil)))
      t)))

(defun vi-yank-line (arg)
  "Yank (in vi sense) lines (= `yy' command)."
  (interactive "*P")
  (setq arg (cons (1- (vi-prefix-numeric-value arg)) (vi-prefix-char-value arg)))
  (if (vi-yank-op 'next-line arg)
      (vi-set-last-change-command 'vi-yank-op 'next-line arg)))

(defun vi-string-end-with-nl-p (string)
  "See if STRING ends with a newline char.  Used in checking whether the yanked
text should be put back as lines or not."
  (= (aref string (1- (length string))) ?\n))

(defun vi-put-before (arg &optional after-p)
  "Put yanked (in vi sense) text back before/above cursor.  If a numeric prefix
value (currently it should be >1) is given, put back text as lines.
If the optional after-p is given, put after/below the cursor."
  (interactive "P")
  (let ((reg (vi-prefix-char-value arg)) put-text)
    (if (and reg (or (< reg ?1) (> reg ?9)) (null (get-register reg)))
	(error "Nothing in register %c" reg)
      (if (null reg) (setq reg ?1))	; the default is the last text killed
      (setq put-text
	    (if (and (>= reg ?1) (<= reg ?9))
		(let ((ring-length (length kill-ring)))
		  (setq this-command 'yank) ; So we may yank-pop !!
		  (nth (% (+ (- reg ?0 1) (- ring-length
					     (length kill-ring-yank-pointer)))
			  ring-length) kill-ring))
	      (if (stringp (get-register reg))
		  (get-register reg)
		(error "Register %c is not containing text string" reg))))