Add emacs directory

git-svn-id: http://photonzero.com/dotfiles/trunk@54 23f722f6-122a-0410-8cef-c75bd312dd78

.emacs.d/vim-mode/vim-ex.el

@@ -0,0 +1,440 @@
+;;; vim-ex.el - Ex-mode.
+
+;; Copyright (C) 2009, 2010 Frank Fischer
+
+;; Author: Frank Fischer <frank.fischer@mathematik.tu-chemnitz.de>,
+;;
+;; This file is not part of GNU Emacs.
+
+;;; Code:
+
+(defvar vim:ex-commands nil
+  "List of pairs (command . function).")
+
+(defvar vim:ex-current-buffer)
+
+(vim:deflocalvar vim:ex-local-commands nil
+  "List of pairs (command . function).")
+
+(defvar vim:ex-history nil
+  "History of ex-commands.")
+
+(defun vim:emap (keys command)
+  "Maps an ex-command to some function."
+  (unless (find-if #'(lambda (x) (string= (car x) keys)) vim:ex-commands)
+    (add-to-list 'vim:ex-commands (cons keys command))))
+
+(defun vim:local-emap (keys command)
+  "Maps an ex-command to some function buffer-local."
+  (unless (find-if #'(lambda (x) (string= (car x) keys)) vim:ex-local-commands)
+    (add-to-list 'vim:ex-local-commands (cons keys command))))
+
+(defun vim:ex-binding (cmd)
+  "Returns the current binding of `cmd' or nil."
+  (with-current-buffer vim:ex-current-buffer
+    (or (cdr-safe (assoc cmd vim:ex-local-commands))
+        (cdr-safe (assoc cmd vim:ex-commands)))))
+
+(defvar vim:ex-keymap (make-sparse-keymap)
+  "Keymap used in ex-mode.")
+
+(define-key vim:ex-keymap "\t" 'minibuffer-complete)
+(define-key vim:ex-keymap [return] 'exit-minibuffer)
+(define-key vim:ex-keymap (kbd "RET") 'exit-minibuffer)
+(define-key vim:ex-keymap " " 'vim:ex-expect-argument)
+(define-key vim:ex-keymap (kbd "C-j") 'vim:ex-execute-command)
+(define-key vim:ex-keymap (kbd "C-g") 'abort-recursive-edit)
+(define-key vim:ex-keymap [up] 'previous-history-element)
+(define-key vim:ex-keymap [down] 'next-history-element)
+(define-key vim:ex-keymap "\d" 'vim:ex-delete-backward-char)
+
+(defun vim:ex-delete-backward-char (n)
+  "Delete the previous `n' characters. If ex-buffer is empty,
+cancel ex-mode."
+  (interactive "p")
+  (if (and (>= n 1)
+           (zerop (length (minibuffer-contents))))
+      (exit-minibuffer))
+  (delete-backward-char n))
+
+(defvar vim:ex-keep-reading nil)
+(defvar vim:ex-cmdline nil)
+(defvar vim:ex-cmd nil)
+(defvar vim:ex-beg nil)
+(defvar vim:ex-end nil)
+
+(defun vim:ex-split-cmdline (cmdline)
+  (multiple-value-bind (cmd-region beg end) (vim:ex-parse cmdline)
+    (if (null cmd-region)
+        (values cmdline "" cmdline "" beg end)
+      (let ((range (substring cmdline 0 (car cmd-region)))
+            (cmd (substring cmdline (car cmd-region) (cdr cmd-region)))
+            (spaces "")
+            (arg (substring cmdline (cdr cmd-region))))
+    
+        ;; skip whitespaces
+        (when (string-match "\\`\\s-*" arg)
+          (setq spaces (match-string 0 arg)
+                arg (substring arg (match-end 0))))
+      
+        (values range cmd spaces arg beg end)))))
+
+(defun vim:ex-expect-argument (n)
+  ;; called if the space separating the command from the argument has
+  ;; been pressed
+  (interactive "p")
+  (let ((cmdline (vim:minibuffer-contents)))
+    (self-insert-command n)
+    (multiple-value-bind (range cmd spaces arg beg end) (vim:ex-split-cmdline cmdline)
+
+      (when (and (= (point) (point-max))
+                 (zerop (length spaces))
+                 (zerop (length arg)))
+        (while (stringp cmd)
+          (setq cmd (vim:ex-binding cmd)))
+        
+        (if (null cmd) (ding)
+          (let ((result (case (vim:cmd-arg cmd)
+                          (file
+                           (vim:ex-complete-file-argument nil nil nil))
+                          (buffer
+                           (vim:ex-complete-buffer-argument nil nil nil))
+                          ((t)
+                           (vim:ex-complete-text-argument nil nil nil)))))
+            (when result (insert result))))))))
+          
+(defun vim:ex-complete (cmdline predicate flag)
+  (multiple-value-bind (range cmd spaces arg beg end) (vim:ex-split-cmdline cmdline)
+    (setq vim:ex-cmd cmd)
+
+    (cond
+     ;; only complete at the end of the command
+     ((< (point) (point-max)) nil)
+       
+     ;; if at the end of a command, complete the command
+     ((and (zerop (length spaces)) (zerop (length arg)))
+      (let ((result (vim:ex-complete-command cmd predicate flag)))
+        (cond
+         ((null result) nil)
+         ((eq t result) t)
+         ((stringp result)
+          (if flag result (concat range result)))
+         ((listp result) (if flag result (mapcar #'(lambda (x) (concat range x)) result)))
+         (t (error "Completion returned unexpected value.")))))
+              
+     ;; otherwise complete the argument
+     (t 
+      (let ((result (vim:ex-complete-argument arg predicate flag)))
+        (cond
+         ((null result) nil)
+         ((eq t result) t)
+         ((stringp result) (if flag result (concat range cmd spaces result)))
+         ((listp result) (if flag result (mapcar #'(lambda (x) (concat range cmd spaces x)) result)))
+         (t (error "Completion returned unexpected value."))))))))
+
+        
+(defun vim:ex-complete-command (cmd predicate flag)
+  ;; completes the command
+  (with-current-buffer vim:ex-current-buffer
+    (cond
+     ((null flag) (or (try-completion cmd vim:ex-local-commands predicate)
+                      (try-completion cmd vim:ex-commands predicate)))
+   
+     ((eq t flag) (or (all-completions cmd vim:ex-local-commands predicate)
+                      (all-completions cmd vim:ex-commands predicate)))
+   
+     ((eq 'lambda flag) (or (vim:test-completion cmd vim:ex-local-commands predicate)
+                            (vim:test-completion cmd vim:ex-commands predicate))))))
+
+(defun vim:ex-complete-argument (arg predicate flag)
+  ;; completes the argument
+  (let ((cmd vim:ex-cmd))
+    (while (stringp cmd)
+      (setq cmd (vim:ex-binding cmd)))
+
+    (if (null cmd) (ding)
+      (case (vim:cmd-arg cmd)
+        (file
+         (vim:ex-complete-file-argument arg predicate flag))
+        (buffer
+         (vim:ex-complete-buffer-argument arg predicate flag))
+        ((t)
+         (vim:ex-complete-text-argument arg predicate flag))
+        (t (ding))))))
+
+(defun vim:ex-complete-file-argument (arg predicate flag)
+  ;; completes a file-name
+  (if (null arg)
+      default-directory
+    (let ((dir (or (file-name-directory arg)
+                   (with-current-buffer vim:ex-current-buffer default-directory)))
+          (fname (file-name-nondirectory arg)))
+      (cond
+       ((null dir) (ding))
+       ((null flag)
+        (let ((result (file-name-completion fname dir)))
+	  (case result
+	    ((nil) nil)
+	    ((t) t)
+	    (t (concat dir result)))))
+       
+       ((eq t flag) 
+        (file-name-all-completions fname dir))
+       
+       ((eq 'lambda flag)
+        (eq (file-name-completion fname dir) t))))))
+      
+(defun vim:ex-complete-buffer-argument (arg predicate flag)
+  ;; completes a buffer name
+  (when arg
+    (let ((buffers (mapcar #'(lambda (buffer) (cons (buffer-name buffer) nil)) (buffer-list t))))
+      (cond
+       ((null flag)
+        (try-completion arg buffers predicate))
+       ((eq t flag) 
+        (all-completions arg buffers predicate))
+       ((eq 'lambda flag)
+        (vim:test-completion arg buffers predicate))))))
+
+(defun vim:ex-complete-text-argument (arg predicate flag)
+  ;; completes an arbitrary text-argument
+  (when arg
+    (case flag
+      ((nil) t)
+      ((t) (list arg))
+      ('lambda t))))
+
+(defun vim:ex-execute-command (cmdline)
+  (interactive)
+
+  (multiple-value-bind (range cmd spaces arg beg end) (vim:ex-split-cmdline cmdline)
+    (setq vim:ex-cmd cmd)
+    
+    (let ((cmd vim:ex-cmd)
+          (motion (cond
+                   ((and beg end)
+                    (vim:make-motion :begin (save-excursion
+                                              (goto-line beg)
+                                              (line-beginning-position))
+                                     :end (save-excursion
+                                            (goto-line end)
+                                            (line-beginning-position))
+                                     :has-begin t
+                                     :type 'linewise))
+                   (beg
+                    (vim:make-motion :begin (save-excursion
+                                              (goto-line beg)
+                                              (line-beginning-position))
+                                     :end (save-excursion
+                                            (goto-line beg)
+                                            (line-beginning-position))
+                                     :has-begin t
+                                     :type 'linewise))))
+          (count (and (not end) beg)))
+      
+      (while (stringp cmd)
+        (setq cmd (vim:ex-binding cmd)))
+
+      (when (zerop (length arg))
+        (setq arg nil))
+
+      (with-current-buffer vim:ex-current-buffer
+        (cond
+         (cmd (case (vim:cmd-type cmd)
+                ('complex
+                 (if (vim:cmd-arg-p cmd)
+                     (funcall cmd :motion motion :argument arg)
+                   (funcall cmd :motion motion)))
+                ('simple
+                (when end
+                  (error "Command does not take a range: %s" vim:ex-cmd))
+                (if (vim:cmd-arg-p cmd)
+                    (if (vim:cmd-count-p cmd)
+                        (funcall cmd :count beg :argument arg)
+                      (funcall cmd :argument arg))
+                  (if (vim:cmd-count-p cmd)
+                      (funcall cmd :count count)
+                    (funcall cmd))))
+                (t (error "Unexpected command-type bound to %s" vim:ex-cmd))))
+         (beg (vim:motion-go-to-first-non-blank-beg :count (or end beg)))
+         (t (ding)))))))
+    
+
+;; parser for ex-commands
+(defun vim:ex-parse (text)
+  "Extracts the range-information from `text'.
+Returns a list of up to three elements: (cmd beg end)"
+  (let (begin
+        (begin-off 0)
+        sep
+        end
+        (end-off 0)
+        (pos 0)
+        (cmd nil))
+    
+    (multiple-value-bind (beg npos) (vim:ex-parse-address text pos)
+      (when npos
+        (setq begin beg
+              pos npos)))
+
+    (multiple-value-bind (off npos) (vim:ex-parse-offset text pos)
+      (when npos
+        (unless begin (setq begin 'current-line))
+        (setq begin-off off
+              pos npos)))
+
+    (when (and (< pos (length text))
+               (or (= (aref text pos) ?\,)
+                   (= (aref text pos) ?\;)))
+      (setq sep (aref text pos))
+      (incf pos)
+      (multiple-value-bind (e npos) (vim:ex-parse-address text pos)
+        (when npos
+          (setq end e
+          pos npos)))
+      
+      (multiple-value-bind (off npos) (vim:ex-parse-offset text pos)
+        (when npos
+          (unless end (setq end 'current-line))
+          (setq end-off off
+          pos npos))))
+
+    ;; handle the special '%' range
+    (when (or (eq begin 'all) (eq end 'all))
+      (setq begin 'first-line
+            begin-off 0
+            end 'last-line
+            end-off 0
+            sep ?,))
+    
+    (when (= pos (or (string-match "[a-zA-Z0-9!]+" text pos) -1))
+      (setq cmd (cons (match-beginning 0) (match-end 0))))
+               
+    (multiple-value-bind (start end) (vim:ex-get-range (and begin (cons begin begin-off)) sep (and end (cons end end-off)))
+      (values cmd start end))))
+
+
+(defun vim:ex-parse-address (text pos)
+  (cond
+   ((>= pos (length text)) nil)
+   
+   ((= pos (or (string-match "[0-9]+" text pos) -1))
+    (values (cons 'abs (string-to-number (match-string 0 text)))
+            (match-end 0)))
+
+   ((= (aref text pos) ?$)
+    (values (cons 'abs (line-number-at-pos (point-max))) (1+ pos)))
+
+   ((= (aref text pos) ?\%)
+    (values 'all (1+ pos)))
+    
+   ((= (aref text pos) ?.)
+    (values 'current-line (1+ pos)))
+
+   ((= (aref text pos) ?')
+    (if (>= (1+ pos) (length text))
+        nil
+      (values `(mark ,(aref text (1+ pos))) (+ 2 pos))))
+
+   ((= (aref text pos) ?/)
+    (when (string-match "\\([^/]+\\|\\\\.\\)\\(?:/\\|$\\)"
+                        text (1+ pos))
+      (values (cons 're-fwd (match-string 1 text))
+              (match-end 0))))
+   
+   ((= (aref text pos) ??)
+    (when (string-match "\\([^?]+\\|\\\\.\\)\\(?:?\\|$\\)"
+                        text (1+ pos))
+      (values (cons 're-bwd (match-string 1 text))
+              (match-end 0))))
+   
+   ((and (= (aref text pos) ?\\)
+         (< pos (1- (length text))))
+    (case (aref text (1+ pos))
+      (?/ (values 'next-of-prev-search (1+ pos)))
+      (?? (values 'prev-of-prev-search (1+ pos)))
+      (?& (values 'next-of-prev-subst (1+ pos)))))
+
+   (t nil)))
+
+
+(defun vim:ex-parse-offset (text pos)
+  (let ((off nil))
+    (while (= pos (or (string-match "\\([-+]\\)\\([0-9]+\\)?" text pos) -1))
+      (if (string= (match-string 1 text) "+")
+          (setq off (+ (or off 0) (if (match-beginning 2)
+                                      (string-to-number (match-string 2 text))
+                                    1)))
+                
+        (setq off (- (or off 0) (if (match-beginning 2)
+                                    (string-to-number (match-string 2 text))
+                                  1))))
+      (setq pos (match-end 0)))
+    (and off (values off pos))))
+     
+
+(defun vim:ex-get-range (start sep end)
+  (with-current-buffer vim:ex-current-buffer
+    (when start
+      (setq start (vim:ex-get-line start)))
+
+    (when (and sep end)
+      (save-excursion
+        (when (= sep ?\;) (goto-line start))
+        (setq end (vim:ex-get-line end))))
+  
+    (values start end)))
+
+
+(defun vim:ex-get-line (address)
+  (let ((base (car address))
+        (offset (cdr address)))
+    
+    (cond
+     ((null base) nil)
+     ((consp offset)
+      (let ((line (vim:ex-get-line (car address))))
+        (when line
+        (save-excursion
+          (goto-line line)
+          (vim:ex-get-line (cdr address))))))
+     
+     (t
+      (+ offset
+         (case (or (car-safe base) base)
+         (abs (cdr base))
+           
+         ;; TODO: (1- ...) may be wrong if the match is the empty string
+         (re-fwd (save-excursion
+                   (beginning-of-line 2)
+                   (and (re-search-forward (cdr base))
+                        (line-number-at-pos (1- (match-end 0))))))
+           
+         (re-bwd (save-excursion
+                   (beginning-of-line 0)
+                   (and (re-search-backward (cdr base))
+                        (line-number-at-pos (match-beginning 0)))))
+           
+         (current-line (line-number-at-pos (point)))
+         (first-line (line-number-at-pos (point-min)))
+         (last-line (line-number-at-pos (point-max)))
+         (mark (line-number-at-pos (vim:get-local-mark (cadr base))))
+         (next-of-prev-search (error "Next-of-prev-search not yet implemented."))
+         (prev-of-prev-search (error "Prev-of-prev-search not yet implemented."))
+         (next-of-prev-subst (error "Next-of-prev-subst not yet implemented."))
+         (t (error "Invalid address: %s" address))))))))
+
+
+(defun vim:ex-read-command (&optional initial-input)
+  "Starts ex-mode."
+  (interactive)
+  (let ((vim:ex-current-buffer (current-buffer)))
+    (let ((minibuffer-local-completion-map vim:ex-keymap))
+      (let ((result (completing-read ":" 'vim:ex-complete nil nil initial-input  'vim:ex-history)))
+        (when (and result
+                   (not (zerop (length result))))
+          (vim:ex-execute-command result))))))
+
+(provide 'vim-ex)
+
+;;; vim-ex.el ends here