emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/popup 8937b92 003/184: Refactoring and auto-test.


From: ELPA Syncer
Subject: [nongnu] elpa/popup 8937b92 003/184: Refactoring and auto-test.
Date: Wed, 6 Oct 2021 00:00:55 -0400 (EDT)

branch: elpa/popup
commit 8937b927f9f02b3f33af7cd9fe8f383be7e28998
Author: Tomohiro Matsuyama <tomo@cx4a.org>
Commit: Tomohiro Matsuyama <tomo@cx4a.org>

    Refactoring and auto-test.
---
 popup-test.el | 124 ++++++++++++++++
 popup.el      | 469 ++++++++++++++++++++++++++++++++++++++++------------------
 2 files changed, 451 insertions(+), 142 deletions(-)

diff --git a/popup-test.el b/popup-test.el
new file mode 100644
index 0000000..3839717
--- /dev/null
+++ b/popup-test.el
@@ -0,0 +1,124 @@
+(require 'popup)
+
+(defmacro test (explain &rest body)
+  (declare (indent 1))
+  `(let ((buf "*buf*")
+         (window-config (current-window-configuration)))
+     (unwind-protect
+         (progn
+           (delete-other-windows)
+           (switch-to-buffer buf)
+           (erase-buffer)
+           (insert " ")
+           (let ((success (progn ,@body)))
+             (unless success
+               (error "failed: %s" ,explain))))
+       (when popup
+         (popup-delete popup)
+         (setq popup nil))
+       (kill-buffer buf)
+       (set-window-configuration window-config))))
+
+(defmacro ui-test (prompt &rest body)
+  (declare (indent 1))
+  `(test ,prompt ,@body (yes-or-no-p ,prompt)))
+
+(defun input (key)
+  (push key unread-command-events))
+
+(defvar popup nil)
+
+(test "popup-create"
+  (setq popup (popup-create (point) 10 10)))
+
+(test "popup-delete"
+  (setq popup (popup-create (point) 10 10))
+  (popup-delete popup)
+  (not (popup-live-p popup)))
+
+(ui-test "popup?"
+  (setq popup (popup-create (point) 10 10))
+  (popup-set-list popup '("hello" "world"))
+  (popup-draw popup))
+
+(ui-test "hidden?"
+  (setq popup (popup-create (point) 10 10))
+  (popup-set-list popup '("hello" "world"))
+  (popup-draw popup)
+  (popup-hide popup))
+
+(ui-test "isearch?"
+  (setq popup (popup-create (point) 10 10))
+  (popup-set-list popup '("hello" "world"))
+  (popup-draw popup)
+  (input ?e)
+  (popup-isearch popup))
+
+(ui-test "tip?"
+  (popup-tip
+   "Start isearch on POPUP. This function is synchronized, meaning
+event loop waits for quiting of isearch.
+
+CURSOR-COLOR is a cursor color during isearch. The default value
+is `popup-isearch-cursor-color'.
+
+KEYMAP is a keymap which is used when processing events during
+event loop. The default value is `popup-isearch-keymap'.
+
+CALLBACK is a function taking one argument. `popup-isearch' calls
+CALLBACK, if specified, after isearch finished or isearch
+canceled. The arguments is whole filtered list of items.
+
+HELP-DELAY is a delay of displaying helps."
+   :nowait t))
+
+(ui-test "fold?"
+  (let ((s (make-string (- (window-width) 3) ? )))
+    (insert s)
+    (setq popup (popup-tip "long long long long line" :nowait t))))
+
+(ui-test "fold?"
+  (let ((s (make-string (- (window-height) 3) ?\n)))
+    (insert s)
+    (setq popup (popup-tip "bla\nbla\nbla\nbla\nbla" :nowait t))))
+
+(ui-test "margin?"
+  (setq popup (popup-tip "Margin?" :nowait t :margin t)))
+
+(ui-test "two lines?"
+  (setq popup (popup-tip "Foo\nBar\nBaz" :nowait t :height 2)))
+
+(ui-test "scroll bar?"
+  (setq popup (popup-tip "Foo\nBar\nBaz\nFez\nOz" :nowait t :height 3 
:scroll-bar t :margin t)))
+
+(ui-test "min-height?"
+  (setq popup (popup-tip "Hello" :nowait t :min-height 10)))
+
+(ui-test "menu?"
+  (setq popup (popup-menu* '("Foo" "Bar" "Baz") :nowait t)))
+
+(ui-test "cascade menu?"
+  (setq popup (popup-cascade-menu '(("Foo" "Foo1" "Foo2") "Bar" "Baz") :nowait 
t :margin t)))
+
+(ui-test "next?"
+  (setq popup (popup-cascade-menu '("Foo" "Bar" "Baz") :nowait t :margin t))
+  (popup-next popup))
+
+(ui-test "previous?"
+  (setq popup (popup-cascade-menu '("Foo" "Bar" "Baz") :nowait t :margin t))
+  (popup-previous popup))
+
+(ui-test "select?"
+  (setq popup (popup-cascade-menu '("Foo" "Bar" "Baz") :nowait t :margin t))
+  (popup-select popup 1))
+
+(ui-test "scroll-down?"
+  (setq popup (popup-cascade-menu (loop repeat 100 collect "Foo") :nowait t 
:height 10 :margin t :scroll-bar t))
+  (popup-scroll-down popup 10))
+
+(ui-test "scroll-up?"
+  (setq popup (popup-cascade-menu (loop repeat 100 collect "Foo") :nowait t 
:height 10 :margin t :scroll-bar t))
+  (popup-scroll-down popup 999)
+  (popup-scroll-up popup 10))
+
+(message "Congratulations!")
diff --git a/popup.el b/popup.el
index e26bf02..41605d5 100644
--- a/popup.el
+++ b/popup.el
@@ -1,4 +1,4 @@
-;;; popup.el --- Visual popup interface
+;;; popup.el --- Visual Popup User Interface
 
 ;; Copyright (C) 2009, 2010, 2011  Tomohiro Matsuyama
 
@@ -30,22 +30,22 @@
 
 
 
-;; Utilities
+;;; Utilities
 
 (defvar popup-use-optimized-column-computation t
-  "Use optimized column computation routine.
-If there is a problem, please set it to nil.")
+  "Use the optimized column computation routine.
+If there is a problem, please set it nil.")
 
-;; Borrowed from anything.el
 (defmacro popup-aif (test-form then-form &rest else-forms)
-  "Anaphoric if. Temporary variable `it' is the result of test-form."
+  "Anaphoric if. Temporary variable `it' is the result of
+TEST-FORM."
   (declare (indent 2))
   `(let ((it ,test-form))
      (if it ,then-form ,@else-forms)))
 
 (defun popup-x-to-string (x)
   "Convert any object to string effeciently.
-This is faster than prin1-to-string in many cases."
+This is faster than `prin1-to-string' in many cases."
   (typecase x
     (string x)
     (symbol (symbol-name x))
@@ -54,8 +54,9 @@ This is faster than prin1-to-string in many cases."
     (t (format "%s" x))))
 
 (defun popup-substring-by-width (string width)
-  "Return cons of substring and remaining string by `WIDTH'."
-  ;; Expand tabs with 4 spaces
+  "Return a cons cell of substring and remaining string by
+splitting with WIDTH."
+  ;; Expand tabs into 4 spaces
   (setq string (replace-regexp-in-string "\t" "    " string))
   (loop with len = (length string)
         with w = 0
@@ -68,20 +69,25 @@ This is faster than prin1-to-string in many cases."
           (list string))))
 
 (defun popup-fill-string (string &optional width max-width justify squeeze)
-  "Split STRING into fixed width strings and return a cons cell like
-\(WIDTH . ROWS). Here, the car WIDTH indicates the actual maxim width of ROWS.
+  "Split STRING into fixed width strings and return a cons cell
+like \(WIDTH . ROWS). Here, the car WIDTH indicates the actual
+maxim width of ROWS.
 
-The argument WIDTH specifies the width of filling each paragraph. WIDTH nil
-means don't perform any justification and word wrap. Note that this function
-doesn't add any padding characters at the end of each row.
+The argument WIDTH specifies the width of filling each
+paragraph. WIDTH nil means don't perform any justification and
+word wrap. Note that this function doesn't add any padding
+characters at the end of each row.
 
-MAX-WIDTH, if WIDTH is nil, specifies the maximum number of columns.
+MAX-WIDTH, if WIDTH is nil, specifies the maximum number of
+columns.
 
-The optional fourth argument JUSTIFY specifies which kind of justification
-to do: `full', `left', `right', `center', or `none' (equivalent to nil).
-A value of t means handle each paragraph as specified by its text properties.
+The optional fourth argument JUSTIFY specifies which kind of
+justification to do: `full', `left', `right', `center', or
+`none' (equivalent to nil).  A value of t means handle each
+paragraph as specified by its text properties.
 
-SQUEEZE nil means leave whitespaces other than line breaks untouched."
+SQUEEZE nil means leave whitespaces other than line breaks
+untouched."
   (if (eq width 0)
       (error "Can't fill string with 0 width"))
   (if width
@@ -126,23 +132,25 @@ SQUEEZE nil means leave whitespaces other than line 
breaks untouched."
          (set-buffer-modified-p modified)))))
   
 (defun popup-preferred-width (list)
-  "Return preferred width of popup to show `LIST' beautifully."
+  "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 (* (ceiling (/ (+ (or width 0) (or summary-width 0)) 
10.0)) 10)))
+        finally return
+        (let ((total (+ (or width 0) (or summary-width 0))))
+          (* (ceiling (/ total 10.0)) 10))))
 
-;; window-full-width-p is not defined in Emacs 22.1
 (defun popup-window-full-width-p (&optional window)
+  "A portable version of `window-full-width-p'."
   (if (fboundp 'window-full-width-p)
       (window-full-width-p window)
     (= (window-width window) (frame-width (window-frame (or window 
(selected-window)))))))
 
-;; truncated-partial-width-window-p is not defined in Emacs 22
 (defun popup-truncated-partial-width-window-p (&optional window)
+  "A portable version of `truncated-partial-width-window-p'."
   (unless window
     (setq window (selected-window)))
   (unless (popup-window-full-width-p window)
@@ -153,6 +161,7 @@ SQUEEZE nil means leave whitespaces other than line breaks 
untouched."
        t-p-w-w))))
 
 (defun popup-current-physical-column ()
+  "Return the current physical column."
   (or (when (and popup-use-optimized-column-computation
                  (eq (window-hscroll) 0))
         (let ((current-column (current-column)))
@@ -162,22 +171,33 @@ SQUEEZE nil means leave whitespaces other than line 
breaks untouched."
               current-column)))
       (car (posn-col-row (posn-at-point)))))
 
+(defun popup-vertical-motion (column direction)
+  "A portable version of `vertical-motion'."
+  (if (>= emacs-major-version 23)
+      (vertical-motion (cons column direction))
+    (vertical-motion direction)
+    (move-to-column (+ (current-column) column))))
+
 (defun popup-last-line-of-buffer-p ()
+  "Return non-nil if the cursor is at the last line of the
+buffer."
   (save-excursion (end-of-line) (/= (forward-line) 0)))
 
 (defun popup-lookup-key-by-event (function event)
   (or (funcall function (vector event))
       (if (symbolp event)
           (popup-aif (get event 'event-symbol-element-mask)
-              (funcall function (vector (logior (or (get (car it) 
'ascii-character) 0)
-                                                (cadr it))))))))
+              (funcall function
+                       (vector (logior (or (get (car it) 'ascii-character)
+                                           0)
+                                       (cadr it))))))))
 
 
 
