Commit c02ec730 authored by TAKAGI Kentaro's avatar TAKAGI Kentaro

Apply the patch of #8.

parent 5374e558
......@@ -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)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment