ld/yasnippet
1
0
Fork 0
mirror of https://github.com/joaotavora/yasnippet.git synced 2025-10-15 14:03:04 +00:00
Code Issues Packages Projects Releases Wiki Activity

incorporate the latest dropdown-list.el

Browse Source
This commit is contained in:
Zhang Chiyuan 2008-04-07 10:35:50 +00:00
parent 57ae10bc4c
commit b9f3509252
1 changed files with 163 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

245
yasnippet.el
View File

@ -1208,33 +1208,77 @@ handle the end-of-buffer error fired in it by calling
;; dropdown-list.el is used by yasnippet to select multiple ;; dropdown-list.el is used by yasnippet to select multiple
;; candidate snippets. ;; candidate snippets.
;; ;;
;; This is a slightly modified version of the original
;; dropdown-list.el
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; dropdown-list.el --- Drop-down menu interface
;;; dropdown-list.el --- dropdown menu interface ;;
;; Filename: dropdown-list.el
;; Description: Drop-down menu interface
;; Author: Jaeyoun Chung [jay.chung@gmail.com]
;; Maintainer:
;; Copyright (C) 2008 Jaeyoun Chung ;; Copyright (C) 2008 Jaeyoun Chung
;; Created: Sun Mar 16 11:20:45 2008 (Pacific Daylight Time)
;; Author: jay AT kldp DOT org ;; Version:
;; Keywords: convenience ;; 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
;; ;;
;; overlay code stolen from company-mode.el ;; 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, 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: ;;; Code:
(eval-when-compile (require 'cl)) ;; decf, fourth, incf, loop, mapcar*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defface dropdown-list-face (defface dropdown-list-face
'((t :inherit default '((t :inherit default :background "lightyellow" :foreground "black"))
:background "lightyellow" "*Bla." :group 'dropdown-list)
:foreground "black"))
"*Bla."
:group 'dropdown-list)
(defface dropdown-list-selection-face (defface dropdown-list-selection-face
'((t :inherit dropdown-list '((t :inherit dropdown-list :background "purple"))
:background "purple")) "*Bla." :group 'dropdown-list)
"*Bla."
:group 'dropdown-list)
(defvar dropdown-list-overlays nil) (defvar dropdown-list-overlays nil)
@ -1242,14 +1286,12 @@ handle the end-of-buffer error fired in it by calling
(while dropdown-list-overlays (while dropdown-list-overlays
(delete-overlay (pop dropdown-list-overlays)))) (delete-overlay (pop dropdown-list-overlays))))
(defun dropdown-list-put-overlay (beg end &optional prop value prop2 (defun dropdown-list-put-overlay (beg end &optional prop value prop2 value2)
value2)
(let ((ov (make-overlay beg end))) (let ((ov (make-overlay beg end)))
(overlay-put ov 'window t) (overlay-put ov 'window t)
(when prop (when prop
(overlay-put ov prop value) (overlay-put ov prop value)
(when prop2 (when prop2 (overlay-put ov prop2 value2)))
(overlay-put ov prop2 value2)))
ov)) ov))
(defun dropdown-list-line (start replacement &optional no-insert) (defun dropdown-list-line (start replacement &optional no-insert)
@ -1260,8 +1302,7 @@ value2)
before-string after-string) before-string after-string)
(goto-char (point-at-eol)) (goto-char (point-at-eol))
(if (< (current-column) start) (if (< (current-column) start)
(progn (setq before-string (progn (setq before-string (make-string (- start (current-column)) ? ))
(make-string (- start (current-column)) ? ))
(setq beg-point (point))) (setq beg-point (point)))
(goto-char (point-at-bol)) ;; Emacs bug, move-to-column is wrong otherwise (goto-char (point-at-bol)) ;; Emacs bug, move-to-column is wrong otherwise
(move-to-column start) (move-to-column start)
@ -1273,40 +1314,29 @@ value2)
(move-to-column end) (move-to-column end)
(setq end-point (point)) (setq end-point (point))
(let ((end-offset (- (current-column) end))) (let ((end-offset (- (current-column) end)))
(when (> end-offset 0) (when (> end-offset 0) (setq after-string (make-string end-offset ?b))))
(setq after-string (make-string end-offset ?b))))
(when no-insert (when no-insert
;; prevent inheriting of faces ;; prevent inheriting of faces
(setq before-string (when before-string (setq before-string (when before-string (propertize before-string 'face 'default)))
(propertize before-string 'face 'default))) (setq after-string (when after-string (propertize after-string 'face 'default))))
(setq after-string (when after-string (let ((string (concat before-string replacement after-string)))
(propertize after-string 'face 'default))))
(let ((string (concat before-string
replacement
after-string)))
(if no-insert (if no-insert
string string
(push (dropdown-list-put-overlay beg-point end-point (push (dropdown-list-put-overlay beg-point end-point 'invisible t
'invisible t 'after-string string)
'after-string string)
dropdown-list-overlays))))) dropdown-list-overlays)))))
(defun dropdown-list-start-column (display-width) (defun dropdown-list-start-column (display-width)
(let ((column (mod (current-column) (window-width))) (let ((column (mod (current-column) (window-width)))
(width (window-width))) (width (window-width)))
(cond ((<= (+ column display-width) width) (cond ((<= (+ column display-width) width) column)
column) ((> column display-width) (- column display-width))
((> column display-width) ((>= width display-width) (- width display-width))
(- column display-width)) (t nil))))
((>= width display-width)
(- width display-width))
(t
nil))))
(defun dropdown-list-move-to-start-line (candidate-count) (defun dropdown-list-move-to-start-line (candidate-count)
(decf candidate-count) (decf candidate-count)
(let ((above-line-count (save-excursion (- (vertical-motion (- (let ((above-line-count (save-excursion (- (vertical-motion (- candidate-count)))))
candidate-count)))))
(below-line-count (save-excursion (vertical-motion candidate-count)))) (below-line-count (save-excursion (vertical-motion candidate-count))))
(cond ((= below-line-count candidate-count) (cond ((= below-line-count candidate-count)
t) t)
@ -1316,8 +1346,7 @@ candidate-count)))))
((>= (+ below-line-count above-line-count) candidate-count) ((>= (+ below-line-count above-line-count) candidate-count)
(vertical-motion (- (- candidate-count below-line-count))) (vertical-motion (- (- candidate-count below-line-count)))
t) t)
(t (t nil))))
nil))))
(defun dropdown-list-at-point (candidates &optional selidx) (defun dropdown-list-at-point (candidates &optional selidx)
(dropdown-list-hide) (dropdown-list-hide)
@ -1335,48 +1364,100 @@ candidate-count)))))
'face (if (eql (incf i) selidx) 'face (if (eql (incf i) selidx)
'dropdown-list-selection-face 'dropdown-list-selection-face
'dropdown-list-face)))) 'dropdown-list-face))))
candidates lengths))) candidates
lengths)))
(save-excursion (save-excursion
(and start (and start
(dropdown-list-move-to-start-line (length candidates)) (dropdown-list-move-to-start-line (length candidates))
(loop initially (vertical-motion 0) (loop initially (vertical-motion 0)
for candidate in candidates for candidate in candidates
do (dropdown-list-line (+ (current-column) start) candidate) do (dropdown-list-line (+ (current-column) start) candidate)
while (/= (vertical-motion 1) 0) while (/= (vertical-motion 1) 0)
finally return t))))) finally return t)))))
(defun dropdown-list (candidates) (defun dropdown-list (candidates)
(let ((selection) (temp-buffer)) (let ((selection)
(temp-buffer))
(save-window-excursion (save-window-excursion
(unwind-protect (unwind-protect
(let ((candidate-count (length candidates)) (let ((candidate-count (length candidates))
done key selidx) done key selidx)
(while (not done) (while (not done)
(unless (dropdown-list-at-point candidates selidx) (unless (dropdown-list-at-point candidates selidx)
(switch-to-buffer (setq temp-buffer (get-buffer-create "*selection*")) 'norecord) (switch-to-buffer (setq temp-buffer (get-buffer-create "*selection*"))
(delete-other-windows) 'norecord)
(delete-region (point-min) (point-max)) (delete-other-windows)
(insert (make-string (length candidates) ?\n)) (delete-region (point-min) (point-max))
(goto-char (point-min)) (insert (make-string (length candidates) ?\n))
(dropdown-list-at-point candidates selidx)) (goto-char (point-min))
(setq key (read-key-sequence "")) (dropdown-list-at-point candidates selidx))
(cond ((and (stringp key) (>= (aref key 0) ?1) (<= (aref key 0) (setq key (read-key-sequence ""))
(+ ?0 (min 9 candidate-count)))) (cond ((and (stringp key)
(setq selection (- (aref key 0) ?1) (>= (aref key 0) ?1)
done t)) (<= (aref key 0) (+ ?0 (min 9 candidate-count))))
((member key '("" [up])) (setq selection (- (aref key 0) ?1)
(setq selidx (mod (+ candidate-count (1- (or selidx 0))) done t))
candidate-count))) ((member key `(,(char-to-string ?\C-p) [up]))
((member key '("" [down])) (setq selidx (mod (+ candidate-count (1- (or selidx 0)))
(setq selidx (mod (1+ (or selidx -1)) candidate-count))) candidate-count)))
((member key '(" "))) ((member key `(,(char-to-string ?\C-n) [down]))
((member key (list (kbd "C-j") (kbd "RET") (kbd "<return>"))) (setq selidx (mod (1+ (or selidx -1)) candidate-count)))
(setq selection selidx ((member key `(,(char-to-string ?\f))))
done t)) ((member key `(,(char-to-string ?\r) [return]))
(t (setq selection selidx
(setq done t))))) done t))
(t (setq done t)))))
(dropdown-list-hide) (dropdown-list-hide)
(and temp-buffer (kill-buffer temp-buffer))) (and temp-buffer (kill-buffer temp-buffer)))
;; (when selection
;; (message "your selection => %d: %s" selection (nth selection candidates))
;; (sit-for 1))
selection))) selection)))
;;; contents dropdown-list.el ends here (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