diff options
| author | Richard M. Stallman | 1997-05-17 18:38:17 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1997-05-17 18:38:17 +0000 |
| commit | 4f76fb9ac47f2e8b5259da1677922cb4b96e1e4c (patch) | |
| tree | 419601ebb3771e7faa21396b0ebdaa1f8eafd364 | |
| parent | 0303e8da31e6456f62a51ea0718ef0e7d3b0ad1d (diff) | |
| download | emacs-4f76fb9ac47f2e8b5259da1677922cb4b96e1e4c.tar.gz emacs-4f76fb9ac47f2e8b5259da1677922cb4b96e1e4c.zip | |
(event-closest-point): New function.
(event-closest-point-1): New subroutine.
(mouse-event-p, button-event-p): New functions.
| -rw-r--r-- | lisp/emacs-lisp/levents.el | 55 |
1 files changed, 55 insertions, 0 deletions
diff --git a/lisp/emacs-lisp/levents.el b/lisp/emacs-lisp/levents.el index bc5c06c9cbc..ed12511f322 100644 --- a/lisp/emacs-lisp/levents.el +++ b/lisp/emacs-lisp/levents.el | |||
| @@ -73,6 +73,21 @@ In this emulation, it returns nil." | |||
| 73 | (or (memq 'click (get (car obj) 'event-symbol-elements)) | 73 | (or (memq 'click (get (car obj) 'event-symbol-elements)) |
| 74 | (memq 'drag (get (car obj) 'event-symbol-elements))))) | 74 | (memq 'drag (get (car obj) 'event-symbol-elements))))) |
| 75 | 75 | ||
| 76 | (defun button-event-p (obj) | ||
| 77 | "True if the argument is a mouse-button press or release event object." | ||
| 78 | (and (consp obj) (symbolp (car obj)) | ||
| 79 | (or (memq 'click (get (car obj) 'event-symbol-elements)) | ||
| 80 | (memq 'down (get (car obj) 'event-symbol-elements)) | ||
| 81 | (memq 'drag (get (car obj) 'event-symbol-elements))))) | ||
| 82 | |||
| 83 | (defun mouse-event-p (obj) | ||
| 84 | "True if the argument is a mouse-button press or release event object." | ||
| 85 | (and (consp obj) (symbolp (car obj)) | ||
| 86 | (or (eq (car obj) 'mouse-movement) | ||
| 87 | (memq 'click (get (car obj) 'event-symbol-elements)) | ||
| 88 | (memq 'down (get (car obj) 'event-symbol-elements)) | ||
| 89 | (memq 'drag (get (car obj) 'event-symbol-elements))))) | ||
| 90 | |||
| 76 | (defun character-to-event (ch &optional event) | 91 | (defun character-to-event (ch &optional event) |
| 77 | "Converts a numeric ASCII value to an event structure, replete with | 92 | "Converts a numeric ASCII value to an event structure, replete with |
| 78 | bucky bits. The character is the first argument, and the event to fill | 93 | bucky bits. The character is the first argument, and the event to fill |
| @@ -142,6 +157,46 @@ not occur over text, then this returns nil. Otherwise, it returns an index | |||
| 142 | into the buffer visible in the event's window." | 157 | into the buffer visible in the event's window." |
| 143 | (posn-point (event-end event))) | 158 | (posn-point (event-end event))) |
| 144 | 159 | ||
| 160 | ;; Return position of start of line LINE in WINDOW. | ||
| 161 | ;; If LINE is nil, return the last position | ||
| 162 | ;; visible in WINDOW. | ||
| 163 | (defun event-closest-point-1 (window &optional line) | ||
| 164 | (let* ((total (- (window-height window) | ||
| 165 | (if (window-minibuffer-p window) | ||
| 166 | 0 1))) | ||
| 167 | (distance (or line total))) | ||
| 168 | (save-excursion | ||
| 169 | (goto-char (window-start window)) | ||
| 170 | (if (= (vertical-motion distance) distance) | ||
| 171 | (if (not line) | ||
| 172 | (forward-char -1))) | ||
| 173 | (point)))) | ||
| 174 | |||
| 175 | (defun event-closest-point (event &optional start-window) | ||
| 176 | "Return the nearest position to where EVENT ended its motion. | ||
| 177 | This is computed for the window where EVENT's motion started, | ||
| 178 | or for window WINDOW if that is specified." | ||
| 179 | (or start-window (setq start-window (posn-window (event-start event)))) | ||
| 180 | (if (eq start-window (posn-window (event-end event))) | ||
| 181 | (if (eq (event-point event) 'vertical-line) | ||
| 182 | (event-closest-point-1 start-window | ||
| 183 | (cdr (posn-col-row (event-end event)))) | ||
| 184 | (if (eq (event-point event) 'mode-line) | ||
| 185 | (event-closest-point-1 start-window) | ||
| 186 | (event-point event))) | ||
| 187 | ;; EVENT ended in some other window. | ||
| 188 | (let* ((end-w (posn-window (event-end event))) | ||
| 189 | (end-w-top) | ||
| 190 | (w-top (nth 1 (window-edges start-window)))) | ||
| 191 | (setq end-w-top | ||
| 192 | (if (windowp end-w) | ||
| 193 | (nth 1 (window-edges end-w)) | ||
| 194 | (/ (cdr (posn-x-y (event-end event))) | ||
| 195 | ((frame-char-height end-w))))) | ||
| 196 | (if (>= end-w-top w-top) | ||
| 197 | (event-closest-point-1 start-window) | ||
| 198 | (window-start start-window))))) | ||
| 199 | |||
| 145 | (defun event-process (event) | 200 | (defun event-process (event) |
| 146 | "Returns the process of the given process-output event." | 201 | "Returns the process of the given process-output event." |
| 147 | (nth 1 event)) | 202 | (nth 1 event)) |