From 3640edd02ec1507911e08e404b5b66774879dbd9 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Wed, 15 Jul 2015 08:04:55 +0200 Subject: [PATCH] new version of popup. --- bba.org | 2 +- elpa/popup-20140207.1702/popup-pkg.el | 1 - .../popup-autoloads.el | 7 +- elpa/popup-20150626.711/popup-pkg.el | 1 + .../popup.el | 134 ++++++++++-------- 5 files changed, 76 insertions(+), 69 deletions(-) delete mode 100644 elpa/popup-20140207.1702/popup-pkg.el rename elpa/{popup-20140207.1702 => popup-20150626.711}/popup-autoloads.el (62%) create mode 100644 elpa/popup-20150626.711/popup-pkg.el rename elpa/{popup-20140207.1702 => popup-20150626.711}/popup.el (93%) diff --git a/bba.org b/bba.org index 23a0cf66..ad68294b 100644 --- a/bba.org +++ b/bba.org @@ -111,7 +111,7 @@ Keep track of your important stuff! (if (>= emacs-major-version 24) (progn (add-to-list 'load-path "~/.emacs.d/elpa") - (add-to-list 'load-path "~/.emacs.d/elpa/popup-20140207.1702") + (add-to-list 'load-path "~/.emacs.d/elpa/popup-20150626.711") (require 'package) (package-initialize) (add-to-list 'package-archives '("melpa" . "http://melpa.org/packages/") t) diff --git a/elpa/popup-20140207.1702/popup-pkg.el b/elpa/popup-20140207.1702/popup-pkg.el deleted file mode 100644 index 79df43d3..00000000 --- a/elpa/popup-20140207.1702/popup-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "popup" "20140207.1702" "Visual Popup User Interface" (quote ((cl-lib "0.3")))) diff --git a/elpa/popup-20140207.1702/popup-autoloads.el b/elpa/popup-20150626.711/popup-autoloads.el similarity index 62% rename from elpa/popup-20140207.1702/popup-autoloads.el rename to elpa/popup-20150626.711/popup-autoloads.el index 3e3220f7..a5b5b884 100644 --- a/elpa/popup-20140207.1702/popup-autoloads.el +++ b/elpa/popup-20150626.711/popup-autoloads.el @@ -1,18 +1,15 @@ ;;; popup-autoloads.el --- automatically extracted autoloads ;; ;;; Code: - +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil nil ("popup-pkg.el" "popup.el") (21446 8667 -;;;;;; 508939 0)) +;;;### (autoloads nil nil ("popup.el") (21908 14202 623366 0)) ;;;*** -(provide 'popup-autoloads) ;; Local Variables: ;; version-control: never ;; no-byte-compile: t ;; no-update-autoloads: t -;; coding: utf-8 ;; End: ;;; popup-autoloads.el ends here diff --git a/elpa/popup-20150626.711/popup-pkg.el b/elpa/popup-20150626.711/popup-pkg.el new file mode 100644 index 00000000..f28de5ec --- /dev/null +++ b/elpa/popup-20150626.711/popup-pkg.el @@ -0,0 +1 @@ +(define-package "popup" "20150626.711" "Visual Popup User Interface" '((cl-lib "0.3")) :keywords '("lisp")) diff --git a/elpa/popup-20140207.1702/popup.el b/elpa/popup-20150626.711/popup.el similarity index 93% rename from elpa/popup-20140207.1702/popup.el rename to elpa/popup-20150626.711/popup.el index 28778543..74369801 100644 --- a/elpa/popup-20140207.1702/popup.el +++ b/elpa/popup-20150626.711/popup.el @@ -1,11 +1,11 @@ ;;; popup.el --- Visual Popup User Interface -;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Tomohiro Matsuyama +;; Copyright (C) 2009-2015 Tomohiro Matsuyama -;; Author: Tomohiro Matsuyama +;; Author: Tomohiro Matsuyama ;; Keywords: lisp -;; Version: 20140207.1702 -;; X-Original-Version: 0.5.0 +;; Package-Version: 20150626.711 +;; Version: 0.5.3 ;; Package-Requires: ((cl-lib "0.3")) ;; This program is free software; you can redistribute it and/or modify @@ -32,7 +32,7 @@ (require 'cl-lib) -(defconst popup-version "0.5.0") +(defconst popup-version "0.5.3") @@ -149,34 +149,6 @@ untouched." (progn ,@body) (set-buffer-modified-p modified))))) -(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))))))) - -(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) - (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 () - "Return the 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-vertical-motion (column direction) "A portable version of `vertical-motion'." (if (>= emacs-major-version 23) @@ -244,7 +216,7 @@ buffer." face mouse-face selection-face summary-face margin-left margin-right margin-left-cancel scroll-bar symbol cursor offset scroll-top current-height list newlines - pattern original-list) + pattern original-list invis-overlays) (defun popup-item-propertize (item &rest properties) "Same as `propertize' except that this avoids overriding @@ -407,16 +379,15 @@ usual." (put-text-property start (length content) 'face face content)) (when mouse-face (put-text-property 0 (length content) 'mouse-face mouse-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)))) + (let ((prop (if (overlay-get overlay 'dangle) + 'after-string + 'display))) + (overlay-put overlay + prop + (concat prefix + content + scroll-bar-char + postfix))))) (cl-defun popup-create-line-string (popup string @@ -538,8 +509,9 @@ KEYMAP is a keymap that will be put on the popup contents." (setq width (min width (popup-calculate-max-width max-width)))) (save-excursion (goto-char point) - (let* ((row (line-number-at-pos)) - (column (popup-current-physical-column)) + (let* ((col-row (posn-col-row (posn-at-point))) + (row (cdr col-row)) + (column (car col-row)) (overlays (make-vector height nil)) (popup-width (+ width (if scroll-bar 1 0) @@ -564,6 +536,7 @@ KEYMAP is a keymap that will be put on the popup contents." (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)))) + invis-overlays current-column) ;; Case: no newlines at the end of the buffer (when (> newlines 0) @@ -597,17 +570,27 @@ KEYMAP is a keymap that will be put on the popup contents." (let (overlay begin w (dangle t) (prefix "") (postfix "")) (when around (popup-vertical-motion column direction)) - (setq around t - current-column (popup-current-physical-column)) + (cl-loop for ov in (overlays-in (save-excursion + (beginning-of-visual-line) + (point)) + (save-excursion + (end-of-visual-line) + (point))) + when (and (not (overlay-get ov 'popup)) + (not (overlay-get ov 'popup-item)) + (or (overlay-get ov 'invisible) + (overlay-get ov 'display))) + do (progn + (push (list ov (overlay-get ov 'display)) invis-overlays) + (overlay-put ov 'display ""))) + (setq around t) + (setq current-column (car (posn-col-row (posn-at-point)))) - (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)) + (- window-hscroll current-column) 0) (- column current-column)) ? ))) @@ -622,14 +605,15 @@ KEYMAP is a keymap that will be put on the popup contents." (setq postfix (make-string (- w) ? ))) (setq overlay (make-overlay begin (point))) + (overlay-put overlay 'popup t) (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))) + (if (> direction 0) i (- height i 1)) + overlay))) (cl-loop for p from (- 10000 (* depth 1000)) for overlay in (nreverse (append overlays nil)) do (overlay-put overlay 'priority p)) @@ -658,6 +642,7 @@ KEYMAP is a keymap that will be put on the popup contents." :list nil :newlines newlines :overlays overlays + :invis-overlays invis-overlays :keymap keymap))) (push it popup-instances) it)))) @@ -675,12 +660,16 @@ KEYMAP is a keymap that will be put on the popup contents." (popup-save-buffer-state (goto-char (point-max)) (dotimes (i newlines) - (if (= (char-before) ?\n) + (if (and (char-before) + (= (char-before) ?\n)) (delete-char -1))))))) nil) (defun popup-draw (popup) "Draw POPUP." + (cl-loop for (ov olddisplay) in (popup-invis-overlays popup) + do (overlay-put ov 'display "")) + (cl-loop with height = (popup-height popup) with min-height = (popup-min-height popup) with popup-face = (popup-face popup) @@ -779,6 +768,8 @@ KEYMAP is a keymap that will be put on the popup contents." (defun popup-hide (popup) "Hide POPUP." + (cl-loop for (ov olddisplay) in (popup-invis-overlays popup) + do (overlay-put ov 'display olddisplay)) (dotimes (i (popup-height popup)) (popup-hide-line popup i))) @@ -928,11 +919,11 @@ Pages up through POPUP." (propertize pattern 'face 'isearch-fail) pattern))) -(defun popup-isearch-update (popup pattern &optional callback) +(defun popup-isearch-update (popup filter 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)))) + (let ((list (funcall filter pattern (popup-original-list popup)))) (popup-set-filtered-list popup list) (if callback (funcall callback list))) @@ -940,6 +931,7 @@ Pages up through POPUP." (cl-defun popup-isearch (popup &key + (filter 'popup-isearch-filter-list) (cursor-color popup-isearch-cursor-color) (keymap popup-isearch-keymap) callback @@ -947,6 +939,8 @@ Pages up through POPUP." "Start isearch on POPUP. This function is synchronized, meaning event loop waits for quiting of isearch. +FILTER is function with two argumenst to perform popup items filtering. + CURSOR-COLOR is a cursor color during isearch. The default value is `popup-isearch-cursor-color'. @@ -981,10 +975,10 @@ HELP-DELAY is a delay of displaying helps." ((eq binding 'popup-isearch-done) (cl-return nil)) ((eq binding 'popup-isearch-cancel) - (popup-isearch-update popup "" callback) + (popup-isearch-update popup filter "" callback) (cl-return t)) ((eq binding 'popup-isearch-close) - (popup-isearch-update popup "" callback) + (popup-isearch-update popup filter "" callback) (setq unread-command-events (append (listify-key-sequence key) unread-command-events)) (cl-return nil)) @@ -995,7 +989,7 @@ HELP-DELAY is a delay of displaying helps." (setq unread-command-events (append (listify-key-sequence key) unread-command-events)) (cl-return nil))) - (popup-isearch-update popup pattern callback)))) + (popup-isearch-update popup filter pattern callback)))) (if old-cursor-color (set-cursor-color old-cursor-color))))) @@ -1186,6 +1180,7 @@ PROMPT is a prompt string when reading events during event loop." prompt help-delay isearch + isearch-filter isearch-cursor-color isearch-keymap isearch-callback @@ -1194,6 +1189,7 @@ PROMPT is a prompt string when reading events during event loop." (while (popup-live-p menu) (and isearch (popup-isearch menu + :filter isearch-filter :cursor-color isearch-cursor-color :keymap isearch-keymap :callback isearch-callback @@ -1229,6 +1225,7 @@ PROMPT is a prompt string when reading events during event loop." :parent-offset index :help-delay help-delay :isearch isearch + :isearch-filter isearch-filter :isearch-cursor-color isearch-cursor-color :isearch-keymap isearch-keymap :isearch-callback isearch-callback)) @@ -1247,6 +1244,7 @@ PROMPT is a prompt string when reading events during event loop." (popup-menu-show-help menu)) ((eq binding 'popup-isearch) (popup-isearch menu + :filter 'isearch-filter :cursor-color isearch-cursor-color :keymap isearch-keymap :callback isearch-callback @@ -1315,14 +1313,16 @@ PROMPT is a prompt string when reading events during event loop." nowait prompt isearch + (isearch-filter 'popup-isearch-filter-list) (isearch-cursor-color popup-isearch-cursor-color) (isearch-keymap popup-isearch-keymap) isearch-callback + initial-index &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, -ISEARCH, ISEARCH-CURSOR-COLOR, ISEARCH-KEYMAP, and +ISEARCH, ISEARCH-FILTER, ISEARCH-CURSOR-COLOR, ISEARCH-KEYMAP, and ISEARCH-CALLBACK. If KEYMAP is a keymap which is used when processing events during @@ -1343,6 +1343,9 @@ 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-FILTER is a filtering function taking two arguments: +search pattern and list of items. Returns a list of matching items. + ISEARCH-CURSOR-COLOR is a cursor color during isearch. The default value is `popup-isearch-cursor-color'. @@ -1351,7 +1354,10 @@ 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." +isearch canceled. The arguments is whole filtered list of items. + +If `INITIAL-INDEX' is non-nil, this is an initial index value for +`popup-select'. Only positive integer is valid." (and (eq margin t) (setq margin 1)) (or margin-left (setq margin-left margin)) (or margin-right (setq margin-right margin)) @@ -1379,12 +1385,16 @@ isearch canceled. The arguments is whole filtered list of items." (if cursor (popup-jump menu cursor) (popup-draw menu)) + (when initial-index + (dotimes (_i (min (- (length list) 1) initial-index)) + (popup-next menu))) (if nowait menu (popup-menu-event-loop menu keymap fallback :prompt prompt :help-delay help-delay :isearch isearch + :isearch-filter isearch-filter :isearch-cursor-color isearch-cursor-color :isearch-keymap isearch-keymap :isearch-callback isearch-callback))) -- 2.47.3