added dropdown-list module

1 files changed, 258 insertions, 0 deletions

diff --git a/emacs.d/dropdown-list/dropdown-list.el b/emacs.d/dropdown-list/dropdown-list.el
new file mode 100644
index 0000000..452fcbc
--- /dev/null
+++ b/emacs.d/dropdown-list/dropdown-list.el
@@ -0,0 +1,258 @@
+;;; dropdown-list.el --- Drop-down menu interface
+;;
+;; Filename: dropdown-list.el
+;; Description: Drop-down menu interface
+;; Author: Jaeyoun Chung [jay.chung@gmail.com]
+;; Maintainer:
+;; Copyright (C) 2008 Jaeyoun Chung
+;; Created: Fri Aug 14 11:46:34 2009 (Central European Time)
+;; Version:
+;; Last-Updated: Fri Aug 14 11:46:34 2009 (Central European Time)
+;;           By: Deniz Dogan
+;;     Update #: 44
+;; URL: http://www.emacswiki.org/cgi-bin/wiki/dropdown-list.el
+;; Keywords: convenience menu
+;; Compatibility: GNU Emacs 21.x, GNU Emacs 22.x, GNU Emacs 23.x
+;;
+;; Features that might be required by this library:
+;;
+;;   `cl'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;  According to Jaeyoun Chung, "overlay code stolen from company-mode.el."
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;; 2009/08/14 Deniz Dogan
+;;     Making TAB select the chosen option.  If no option has been selected, chooses the
+;;     first one.
+;; 2008/03/16 dadams
+;;     Clean-up - e.g. use char-to-string for control chars removed by email posting.
+;;     Moved example usage code (define-key*, command-selector) inside the library.
+;;     Require cl.el at byte-compile time.
+;;     Added GPL statement.
+;; 2008/01/06 Jaeyoun Chung
+;;     Posted to gnu-emacs-sources@gnu.org at 9:10 p.m.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl)) ;; decf, fourth, incf, loop, mapcar*
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defface dropdown-list-face
+    '((t :inherit default :background "lightyellow" :foreground "black"))
+  "*Bla." :group 'dropdown-list)
+
+(defface dropdown-list-selection-face
+    '((t :inherit dropdown-list :background "purple"))
+  "*Bla." :group 'dropdown-list)
+
+(defvar dropdown-list-overlays nil)
+
+(defun dropdown-list-hide ()
+  (while dropdown-list-overlays
+    (delete-overlay (pop dropdown-list-overlays))))
+
+(defun dropdown-list-put-overlay (beg end &optional prop value prop2 value2)
+  (let ((ov (make-overlay beg end)))
+    (overlay-put ov 'window t)
+    (when prop
+      (overlay-put ov prop value)
+      (when prop2 (overlay-put ov prop2 value2)))
+    ov))
+
+(defun dropdown-list-line (start replacement &optional no-insert)
+  ;; start might be in the middle of a tab, which means we need to hide the
+  ;; tab and add spaces
+  (let ((end (+ start (length replacement)))
+        beg-point end-point
+        before-string after-string)
+    (goto-char (point-at-eol))
+    (if (< (current-column) start)
+        (progn (setq before-string (make-string (- start (current-column)) ? ))
+               (setq beg-point (point)))
+      (goto-char (point-at-bol)) ;; Emacs bug, move-to-column is wrong otherwise
+      (move-to-column start)
+      (setq beg-point (point))
+      (when (> (current-column) start)
+        (goto-char (1- (point)))
+        (setq beg-point (point))
+        (setq before-string (make-string (- start (current-column)) ? ))))
+    (move-to-column end)
+    (setq end-point (point))
+    (let ((end-offset (- (current-column) end)))
+      (when (> end-offset 0) (setq after-string (make-string end-offset ?b))))
+    (when no-insert
+      ;; prevent inheriting of faces
+      (setq before-string (when before-string (propertize before-string 'face 'default)))
+      (setq after-string (when after-string (propertize after-string 'face 'default))))
+    (let ((string (concat before-string replacement after-string)))
+      (if no-insert
+          string
+        (push (dropdown-list-put-overlay beg-point end-point 'invisible t
+                                         'after-string string)
+              dropdown-list-overlays)))))
+
+(defun dropdown-list-start-column (display-width)
+  (let ((column (mod (current-column) (window-width)))
+        (width (window-width)))
+    (cond ((<= (+ column display-width) width) column)
+          ((> column display-width) (- column display-width))
+          ((>= width display-width) (- width display-width))
+          (t nil))))
+
+(defun dropdown-list-move-to-start-line (candidate-count)
+  (decf candidate-count)
+  (let ((above-line-count (save-excursion (- (vertical-motion (- candidate-count)))))
+        (below-line-count (save-excursion (vertical-motion candidate-count))))
+    (cond ((= below-line-count candidate-count)
+           t)
+          ((= above-line-count candidate-count)
+           (vertical-motion (- candidate-count))
+           t)
+          ((>= (+ below-line-count above-line-count) candidate-count)
+           (vertical-motion (- (- candidate-count below-line-count)))
+           t)
+          (t nil))))
+
+(defun dropdown-list-at-point (candidates &optional selidx)
+  (dropdown-list-hide)
+  (let* ((lengths (mapcar #'length candidates))
+         (max-length (apply #'max lengths))
+         (start (dropdown-list-start-column (+ max-length 3)))
+         (i -1)
+         (candidates (mapcar* (lambda (candidate length)
+                                (let ((diff (- max-length length)))
+                                  (propertize
+                                   (concat (if (> diff 0)
+                                               (concat candidate (make-string diff ? ))
+                                             (substring candidate 0 max-length))
+                                           (format "%3d" (+ 2 i)))
+                                   'face (if (eql (incf i) selidx)
+                                             'dropdown-list-selection-face
+                                           'dropdown-list-face))))
+                              candidates
+                              lengths)))
+    (save-excursion
+      (and start
+           (dropdown-list-move-to-start-line (length candidates))
+           (loop initially (vertical-motion 0)
+              for candidate in candidates
+              do (dropdown-list-line (+ (current-column) start) candidate)
+              while (/= (vertical-motion 1) 0)
+              finally return t)))))
+
+(defun dropdown-list (candidates)
+  (let ((selection)
+        (temp-buffer))
+    (save-window-excursion
+      (unwind-protect
+           (let ((candidate-count (length candidates))
+                 done key selidx)
+             (while (not done)
+               (unless (dropdown-list-at-point candidates selidx)
+                 (switch-to-buffer (setq temp-buffer (get-buffer-create "*selection*"))
+                                   'norecord)
+                 (delete-other-windows)
+                 (delete-region (point-min) (point-max))
+                 (insert (make-string (length candidates) ?\n))
+                 (goto-char (point-min))
+                 (dropdown-list-at-point candidates selidx))
+               (setq key (read-key-sequence ""))
+               (cond ((and (stringp key)
+                           (>= (aref key 0) ?1)
+                           (<= (aref key 0) (+ ?0 (min 9 candidate-count))))
+                      (setq selection (- (aref key 0) ?1)
+                            done      t))
+                     ((member key `(,(char-to-string ?\C-p) [up]))
+                      (setq selidx (mod (+ candidate-count (1- (or selidx 0)))
+                                        candidate-count)))
+                     ((member key `(,(char-to-string ?\C-n) [down]))
+                      (setq selidx (mod (1+ (or selidx -1)) candidate-count)))
+                     ((member key `(,(char-to-string ?\C-i) [tab]))
+                      (setq done t
+                            selection (if (null selidx) 0 selidx)))
+                     ((member key `(,(char-to-string ?\f))))
+                     ((member key `(,(char-to-string ?\r) [return]))
+                      (setq selection selidx
+                            done      t))
+                     (t (setq done t)))))
+        (dropdown-list-hide)
+        (and temp-buffer (kill-buffer temp-buffer)))
+      ;;     (when selection
+      ;;       (message "your selection => %d: %s" selection (nth selection candidates))
+      ;;       (sit-for 1))
+      selection)))
+
+(defun define-key* (keymap key command)
+  "Add COMMAND to the multiple-command binding of KEY in KEYMAP.
+Use multiple times to bind different COMMANDs to the same KEY."
+  (define-key keymap key (combine-command command (lookup-key keymap key))))
+
+(defun combine-command (command defs)
+  "$$$$$ FIXME - no doc string"
+  (cond ((null defs) command)
+        ((and (listp defs)
+              (eq 'lambda (car defs))
+              (= (length defs) 4)
+              (listp (fourth defs))
+              (eq 'command-selector (car (fourth defs))))
+         (unless (member `',command (cdr (fourth defs)))
+           (setcdr (fourth defs) (nconc (cdr (fourth defs)) `(',command))))
+         defs)
+        (t
+         `(lambda () (interactive) (command-selector ',defs ',command)))))
+
+(defvar command-selector-last-command nil "$$$$$ FIXME - no doc string")
+
+(defun command-selector (&rest candidates)
+  "$$$$$ FIXME - no doc string"
+  (if (and (eq last-command this-command) command-selector-last-command)
+      (call-interactively command-selector-last-command)
+    (let* ((candidate-strings
+            (mapcar (lambda (candidate)
+                      (format "%s" (if (symbolp candidate)
+                                       candidate
+                                     (let ((s (format "%s" candidate)))
+                                       (if (>= (length s) 7)
+                                           (concat (substring s 0 7) "...")
+                                         s)))))
+                    candidates))
+           (selection (dropdown-list candidate-strings)))
+      (when selection
+        (let ((cmd (nth selection candidates)))
+          (call-interactively cmd)
+          (setq command-selector-last-command cmd))))))
+
+;;;;;;;;;;;;;;;;;;;;
+
+(provide 'dropdown-list)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; dropdown-list.el ends here
+