-;; Popup common
+;;; Core
 
 (defgroup popup nil
-  "Visual popup interface"
+  "Visual Popup User Interface"
   :group 'lisp
   :prefix "popup-")
 
@@ -216,18 +236,18 @@ SQUEEZE nil means leave whitespaces other than line 
breaks untouched."
   pattern original-list)
 
 (defun popup-item-propertize (item &rest properties)
-  "Same to `propertize` but this avoids overriding existed value with `nil` 
property."
-  (let (props)
-    (while properties
-      (when (cadr properties)
-        (push (car properties) props)
-        (push (cadr properties) props))
-      (setq properties (cddr properties)))
-    (apply 'propertize
-           (popup-x-to-string item)
-           (nreverse props))))
+  "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)))
 
 (defun popup-item-property (item property)
+  "Same as `get-text-property' except that this returns nil if
+ITEM is not string."
   (if (stringp item)
       (get-text-property 0 property item)))
 
@@ -240,8 +260,8 @@ SQUEEZE nil means leave whitespaces other than line breaks 
untouched."
                          document
                          symbol
                          summary)
-  "Utility function to make popup item.
-See also `popup-item-propertize'."
+  "Utility function to make popup item. See also
+`popup-item-propertize'."
   (popup-item-propertize name
                          'value value
                          'popup-face popup-face
@@ -276,23 +296,30 @@ See also `popup-item-propertize'."
         (display-buffer (current-buffer)))
       t)))
 
+(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)))))))
+
 (defun popup-item-show-help (item &optional persist)
+  "Display the documentation of ITEM with `display-buffer'. If
+PERSIST is nil, the documentation buffer will be closed
+automatically, meaning interal event loop ensures the buffer to
+be closed. Otherwise, the buffer will be just displayed as
+usual."
   (when item
     (if (not persist)
-        (save-window-excursion
-          (when (popup-item-show-help-1 item)
-            (block nil
-              (while t
-                (clear-this-command-keys)
-                (let ((key (read-key-sequence-vector nil)))
-                  (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))))))))
+        (popup-item-show-help-with-event-loop item)
       (popup-item-show-help-1 item))))
 
 (defun popup-set-list (popup list)
@@ -301,10 +328,12 @@ See also `popup-item-propertize'."
   (setf (popup-original-list popup) list))
   
 (defun popup-set-filtered-list (popup list)
-  (setf (popup-list popup) list
-        (popup-offset popup) (if (> (popup-direction popup) 0)
-                                 0
-                               (max (- (popup-height popup) (length list)) 
0))))
+  (let ((offset
+         (if (> (popup-direction popup) 0)
+             0
+           (max (- (popup-height popup) (length list)) 0))))
+    (setf (popup-list popup) list
+          (popup-offset popup) offset)))
 
 (defun popup-selected-item (popup)
   (nth (popup-cursor popup) (popup-list popup)))
@@ -328,9 +357,13 @@ See also `popup-item-propertize'."
     (and (eq (overlay-get overlay 'display) nil)
          (eq (overlay-get overlay 'after-string) nil))))
 
-(defun popup-set-line-item (popup line item face margin-left margin-right 
scroll-bar-char symbol summary)
+(defun* popup-set-line-item (popup line &key item face margin-left 
margin-right scroll-bar-char symbol summary)
   (let* ((overlay (popup-line-overlay popup line))
-         (content (popup-create-line-string popup (popup-x-to-string item) 
margin-left margin-right symbol summary))
+         (content (popup-create-line-string popup (popup-x-to-string item)
+                                            :margin-left margin-left
+                                            :margin-right margin-right
+                                            :symbol symbol
+                                            :summary summary))
          (start 0)
          (prefix (overlay-get overlay 'prefix))
          (postfix (overlay-get overlay 'postfix))
@@ -354,29 +387,48 @@ See also `popup-item-propertize'."
                          scroll-bar-char
                          postfix))))
 
-(defun popup-create-line-string (popup string margin-left margin-right symbol 
summary)
+(defun* popup-create-line-string (popup string &key margin-left margin-right 
symbol summary)
   (let* ((popup-width (popup-width popup))
          (summary-width (string-width summary))
-         (string (car (popup-substring-by-width string
-                                                (- popup-width
-                                                   (if (> summary-width 0)
-                                                       (+ summary-width 2)
-                                                     0)))))
-         (string-width (string-width string)))
+         (content-width (- popup-width
+                           (if (> summary-width 0)
+                               (+ summary-width 2)
+                             0)))
+         (string (car (popup-substring-by-width string content-width)))
+         (string-width (string-width string))
+         (spacing (max (- popup-width string-width summary-width) 0)))
     (concat margin-left
             string
-            (make-string (max (- popup-width string-width summary-width) 0) ? )
+            (make-string spacing ? )
             summary
             symbol
             margin-right)))
 
 (defun popup-live-p (popup)
+  "Return non-nil if POPUP is alive."
   (and popup (popup-overlays popup) t))
 
 (defun popup-child-point (popup &optional offset)
-  (overlay-end (popup-line-overlay popup
-                                   (or offset
-                                       (popup-selected-line popup)))))
+  (overlay-end
+   (popup-line-overlay
+    popup
+    (or offset
+        (popup-selected-line popup)))))
+
+(defun popup-calculate-direction (height row)
+  "Return a proper direction when displaying a popup on this
+window. HEIGHT is the a height of the popup, and ROW is a line
+number at the point."
+  (let* ((remaining-rows (- (max 1 (- (window-height)
+                                      (if mode-line-format 1 0)
+                                      (if header-line-format 1 0)))
+                            (count-lines (window-start) (point))))
+         (enough-space-above (> row height))
+         (enough-space-below (<= height remaining-rows)))
+    (if (and enough-space-above
+             (not enough-space-below))
+        -1
+      1)))
 
 (defun* popup-create (point
                       width
@@ -392,6 +444,34 @@ See also `popup-item-propertize'."
                       symbol
                       parent
                       parent-offset)
+  "Create a popup instance at POINT with WIDTH and HEIGHT.
+
+MIN-HEIGHT is a minimal height of the popup. The default value is
+0.
+
+If AROUND is non-nil, the popup will be displayed around the
+point but not at the point.
+
+FACE is a background face of the popup. The default value is POPUP-FACE.
+
+SELECTION-FACE is a foreground (selection) face of the popup The
+default value is POPUP-FACE.
+
+If SCROLL-BAR is non-nil, the popup will have a scroll bar at the
+right.
+
+If MARGIN-LEFT is non-nil, the popup will have a margin at the
+left.
+
+If MARGIN-RIGHT is non-nil, the popup will have a margin at the
+right.
+
+SYMBOL is a single character which indicates a kind of the item.
+
+PARENT is a parent popup instance. If PARENT is omitted, the
+popup will be a root instance.
+
+PARENT-OFFSET is a row offset from the parent popup."
   (or margin-left (setq margin-left 0))
   (or margin-right (setq margin-right 0))
   (unless point
@@ -423,36 +503,34 @@ See also `popup-item-propertize'."
                        (and parent (popup-direction parent))
 
                        ;; Calculate direction
-                       (if (and (> row height)
-                                (> height (- (max 1 (- (window-height)
-                                                       (if mode-line-format 1 
0)
-                                                       (if header-line-format 
1 0)))
-                                             (count-lines window-start 
(point)))))
-                           -1
-                         1)))
+                       (popup-calculate-direction height row)))
            (depth (if parent (1+ (popup-depth parent)) 0))
            (newlines (max 0 (+ (- height (count-lines point (point-max))) (if 
around 1 0))))
            current-column)
+      ;; Case: no newlines at the end of the buffer
       (when (> newlines 0)
         (popup-save-buffer-state
           (goto-char (point-max))
           (insert (make-string newlines ?\n))))
       
+      ;; Case: the popup overflows
       (if overflow
           (if foldable
               (progn
                 (decf column (- popup-width margin-left margin-right))
                 (unless around (move-to-column column)))
             (when (not truncate-lines)
-              ;; Cut out overflow
+              ;; Truncate.
               (let ((d (1+ (- popup-width (- window-width column)))))
                 (decf popup-width d)
                 (decf width d)))
             (decf column margin-left))
         (decf column margin-left))
+
+      ;; Case: no space at the left
       (when (and (null parent)
                  (< column 0))
-          ;; Cancel margin left
+        ;; Cancel margin left
         (setq column 0)
         (decf popup-width margin-left)
         (setq margin-left-cancel t))
@@ -460,10 +538,7 @@ See also `popup-item-propertize'."
       (dotimes (i height)
         (let (overlay begin w (dangle t) (prefix "") (postfix ""))
           (when around
-            (if (>= emacs-major-version 23)
-                (vertical-motion (cons column direction))
-              (vertical-motion direction)
-              (move-to-column (+ (current-column) column))))
+            (popup-vertical-motion column direction))
          (setq around t
                 current-column (popup-current-physical-column))
 
@@ -472,11 +547,12 @@ See also `popup-item-propertize'."
             (setq current-column (popup-current-physical-column)))
           (when (< current-column column)
             ;; Extend short buffer lines by popup prefix (line of spaces)
-            (setq prefix (make-string (+ (if (= current-column 0)
-                                             (- window-hscroll 
(current-column))
-                                           0)
-                                         (- column current-column))
-                                      ? )))
+            (setq prefix (make-string
+                          (+ (if (= current-column 0)
+                                 (- window-hscroll (current-column))
+                               0)
+                             (- column current-column))
+                          ? )))
 
           (setq begin (point))
           (setq w (+ popup-width (length prefix)))
@@ -516,6 +592,7 @@ See also `popup-item-propertize'."
                             :scroll-bar scroll-bar
                             :symbol symbol
                             :cursor 0
+                            :offset 0
                             :scroll-top 0
                             :current-height 0
                             :list nil
@@ -525,11 +602,13 @@ See also `popup-item-propertize'."
         it))))
 
 (defun popup-delete (popup)
+  "Delete POPUP instance."
   (when (popup-live-p popup)
     (popup-hide popup)
     (mapc 'delete-overlay (popup-overlays popup))
     (setf (popup-overlays popup) nil)
     (setq popup-instances (delq popup popup-instances))
+    ;; Restore newlines state
     (let ((newlines (popup-newlines popup)))
       (when (> newlines 0)
         (popup-save-buffer-state
@@ -540,6 +619,7 @@ See also `popup-item-propertize'."
   nil)
 
 (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)
@@ -582,7 +662,14 @@ See also `popup-item-propertize'."
         
         do
         ;; Show line and set item to the line
-        (popup-set-line-item popup o item face margin-left margin-right 
scroll-bar-char sym summary)
+        (popup-set-line-item popup o
+                             :item item
+                             :face face
+                             :margin-left margin-left
+                             :margin-right margin-right
+                             :scroll-bar-char scroll-bar-char
+                             :symbol sym
+                             :summary summary)
         
         finally
         ;; Remember current height
@@ -595,7 +682,14 @@ See also `popup-item-propertize'."
               (progn
                 (when min-height
                   (while (< o min-height)
-                    (popup-set-line-item popup o "" popup-face margin-left 
margin-right scroll-bar-char symbol "")
+                    (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)
@@ -605,13 +699,22 @@ See also `popup-item-propertize'."
                   if (< o h)
                   do (popup-hide-line popup o)
                   if (>= o h)
-                  do (popup-set-line-item popup o "" popup-face margin-left 
margin-right scroll-bar-char symbol ""))))))
+                  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."
   (dotimes (i (popup-height popup))
     (popup-hide-line popup i)))
 
 (defun popup-hidden-p (popup)
+  "Return non-nil if POPUP is hidden."
   (let ((hidden t))
     (when (popup-live-p popup)
       (dotimes (i (popup-height popup))
@@ -620,6 +723,7 @@ See also `popup-item-propertize'."
     hidden))
 
 (defun popup-select (popup i)
+  "Select the item at I of POPUP and draw."
   (setq i (+ i (popup-offset popup)))
   (when (and (<= 0 i) (< i (popup-height popup)))
     (setf (popup-cursor popup) i)
@@ -627,6 +731,7 @@ See also `popup-item-propertize'."
     t))
 
 (defun popup-next (popup)
+  "Select the next item of POPUP and draw."
   (let ((height (popup-height popup))
         (cursor (1+ (popup-cursor popup)))
         (scroll-top (popup-scroll-top popup))
@@ -644,6 +749,7 @@ See also `popup-item-propertize'."
     (popup-draw popup)))
 
 (defun popup-previous (popup)
+  "Select the previous item of POPUP and draw."
   (let ((height (popup-height popup))
         (cursor (1- (popup-cursor popup)))
         (scroll-top (popup-scroll-top popup))
@@ -661,6 +767,7 @@ See also `popup-item-propertize'."
     (popup-draw popup)))
 
 (defun popup-scroll-down (popup &optional n)
+  "Scroll down N of POPUP and draw."
   (let ((scroll-top (min (+ (popup-scroll-top popup) (or n 1))
                          (- (length (popup-list popup)) (popup-height 
popup)))))
     (setf (popup-cursor popup) scroll-top
@@ -668,6 +775,7 @@ See also `popup-item-propertize'."
     (popup-draw popup)))
 
 (defun popup-scroll-up (popup &optional n)
+  "Scroll up N of POPUP and draw."
   (let ((scroll-top (max (- (popup-scroll-top popup) (or n 1))
                          0)))
     (setf (popup-cursor popup) scroll-top
@@ -676,7 +784,7 @@ See also `popup-item-propertize'."
 
 
 
-;; Popup isearch
+;;; Popup Incremental Search
 
 (defface popup-isearch-match
   '((t (:background "sky blue")))
@@ -706,17 +814,18 @@ See also `popup-item-propertize'."
           (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)))
+        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)
@@ -739,46 +848,59 @@ See also `popup-item-propertize'."
                        (keymap popup-isearch-keymap)
                        callback
                        help-delay)
+  "Start isearch on POPUP. This function is synchronized, meaning
+event loop waits for quiting of isearch.
+
+CURSOR-COLOR is a cursor color during isearch. The default value
+is `popup-isearch-cursor-color'.
+
+KEYMAP is a keymap which is used when processing events during
+event loop. The default value is `popup-isearch-keymap'.
+
+CALLBACK is a function taking one argument. `popup-isearch' calls
+CALLBACK, if specified, after isearch finished or isearch
+canceled. The arguments is whole filtered list of items.
+
+HELP-DELAY is a delay of displaying helps."
   (let ((list (popup-original-list popup))
         (pattern (or (popup-pattern popup) ""))
         (old-cursor-color (frame-parameter (selected-frame) 'cursor-color))
-        prompt key binding done)
+        prompt key binding)
     (unwind-protect
-        (unless (block nil
-                  (if cursor-color
-                      (set-cursor-color cursor-color))
-                  (while t
-                    (setq prompt (popup-isearch-prompt popup pattern))
-                    (setq key (popup-menu-read-key-sequence keymap prompt 
help-delay))
-                    (if (null key)
-                        (unless (funcall popup-menu-show-quick-help-function 
popup nil :prompt prompt)
-                          (clear-this-command-keys)
-                          (push (read-event prompt) unread-command-events))
-                      (setq binding (lookup-key keymap key))
-                      (cond
-                       ((and (stringp key)
-                             (popup-isearch-char-p (aref key 0)))
-                        (setq pattern (concat pattern key)))
-                       ((eq binding 'popup-isearch-done)
-                        (return t))
-                       ((eq binding 'popup-isearch-cancel)
-                        (return nil))
-                       ((eq binding 'popup-isearch-delete)
-                        (if (> (length pattern) 0)
-                            (setq pattern (substring pattern 0 (1- (length 
pattern))))))
-                       (t
-                        (setq unread-command-events
-                              (append (listify-key-sequence key) 
unread-command-events))
-                        (return t)))
-                      (popup-isearch-update popup pattern callback))))
-          (popup-isearch-update popup "" callback)
-          t) ; Return non-nil if isearch is cancelled
+        (block nil
+          (if cursor-color
+              (set-cursor-color cursor-color))
+          (while t
+            (setq prompt (popup-isearch-prompt popup pattern))
+            (setq key (popup-menu-read-key-sequence keymap prompt help-delay))
+            (if (null key)
+                (unless (funcall popup-menu-show-quick-help-function popup nil 
:prompt prompt)
+                  (clear-this-command-keys)
+                  (push (read-event prompt) unread-command-events))
+              (setq binding (lookup-key keymap key))
+              (cond
+               ((and (stringp key)
+                     (popup-isearch-char-p (aref key 0)))
+                (setq pattern (concat pattern key)))
+               ((eq binding 'popup-isearch-done)
+                (return nil))
+               ((eq binding 'popup-isearch-cancel)
+                (popup-isearch-update popup "" callback)
+                (return t))
+               ((eq binding 'popup-isearch-delete)
+                (if (> (length pattern) 0)
+                    (setq pattern (substring pattern 0 (1- (length 
pattern))))))
+               (t
+                (setq unread-command-events
+                      (append (listify-key-sequence key) 
unread-command-events))
+                (return nil)))
+              (popup-isearch-update popup pattern callback))))
       (if old-cursor-color
           (set-cursor-color old-cursor-color)))))
 
 
 
-;; Popup tip
+;;; Popup Tip
 
 (defface popup-tip-face
   '((t (:background "khaki1" :foreground "black")))
@@ -804,6 +926,16 @@ See also `popup-item-propertize'."
                    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.
+
+If TRUNCATE is non-nil, the tooltip can be truncated.
+
+If NOWAIT is non-nil, this function immediately returns the
+tooltip instance without entering event loop.
+
+PROMPT is a prompt string when reading events during event loop."
   (if (bufferp string)
       (setq string (with-current-buffer string (buffer-string))))
   ;; TODO strip text (mainly face) properties
@@ -847,7 +979,7 @@ See also `popup-item-propertize'."
 
 
 
-;; Popup menu
+;;; Popup Menu
 
 (defface popup-menu-face
   '((t (:background "lightgray" :foreground "black")))
@@ -924,7 +1056,17 @@ See also `popup-item-propertize'."
 
 (defun popup-menu-fallback (event default))
 
-(defun* popup-menu-event-loop (menu keymap fallback &optional prompt 
help-delay isearch isearch-cursor-color isearch-keymap isearch-callback &aux 
key binding)
+(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
@@ -976,7 +1118,6 @@ See also `popup-item-propertize'."
          (t
           (funcall fallback key (key-binding key))))))))
 
-;; popup-menu is used by mouse.el unfairly...
 (defun* popup-menu* (list
                      &key
                      point
@@ -993,12 +1134,46 @@ See also `popup-item-propertize'."
                      (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 unless. Almost arguments are same as
+`popup-create' except for KEYMAP, FALLBACK, HELP-DELAY, PROMPT,
+ISEARCH, ISEARCH-CURSOR-COLOR, ISEARCH-KEYMAP, and
+ISEARCH-CALLBACK.
+
+If KEYMAP is a keymap which is used when processing events during
+event loop.
+
+If FALLBACK is a function taking two arguments; a key and a
+command. FALLBACK is called when no special operation is found on
+the key. The default value is `popup-menu-fallback', which does
+nothing.
+
+HELP-DELAY is a delay of displaying helps.
+
+If NOWAIT is non-nil, this function immediately returns the menu
+instance without entering event loop.
+
+PROMPT is a prompt string when reading events during event loop.
+
+If ISEARCH is non-nil, do isearch as soon as displaying the popup
+menu.
+
+ISEARCH-CURSOR-COLOR is a cursor color during isearch. The
+default value is `popup-isearch-cursor-color'.
+
+ISEARCH-KEYMAP is a keymap which is used when processing events
+during event loop. The default value is `popup-isearch-keymap'.
+
+ISEARCH-CALLBACK is a function taking one argument.  `popup-menu'
+calls ISEARCH-CALLBACK, if specified, after isearch finished or
+isearch canceled. The arguments is whole filtered list of items."
   (and (eq margin t) (setq margin 1))
   (or margin-left (setq margin-left margin))
   (or margin-right (setq margin-right margin))
@@ -1020,13 +1195,23 @@ See also `popup-item-propertize'."
       (progn
         (popup-set-list menu list)
         (popup-draw menu)
-        (popup-menu-event-loop menu keymap fallback prompt help-delay isearch
-                               isearch-cursor-color isearch-keymap 
isearch-callback))
-    (popup-delete menu)))
+        (if nowait
+            menu
+          (popup-menu-event-loop menu keymap fallback
+                                 :prompt prompt
+                                 :help-delay help-delay
+                                 :isearch isearch
+                                 :isearch-cursor-color isearch-cursor-color
+                                 :isearch-keymap isearch-keymap
+                                 :isearch-callback isearch-callback)))
+    (unless nowait
+      (popup-delete menu))))
 
 (defun popup-cascade-menu (list &rest args)
-  "Same to `popup-menu', but an element of `LIST' can be
-list of submenu."
+  "Same as `popup-menu' except that an element of LIST can be
+also a sub-menu if the element is a cons cell formed (ITEM
+. SUBLIST) where ITEM is an usual item and SUBLIST is a list of
+the sub menu."
   (apply 'popup-menu*
          (mapcar (lambda (item)
                    (if (consp item)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]