;;; mlessvim.el --- (Modeless vim) perform vi-like operations in
;;; emacs using a single "action key"

;; Copyright (C). This is released under the BSD license.

;; Author: Tom Wright <tat.wright@tat.wright.name>
;; Last change: Nov 2008
;; Version: 0
;; Keywords: vi, vim, modeless

;;; Motivation

;; Emacs can have some perceived advantages over vi/vim.
;;  * You might already know how to use it or customize it
;;  * It doesn't have modeful input.
;;  * It has the concept of different editing modes with extra key-bindings
;;  * It can open multiple windows
;;  * It has a terminal that works.
;;  * Some people like lisp.

;; However, one possible gripe is that it isn't as good at editing text
;; at vi, you can't press "da(" or "d/end" or "dap". Modeless vim seeks 
;; to add these sort of commands to emacs... without having to add
;; a transient normal mode like vim, which you have to continually exit and enter. 
;; Instead a "perform some sort of clever text manipulation"
;; prefix key is added.

;; Another theme of modeless-vim is "you don't have to press the control and alt keys"
;; quite as much, but nor do you have to continually press "C-]" - hence the prefix key.

;;; Installation
;; Place mlessvim.el in your load-path. (See "C-h v load-path" for details), and require it
;; on startup. If you want to go into mlessvim mode by default run mlessvim-mode.
;;  This can be done with the following line in your .emacs file.
;; (require 'mlessvim)
;; (mlessvim-mode 1)

;; Next you have to find a nice key to use as your mlessvim prefix key. The context menu 
;; or super key is good for this (assuming you don't use a thinkpad 
;; - hurrah for IBM... or something like that). 

;; To find out what emacs calls a key use M-x global-set-key then press the key.

;; Then run "M-x customize-group mlessvim." and change mlv-top-key to the string
;; "<KEYNAME>" (including both the quotes and the <>), saving this setting for future 
;; and current sessions.

;; Next see mlv-help for a list of bindings.


;;; Caps lock
;; If you want to use caps lock for your prefix key life is more fun. One
;; approach is to remap the caps key to a symbol which emacs understands and bind
;; to this symbol. On X systems (windows / mac) see xmodmap, on windows see sharpkeys.

;;; Contact
;; If you have an questions or suggestions feel free to contact me on 
;;  or would just like to say how much you dislike this mode
;; feel free to contact me at tat.wright@tat.wright.name.

;;; Plausibly Asked Questions

;;Q: Why on earth would you waste your time doing something so ludicrously pointless
;;   when you could instead just use an editor that works and actually do something useful.
;;   This code is all trivial and slightly broken anyway! More to the point
;;   there are already two vi emulation mode in emacs! You lose.
;;A: Yes. (I'm also exceedingly dull and have no social life).

;;Q: Isn't it possible to get exactly the same effects in vim by using the C-o command when in insert mode?
;;A: Yes... in a way. This is still in using vim rather than emacs. Some people might think that 
;;   emacs offers advatanges over vim *other than* its keybinding model (for example the fact that
;;   it attempts to be an entire operating system...)

;;Q: Why couldn't you just have adapted viper mode so it used a prefix key?
;;A: This may have been a good idea. I (very) briefly looked into this, but decided that (a) playing was more fun
;;   (b) I wanted whatever I did to play well with emacs help - in particular "C-h k <prefix key> d w" should give
;;    you a function name and help for that function.

;;Q: Don't you think it was a bad idea to subtly break the meaning of vim keys? Does this may this hard to learn?
;;A: Maybe. I know that conventional wisdom says that one should make something near identical or complete smash 
;;   the specification - perhaps I could claim that I'm doing the later. One defence is that I wrote this for
;;   myself originally so defined so of the commands to do what I wanted them to do rather than what something
;;   more like vim would do. Hopefully having another set of bindings in your head won't destroy your ability
;;   to use vim (I still manage to use vim when it is convenient) also hopefully these bindings aren't too hard to learn.

;;Q: Don't you think chaning the default emacs bindings is a bad idea?
;;A: This doesn't really change the default emacs bindings - rather add lots of things do them. (Though I
;;   do sometimes think that there is some irresistible force which tells me to do everything using 
;;   modeless-vim commands.) Hopefully you can just fall back to using the emacs key if you are on an emacs editor;
;;   the modeless-vim bindings all start with a prefix command - so are quite easy to recognise. Also
;;   one tends to use an editor for large periods of time - this means that it makes sense to have something
;;   fairly customised.

;;Q: Why have you flooded my apropos search for "case"/"word"/"line" with matching functions?
;;A: Not quite sure. If it makes you feel happier it means emacs' help facilities work properly. There aren't *that* many matches.


;; Vim-like text commands from a prefixed emacs shortcut

(require 'cl)
(require 'simple)
(require 'edmacro)
    
(defun mlv-defoperator (name key doc-verb doc-adverbial func-name)
  (add-to-list 'mlv-operations name)
  (add-to-list 'mlv-operation-keys (cons name key))
  (add-to-list 'mlv-operation-doc (cons name (list doc-verb doc-adverbial)))
  (add-to-list 'mlv-operation-funcs (cons name func-name)))


(setq mlv-selectors ())
(defmacro mlv-defselector (symbol key &rest body)
  "Define a selector with name symbol whose keybindings use key,
and where body returns a pair representing the selected region"
  (let* ((name (symbol-name symbol))
	 (funsymbol (intern (concat "mlv-" name))))
    `(progn
       (defun ,funsymbol () ,@ 
	 (save-excursion body))
       (add-to-list (quote mlv-selectors) ,name)
       (put (quote ,funsymbol) (quote key) ,key))))


(setq mlv-functions ())
(defmacro mlvdefun (name key &rest body)
  `(progn
     (defun ,name ,@ body)
     (add-to-list 'mlv-functions (quote ,name))
     (put (quote ,name) (quote key) ,key)
     (define-key mlv-top-map ,key (quote ,name))))


(defmacro mlv-def-innerselector (symbol &optional doc)
  "Defines a variant on a selector which selects everything but the first and last characters of 
a given selection."
  (let ((variant-symbol (intern (concat "mlv-" (symbol-name symbol)))))
    `(mlv-defselector 
      ,(intern (concat "in-" (symbol-name symbol)))
      ,(concat "i" (get variant-symbol 'key))
      ,doc
      (destructuring-bind (a b) (sort (,variant-symbol) '<)
	(list (+ a 1) (- b 1))))))


(defmacro mlv-tap-selector (thing key &optional doc)
  "Define a selector from a thing-at-point"
  `(mlv-defselector ,thing ,key ,doc
		    (let ((tap-bounds (bounds-of-thing-at-point (quote ,thing))))
		      (if (null tap-bounds)
			  ()
			(list (car tap-bounds) (cdr tap-bounds))))))
(defmacro mlv-tap-end-selector (thing key &optional doc)
  "Define a selector from the point to the end of thing-at-point"
  `(mlv-defselector ,(intern (format "end-of-%s" (symbol-name thing))) ,key ,doc
		    (let ((tap-bounds (bounds-of-thing-at-point (quote ,thing))))
		      (if (null tap-bounds)
			  ()
			(list (point) (cdr tap-bounds))))))


(mlv-tap-selector word "w"
  "the region between the beginning and end of the word containing the point")
(mlv-tap-end-selector word "W"
  "the region between the point and the end of the word containing the point")


(mlv-tap-selector line "l"
  "the region between the beginning of the line containing the point and the beginning of the next line")
(mlv-tap-end-selector line "L"
  "the region between the point and the beginning of the next line")
		      

(mlv-tap-selector symbol "s"
  "the region between the beginning and end of the symbol in your current mode containing the point")
(mlv-tap-end-selector symbol "S"
  "the region between the point and the end of the symbol containing the point in your current mode")

(mlv-tap-selector word "w"
  "the region between the beginning and end of the word containing the point")
(mlv-tap-end-selector word "W"
  "the region between the point and the end of the word containing the point")


(mlv-tap-selector line "l"
  "the region between the beginning of the line containing the point and the beginning of the next line")
(mlv-tap-end-selector line "L"
  "the region between the point and the beginning of the next line")
		      

(mlv-tap-selector symbol "s"
  "the region between the beginning and end of the symbol in your current mode containing the point")
(mlv-tap-end-selector symbol "S"
  "the region between the point and the end of the symbol containing the point in your current mode")

(mlv-tap-selector whitespace "<SPC>"
   "the whitespace containing the point upto the end of line (or if there is no whitespace on the line the new line character")

(mlv-defselector multiline-whitespace "<RET>" 
   "the whitespace containing the point, excluding whitespace at the beginning of lines before characters"
   (save-excursion
     (list
      (progn 
	(search-backward-regexp "[^ \n]")
	(forward-line 1)
	(beginning-of-line)
	(point))
      (progn
	(forward-char 1)
	(if (search-forward-regexp "[^ \n]" nil t)
	    (beginning-of-line)
	    (goto-char (point-max)))
	(point)))))


(defmacro mlv-selector-from-move (symbol key &rest mover)
  `(mlv-defselector ,symbol ,key
     (list
      (point)
      (progn
	,mover
	(point)))))

(setq mlv-operation-keys ())
(setq mlv-operations ())
(setq mlv-operation-funcs ())
(setq mlv-operation-doc ())


;; name, letter, 

(mlv-defoperator "cut" "x" "Delete" "from the current buffer placing a copy on the kill ring" "kill-region")
(mlv-defoperator "copy"  "c" "Place" "on the kill ring" "kill-ring-save")
(mlv-defoperator "del"  "d" "Delete" "from the buffer, without placing a copy on the kill-ring" "delete-region")
(mlv-defoperator "upcase"  "u" "Make" "uppercase" "upcase-region")
(mlv-defoperator "downcase" "U" "Make" "lowercase" "downcase-region")
(mlv-defoperator "titlecase" "t" "Make" "title case" "upcase-initials-region")
(mlv-defoperator "surround" "e" "Surround" "with a character" "mlv-surround")


(defun mlv-surround (beg end)
  "Surround a region with some character"
  (let* ((surround (char-to-string (read-char "wrap with:"))) open close)
    
    (setq open surround)
    ; ever heard of a switch?
    (setq close (cond ((equal surround "(") ")")
		      ((equal surround "[") "]")
		      ((equal surround "'") "'")
		      ((equal surround "\"") "\"")))
    (save-excursion
      (goto-char (min beg end))
      (insert open)
      (goto-char (+ (max beg end) 1))
      (insert close))))


  

(defun mlv-make-toplevel-maps ()
  "Construct the top level keys for most operations"
  (dolist (operation-pair mlv-operation-keys)
    (let ((operation (car operation-pair))
	  (key (cdr operation-pair)))
      (let ((symbol (intern (format "mlv-%s-map" operation))))
	(message "setting %s to %s" key symbol)
	(define-prefix-command symbol)
	(define-key mlv-top-map (read-kbd-macro key) symbol)))))




(defvar mlv-top-key  "<select>" "Keybinding used to start mlv commands")
(define-prefix-command 'mlv-top-map)
(define-prefix-command 'mlv-top-map)
(define-prefix-command 'mlv-topmost-map)
(define-key mlv-topmost-map (read-kbd-macro mlv-top-key) mlv-top-map)

(mlv-make-toplevel-maps)

(define-prefix-command 'mlv-go-map)
(define-key mlv-top-map (kbd "g") 'mlv-go-map)


(define-key mlv-top-map (kbd "1") 'digit-argument)



(defun mlv-jump-to-magic-register ()
  "Jumps to the point stored in the register ."
  (interactive)
  (register-to-point (string-to-char ".")))

(define-key mlv-top-map "m" 'point-to-register)
(define-key mlv-go-map "m" 'register-to-point)
(define-key mlv-go-map "." 'mlv-jump-to-magic-register)


(defun range-union (pair1 pair2)
  (destructuring-bind ((a b) (c d)) (list (sort pair1 '<) (sort pair2 '<))
    (list (min a c)
	  (max b d))))


(defun mlv-bracket-backward ()
  (save-excursion
    (list
     (progn
       (search-backward "(")
       (point))
     (progn
       (forward-sexp)
       (point)))))


(defun mlv-bracket-forward ()
  (save-excursion
    (reverse
     (list
      (progn
	(search-forward ")")
	(point))
      (progn
	(backward-sexp)
	(point))))))

 

(mlv-defselector bracket "(" 
		 "the region including the surrounding the brackets and the current point"
		 (range-union (mlv-bracket-backward) (mlv-bracket-forward)))

(mlv-def-innerselector bracket
		 "the region between the surrouding brackets containing the current point but not the surrounding brackets")

(mlv-defselector argument ","
		 "the region between a pair of commands or a bracket and a comma"
		 (save-excursion
		   (list
		    (progn
		      (search-backward-regexp "[(,]")
		      (if (looking-at "(") (forward-char))
		      (point))
		    (progn
		      (forward-char)
		      (search-forward-regexp "[),]")
		      (backward-char)
		      (point)))))


;; (mlv-defselector defun "d"
;; 		 (py-mark-def-or-class)
;; 		 (list (point) (mark)))


;; (mlv-defselector class "c"
;; 		 (py-mark-def-of-class t)
;; 		 (list (point) (mark)))
		 

(define-key mlv-top-map (read-kbd-macro mlv-top-key) 'execute-extended-command)

(define-prefix-command 'mlv-open-map)
(define-key mlv-top-map (kbd "o") 'mlv-open-map)

(define-prefix-command 'mlv-hide-map)
(define-key mlv-top-map (kbd "h") 'mlv-hide-map)

(define-prefix-command 'mlv-factor-map)
(define-key mlv-top-map (kbd "r") 'mlv-factor-map)

(define-prefix-command 'mlv-insert-map)
(define-key mlv-top-map (kbd "i") 'mlv-insert-map)

(define-key mlv-top-map (kbd "p") 'yank)

(mlvdefun mlv-paste-after "P" ()
  "Insert the current kill-ring before the current point"
  (message "Pasting before")
  (interactive)
  (let ((point (point)))
    (yank)
    (goto-char point)))


(define-prefix-command 'mlv-save-map)
(define-key mlv-top-map (kbd "s") 'mlv-save-map)
(define-key mlv-save-map (kbd "b") 'save-buffer)
(define-key mlv-hide-map (kbd "b") 'bury-buffer)


(mlv-defselector 
 search "/"
 (interactive)
 "Region matching a search"
  (save-excursion
    (isearch-forward-regexp)
    (list
     (point)
     (- (point) (length isearch-string)))))


(defun mlv-get-operation-key (operation)
 "Get the key used for binding a particular operation."
 (cdr (assoc operation mlv-operation-keys)))


(defun mlv-get-selector-key (selector)
 "Get the key used for binding a particular selecxotor."
 (get
  (intern (format "mlv-%s" selector))
  'key))


(defun mlv-bind-action (operation selector)
 "Bind a particular action."
 (define-key
   (mlv-get-operation-map operation)
   (read-kbd-macro
    (mlv-get-selector-key selector))
   (intern
    (format "mlv-%s-%s" operation selector))))


(defun mlv-insert (beg end)
 "Insert the text in the specified region"
 (insert (apply 'buffer-substring (list beg end))))


(defun mlv-del-buffer ()
 "Delete the current buffer."
 (interactive)
 (kill-buffer (current-buffer)))
(define-key mlv-del-map (kbd "b") 'mlv-del-buffer)


(defun mlv-including ()
 "Return a pair consisting of the starting and ending point of the
region starting with and ending with
two delimiters containing the point"
 (save-excursion
  (defun find-opening ()
    (if (search-backward (char-to-string delimiter) nil t)
        (print (point)) (error (concat "Could not find opening "
(char-to-string delimiter)))))
  (defun find-closing ()
    (forward-char)
    (if (search-forward (char-to-string delimiter) nil t)
        (point) (error (concat "Could not find closing " (char-to-string
delimiter)))))
  (list (find-opening) (find-closing))))


(mlv-defselector 
 in ";"
 "Interactively select a region by searching backwards and then forwards from the current point."
 (save-excursion
   (let ((old-point (point)))
     (list
      (progn
	(isearch-backward)
	(point))
      (progn
	(goto-char old-point)
	(isearch-forward)
	(point))))))


(defun mlv-copy-buffer ()
 "Clones the current buffer and displays it in the the other window"
 (interactive)
 (clone-indirect-buffer-other-window nil t))
(define-key mlv-copy-map (kbd "b") 'mlv-copy-buffer)


(defun mlv-go-char (char &optional count)
 "Go to the next character char, if count is unspecified, otherwise
go to the count'th occurene."  (interactive "cCharacter to jump
to:\np")
 (search-forward (char-to-string char) nil t count))

(define-key mlv-go-map (kbd "f") 'mlv-go-char-interactive)


(defun mlv-go-back-to-char (char &optional count)
 "Go to the next character char, if count is unspecified, otherwise
go to the count'th occurene."  (interactive "cCharacter to jump
to:\np")
 (search-backward (char-to-string char) nil t count))

(define-key mlv-go-map (kbd "b") 'mlv-go-back-to-char)


(defun join-with (sep L)
  "Join the list of strings L with the separator sep"
  (if (null (cdr L)) (car L)
    (concat (car L) sep (join-with sep (cdr L)))))


(defun mlv-prefix (&rest parts)
  (intern (join-with "-" (cons "mlv"  (mapcar 'symbol-name parts)))))


(mlvdefun mlv-join-line "j" ()
  "Join the following line to the end of this line"
  (interactive)
  (save-excursion
    (end-of-line)
    (mlv-del-whitespace)
    (just-one-space)))


(defmacro mlv-popped-char-loop (var op pop msg)
  (assert (symbolp var))
  `(let ((enter 13)
	(backspace 127)
	(first-point (point))
	(finished nil)
	char
	(points ()))
     
    (while (not finished)
      (setq ,var (read-char ,msg))
      (cond
       ((= ,var enter)
	(setq finished t))
       ((= ,var backspace)
	,pop)
       (t
	,op)))))


(mlvdefun mlv-append-to-line "a" ()
  "interactively append to the end of the current line"
  (interactive)
  (save-excursion
    (end-of-line)
    (mlv-popped-char-loop char 
			  (insert char)
			  (delete-backward-char 1)
			  "insert character (enter to finish):")))


(defmacro mlv-defsearcher (name key search position unposition)
  (assert (symbolp name))
  `(progn 
     (defun ,(mlv-prefix name) ()
       "Do some clever searching"
       (interactive)
       (mlv-popped-char-loop char 
			     (progn 
			       (push (point) points)
			       ,unposition
			       ,search
			       ,position)
			     (goto-char (pop points))
			     "go to character (enter to finish)"))
     (define-key mlv-top-map ,key (quote ,(mlv-prefix name)))))


(mlv-defsearcher go-forward "f"        
		  (search-forward (char-to-string char))
		  (backward-char 1)
		  (forward-char 1))

(mlv-defsearcher go-forward-after "F"
			 (search-forward (char-to-string char))
			 nil
			 nil)

(mlv-defsearcher go-backward "b"
			 (search-backward (char-to-string char))
			 nil
			 nil)

(mlv-defsearcher go-backward-after "B"
			 (search-backward (char-to-string char))
			 (forward-char 1)
			 (backward-char 1))
			 


(defmacro mlv-selector-from-move (symbol key &rest mover)
  `(mlv-defselector ,symbol ,key
     (list
      (point)
      (progn
	,mover
	(point)))))


(mlv-defselector 
 forward
 "f"
 "the region between a point and an interactive search for characters terminated with <RET>"
 (save-excursion
   (list
    (point)
    (progn 
      (call-interactively 'mlv-go-forward)
      (point)))))


(defun mlv-repeat ()
 (interactive)
 (repeat 1))


(defun mlv-wrap-region (prefix suffix)
 "Writes prefix before the current region and suffix after the current region"
 (interactive "sString Before:\nsString after:")
 (let ((beg (copy-marker (region-beginning)))
      (end (copy-marker (region-end))))
  (save-excursion
    (goto-char beg) (insert prefix)
    (goto-char end) (insert suffix))))


(defun mlv-wrap-char-region (char)
 "Wraps the current region in a certain character"
 (interactive "cEnclosing character:")
 (mlv-wrap-region (char-to-string char) (char-to-string char)))
;(define-key mlv-top-map (kbd "e") 'mlv-wrap-char-region)


(defun mlv-single-quote-region ()
 "Single quote the currently selected region"
 (interactive)
 (mlv-wrap-region "'" "'"))
(define-key mlv-top-map (kbd "'") 'mlv-single-quote-region)


(defun mlv-double-quote-region ()
 "Single quote the currently selected region"
 (interactive)
 (mlv-wrap-region "\"" "\""))
(define-key mlv-top-map (kbd "\"") 'mlv-double-quote-region)


(mlv-defselector search-word "/"
 "Start an interactive search for the word at the point"
 (interactive)
 (backward-word 1)
 (isearch)
 (isearch-yank-word))


(defun refactor-value-extract-region (name)
 "Convert the current region to an assignment on the previous line"
 (interactive "sParameter Name:")
 (let ((expression (buffer-substring (region-beginning) (region-end))))
  (save-excursion
    (delete-region (region-beginning) (region-end))
    (insert name)
    (previous-line 1)
    (end-of-line)
    (newline)
    (indent-according-to-mode)
    (insert (concat name " = "  expression)))))

(define-key mlv-factor-map (kbd "n") 'refactor-value-extract-region)
(define-key mlv-factor-map (kbd "n") 'refactor-value-extract-region)

(define-globalized-minor-mode mlv-mode-global mlv-mode
mlv-mode)


(mlv-defselector camel-word "k"
 "the region between the beginning and end of the current camelcase word containing the point"
 (interactive)
 (save-excursion
   (let ((case-fold-search nil))
     (list 
      (save-excursion
	(search-backward-regexp "[^a-z]")
	(point))
      (save-excursion
	(search-forward-regexp "[^a-z]")
	(backward-char)
	(point))))))


(mlv-defselector
 selection  "r"
 "the region between the mark and the point"
 (list
  (point)
  (mark)))


(mlv-defselector 
 quote "'"
 "the region contained within a pair of ' characters"
 (save-excursion
   (list
    (progn 
      (search-backward "'")
      (point))
    (progn
    (forward-char 1)
    (search-forward "'")
    (point)))))
(mlv-def-innerselector quote
   "the region between a pair of ' characters containing the current point excluding the '")


(mlv-defselector double-quote "\""
  "the region contained within a pair of double quote characters"
  (save-excursion
    (list
     (progn 
       (search-backward "\"")
       (point))
     (progn
     (forward-char 1)
     (search-forward "\"")
     (point)))))

(mlv-def-innerselector double-quote 
   "the region between a pair of quote double characters containing the current point excluding the double quotes themselves")


(mlv-defselector to "t"
  "the region between the insertion point and the next occurence of a character"
  (message "To")
  (let ((char (read-char "To:")))
    (save-excursion
      (list 
       (point)
       (- (search-forward (char-to-string char)) 1)))))


(mlv-defselector to-including "T"
  "the region from the insertion point upto and including the next occurence of a character"
  (message "INCLUDING")
  (let ((char (read-char "To (including final character):")))
    (save-excursion
      (list 
       (point)
       (search-forward (char-to-string char))))))


(defun mlv-make-commands ()
 (dolist (operation mlv-operations)
   (dolist (selector mlv-selectors)
     (eval (read (mlv-make-action operation selector)))
     (mlv-bind-action operation selector))))


(defun mlv-get-operation-map (operation)
 "Get the top level key map for a particular operation"
 (eval (intern
        (format "mlv-%s-map" operation))))


(defun mlv-make-action (operation selector)
 "Generate code for the action of carrying out operation on selector"e
 (concat
  (mlv-make-header operation selector)
  (mlv-make-body operation selector)
  "\n)"))


(defun mlv-make-header (operation selector)
 "Make the header for an automatically generated command"
 (let ((fname (format "mlv-%s-%s" operation selector))
      (fdoc (mlv-make-doc operation selector)))
   (format "(defun %s ()\n \t\"%s\"\n" fname fdoc)))


(defun mlv-make-binding (operator selector)
 (format
  "(define-key mlv-%s-map (kbd \"%s\") mlv-%s-%s)"
  operator
  (mlv-get-key selector)
  operator
  selector))


(defun mlv-get-key (selector)
 (get
  (intern
   (format "mlv-%s" selector))
  'key))

(defun mlv-make-body (operation selector)
 "Make the body of an automatically generated function."
 (let
     ((op-func (mlv-get-operation-func-name operation))
      (sel-func (format "mlv-%s" selector)))
      (format "\t(interactive)\n\t(apply '%s (%s))" op-func sel-func)))


(defun mlv-get-operation-func-name (name)
 "Get the name of the function used to carry out a particular operation."
 (let ((name (cdr (assoc name mlv-operation-funcs))))
   (progn
     (assert (not (null name)))
     name)))


(defun mlv-make-doc (operation selector)
 "Create the documentation for a particular action."
 (let
     ((op-doc-list (mlv-get-operation-doc operation))
      (sel-doc (mlv-get-selector-doc selector)))
   (format (concat
            (car op-doc-list) " " sel-doc " " (cadr op-doc-list)))))


(defun mlv-get-operation-doc (name)
 "Get a pair consisting of the operation name and a description of where this
operation will be carried out"
 (cdr (assoc name mlv-operation-doc)))


(defun mlv-get-selector-doc (name)
 "Get the documentation related to a selector."
 (documentation
  (intern (format "mlv-%s" name))))

(mlv-make-commands)


(set-default 'mlv-highlight-word "")
(make-variable-buffer-local 'mlv-highlight-word)
(mlvdefun mlv-highlight-current-word "*" ()
  "Highlight the symbol under the point. Analagous to vim's * operator. If the symbol under the point is the same as the previous highlight unhighlight the previous search"
  (interactive)
  (unhighlight-regexp (regexp-quote mlv-highlight-word))
  (let ((new-word (thing-at-point 'symbol)))
    (if (not (equal mlv-highlight-word new-word))
	(progn
	  (highlight-regexp (regexp-quote new-word))
	  (setq mlv-highlight-word new-word))
      (setq mlv-highlight-word ""))))
(define-key mlv-top-map (kbd "8") 'mlv-highlight-current-word)


(mlvdefun mlv-search-current-symbol "/" ()
  "Search for the over which the cursor is positioned"
  (interactive)
  (let ((symbol (thing-at-point 'symbol)))
  (isearch-resume symbol nil nil t symbol nil)))

(defun mlv-selector-help (name)
  "Return a string containing help for the given selector"
  (format "%s - %s\n    %s\n"
	  name
	  (mlv-get-selector-key name)
	  (mlv-sentensize (mlv-get-selector-doc name))))

(defun mlv-operation-help (name)
  "Return a string containing help for the given operation"
  (destructuring-bind (start end) (mlv-get-operation-doc name)
    (format "%s - %s\n    %s something %s.\n" 
	    name
	    (mlv-get-operation-key name)
	    start
	    end)))

(defun mlv-function-help (fun)
  "Return a string containing help for the given function"
  (format "%s - %s - %s\n" (symbol-name fun)
	  (get fun 'key)
	  (documentation fun)))


(defun mlv-help ()
  "List all modeful vim operators."
  (interactive)
  (save-excursion
    (let ((buffer (get-buffer-create "*Mlessvim help*")))
      (set-buffer buffer)
      (mark-whole-buffer)
      (mlv-del-selection)
      (insert (format
       "All modeful vim commands are executed by pressing the prefix key (%s) followed by some sequence of letters.
Some of the commands act on a particular region of text, if this is the case the sequence is of the form
<operation> <selector> - meaning perform operation on the region selected by selector.\n\n"
       mlv-top-key))
      (insert (format "*** Examples ***\n\nPressing %s d w will delete the current word.\n" mlv-top-key))
      (insert (format "Pressing %s n will open a new line\n\n" mlv-top-key))
      (insert "*** Modeless vim operations ***\n\n")
      (dolist (op-name mlv-operations)
	(insert (mlv-operation-help op-name)))
      (insert "\n\n*** Modeless vim selectors ***\n\n")
      (dolist (sel-name (reverse mlv-selectors))
	(insert (mlv-selector-help sel-name)))
      (insert "\n\n*** Miscellaneous functions ***\n\n")
      (dolist (fun (reverse mlv-functions))
	(insert (mlv-function-help fun)))
      (goto-char 0)
      (switch-to-buffer-other-window buffer))))
(define-key mlv-top-map (kbd "?") 'mlv-help)


(defun mlv-sentensize (fragment)
  "Turn this sentence fragment into a 'sentence'."
  (if (not fragment)
      ""
    (format "%s%s."
	    (upcase (substring fragment 0 1))
	    (substring fragment 1))))


(mlvdefun mlv-open-line-before "N" ()
  "Open a line before the current line"
  (interactive)
  (interactive)
  (beginning-of-line)
  (newline-and-indent)
  (previous-line))


(mlvdefun mlv-open-line-after "n" ()
  "Open a line after the current line"
  (interactive)
  (interactive)
  (end-of-line)
  (newline-and-indent))

(setq mlessvim-mode nil)
(defun mlessvim-mode (&optional arg)
  (interactive)
  (setq mlessvim-mode 
	(if (null arg) (not mlessvim-mode)
	  (> (prefix-numeric-value arg) 0))))
(add-to-list 'minor-mode-map-alist (cons 'mlessvim-mode 'mlv-topmost-map))
(add-to-list 'minor-mode-alist '(mlessvim-mode " m<v"))


(defgroup mlessvim nil "The prefix used to start mlv commands")
(defcustom mlv-top-key "<select>" 
  "Prefix key used for mlessvim commands"
  :set (lambda (_ x)
	 (define-key mlv-topmost-map (read-kbd-macro mlv-top-key) nil)
	 (define-key mlv-top-map (read-kbd-macro mlv-top-key) nil)
	 (setq mlv-top-key x)
	 (define-key mlv-topmost-map (read-kbd-macro mlv-top-key) 'mlv-top-map)
	 (define-key mlv-top-map (read-kbd-macro mlv-top-key) 'execute-extended-command))
  :group 'mlessvim)
(provide 'mlessvim)

;;; mlessvim.el ends here