(long-line-optimizations-p)
(let ((window-line-height (window-line-height))
(maximum-height (* 2 (frame-char-height))))
- (or (and window-line-height
- (> (car window-line-height)
- maximum-height))
- ;; `window-line-height' isn't available.
- ;; Redisplay first and try to ascertain the height
- ;; of the line again.
- (prog1 nil (redisplay t))
- ;; Likewise if the line height still isn't
- ;; available.
- (not (setq window-line-height
- (window-line-height)))
- ;; Actually check the height now.
- (> (car window-line-height)
- maximum-height))))
- (if (catch 'hscrolled-away
- (let ((beg nil) end string y)
- ;; Detect whether or not the window is hscrolled. If it
- ;; is, set beg to the location of the first column
- ;; instead.
- (when (> (window-hscroll) 0)
- (setq y (+ (or (cdr (posn-x-y (posn-at-point)))
- (throw 'hscrolled-away t))
- (window-header-line-height)
- (window-tab-line-height)))
- (let* ((posn (posn-at-x-y 0 y))
- (point (posn-point posn)))
- (setq beg point)))
- ;; Check if lines are being truncated; if so, use the
- ;; character at the end of the window as the end of the
- ;; text to be displayed, as the visual line may extend
- ;; past the window.
- (when (or truncate-lines beg) ; truncate-lines or hscroll.
- (setq y (or y (+ (or (cdr (posn-x-y (posn-at-point)))
- (throw 'hscrolled-away t))
- (window-header-line-height)
- (window-tab-line-height))))
- (let* ((posn (posn-at-x-y (1- (window-width nil t)) y))
- (point (posn-point posn)))
- (setq end point)))
- ;; Now find the rest of the visual line.
- (save-excursion
- (unless beg
- (beginning-of-visual-line)
- (setq beg (point)))
- (unless end
- (end-of-visual-line)
- (setq end (point))))
- ;; Obtain a substring containing the beginning of the
- ;; visual line and the end.
- (setq string (buffer-substring beg end))
- ;; Hack `invisible' properties within the new string.
- ;; Look for each change of the property that is a variable
- ;; name and replace it with its actual value according to
- ;; `buffer-invisibility-spec'.
- (when (listp buffer-invisibility-spec)
- (let ((index 0)
- (property (get-text-property 0
- 'invisible
- string))
- index1 invisible)
- (while index
- ;; Find the end of this text property.
- (setq index1 (next-single-property-change index
- 'invisible
- string))
- ;; Replace the property with whether or not it is
- ;; non-nil.
- (when property
- (setq invisible nil)
- (catch 'invisible
- (dolist (spec buffer-invisibility-spec)
- ;; Process one element of the buffer
- ;; invisibility specification.
- (if (consp spec)
- (when (eq (cdr spec) 't)
- ;; (ATOM . t) makes N invisible if N is
- ;; equal to ATOM or a list containing
- ;; ATOM.
- (when (or (eq (car spec) property)
- (and (listp spec)
- (memq (car spec) invisible)))
- (throw 'invisible (setq invisible t))))
- ;; Otherwise, N is invisible if SPEC is
- ;; equal to N.
- (when (eq spec property)
- (throw 'invisible (setq invisible t))))))
- (put-text-property index (or index1
- (- end beg))
- 'invisible invisible string))
- ;; Set index to that of the next text property and
- ;; continue.
- (setq index index1
- property (and index1
- (get-text-property index1
- 'invisible
- string))))))
- (let ((resize-mini-windows t) difference width
- (message-log-max nil))
- ;; Find the offset of point from beg and display a cursor
- ;; below.
- (setq difference (- (point) beg)
- width (string-pixel-width
- (substring string 0 difference)))
- (message "%s\n%s^" string
- (propertize " "
- 'display (list 'space
- :width (list width)))))
- nil)))))
+ (unless window-line-height
+ ;; `window-line-height' isn't available.
+ ;; Redisplay first and try to ascertain the height
+ ;; of the line again.
+ (redisplay t)
+ (setq window-line-height (window-line-height)))
+ ;; `window-line-height' might still be unavailable.
+ (and window-line-height
+ (> (car window-line-height)
+ maximum-height))))
+ (catch 'hscrolled-away
+ (let ((beg nil) end string y)
+ ;; Detect whether or not the window is hscrolled. If it
+ ;; is, set beg to the location of the first column
+ ;; instead.
+ (when (> (window-hscroll) 0)
+ (setq y (+ (or (cdr (posn-x-y (posn-at-point)))
+ (throw 'hscrolled-away t))
+ (window-header-line-height)
+ (window-tab-line-height)))
+ (let* ((posn (posn-at-x-y 0 y))
+ (point (posn-point posn)))
+ (setq beg point)))
+ ;; Check if lines are being truncated; if so, use the
+ ;; character at the end of the window as the end of the
+ ;; text to be displayed, as the visual line may extend
+ ;; past the window.
+ (when (or truncate-lines beg) ; truncate-lines or hscroll.
+ (setq y (or y (+ (or (cdr (posn-x-y (posn-at-point)))
+ (throw 'hscrolled-away t))
+ (window-header-line-height)
+ (window-tab-line-height))))
+ (let* ((posn (posn-at-x-y (1- (window-width nil t)) y))
+ (point (posn-point posn)))
+ (setq end point)))
+ ;; Now find the rest of the visual line.
+ (save-excursion
+ (unless beg
+ (beginning-of-visual-line)
+ (setq beg (point)))
+ (unless end
+ (end-of-visual-line)
+ (setq end (point))))
+ ;; Obtain a substring containing the beginning of the
+ ;; visual line and the end.
+ (setq string (buffer-substring beg end))
+ ;; Hack `invisible' properties within the new string.
+ ;; Look for each change of the property that is a variable
+ ;; name and replace it with its actual value according to
+ ;; `buffer-invisibility-spec'.
+ (when (listp buffer-invisibility-spec)
+ (let ((index 0)
+ (property (get-text-property 0
+ 'invisible
+ string))
+ index1 invisible)
+ (while index
+ ;; Find the end of this text property.
+ (setq index1 (next-single-property-change index
+ 'invisible
+ string))
+ ;; Replace the property with whether or not it is
+ ;; non-nil.
+ (when property
+ (setq invisible nil)
+ (catch 'invisible
+ (dolist (spec buffer-invisibility-spec)
+ ;; Process one element of the buffer
+ ;; invisibility specification.
+ (if (consp spec)
+ (when (eq (cdr spec) 't)
+ ;; (ATOM . t) makes N invisible if N is
+ ;; equal to ATOM or a list containing
+ ;; ATOM.
+ (when (or (eq (car spec) property)
+ (and (listp spec)
+ (memq (car spec) invisible)))
+ (throw 'invisible (setq invisible t))))
+ ;; Otherwise, N is invisible if SPEC is
+ ;; equal to N.
+ (when (eq spec property)
+ (throw 'invisible (setq invisible t))))))
+ (put-text-property index (or index1
+ (- end beg))
+ 'invisible invisible string))
+ ;; Set index to that of the next text property and
+ ;; continue.
+ (setq index index1
+ property (and index1
+ (get-text-property index1
+ 'invisible
+ string))))))
+ (let ((resize-mini-windows t) difference width
+ (message-log-max nil))
+ ;; Find the offset of point from beg and display a cursor
+ ;; below.
+ (setq difference (- (point) beg)
+ width (string-pixel-width
+ (substring string 0 difference)))
+ (message "%s\n%s^" string
+ (propertize " "
+ 'display (list 'space
+ :width (list width)))))
+ nil))))
(defun touch-screen-drag (event)
"Handle a drag EVENT by setting the region to its new point.
(interactive "e")
(let* ((posn (cadr event)) ; Position of the tool.
(point (posn-point posn)) ; Point of the event.
- ; Window where the tap originated.
+ ;; Window where the tap originated.
(window (nth 1 touch-screen-current-tool))
+ ;; The currently selected window. Used to redisplay within
+ ;; the correct window while scrolling.
+ (old-window (selected-window))
initial-point)
;; Keep dragging.
(with-selected-window window
- ;; Figure out what character to go to. If this posn is
- ;; in the window, go to (posn-point posn). If not,
- ;; then go to the line before either window start or
- ;; window end.
+ ;; Figure out what character to go to. If this posn is in the
+ ;; window, go to (posn-point posn). If not, then go to the line
+ ;; before either window start or window end.
(setq initial-point (point))
- (if (and (eq (posn-window posn) window)
- point (not (eq point initial-point)))
- (let* ((bounds touch-screen-word-select-bounds)
- (initial touch-screen-word-select-initial-word)
- (maybe-select-word (or (not touch-screen-word-select)
- (or (not bounds)
- (> point (cdr bounds))
- (< point (car bounds))))))
- (if (and touch-screen-word-select
- ;; point is now outside the last word selected.
- maybe-select-word
- (not (posn-object posn))
- (when-let* ((char (char-after point))
- (class (char-syntax char)))
- ;; Don't select words if point isn't inside a
- ;; word constituent or similar.
- (or (eq class ?w) (eq class ?_))))
- ;; Determine the confines of the word containing
- ;; POINT.
- (let (word-start word-end)
- (save-excursion
- (goto-char point)
- (forward-word-strictly)
- ;; Set word-end to ZV if there is no word after
- ;; this one.
- (setq word-end (point))
- ;; Now try to move backwards. Set word-start to
- ;; BEGV if this word is there.
- (backward-word-strictly)
- (setq word-start (point)))
- (let ((mark (mark)))
- ;; Extend the region to cover either word-end or
- ;; word-start; whether to goto word-end or
- ;; word-start is subject to the position of the
- ;; mark relative to point.
- (if (< word-start mark)
- ;; The start of the word is behind mark.
- ;; Extend the region towards the start.
- (goto-char word-start)
- ;; Else, go to the end of the word.
- (goto-char word-end))
+ (when (or (not point)
+ (not (eq point initial-point)))
+ (if (and (eq (posn-window posn) window)
+ point
+ ;; point must be visible in the window. If it isn't,
+ ;; the window must be scrolled.
+ (pos-visible-in-window-p point))
+ (let* ((bounds touch-screen-word-select-bounds)
+ (initial touch-screen-word-select-initial-word)
+ (maybe-select-word (or (not touch-screen-word-select)
+ (or (not bounds)
+ (> point (cdr bounds))
+ (< point (car bounds))))))
+ (if (and touch-screen-word-select
+ ;; point is now outside the last word selected.
+ maybe-select-word
+ (not (posn-object posn))
+ (when-let* ((char (char-after point))
+ (class (char-syntax char)))
+ ;; Don't select words if point isn't inside a
+ ;; word constituent or similar.
+ (or (eq class ?w) (eq class ?_))))
+ ;; Determine the confines of the word containing
+ ;; POINT.
+ (let (word-start word-end)
+ (save-excursion
+ (goto-char point)
+ (forward-word-strictly)
+ ;; Set word-end to ZV if there is no word after
+ ;; this one.
+ (setq word-end (point))
+ ;; Now try to move backwards. Set word-start to
+ ;; BEGV if this word is there.
+ (backward-word-strictly)
+ (setq word-start (point)))
+ (let ((mark (mark)))
+ ;; Extend the region to cover either word-end or
+ ;; word-start; whether to goto word-end or
+ ;; word-start is subject to the position of the
+ ;; mark relative to point.
+ (if (< word-start mark)
+ ;; The start of the word is behind mark.
+ ;; Extend the region towards the start.
+ (goto-char word-start)
+ ;; Else, go to the end of the word.
+ (goto-char word-end))
+ ;; If point is less than mark, which is is less
+ ;; than the end of the word that was originally
+ ;; selected, try to keep it selected by moving
+ ;; mark there.
+ (when (and initial (<= (point) mark)
+ (< mark (cdr initial)))
+ (set-mark (cdr initial)))
+ ;; Do the opposite when the converse is true.
+ (when (and initial (>= (point) mark)
+ (> mark (car initial)))
+ (set-mark (car initial))))
+ (if bounds
+ (progn (setcar bounds word-start)
+ (setcdr bounds word-end))
+ (setq touch-screen-word-select-bounds
+ (cons word-start word-end))))
+ (when maybe-select-word
+ (goto-char (posn-point posn))
+ (when initial
;; If point is less than mark, which is is less
;; than the end of the word that was originally
;; selected, try to keep it selected by moving
;; mark there.
- (when (and initial (<= (point) mark)
- (< mark (cdr initial)))
+ (when (and (<= (point) (mark))
+ (< (mark) (cdr initial)))
(set-mark (cdr initial)))
;; Do the opposite when the converse is true.
- (when (and initial (>= (point) mark)
- (> mark (car initial)))
+ (when (and (>= (point) (mark))
+ (> (mark) (car initial)))
(set-mark (car initial))))
- (if bounds
- (progn (setcar bounds word-start)
- (setcdr bounds word-end))
- (setq touch-screen-word-select-bounds
- (cons word-start word-end))))
- (when maybe-select-word
- (goto-char (posn-point posn))
- (when initial
- ;; If point is less than mark, which is is less than
- ;; the end of the word that was originally selected,
- ;; try to keep it selected by moving mark there.
- (when (and (<= (point) (mark))
- (< (mark) (cdr initial)))
- (set-mark (cdr initial)))
- ;; Do the opposite when the converse is true.
- (when (and (>= (point) (mark))
- (> (mark) (car initial)))
- (set-mark (car initial))))
- (setq touch-screen-word-select-bounds nil)))
- ;; Finally, display a preview of the line around point if
- ;; requested by the user.
- (when (and touch-screen-preview-select
- (not (eq (point) initial-point)))
- (touch-screen-preview-select)))
- ;; POSN is outside the window. Scroll accordingly.
- (let ((relative-xy
- (touch-screen-relative-xy posn window)))
- (let ((scroll-conservatively 101))
+ (setq touch-screen-word-select-bounds nil)))
+ ;; Finally, display a preview of the line around point
+ ;; if requested by the user.
+ (when (and touch-screen-preview-select
+ (not (eq (point) initial-point)))
+ (touch-screen-preview-select)))
+ ;; POSN is outside the window. Scroll accordingly.
+ (let* ((relative-xy
+ (touch-screen-relative-xy posn window))
+ (xy (posn-x-y posn))
+ ;; The height of the window's text area.
+ (body-height (window-body-height nil t))
+ ;; This is used to find the character closest to
+ ;; POSN's column at the bottom of the window.
+ (height (- body-height
+ ;; Use the last row of the window, not its
+ ;; last pixel.
+ (frame-char-height)))
+ (midpoint (/ body-height 2))
+ (scroll-conservatively 101))
(cond
- ((< (cdr relative-xy) 0)
+ ((< (cdr relative-xy) midpoint)
+ ;; POSN is before half the window, yet POINT does not
+ ;; exist or is not completely visible within. Scroll
+ ;; downwards.
(ignore-errors
- (goto-char (1- (window-start)))
- (setq touch-screen-word-select-bounds nil))
- (redisplay))
- ((> (cdr relative-xy)
- (let ((edges (window-inside-pixel-edges)))
- (- (nth 3 edges) (cadr edges))))
+ ;; Scroll down by a single line.
+ (scroll-down 1)
+ ;; After scrolling, look up the new posn at EVENT's
+ ;; column and go there.
+ (setq posn (posn-at-x-y (car xy) 0)
+ point (posn-point posn))
+ (if point
+ (goto-char point)
+ ;; If there's no buffer position at that column, go
+ ;; to the window start.
+ (goto-char (window-start)))
+ ;; Display a preview of the line now around point if
+ ;; requested by the user.
+ (when touch-screen-preview-select
+ (touch-screen-preview-select))
+ ;; Select old-window, so that redisplay doesn't
+ ;; display WINDOW as selected if it isn't already.
+ (with-selected-window old-window
+ ;; Now repeat this every `mouse-scroll-delay' until
+ ;; input becomes available, but scroll down a few
+ ;; more lines.
+ (while (sit-for mouse-scroll-delay)
+ ;; Select WINDOW again.
+ (with-selected-window window
+ ;; Keep scrolling down until input becomes
+ ;; available.
+ (scroll-down 4)
+ ;; After scrolling, look up the new posn at
+ ;; EVENT's column and go there.
+ (setq posn (posn-at-x-y (car xy) 0)
+ point (posn-point posn))
+ (if point
+ (goto-char point)
+ ;; If there's no buffer position at that
+ ;; column, go to the window start.
+ (goto-char (window-start)))
+ ;; Display a preview of the line now around
+ ;; point if requested by the user.
+ (when touch-screen-preview-select
+ (touch-screen-preview-select))))))
+ (setq touch-screen-word-select-bounds nil))
+ ((>= (cdr relative-xy) midpoint)
+ ;; Default to scrolling upwards even if POSN is still
+ ;; within the confines of the window. If POINT is
+ ;; partially visible, and the branch above hasn't been
+ ;; taken it must be somewhere at the bottom of the
+ ;; window, so scroll downwards.
(ignore-errors
- (goto-char (1+ (window-end nil t)))
- (setq touch-screen-word-select-bounds nil))
- (redisplay)))
- ;; Finally, display a preview of the line now around point
- ;; if requested by the user.
- (when touch-screen-preview-select
- (touch-screen-preview-select))))))))
+ ;; Scroll up by a single line.
+ (scroll-up 1)
+ ;; After scrolling, look up the new posn at EVENT's
+ ;; column and go there.
+ (setq posn (posn-at-x-y (car xy) height)
+ point (posn-point posn))
+ (if point
+ (goto-char point)
+ ;; If there's no buffer position at that column, go
+ ;; to the window start.
+ (goto-char (window-end nil t)))
+ ;; Display a preview of the line now around point if
+ ;; requested by the user.
+ (when touch-screen-preview-select
+ (touch-screen-preview-select))
+ ;; Select old-window, so that redisplay doesn't
+ ;; display WINDOW as selected if it isn't already.
+ (with-selected-window old-window
+ ;; Now repeat this every `mouse-scroll-delay' until
+ ;; input becomes available, but scroll down a few
+ ;; more lines.
+ (while (sit-for mouse-scroll-delay)
+ ;; Select WINDOW again.
+ (with-selected-window window
+ ;; Keep scrolling down until input becomes
+ ;; available.
+ (scroll-up 4)
+ ;; After scrolling, look up the new posn at
+ ;; EVENT's column and go there.
+ (setq posn (posn-at-x-y (car xy) height)
+ point (posn-point posn))
+ (if point
+ (goto-char point)
+ ;; If there's no buffer position at that
+ ;; column, go to the window start.
+ (goto-char (window-end nil t)))
+ ;; Display a preview of the line now around
+ ;; point if requested by the user.
+ (when touch-screen-preview-select
+ (touch-screen-preview-select))))))))))))))
(defun touch-screen-restart-drag (event)
"Restart dragging to select text.
projects / emacs.git / commitdiff