From 62f897fdf5988840ee5538e30fbd3c7bcb715735 Mon Sep 17 00:00:00 2001
From: Tom Willemsen
Date: Mon, 21 Feb 2011 00:27:43 +0100
Subject: New .emacs style

 * .emacs only loops through .emacs.d and runs the *.el files there.

 * files are automatically compiled before loading. But only if it
   hasn't already been compiled.

 * all emacs el files, save for the startup scripts, have been moved
   to .emacs.d/elisp
---
 emacs.d/popup.el | 1061 ------------------------------------------------------
 1 file changed, 1061 deletions(-)
 delete mode 100644 emacs.d/popup.el

(limited to 'emacs.d/popup.el')

diff --git a/emacs.d/popup.el b/emacs.d/popup.el
deleted file mode 100644
index 0f14dfe..0000000
--- a/emacs.d/popup.el
+++ /dev/null
@@ -1,1061 +0,0 @@
-;;; popup.el --- Visual popup interface
-
-;; Copyright (C) 2009, 2010  Tomohiro Matsuyama
-
-;; Author: Tomohiro Matsuyama <tomo@cx4a.org>
-;; Keywords: lisp
-;; Version: 0.4
-
-;; 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/>.
-
-;;; Commentary:
-
-;; 
-
-;;; Code:
-
-(eval-when-compile
-  (require 'cl))
-
-
-
-;; Utilities
-
-(defvar popup-use-optimized-column-computation t
-  "Use optimized column computation routine.
-If there is a problem, please set it to 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."
-  (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."
-  (typecase x
-    (string x)
-    (symbol (symbol-name x))
-    (integer (number-to-string x))
-    (float (number-to-string x))
-    (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
-  (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))))
-
-(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.
-
-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.
-
-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."
-  (if (eq width 0)
-      (error "Can't fill string with 0 width"))
-  (if width
-      (setq max-width width))
-  (with-temp-buffer
-    (let ((tab-width 4)
-          (fill-column width)
-          (left-margin 0)
-          (kinsoku-limit 1)
-          indent-tabs-mode
-          row rows)
-      (insert string)
-      (untabify (point-min) (point-max))
-      (if width
-          (fill-region (point-min) (point-max) justify (not squeeze)))
-      (goto-char (point-min))
-      (setq width 0)
-      (while (prog2
-                 (let ((line (buffer-substring
-                              (point) (progn (end-of-line) (point)))))
-                   (if max-width
-                       (while (progn
-                                (setq row (truncate-string-to-width line max-width)
-                                      width (max width (string-width row)))
-                                (push row rows)
-                                (if (not (= (length row) (length line)))
-                                    (setq line (substring line (length row))))))
-                     (setq width (max width (string-width line)))
-                     (push line rows)))
-                 (< (point) (point-max))
-               (beginning-of-line 2)))
-      (cons width (nreverse rows)))))
-
-(defmacro popup-save-buffer-state (&rest body)
-  (declare (indent 0))
-  `(save-excursion
-     (let ((buffer-undo-list t)
-           (buffer-read-only nil)
-           (modified (buffer-modified-p)))
-       (unwind-protect
-           (progn ,@body)
-         (set-buffer-modified-p modified)))))
-  
-(defun popup-preferred-width (list)
-  "Return preferred width of popup 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)))
-
-;; window-full-width-p is not defined in Emacs 22.1
-(defun popup-window-full-width-p (&optional window)
-  (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)
-  (unless window
-    (setq window (selected-window)))
-  (unless (popup-window-full-width-p window)
-    (let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows
-				       (window-buffer window))))
-      (if (integerp t-p-w-w)
-	  (< (window-width window) t-p-w-w)
-	t-p-w-w))))
-
-(defun popup-current-physical-column ()
-  (or (when (and popup-use-optimized-column-computation
-                 (eq (window-hscroll) 0))
-        (let ((current-column (current-column)))
-          (if (or (popup-truncated-partial-width-window-p)
-                  truncate-lines
-                  (< current-column (window-width)))
-              current-column)))
-      (car (posn-col-row (posn-at-point)))))
-
-(defun popup-last-line-of-buffer-p ()
-  (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))))))))
-
-
-
-;; Popup common
-
-(defgroup popup nil
-  "Visual popup interface"
-  :group 'lisp
-  :prefix "popup-")
-
-(defface popup-face
-  '((t (:background "lightgray" :foreground "black")))
-  "Face for popup."
-  :group 'popup)
-
-(defface popup-scroll-bar-foreground-face
-  '((t (:background "black")))
-  "Foreground face for scroll-bar."
-  :group 'popup)
-
-(defface popup-scroll-bar-background-face
-  '((t (:background "gray")))
-  "Background face for scroll-bar."
-  :group 'popup)
-
-(defvar popup-instances nil
-  "Popup instances.")
-
-(defvar popup-scroll-bar-foreground-char
-  (propertize " " 'face 'popup-scroll-bar-foreground-face)
-  "Foreground character for scroll-bar.")
-
-(defvar popup-scroll-bar-background-char
-  (propertize " " 'face 'popup-scroll-bar-background-face)
-  "Background character for scroll-bar.")
-
-(defstruct popup
-  point row column width height min-height direction overlays
-  parent depth
-  face selection-face
-  margin-left margin-right margin-left-cancel scroll-bar symbol
-  cursor offset scroll-top current-height list newlines
-  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))))
-
-(defun popup-item-property (item property)
-  (if (stringp item)
-      (get-text-property 0 property item)))
-
-(defun* popup-make-item (name
-                         &key
-                         value
-                         popup-face
-                         selection-face
-                         sublist
-                         document
-                         symbol
-                         summary)
-  "Utility function to make popup item.
-See also `popup-item-propertize'."
-  (popup-item-propertize name
-                         'value value
-                         'popup-face popup-face
-                         'selection-face selection-face
-                         'document document
-                         'symbol symbol
-                         'summary summary
-                         'sublist sublist))
-
-(defsubst popup-item-value (item)               (popup-item-property item 'value))
-(defsubst popup-item-value-or-self (item)       (or (popup-item-value item) item))
-(defsubst popup-item-popup-face (item)          (popup-item-property item 'popup-face))
-(defsubst popup-item-selection-face (item)      (popup-item-property item 'selection-face))
-(defsubst popup-item-document (item)            (popup-item-property item 'document))
-(defsubst popup-item-summary (item)             (popup-item-property item 'summary))
-(defsubst popup-item-symbol (item)              (popup-item-property item 'symbol))
-(defsubst popup-item-sublist (item)             (popup-item-property item 'sublist))
-
-(defun popup-item-documentation (item)
-  (let ((doc (popup-item-document item)))
-    (if (functionp doc)
-        (setq doc (funcall doc (popup-item-value-or-self item))))
-    doc))
-
-(defun popup-item-show-help-1 (item)
-  (let ((doc (popup-item-documentation item)))
-    (when doc
-      (with-current-buffer (get-buffer-create " *Popup Help*")
-        (erase-buffer)
-        (insert doc)
-        (goto-char (point-min))
-        (display-buffer (current-buffer)))
-      t)))
-
-(defun popup-item-show-help (item &optional persist)
-  (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-1 item))))
-
-(defun popup-set-list (popup list)
-  (popup-set-filtered-list popup list)
-  (setf (popup-pattern popup) nil)
-  (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))))
-
-(defun popup-selected-item (popup)
-  (nth (popup-cursor popup) (popup-list popup)))
-
-(defun popup-selected-line (popup)
-  (- (popup-cursor popup) (popup-scroll-top popup)))
-
-(defun popup-line-overlay (popup line)
-  (aref (popup-overlays popup) line))
-
-(defun popup-selected-line-overlay (popup)
-  (popup-line-overlay popup (popup-selected-line popup)))
-
-(defun popup-hide-line (popup line)
-  (let ((overlay (popup-line-overlay popup line)))
-    (overlay-put overlay 'display nil)
-    (overlay-put overlay 'after-string nil)))
-
-(defun popup-line-hidden-p (popup line)
-  (let ((overlay (popup-line-overlay popup line)))
-    (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)
-  (let* ((overlay (popup-line-overlay popup line))
-         (content (popup-create-line-string popup (popup-x-to-string item) margin-left margin-right symbol summary))
-         (start 0)
-         (prefix (overlay-get overlay 'prefix))
-         (postfix (overlay-get overlay 'postfix))
-         end)
-    ;; Overlap face properties
-    (if (get-text-property start 'face content)
-        (setq start (next-single-property-change start 'face content)))
-    (while (and start (setq end (next-single-property-change start 'face content)))
-      (put-text-property start end 'face face content)
-      (setq start (next-single-property-change end 'face content)))
-    (if start
-        (put-text-property start (length content) 'face face content))
-    (unless (overlay-get overlay 'dangle)
-      (overlay-put overlay 'display (concat prefix (substring content 0 1)))
-      (setq prefix nil
-            content (concat (substring content 1))))
-    (overlay-put overlay
-                 'after-string
-                 (concat prefix
-                         content
-                         scroll-bar-char
-                         postfix))))
-
-(defun popup-create-line-string (popup string 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)))
-    (concat margin-left
-            string
-            (make-string (max (- popup-width string-width summary-width) 0) ? )
-            summary
-            symbol
-            margin-right)))
-
-(defun popup-live-p (popup)
-  (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)))))
-
-(defun* popup-create (point
-                      width
-                      height
-                      &key
-                      min-height
-                      around
-                      (face 'popup-face)
-                      (selection-face face)
-                      scroll-bar
-                      margin-left
-                      margin-right
-                      symbol
-                      parent
-                      parent-offset)
-  (or margin-left (setq margin-left 0))
-  (or margin-right (setq margin-right 0))
-  (unless point
-    (setq point
-          (if parent (popup-child-point parent parent-offset) (point))))
-
-  (save-excursion
-    (goto-char point)
-    (let* ((row (line-number-at-pos))
-           (column (popup-current-physical-column))
-           (overlays (make-vector height nil))
-           (popup-width (+ width
-                           (if scroll-bar 1 0)
-                           margin-left
-                           margin-right
-                           (if symbol 2 0)))
-           margin-left-cancel
-           (window (selected-window))
-           (window-start (window-start))
-           (window-hscroll (window-hscroll))
-           (window-width (window-width))
-           (right (+ column popup-width))
-           (overflow (and (> right window-width)
-                          (>= right popup-width)))
-           (foldable (and (null parent)
-                          (>= column popup-width)))
-           (direction (or
-                       ;; Currently the direction of cascade popup won't be changed
-                       (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)))
-           (depth (if parent (1+ (popup-depth parent)) 0))
-           (newlines (max 0 (+ (- height (count-lines point (point-max))) (if around 1 0))))
-           current-column)
-      (when (> newlines 0)
-        (popup-save-buffer-state
-          (goto-char (point-max))
-          (insert (make-string newlines ?\n))))
-      
-      (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
-              (let ((d (1+ (- popup-width (- window-width column)))))
-                (decf popup-width d)
-                (decf width d)))
-            (decf column margin-left))
-        (decf column margin-left))
-      (when (and (null parent)
-                 (< column 0))
-          ;; Cancel margin left
-        (setq column 0)
-        (decf popup-width margin-left)
-        (setq margin-left-cancel t))
-      
-      (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))))
-	  (setq around t
-                current-column (popup-current-physical-column))
-
-          (when (> current-column column)
-            (backward-char)
-            (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 begin (point))
-          (setq w (+ popup-width (length prefix)))
-          (while (and (not (eolp)) (> w 0))
-            (setq dangle nil)
-            (decf w (char-width (char-after)))
-            (forward-char))
-          (if (< w 0)
-              (setq postfix (make-string (- w) ? )))
-
-          (setq overlay (make-overlay begin (point)))
-          (overlay-put overlay 'window window)
-          (overlay-put overlay 'dangle dangle)
-          (overlay-put overlay 'prefix prefix)
-          (overlay-put overlay 'postfix postfix)
-          (overlay-put overlay 'width width)
-          (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))
-      (let ((it (make-popup :point point
-                            :row row
-                            :column column
-                            :width width
-                            :height height
-                            :min-height min-height
-                            :direction direction
-                            :parent parent
-                            :depth depth
-                            :face face
-                            :selection-face selection-face
-                            :margin-left margin-left
-                            :margin-right margin-right
-                            :margin-left-cancel margin-left-cancel
-                            :scroll-bar scroll-bar
-                            :symbol symbol
-                            :cursor 0
-                            :scroll-top 0
-                            :current-height 0
-                            :list nil
-                            :newlines newlines
-                            :overlays overlays)))
-        (push it popup-instances)
-        it))))
-
-(defun popup-delete (popup)
-  (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))
-    (let ((newlines (popup-newlines popup)))
-      (when (> newlines 0)
-        (popup-save-buffer-state
-          (goto-char (point-max))
-          (dotimes (i newlines)
-            (if (= (char-before) ?\n)
-                (delete-char -1)))))))
-  nil)
-
-(defun popup-draw (popup)
-  (loop with height = (popup-height popup)
-        with min-height = (popup-min-height popup)
-        with popup-face = (popup-face popup)
-        with selection-face = (popup-selection-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)
-        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-popup-face item) popup-face))
-        for empty-char = (propertize " " 'face face)
-        for scroll-bar-char = (if scroll-bar
-                                  (cond
-                                   ((<= 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 face margin-left margin-right scroll-bar-char sym summary)
-        
-        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 "" popup-face margin-left margin-right scroll-bar-char symbol "")
-                    (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 "" popup-face margin-left margin-right scroll-bar-char symbol ""))))))
-
-(defun popup-hide (popup)
-  (dotimes (i (popup-height popup))
-    (popup-hide-line popup i)))
-
-(defun popup-hidden-p (popup)
-  (let ((hidden t))
-    (when (popup-live-p popup)
-      (dotimes (i (popup-height popup))
-        (unless (popup-line-hidden-p popup i)
-          (setq hidden nil))))
-    hidden))
-
-(defun popup-select (popup i)
-  (setq i (+ i (popup-offset popup)))
-  (when (and (<= 0 i) (< i (popup-height popup)))
-    (setf (popup-cursor popup) i)
-    (popup-draw popup)
-    t))
-
-(defun popup-next (popup)
-  (let ((height (popup-height popup))
-        (cursor (1+ (popup-cursor popup)))
-        (scroll-top (popup-scroll-top popup))
-        (length (length (popup-list popup))))
-    (cond
-     ((>= cursor length)
-      ;; Back to first page
-      (setq cursor 0
-            scroll-top 0))
-     ((= cursor (+ scroll-top height))
-      ;; Go to next page
-      (setq scroll-top (min (1+ scroll-top) (max (- length height) 0)))))
-    (setf (popup-cursor popup) cursor
-          (popup-scroll-top popup) scroll-top)
-    (popup-draw popup)))
-
-(defun popup-previous (popup)
-  (let ((height (popup-height popup))
-        (cursor (1- (popup-cursor popup)))
-        (scroll-top (popup-scroll-top popup))
-        (length (length (popup-list popup))))
-    (cond
-     ((< cursor 0)
-      ;; Go to last page
-      (setq cursor (1- length)
-            scroll-top (max (- length height) 0)))
-     ((= cursor (1- scroll-top))
-      ;; Go to previous page
-      (decf scroll-top)))
-    (setf (popup-cursor popup) cursor
-          (popup-scroll-top popup) scroll-top)
-    (popup-draw popup)))
-
-(defun popup-scroll-down (popup &optional n)
-  (let ((scroll-top (min (+ (popup-scroll-top popup) (or n 1))
-                         (- (length (popup-list popup)) (popup-height popup)))))
-    (setf (popup-cursor popup) scroll-top
-          (popup-scroll-top popup) scroll-top)
-    (popup-draw popup)))
-
-(defun popup-scroll-up (popup &optional n)
-  (let ((scroll-top (max (- (popup-scroll-top popup) (or n 1))
-                         0)))
-    (setf (popup-cursor popup) scroll-top
-          (popup-scroll-top popup) scroll-top)
-    (popup-draw popup)))
-
-
-
-;; Popup isearch
-
-(defface popup-isearch-match
-  '((t (:background "sky blue")))
-  "Popup isearch match face."
-  :group 'popup)
-
-(defvar popup-isearch-cursor-color "blue")
-
-(defvar popup-isearch-keymap
-  (let ((map (make-sparse-keymap)))
-    ;(define-key map "\r"        'popup-isearch-done)
-    (define-key map "\C-g"      'popup-isearch-cancel)
-    (define-key map "\C-h"      'popup-isearch-delete)
-    (define-key map (kbd "DEL") 'popup-isearch-delete)
-    map))
-
-(defsubst popup-isearch-char-p (char)
-  (and (integerp char)
-       (<= 32 char)
-       (<= 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)))
-
-(defun popup-isearch-prompt (popup pattern)
-  (format "Pattern: %s" (if (= (length (popup-list popup)) 0)
-                            (propertize pattern 'face 'isearch-fail)
-                          pattern)))
-
-(defun popup-isearch-update (popup pattern &optional callback)
-  (setf (popup-cursor popup) 0
-        (popup-scroll-top popup) 0
-        (popup-pattern popup) pattern)
-  (let ((list (popup-isearch-filter-list pattern (popup-original-list popup))))
-    (popup-set-filtered-list popup list)
-    (if callback
-        (funcall callback list)))
-  (popup-draw popup))
-
-(defun* popup-isearch (popup
-                       &key
-                       (cursor-color popup-isearch-cursor-color)
-                       (keymap popup-isearch-keymap)
-                       callback
-                       help-delay)
-  (let ((list (popup-original-list popup))
-        (pattern (or (popup-pattern popup) ""))
-        (old-cursor-color (frame-parameter (selected-frame) 'cursor-color))
-        prompt key binding done)
-    (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
-      (if old-cursor-color
-          (set-cursor-color old-cursor-color)))))
-
-
-
-;; Popup tip
-
-(defface popup-tip-face
-  '((t (:background "khaki1" :foreground "black")))
-  "Face for popup tip."
-  :group 'popup)
-
-(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)
-  (if (bufferp string)
-      (setq string (with-current-buffer string (buffer-string))))
-  ;; TODO strip text (mainly face) properties
-  (setq string (substring-no-properties string))
-
-  (and (eq margin t) (setq margin 1))
-  (or margin-left (setq margin-left margin))
-  (or margin-right (setq margin-right margin))
-  
-  (let ((it (popup-fill-string string width popup-tip-max-width)))
-    (setq width (car it)
-          lines (cdr it)))
-  
-  (setq tip (popup-create point width height
-                          :min-height min-height
-                          :around around
-                          :margin-left margin-left
-                          :margin-right margin-right
-                          :scroll-bar scroll-bar
-                          :face 'popup-tip-face
-                          :parent parent
-                          :parent-offset parent-offset))
-
-  (unwind-protect
-      (when (> (popup-width tip) 0)                   ; not to be corrupted
-        (when (and (not (eq width (popup-width tip))) ; truncated
-                   (not truncate))
-          ;; Refill once again to lines be fitted to popup width
-          (setq width (popup-width tip))
-          (setq lines (cdr (popup-fill-string string width width))))
-
-        (popup-set-list tip lines)
-        (popup-draw tip)
-        (if nowait
-            tip
-          (clear-this-command-keys)
-          (push (read-event prompt) unread-command-events)
-          t))
-    (unless nowait
-      (popup-delete tip))))
-
-
-
-;; Popup menu
-
-(defface popup-menu-face
-  '((t (:background "lightgray" :foreground "black")))
-  "Face for popup menu."
-  :group 'popup)
-
-(defface popup-menu-selection-face
-  '((t (:background "steelblue" :foreground "white")))
-  "Face for popup menu selection."
-  :group 'popup)
-
-(defvar popup-menu-show-tip-function 'popup-tip
-  "Function used for showing tooltip by `popup-menu-show-quick-help'.")
-
-(defvar popup-menu-show-quick-help-function 'popup-menu-show-quick-help
-  "Function used for showing quick help by `popup-menu*'.")
-
-(defun popup-menu-show-help (menu &optional persist item)
-  (popup-item-show-help (or item (popup-selected-item menu)) persist))
-
-(defun popup-menu-documentation (menu &optional item)
-  (popup-item-documentation (or item (popup-selected-item menu))))
-
-(defun popup-menu-show-quick-help (menu &optional item &rest args)
-  (let* ((point (plist-get args :point))
-         (height (or (plist-get args :height) (popup-height menu)))
-         (min-height (min height (popup-current-height menu)))
-         (around nil)
-         (parent-offset (popup-offset menu))
-         (doc (popup-menu-documentation menu item)))
-    (when (stringp doc)
-      (if (popup-hidden-p menu)
-          (setq around t
-                menu nil
-                parent-offset nil)
-        (setq point nil))
-      (let ((popup-use-optimized-column-computation nil)) ; To avoid wrong positioning
-        (apply popup-menu-show-tip-function
-               doc
-               :point point
-               :height height
-               :min-height min-height
-               :around around
-               :parent menu
-               :parent-offset parent-offset
-               args)))))
-
-(defun popup-menu-read-key-sequence (keymap &optional prompt timeout)
-  (catch 'timeout
-    (let ((timer (and timeout
-                      (run-with-timer timeout nil
-                                      (lambda ()
-                                        (if (zerop (length (this-command-keys)))
-                                            (throw 'timeout nil))))))
-          (old-global-map (current-global-map))
-          (temp-global-map (make-sparse-keymap))
-          (overriding-terminal-local-map (make-sparse-keymap)))
-      (substitute-key-definition 'keyboard-quit 'keyboard-quit
-                                 temp-global-map old-global-map)
-      (define-key temp-global-map [menu-bar] (lookup-key old-global-map [menu-bar]))
-      (define-key temp-global-map [tool-bar] (lookup-key old-global-map [tool-bar]))
-      (set-keymap-parent overriding-terminal-local-map keymap)
-      (if (current-local-map)
-          (define-key overriding-terminal-local-map [menu-bar]
-            (lookup-key (current-local-map) [menu-bar])))
-      (unwind-protect
-          (progn
-            (use-global-map temp-global-map)
-            (clear-this-command-keys)
-            (with-temp-message prompt
-              (read-key-sequence nil)))
-        (use-global-map old-global-map)
-        (if timer (cancel-timer timer))))))
-
-(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)
-  (block nil
-    (while (popup-live-p menu)
-      (and isearch
-           (popup-isearch menu
-                          :cursor-color isearch-cursor-color
-                          :keymap isearch-keymap
-                          :callback isearch-callback
-                          :help-delay help-delay)
-           (keyboard-quit))
-      (setq key (popup-menu-read-key-sequence keymap prompt help-delay))
-      (if (null key)
-          (unless (funcall popup-menu-show-quick-help-function menu nil :prompt prompt)
-            (clear-this-command-keys)
-            (push (read-event prompt) unread-command-events))
-        (if (eq (lookup-key (current-global-map) key) 'keyboard-quit)
-            (keyboard-quit))
-        (setq binding (lookup-key keymap key))
-        (cond
-         ((eq binding 'popup-close)
-          (if (popup-parent menu)
-              (return)))
-         ((memq binding '(popup-select popup-open))
-          (let* ((item (popup-selected-item menu))
-                 (sublist (popup-item-sublist item)))
-            (if sublist
-                (popup-aif (popup-cascade-menu sublist
-                                               :around nil
-                                               :parent menu
-                                               :margin-left (popup-margin-left menu)
-                                               :margin-right (popup-margin-right menu)
-                                               :scroll-bar (popup-scroll-bar menu))
-                    (and it (return it)))
-              (if (eq binding 'popup-select)
-                  (return (popup-item-value-or-self item))))))
-         ((eq binding 'popup-next)
-          (popup-next menu))
-         ((eq binding 'popup-previous)
-          (popup-previous menu))
-         ((eq binding 'popup-help)
-          (popup-menu-show-help menu))
-         ((eq binding 'popup-isearch)
-          (popup-isearch menu
-                         :cursor-color isearch-cursor-color
-                         :keymap isearch-keymap
-                         :callback isearch-callback
-                         :help-delay help-delay))
-         ((commandp binding)
-          (call-interactively binding))
-         (t
-          (funcall fallback key (key-binding key))))))))
-
-;; popup-menu is used by mouse.el unfairly...
-(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
-                     prompt
-                     isearch
-                     (isearch-cursor-color popup-isearch-cursor-color)
-                     (isearch-keymap popup-isearch-keymap)
-                     isearch-callback
-                     &aux menu event)
-  (and (eq margin t) (setq margin 1))
-  (or margin-left (setq margin-left margin))
-  (or margin-right (setq margin-right margin))
-  (if (and scroll-bar
-           (integerp margin-right)
-           (> margin-right 0))
-      ;; Make scroll-bar space as margin-right
-      (decf margin-right))
-  (setq menu (popup-create point width height
-                           :around around
-                           :face 'popup-menu-face
-                           :selection-face 'popup-menu-selection-face
-                           :margin-left margin-left
-                           :margin-right margin-right
-                           :scroll-bar scroll-bar
-                           :symbol symbol
-                           :parent parent))
-  (unwind-protect
-      (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)))
-
-(defun popup-cascade-menu (list &rest args)
-  "Same to `popup-menu', but an element of `LIST' can be
-list of submenu."
-  (apply 'popup-menu*
-         (mapcar (lambda (item)
-                   (if (consp item)
-                       (popup-make-item (car item)
-                                        :sublist (cdr item)
-                                        :symbol ">")
-                     item))
-                 list)
-         :symbol t
-         args))
-
-(defvar popup-menu-keymap
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\r"        'popup-select)
-    (define-key map "\C-f"      'popup-open)
-    (define-key map [right]     'popup-open)
-    (define-key map "\C-b"      'popup-close)
-    (define-key map [left]      'popup-close)
-
-    (define-key map "\C-n"      'popup-next)
-    (define-key map [down]      'popup-next)
-    (define-key map "\C-p"      'popup-previous)
-    (define-key map [up]        'popup-previous)
-
-    (define-key map [f1]        'popup-help)
-    (define-key map (kbd "\C-?") 'popup-help)
-
-    (define-key map "\C-s"      'popup-isearch)
-    map))
-
-(provide 'popup)
-;;; popup.el ends here
-- 
cgit v1.2.3-54-g00ecf