vip.el

早期freebsd实现

	       (setq com (+ 128 (read-char)))
	       (setq char (read-char))
	       (setq cont nil))
	      ((or (= char ?<) (= char ?>))
	       (setq com char)
	       (setq char (read-char))
	       (if (= com char) (setq com (cons char com)))
	       (setq cont nil))
	      ((= char ?\")
	       (let ((reg (read-char)))
		 (if (or (and (<= ?A reg) (<= reg ?z))
			 (and (<= ?1 reg) (<= reg ?9)))
		     (setq vip-use-register reg)
		   (error ""))
		 (setq char (read-char))))
	      (t
	       (setq com char)
	       (setq char (read-char)))))))
  (if (atom com)
      ;; com is a single char, so we construct prefix-arg 
      ;; and if char is ?, describe prefix arg, otherwise exit by
      ;; pushing the char back
      (progn
	(setq prefix-arg (cons value com))
	(while (= char ?U)
	  (vip-describe-arg prefix-arg)
	  (setq char (read-char)))
	(setq unread-command-char char))
    ;; as com is non-nil, this means that we have a command to execute
    (if (or (= (car com) ?r) (= (car com) ?R))
	;; execute apropriate region command.
	(let ((char (car com)) (com (cdr com)))
	  (setq prefix-arg (cons value com))
	  (if (= char ?r) (vip-region prefix-arg)
	    (vip-Region prefix-arg))
	  ;; reset prefix-arg
	  (setq prefix-arg nil))
      ;; otherwise, reset prefix arg and call appropriate command
      (setq value (if (null value) 1 value))
      (setq prefix-arg nil)
      (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C)))
	    ((equal com '(?d . ?d)) (vip-line (cons value ?D)))
	    ((equal com '(?d . ?y)) (vip-yank-defun))
	    ((equal com '(?y . ?y)) (vip-line (cons value ?Y)))
	    ((equal com '(?< . ?<)) (vip-line (cons value ?<)))
	    ((equal com '(?> . ?>)) (vip-line (cons value ?>)))
	    ((equal com '(?! . ?!)) (vip-line (cons value ?!)))
	    ((equal com '(?= . ?=)) (vip-line (cons value ?=)))
	    (t (error ""))))))

(defun vip-describe-arg (arg)
  (let (val com)
    (setq val (vip-P-val arg)
	  com (vip-getcom arg))
    (if (null val)
	(if (null com)
	    (message "Value is nil, and commmand is nil.")
	  (message "Value is nil, and command is %c." com))
      (if (null com)
	  (message "Value is %d, and command is nil." val)
	(message "Value is %d, and command is %c." val com)))))

(defun vip-digit-argument (arg)
  "Begin numeric argument for the next command."
  (interactive "P")
  (vip-prefix-arg-value last-command-char nil
			(if (consp arg) (cdr arg) nil)))

(defun vip-command-argument (arg)
  "Accept a motion command as an argument."
  (interactive "P")
  (condition-case conditions
      (vip-prefix-arg-com
       last-command-char   
       (cond ((null arg) nil)
	     ((consp arg) (car arg))
	     ((numberp arg) arg)
	     (t (error "strange arg")))
       (cond ((null arg) nil)
	     ((consp arg) (cdr arg))
	     ((numberp arg) nil)
	     (t (error "strange arg"))))
    (quit
     (setq vip-use-register nil)
     (signal 'quit nil))))

(defun vip-p-val (arg)
  "Get value part of prefix-argument ARG."
  (cond ((null arg) 1)
	((consp arg) (if (null (car arg)) 1 (car arg)))
	(t arg)))

(defun vip-P-val (arg)
  "Get value part of prefix-argument ARG."
  (cond ((consp arg) (car arg))
	(t arg)))

(defun vip-getcom (arg)
  "Get com part of prefix-argument ARG."
  (cond ((null arg) nil)
	((consp arg) (cdr arg))
	(t nil)))

(defun vip-getCom (arg)
  "Get com part of prefix-argument ARG and modify it."
  (let ((com (vip-getcom arg)))
    (cond ((equal com ?c) ?C)
	  ((equal com ?d) ?D)
	  ((equal com ?y) ?Y)
	  (t com))))


;; repeat last destructive command

(defun vip-append-to-register (reg start end)
  "Append region to text in register REG.
START and END are buffer positions indicating what to append."
  (set-register reg (concat (or (get-register reg) "")
			    (buffer-substring start end))))

(defun vip-execute-com (m-com val com)
  "(M-COM VAL COM)  Execute command COM. The list (M-COM VAL COM) is set
to vip-d-com for later use by vip-repeat"
  (let ((reg vip-use-register))
    (if com
	(cond ((= com ?c) (vip-change vip-com-point (point)))
	      ((= com (- ?c)) (vip-change-subr vip-com-point (point)))
	      ((or (= com ?C) (= com (- ?C)))
	       (save-excursion
		 (set-mark vip-com-point)
		 (vip-enlarge-region (mark) (point))
		 (if vip-use-register
		     (progn
		       (cond ((and (<= ?a vip-use-register)
				   (<= vip-use-register ?z))
			      (copy-to-register
			       vip-use-register (mark) (point) nil))
			     ((and (<= ?A vip-use-register)
				   (<= vip-use-register ?Z))
			      (vip-append-to-register
			       (+ vip-use-register 32) (mark) (point)))
			     (t (setq vip-use-register nil)
				(error "")))
		       (setq vip-use-register nil)))
		 (delete-region (mark) (point)))
	       (open-line 1)
	       (if (= com ?C) (vip-change-mode-to-insert) (yank)))
	      ((= com ?d)
	       (if vip-use-register
		   (progn
		     (cond ((and (<= ?a vip-use-register)
				 (<= vip-use-register ?z))
			    (copy-to-register
			     vip-use-register vip-com-point (point) nil))
			   ((and (<= ?A vip-use-register)
				 (<= vip-use-register ?Z))
			    (vip-append-to-register
			     (+ vip-use-register 32) vip-com-point (point)))
			   (t (setq vip-use-register nil)
			      (error "")))
		     (setq vip-use-register nil)))
	       (setq last-command
		     (if (eq last-command 'd-command) 'kill-region nil))
	       (kill-region vip-com-point (point))
	       (setq this-command 'd-command))
	      ((= com ?D)
	       (save-excursion
		 (set-mark vip-com-point)
		 (vip-enlarge-region (mark) (point))
		 (if vip-use-register
		     (progn
		       (cond ((and (<= ?a vip-use-register)
				   (<= vip-use-register ?z))
			      (copy-to-register
			       vip-use-register (mark) (point) nil))
			     ((and (<= ?A vip-use-register)
				   (<= vip-use-register ?Z))
			      (vip-append-to-register
			       (+ vip-use-register 32) (mark) (point)))
			     (t (setq vip-use-register nil)
				(error "")))
		       (setq vip-use-register nil)))
		 (setq last-command
		       (if (eq last-command 'D-command) 'kill-region nil))
		 (kill-region (mark) (point))
		 (if (eq m-com 'vip-line) (setq this-command 'D-command)))
	       (back-to-indentation))
	      ((= com ?y)
	       (if vip-use-register
		   (progn
		     (cond ((and (<= ?a vip-use-register)
				 (<= vip-use-register ?z))
			    (copy-to-register
			     vip-use-register vip-com-point (point) nil))
			   ((and (<= ?A vip-use-register)
				 (<= vip-use-register ?Z))
			    (vip-append-to-register
			     (+ vip-use-register 32) vip-com-point (point)))
			   (t (setq vip-use-register nil)
			      (error "")))
		     (setq vip-use-register nil)))
	       (setq last-command nil)
	       (copy-region-as-kill vip-com-point (point))
	       (goto-char vip-com-point))
	      ((= com ?Y)
	       (save-excursion
		 (set-mark vip-com-point)
		 (vip-enlarge-region (mark) (point))
		 (if vip-use-register
		     (progn
		       (cond ((and (<= ?a vip-use-register)
				   (<= vip-use-register ?z))
			      (copy-to-register
			       vip-use-register (mark) (point) nil))
			     ((and (<= ?A vip-use-register)
				   (<= vip-use-register ?Z))
			      (vip-append-to-register
			       (+ vip-use-register 32) (mark) (point)))
			     (t (setq vip-use-register nil)
				(error "")))
		       (setq vip-use-register nil)))
		 (setq last-command nil)
		 (copy-region-as-kill (mark) (point)))
	       (goto-char vip-com-point))
	      ((or (= com ?!) (= com (- ?!)))
	       (save-excursion
		 (set-mark vip-com-point)
		 (vip-enlarge-region (mark) (point))
		 (shell-command-on-region
		  (mark) (point)
		  (if (= com ?!)
		      (setq vip-last-shell-com (vip-read-string "!"))
		    vip-last-shell-com)
		  t)))
	      ((= com ?=)
	       (save-excursion
		 (set-mark vip-com-point)
		 (vip-enlarge-region (mark) (point))
		 (if (> (mark) (point)) (exchange-point-and-mark))
		 (indent-region (mark) (point) nil)))
	      ((= com ?<)
	       (save-excursion
		 (set-mark vip-com-point)
		 (vip-enlarge-region (mark) (point))
		 (indent-rigidly (mark) (point) (- vip-shift-width)))
	       (goto-char vip-com-point))
	      ((= com ?>)
	       (save-excursion
		 (set-mark vip-com-point)
		 (vip-enlarge-region (mark) (point))
		 (indent-rigidly (mark) (point) vip-shift-width))
	       (goto-char vip-com-point))
	      ((>= com 128)
	       ;; this is special command #
	       (vip-special-prefix-com (- com 128)))))
    (setq vip-d-com (list m-com val (if (or (= com ?c) (= com ?C) (= com ?!))
					(- com) com)
			  reg))))

(defun vip-repeat (arg)
  "(ARG)  Re-excute last destructive command.  vip-d-com has the form
(COM ARG CH REG), where COM is the command to be re-executed, ARG is the
argument for COM, CH is a flag for repeat, and REG is optional and if exists
is the name of the register for COM."
  (interactive "P")
  (if (eq last-command 'vip-undo)
      ;; if the last command was vip-undo, then undo-more
      (vip-undo-more)
    ;; otherwise execute the command stored in vip-d-com.  if arg is non-nil
    ;; its prefix value is used as new prefix value for the command.
    (let ((m-com (car vip-d-com))
	  (val (vip-P-val arg))
	  (com (car (cdr (cdr vip-d-com))))
	  (reg (nth 3 vip-d-com)))
      (if (null val) (setq val (car (cdr vip-d-com))))
      (if (null m-com) (error "No previous command to repeat."))
      (setq vip-use-register reg)
      (funcall m-com (cons val com)))))

(defun vip-special-prefix-com (char)
  "This command is invoked interactively by the key sequence #<char>"
  (cond ((= char ?c)
	 (downcase-region (min vip-com-point (point))
			  (max vip-com-point (point))))
	((= char ?C)
	 (upcase-region (min vip-com-point (point))
			(max vip-com-point (point))))
	((= char ?g)
	 (set-mark vip-com-point)
	 (vip-global-execute))
	((= char ?q)
	 (set-mark vip-com-point)
	 (vip-quote-region))
	((= char ?s) (spell-region vip-com-point (point)))))


;; undoing

(defun vip-undo ()
  "Undo previous change."
  (interactive)
  (message "undo!")
  (undo-start)
  (undo-more 2)
  (setq this-command 'vip-undo))

(defun vip-undo-more ()
  "Continue undoing previous changes."
  (message "undo more!")
  (undo-more 1)
  (setq this-command 'vip-undo))


;; utilities

(defun vip-string-tail (str)
  (if (or (null str) (string= str "")) nil
    (substring str 1)))

(defun vip-yank-defun ()
  (mark-defun)
  (copy-region-as-kill (point) (mark)))

(defun vip-enlarge-region (beg end)
  "Enlarge region between BEG and END."
  (if (< beg end)
      (progn (goto-char beg) (set-mark end))
    (goto-char end)
    (set-mark beg))
  (beginning-of-line)
  (exchange-point-and-mark)
  (if (or (not (eobp)) (not (bolp))) (next-line 1))
  (beginning-of-line)
  (if (> beg end) (exchange-point-and-mark)))

(defun vip-global-execute ()
  "Call last keyboad macro for each line in the region."
  (if (> (point) (mark)) (exchange-point-and-mark))
  (beginning-of-line)
  (call-last-kbd-macro)
  (while (< (point) (mark))
    (forward-line 1)
    (beginning-of-line)
    (call-last-kbd-macro)))

(defun vip-quote-region ()
  "Quote region by inserting the user supplied string at the beginning of
each line in the region."
  (setq vip-quote-string
	(let ((str
	       (vip-read-string (format "quote string \(default \"%s\"\): "
					vip-quote-string))))
	  (if (string= str "") vip-quote-string str)))
  (vip-enlarge-region (point) (mark))
  (if (> (point) (mark)) (exchange-point-and-mark))
  (insert vip-quote-string)
  (beginning-of-line)
  (forward-line 1)
  (while (and (< (point) (mark)) (bolp))
    (insert vip-quote-string)
    (beginning-of-line)
    (forward-line 1)))

(defun vip-end-with-a-newline-p (string)
  "Check if the string ends with a newline."
  (or (string= text "")
      (= (aref string (1- (length string))) ?\n)))

(defun vip-read-string (prompt &optional init)
  (setq save-minibuffer-local-map (copy-keymap minibuffer-local-map))
  (define-key minibuffer-local-map "\C-h" 'backward-char)
  (define-key minibuffer-local-map "\C-w" 'backward-word)
  (define-key minibuffer-local-map "\e" 'exit-minibuffer)
  (let (str)
    (condition-case conditions
	(setq str (read-string prompt init))
      (quit
       (setq minibuffer-local-map save-minibuffer-local-map)
       (signal 'quit nil)))
    (setq minibuffer-local-map save-minibuffer-local-map)
    str))


;; insertion commands

(defun vip-repeat-insert-command ()
  "This function is called when mode changes from insertion mode to
vi command mode.  It will repeat the insertion command if original insertion
command was invoked with argument > 1."
  (let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com))))
    (if (and val (> val 1)) ;; first check that val is non-nil
	(progn        
	  (setq vip-d-com (list i-com (1- val) ?r))
	  (vip-repeat nil)
	  (setq vip-d-com (list i-com val ?r))))))

(defun vip-insert (arg) ""
  (interactive "P")
  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
    (setq vip-d-com (list 'vip-insert val ?r))
    (if com (vip-loop val (yank))
      (vip-change-mode-to-insert))))

(defun vip-append (arg)
  "Append after point."
  (interactive "P")
  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
    (setq vip-d-com (list 'vip-append val ?r))
    (if (not (eolp)) (forward-char))
    (if (equal com ?r)
	(vip-loop val (yank))
      (vip-change-mode-to-insert))))