branch: elpa/popup
commit 180516e080e84a8666766813b4739efc12a295af
Author: Syohei YOSHIDA <syo...@gmail.com>
Commit: Syohei YOSHIDA <syo...@gmail.com>
Use cl-lib functions instead of cl
---
popup.el | 525 ++++++++++++++++++++++++++++++++-------------------------------
1 file changed, 263 insertions(+), 262 deletions(-)
diff --git a/popup.el b/popup.el
index 2eba784..5163fff 100644
--- a/popup.el
+++ b/popup.el
@@ -5,6 +5,7 @@
;; Author: Tomohiro Matsuyama <t...@cx4a.org>
;; Keywords: lisp
;; Version: 0.5.0
+;; Package-Requires: ((cl-lib "0.3"))
;; 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
@@ -28,7 +29,7 @@
;;; Code:
-(require 'cl)
+(require 'cl-lib)
(defconst popup-version "0.5.0")
@@ -55,7 +56,7 @@ If there is a problem, please set it nil.")
(defun popup-x-to-string (x)
"Convert any object to string effeciently.
This is faster than `prin1-to-string' in many cases."
- (typecase x
+ (cl-typecase x
(string x)
(symbol (symbol-name x))
(integer (number-to-string x))
@@ -67,15 +68,15 @@ This is faster than `prin1-to-string' in many cases."
splitting with WIDTH."
;; Expand tabs into 4 spaces
(setq string (replace-regexp-in-string "\t" " " string))
- (loop with len = (length string)
- with w = 0
- for l from 0
- for c in (append string nil)
- while (<= (incf w (char-width c)) width)
- finally return
- (if (< l len)
- (cons (substring string 0 l) (substring string l))
- (list string))))
+ (cl-loop with len = (length string)
+ with w = 0
+ for l from 0
+ for c in (append string nil)
+ while (<= (incf w (char-width c)) width)
+ finally return
+ (if (< l len)
+ (cons (substring string 0 l) (substring string l))
+ (list string))))
(defun popup-fill-string (string &optional width max-width justify squeeze)
"Split STRING into fixed width strings and return a cons cell
@@ -142,15 +143,15 @@ untouched."
(defun popup-preferred-width (list)
"Return the preferred width to show LIST beautifully."
- (loop with tab-width = 4
- for item in list
- for summary = (popup-item-summary item)
- maximize (string-width (popup-x-to-string item)) into width
- if (stringp summary)
- maximize (+ (string-width summary) 2) into summary-width
- finally return
- (let ((total (+ (or width 0) (or summary-width 0))))
- (* (ceiling (/ total 10.0)) 10))))
+ (cl-loop with tab-width = 4
+ for item in list
+ for summary = (popup-item-summary item)
+ maximize (string-width (popup-x-to-string item)) into width
+ if (stringp summary)
+ maximize (+ (string-width summary) 2) into summary-width
+ finally return
+ (let ((total (+ (or width 0) (or summary-width 0))))
+ (* (ceiling (/ total 10.0)) 10))))
(defun popup-window-full-width-p (&optional window)
"A portable version of `window-full-width-p'."
@@ -241,7 +242,7 @@ buffer."
(propertize " " 'face 'popup-scroll-bar-background-face)
"Background character for scroll-bar.")
-(defstruct popup
+(cl-defstruct popup
point row column width height min-height direction overlays keymap
parent depth
face mouse-face selection-face summary-face
@@ -252,12 +253,12 @@ buffer."
(defun popup-item-propertize (item &rest properties)
"Same as `propertize' except that this avoids overriding
existed value with `nil' property."
- (loop for (k v) on properties by 'cddr
- if v append (list k v) into props
- finally return
- (apply 'propertize
- (popup-x-to-string item)
- props)))
+ (cl-loop for (k v) on properties by 'cddr
+ if v append (list k v) into props
+ finally return
+ (apply 'propertize
+ (popup-x-to-string item)
+ props)))
(defun popup-item-property (item property)
"Same as `get-text-property' except that this returns nil if
@@ -265,16 +266,16 @@ ITEM is not string."
(if (stringp item)
(get-text-property 0 property item)))
-(defun* popup-make-item (name
- &key
- value
- face
- mouse-face
- selection-face
- sublist
- document
- symbol
- summary)
+(cl-defun popup-make-item (name
+ &key
+ value
+ face
+ mouse-face
+ selection-face
+ sublist
+ document
+ symbol
+ summary)
"Utility function to make popup item. See also
`popup-item-propertize'."
(popup-item-propertize name
@@ -316,17 +317,17 @@ ITEM is not string."
(defun popup-item-show-help-with-event-loop (item)
(save-window-excursion
(when (popup-item-show-help-1 item)
- (loop do (clear-this-command-keys)
- for key = (read-key-sequence-vector nil)
- do
- (case (key-binding key)
- ('scroll-other-window
- (scroll-other-window))
- ('scroll-other-window-down
- (scroll-other-window-down nil))
- (t
- (setq unread-command-events (append key unread-command-events))
- (return)))))))
+ (cl-loop do (clear-this-command-keys)
+ for key = (read-key-sequence-vector nil)
+ do
+ (case (key-binding key)
+ ('scroll-other-window
+ (scroll-other-window))
+ ('scroll-other-window-down
+ (scroll-other-window-down nil))
+ (t
+ (setq unread-command-events (append key
unread-command-events))
+ (return)))))))
(defun popup-item-show-help (item &optional persist)
"Display the documentation of ITEM with `display-buffer'. If
@@ -343,7 +344,7 @@ usual."
(popup-set-filtered-list popup list)
(setf (popup-pattern popup) nil)
(setf (popup-original-list popup) list))
-
+
(defun popup-set-filtered-list (popup list)
(let ((offset
(if (> (popup-direction popup) 0)
@@ -374,19 +375,19 @@ usual."
(and (eq (overlay-get overlay 'display) nil)
(eq (overlay-get overlay 'after-string) nil))))
-(defun* popup-set-line-item (popup
- line
- &key
- item
- face
- mouse-face
- margin-left
- margin-right
- scroll-bar-char
- symbol
- summary
- summary-face
- keymap)
+(cl-defun popup-set-line-item (popup
+ line
+ &key
+ item
+ face
+ mouse-face
+ margin-left
+ margin-right
+ scroll-bar-char
+ symbol
+ summary
+ summary-face
+ keymap)
(let* ((overlay (popup-line-overlay popup line))
(content (popup-create-line-string popup (popup-x-to-string item)
:margin-left margin-left
@@ -421,14 +422,14 @@ usual."
scroll-bar-char
postfix))))
-(defun* popup-create-line-string (popup
- string
- &key
- margin-left
- margin-right
- symbol
- summary
- summary-face)
+(cl-defun popup-create-line-string (popup
+ string
+ &key
+ margin-left
+ margin-right
+ symbol
+ summary
+ summary-face)
(let* ((popup-width (popup-width popup))
(summary-width (string-width summary))
(content-width (max
@@ -480,23 +481,23 @@ number at the point."
-1
1)))
-(defun* popup-create (point
- width
- height
- &key
- min-height
- around
- (face 'popup-face)
- mouse-face
- (selection-face face)
- (summary-face 'popup-summary-face)
- scroll-bar
- margin-left
- margin-right
- symbol
- parent
- parent-offset
- keymap)
+(cl-defun popup-create (point
+ width
+ height
+ &key
+ min-height
+ around
+ (face 'popup-face)
+ mouse-face
+ (selection-face face)
+ (summary-face 'popup-summary-face)
+ scroll-bar
+ margin-left
+ margin-right
+ symbol
+ parent
+ parent-offset
+ keymap)
"Create a popup instance at POINT with WIDTH and HEIGHT.
MIN-HEIGHT is a minimal height of the popup. The default value is
@@ -627,9 +628,9 @@ KEYMAP is a keymap that will be put on the popup contents."
(aset overlays
(if (> direction 0) i (- height i 1))
overlay)))
- (loop for p from (- 10000 (* depth 1000))
- for overlay in (nreverse (append overlays nil))
- do (overlay-put overlay 'priority p))
+ (cl-loop for p from (- 10000 (* depth 1000))
+ for overlay in (nreverse (append overlays nil))
+ do (overlay-put overlay 'priority p))
(let ((it (make-popup :point point
:row row
:column column
@@ -678,101 +679,101 @@ KEYMAP is a keymap that will be put on the popup
contents."
(defun popup-draw (popup)
"Draw POPUP."
- (loop with height = (popup-height popup)
- with min-height = (popup-min-height popup)
- with popup-face = (popup-face popup)
- with mouse-face = (popup-mouse-face popup)
- with selection-face = (popup-selection-face popup)
- with summary-face-0 = (popup-summary-face popup)
- with list = (popup-list popup)
- with length = (length list)
- with thum-size = (max (/ (* height height) (max length 1)) 1)
- with page-size = (/ (+ 0.0 (max length 1)) height)
- with scroll-bar = (popup-scroll-bar popup)
- with margin-left = (make-string (if (popup-margin-left-cancel popup) 0
(popup-margin-left popup)) ? )
- with margin-right = (make-string (popup-margin-right popup) ? )
- with symbol = (popup-symbol popup)
- with cursor = (popup-cursor popup)
- with scroll-top = (popup-scroll-top popup)
- with offset = (popup-offset popup)
- with keymap = (popup-keymap popup)
- for o from offset
- for i from scroll-top
- while (< o height)
- for item in (nthcdr scroll-top list)
- for page-index = (* thum-size (/ o thum-size))
- for face = (if (= i cursor)
- (or (popup-item-selection-face item) selection-face)
- (or (popup-item-face item) popup-face))
- for summary-face = (unless (= i cursor) summary-face-0)
- for empty-char = (propertize " " 'face face)
- for scroll-bar-char = (if scroll-bar
- (cond
- ((and (not (eq scroll-bar :always))
- (<= page-size 1))
- empty-char)
- ((and (> page-size 1)
- (>= cursor (* page-index page-size))
- (< cursor (* (+ page-index thum-size)
page-size)))
- popup-scroll-bar-foreground-char)
- (t
- popup-scroll-bar-background-char))
- "")
- for sym = (if symbol
- (concat " " (or (popup-item-symbol item) " "))
- "")
- for summary = (or (popup-item-summary item) "")
-
- do
- ;; Show line and set item to the line
- (popup-set-line-item popup o
- :item item
- :face face
- :mouse-face mouse-face
- :margin-left margin-left
- :margin-right margin-right
- :scroll-bar-char scroll-bar-char
- :symbol sym
- :summary summary
- :summary-face summary-face
- :keymap keymap)
-
- finally
- ;; Remember current height
- (setf (popup-current-height popup) (- o offset))
-
- ;; Hide remaining lines
- (let ((scroll-bar-char (if scroll-bar (propertize " " 'face
popup-face) ""))
- (symbol (if symbol " " "")))
- (if (> (popup-direction popup) 0)
- (progn
- (when min-height
- (while (< o min-height)
- (popup-set-line-item popup o
- :item ""
- :face popup-face
- :margin-left margin-left
- :margin-right margin-right
- :scroll-bar-char scroll-bar-char
- :symbol symbol
- :summary "")
- (incf o)))
- (while (< o height)
- (popup-hide-line popup o)
- (incf o)))
- (loop with h = (if min-height (- height min-height) offset)
- for o from 0 below offset
- if (< o h)
- do (popup-hide-line popup o)
- if (>= o h)
- do (popup-set-line-item popup o
- :item ""
- :face popup-face
- :margin-left margin-left
- :margin-right margin-right
- :scroll-bar-char scroll-bar-char
- :symbol symbol
- :summary ""))))))
+ (cl-loop with height = (popup-height popup)
+ with min-height = (popup-min-height popup)
+ with popup-face = (popup-face popup)
+ with mouse-face = (popup-mouse-face popup)
+ with selection-face = (popup-selection-face popup)
+ with summary-face-0 = (popup-summary-face popup)
+ with list = (popup-list popup)
+ with length = (length list)
+ with thum-size = (max (/ (* height height) (max length 1)) 1)
+ with page-size = (/ (+ 0.0 (max length 1)) height)
+ with scroll-bar = (popup-scroll-bar popup)
+ with margin-left = (make-string (if (popup-margin-left-cancel
popup) 0 (popup-margin-left popup)) ? )
+ with margin-right = (make-string (popup-margin-right popup) ? )
+ with symbol = (popup-symbol popup)
+ with cursor = (popup-cursor popup)
+ with scroll-top = (popup-scroll-top popup)
+ with offset = (popup-offset popup)
+ with keymap = (popup-keymap popup)
+ for o from offset
+ for i from scroll-top
+ while (< o height)
+ for item in (nthcdr scroll-top list)
+ for page-index = (* thum-size (/ o thum-size))
+ for face = (if (= i cursor)
+ (or (popup-item-selection-face item) selection-face)
+ (or (popup-item-face item) popup-face))
+ for summary-face = (unless (= i cursor) summary-face-0)
+ for empty-char = (propertize " " 'face face)
+ for scroll-bar-char = (if scroll-bar
+ (cond
+ ((and (not (eq scroll-bar :always))
+ (<= page-size 1))
+ empty-char)
+ ((and (> page-size 1)
+ (>= cursor (* page-index
page-size))
+ (< cursor (* (+ page-index
thum-size) page-size)))
+ popup-scroll-bar-foreground-char)
+ (t
+ popup-scroll-bar-background-char))
+ "")
+ for sym = (if symbol
+ (concat " " (or (popup-item-symbol item) " "))
+ "")
+ for summary = (or (popup-item-summary item) "")
+
+ do
+ ;; Show line and set item to the line
+ (popup-set-line-item popup o
+ :item item
+ :face face
+ :mouse-face mouse-face
+ :margin-left margin-left
+ :margin-right margin-right
+ :scroll-bar-char scroll-bar-char
+ :symbol sym
+ :summary summary
+ :summary-face summary-face
+ :keymap keymap)
+
+ finally
+ ;; Remember current height
+ (setf (popup-current-height popup) (- o offset))
+
+ ;; Hide remaining lines
+ (let ((scroll-bar-char (if scroll-bar (propertize " " 'face
popup-face) ""))
+ (symbol (if symbol " " "")))
+ (if (> (popup-direction popup) 0)
+ (progn
+ (when min-height
+ (while (< o min-height)
+ (popup-set-line-item popup o
+ :item ""
+ :face popup-face
+ :margin-left margin-left
+ :margin-right margin-right
+ :scroll-bar-char scroll-bar-char
+ :symbol symbol
+ :summary "")
+ (incf o)))
+ (while (< o height)
+ (popup-hide-line popup o)
+ (incf o)))
+ (cl-loop with h = (if min-height (- height min-height) offset)
+ for o from 0 below offset
+ if (< o h)
+ do (popup-hide-line popup o)
+ if (>= o h)
+ do (popup-set-line-item popup o
+ :item ""
+ :face popup-face
+ :margin-left margin-left
+ :margin-right margin-right
+ :scroll-bar-char
scroll-bar-char
+ :symbol symbol
+ :summary ""))))))
(defun popup-hide (popup)
"Hide POPUP."
@@ -885,25 +886,25 @@ Pages up through POPUP."
(<= char 126)))
(defun popup-isearch-filter-list (pattern list)
- (loop with regexp = (regexp-quote pattern)
- for item in list
- do
- (unless (stringp item)
- (setq item (popup-item-propertize (popup-x-to-string item)
- 'value item)))
- if (string-match regexp item)
- collect
- (let ((beg (match-beginning 0))
- (end (match-end 0)))
- (alter-text-property 0 (length item) 'face
- (lambda (prop)
- (unless (eq prop 'popup-isearch-match)
- prop))
- item)
- (put-text-property beg end
- 'face 'popup-isearch-match
- item)
- item)))
+ (cl-loop with regexp = (regexp-quote pattern)
+ for item in list
+ do
+ (unless (stringp item)
+ (setq item (popup-item-propertize (popup-x-to-string item)
+ 'value item)))
+ if (string-match regexp item)
+ collect
+ (let ((beg (match-beginning 0))
+ (end (match-end 0)))
+ (alter-text-property 0 (length item) 'face
+ (lambda (prop)
+ (unless (eq prop 'popup-isearch-match)
+ prop))
+ item)
+ (put-text-property beg end
+ 'face 'popup-isearch-match
+ item)
+ item)))
(defun popup-isearch-prompt (popup pattern)
(format "Pattern: %s" (if (= (length (popup-list popup)) 0)
@@ -920,12 +921,12 @@ Pages up through POPUP."
(funcall callback list)))
(popup-draw popup))
-(defun* popup-isearch (popup
- &key
- (cursor-color popup-isearch-cursor-color)
- (keymap popup-isearch-keymap)
- callback
- help-delay)
+(cl-defun popup-isearch (popup
+ &key
+ (cursor-color popup-isearch-cursor-color)
+ (keymap popup-isearch-keymap)
+ callback
+ help-delay)
"Start isearch on POPUP. This function is synchronized, meaning
event loop waits for quiting of isearch.
@@ -987,23 +988,23 @@ HELP-DELAY is a delay of displaying helps."
(defvar popup-tip-max-width 80)
-(defun* popup-tip (string
- &key
- point
- (around t)
- width
- (height 15)
- min-height
- truncate
- margin
- margin-left
- margin-right
- scroll-bar
- parent
- parent-offset
- nowait
- prompt
- &aux tip lines)
+(cl-defun popup-tip (string
+ &key
+ point
+ (around t)
+ width
+ (height 15)
+ min-height
+ truncate
+ margin
+ margin-left
+ margin-right
+ scroll-bar
+ parent
+ parent-offset
+ nowait
+ prompt
+ &aux tip lines)
"Show a tooltip of STRING at POINT. This function is
synchronized unless NOWAIT specified. Almost arguments are same
as `popup-create' except for TRUNCATE, NOWAIT, and PROMPT.
@@ -1152,17 +1153,17 @@ PROMPT is a prompt string when reading events during
event loop."
(defun popup-menu-fallback (event default))
-(defun* popup-menu-event-loop (menu
- keymap
- fallback
- &key
- prompt
- help-delay
- isearch
- isearch-cursor-color
- isearch-keymap
- isearch-callback
- &aux key binding)
+(cl-defun popup-menu-event-loop (menu
+ keymap
+ fallback
+ &key
+ prompt
+ help-delay
+ isearch
+ isearch-cursor-color
+ isearch-keymap
+ isearch-callback
+ &aux key binding)
(block nil
(while (popup-live-p menu)
(and isearch
@@ -1188,7 +1189,7 @@ PROMPT is a prompt string when reading events during
event loop."
((memq binding '(popup-select popup-open))
(let* ((item (or (popup-menu-item-of-mouse-event (elt key 0))
(popup-selected-item menu)))
- (index (position item (popup-list menu)))
+ (index (cl-position item (popup-list menu)))
(sublist (popup-item-sublist item)))
(unless index (return))
(if sublist
@@ -1224,29 +1225,29 @@ PROMPT is a prompt string when reading events during
event loop."
(t
(funcall fallback key (key-binding key)))))))
-(defun* popup-menu* (list
- &key
- point
- (around t)
- (width (popup-preferred-width list))
- (height 15)
- margin
- margin-left
- margin-right
- scroll-bar
- symbol
- parent
- parent-offset
- (keymap popup-menu-keymap)
- (fallback 'popup-menu-fallback)
- help-delay
- nowait
- prompt
- isearch
- (isearch-cursor-color popup-isearch-cursor-color)
- (isearch-keymap popup-isearch-keymap)
- isearch-callback
- &aux menu event)
+(cl-defun popup-menu* (list
+ &key
+ point
+ (around t)
+ (width (popup-preferred-width list))
+ (height 15)
+ margin
+ margin-left
+ margin-right
+ scroll-bar
+ symbol
+ parent
+ parent-offset
+ (keymap popup-menu-keymap)
+ (fallback 'popup-menu-fallback)
+ help-delay
+ nowait
+ prompt
+ isearch
+ (isearch-cursor-color popup-isearch-cursor-color)
+ (isearch-keymap popup-isearch-keymap)
+ isearch-callback
+ &aux menu event)
"Show a popup menu of LIST at POINT. This function returns a
value of the selected item. Almost arguments are same as
`popup-create' except for KEYMAP, FALLBACK, HELP-DELAY, PROMPT,
