1 files changed, 97 insertions, 0 deletions
diff --git a/modes/modes.el b/modes/modes.el
new file mode 100644
index 0000000..538ab93
--- /dev/null
+++ b/modes/modes.el
@@ -0,0 +1,97 @@
+;;; A modal interface
+
+;;; Dictionary
+
+;; ;;;###autoload
+;; (defvar modes-concepts
+;;   (list 'down 'up 'left 'right 'next 'previous
+;;         'down-max 'up-max 'left-max 'right-max 'next-max 'previous-max
+;; 	'jump)
+;;   "The concepts that a mode can define.")
+
+
+;;;###autoload
+(defvar modes-concept-keymap
+  (list
+   (cons 'down '(?j down))
+   (cons 'up '(?k up))
+   (cons 'right '(?l right))
+   (cons 'left '(?h left))
+   (cons 'forward ?n)
+   (cons 'backward ?p)
+   (cons 'down-max '([?J] S-down))
+   (cons 'up-max '([?K] S-up))
+   (cons 'right-max '([?L] S-right))
+   (cons 'left-max '([?H] S-left))
+   (cons 'forwrad-max ?N)
+   (cons 'backward-max ?P)
+   (cons 'jump 'tab)
+   (cons 'other ?o)
+   (cons 'undo ?u)
+   (cons 'redo ?U))
+  "An alist that maps concepts to keys.")
+
+;;;###autoload
+(defvar modes-map-alist (cons (cons 'modes-mode '(keymap "Modes alist")) nil)
+  "The current mode map.")
+
+(push 'modes-map-alist emulation-mode-map-alists)
+
+;;;###autoload
+(define-minor-mode modes-mode "A modal interface" nil "Modes" nil :global t)
+
+;;;###autoload
+(defun modes-process-key (key)
+  "Process keys appropriately.
+The return value is a list of keys acceptable by `define-key'."
+  (cond
+   ((stringp key) (list (kbd key)))
+   ((vectorp key) (list key))
+   ((or (symbolp key) (integerp key)) (list (vector key)))
+   ((listp key)
+    (mapcar (lambda (k)
+	      (cond
+	       ((stringp k) (kbd k))
+	       ((vectorp k) k)
+	       ((integerp k) (vector k))
+	       ((symbolp k) (vector k))
+	       (t (user-error "Unsupported key: %S" k))))
+	    key))
+   (t (user-error "Unsupported key: %S" key))))
+
+;;;###autoload
+(defun modes-set-mode (alist)
+  "Set a mode.
+A mode is just an ALIST between concepts and functions."
+  (let ((map (cons 'keymap "Modes")))
+    (dolist (concept-to-function alist)
+      (let* ((key (or
+		   (alist-get (car concept-to-function)
+			      modes-concept-keymap)
+		   (error "Unsupported concept: %S" (car concept-to-function))))
+	     (keys (modes-process-key key))
+	     (fun (cdr concept-to-function)))
+	(mapc (lambda (k) (define-key map k fun)) keys)))
+    (set 'modes-map-alist (list (cons 'modes-mode map)))))
+
+;;; Modes
+
+;;; buffer mode
+
+(defun switch-to-last-buffer ()
+  "Switch to the last buffer."
+  (interactive)
+  (switch-to-buffer (other-buffer)))
+
+(set 'modes-buffer-mode
+     '((down . next-buffer)
+       (up . previous-buffer)
+       (other . switch-to-last-buffer)
+       (jump . ibuffer)))
+
+
+
+
+
+
+