From c02ec730101184481d90df143524c88801a5b015 Mon Sep 17 00:00:00 2001 From: TAKAGI Kentaro Date: Wed, 4 Jun 2014 10:42:14 +0900 Subject: [PATCH 1/2] Apply the patch of #8. --- popup.el | 65 ++++++++++++++++++++++++-------------------------------- 1 file changed, 28 insertions(+), 37 deletions(-) diff --git a/popup.el b/popup.el index c79b7ff..fc43704 100644 --- a/popup.el +++ b/popup.el @@ -148,34 +148,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) @@ -243,7 +215,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 @@ -537,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) @@ -563,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) @@ -596,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)) ? ))) @@ -621,6 +605,7 @@ 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) @@ -657,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)))) @@ -680,6 +666,9 @@ KEYMAP is a keymap that will be put on the popup contents." (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) @@ -778,6 +767,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))) From a3d1bfd549a922aa00a362aa4501a3bb494e66d5 Mon Sep 17 00:00:00 2001 From: TAKAGI Kentaro Date: Sat, 30 Aug 2014 00:23:15 +0900 Subject: [PATCH 2/2] Fix test. --- tests/popup-test.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/tests/popup-test.el b/tests/popup-test.el index bfc19c7..caf22b4 100644 --- a/tests/popup-test.el +++ b/tests/popup-test.el @@ -5,6 +5,11 @@ (when (< (frame-width) (length "long long long long line")) (set-frame-size (selected-frame) 80 35)) +(defun popup-test-helper-posn-col-row (dummy) + "This function is workaround. Because `posn-col-row' and `posn-at-point' +can not work well in batch mode." + (cons (current-column) (line-number-at-pos (point)))) + (defmacro popup-test-with-common-setup (&rest body) (declare (indent 0) (debug t)) `(save-excursion @@ -12,8 +17,11 @@ (switch-to-buffer (current-buffer)) (delete-other-windows) (erase-buffer) - ,@body - ))) + (if noninteractive + (cl-letf (((symbol-function 'posn-col-row) + #'popup-test-helper-posn-col-row)) + ,@body) + ,@body)))) (defun popup-test-helper-line-move-visual (arg) "This function is workaround. Because `line-move-visual' can not work well in