--- /dev/null
+;;; dropdown-list.el --- Drop-down menu interface
+;;
+;; Filename: dropdown-list.el
+;; Description: Drop-down menu interface
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+;; Author: Jaeyoun Chung [jay.chung@gmail.com]
+;; Maintainer:
+;; Authors: pluskid <pluskid@gmail.com>, João Távora <joaotavora@gmail.com>
+;; Created: Sun Mar 16 11:20:45 2008 (Pacific Daylight Time)
+;; Version:
+;; Last-Updated: Sun Mar 16 12:19:49 2008 (Pacific Daylight Time)
+;; By: dradams
+;; Update #: 43
+;; URL: http://www.emacswiki.org/cgi-bin/wiki/dropdown-list.el
+;; Keywords: convenience menu
+;; Compatibility: GNU Emacs 21.x, GNU Emacs 22.x
+;;
+;; Features that might be required by this library:
+;;
+;; `cl'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; According to Jaeyoun Chung, "overlay code stolen from company-mode.el."
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;; 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 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; 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-face :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 0))
+ (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] "p"))
+ (setq selidx (mod (+ candidate-count (1- (or selidx 0)))
+ candidate-count)))
+ ((member key `(,(char-to-string ?\C-n) [down] "n"))
+ (setq selidx (mod (1+ (or selidx -1)) candidate-count)))
+ ((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
+;; Local Variables:
+;; coding: utf-8
+;; End: