Mercurial > emacs
comparison lisp/term/sun-mouse.el @ 49599:5ade352e8d1c
Trailing whitespace deleted.
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Tue, 04 Feb 2003 13:30:45 +0000 |
parents | be541feb06cc |
children | 695cf19ef79e d7ddb3e565de |
comparison
equal
deleted
inserted
replaced
49598:0d8b17d428b5 | 49599:5ade352e8d1c |
---|---|
29 ;; Original idea by Stan Jefferson | 29 ;; Original idea by Stan Jefferson |
30 | 30 |
31 ;; Modeled after the GNUEMACS keymap interface. | 31 ;; Modeled after the GNUEMACS keymap interface. |
32 ;; | 32 ;; |
33 ;; User Functions: | 33 ;; User Functions: |
34 ;; make-mousemap, copy-mousemap, | 34 ;; make-mousemap, copy-mousemap, |
35 ;; define-mouse, global-set-mouse, local-set-mouse, | 35 ;; define-mouse, global-set-mouse, local-set-mouse, |
36 ;; use-global-mousemap, use-local-mousemap, | 36 ;; use-global-mousemap, use-local-mousemap, |
37 ;; mouse-lookup, describe-mouse-bindings | 37 ;; mouse-lookup, describe-mouse-bindings |
38 ;; | 38 ;; |
39 ;; Options: | 39 ;; Options: |
195 (defmacro eval-in-windows (form &optional yesmini) | 195 (defmacro eval-in-windows (form &optional yesmini) |
196 "Switches to each window and evaluates FORM. Optional argument | 196 "Switches to each window and evaluates FORM. Optional argument |
197 YESMINI says to include the minibuffer as a window. | 197 YESMINI says to include the minibuffer as a window. |
198 This is a macro, and does not evaluate its arguments." | 198 This is a macro, and does not evaluate its arguments." |
199 `(let ((OriginallySelectedWindow (selected-window))) | 199 `(let ((OriginallySelectedWindow (selected-window))) |
200 (unwind-protect | 200 (unwind-protect |
201 (while (progn | 201 (while (progn |
202 ,form | 202 ,form |
203 (not (eq OriginallySelectedWindow | 203 (not (eq OriginallySelectedWindow |
204 (select-window | 204 (select-window |
205 (next-window nil ,yesmini)))))) | 205 (next-window nil ,yesmini)))))) |
230 )) | 230 )) |
231 | 231 |
232 | 232 |
233 (defun sun-mouse-handler (&optional hit) | 233 (defun sun-mouse-handler (&optional hit) |
234 "Evaluates the function or list associated with a mouse hit. | 234 "Evaluates the function or list associated with a mouse hit. |
235 Expecting to read a hit, which is a list: (button x y delta). | 235 Expecting to read a hit, which is a list: (button x y delta). |
236 A form bound to button by define-mouse is found by mouse-lookup. | 236 A form bound to button by define-mouse is found by mouse-lookup. |
237 The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound. | 237 The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound. |
238 If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*, | 238 If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*, |
239 *mouse-x*, and *mouse-y* as arguments; if the form is a list (listp), | 239 *mouse-x*, and *mouse-y* as arguments; if the form is a list (listp), |
240 the form is eval'ed; if the form is neither of these, it is an error. | 240 the form is eval'ed; if the form is neither of these, it is an error. |
241 Returns nil." | 241 Returns nil." |
242 (interactive) | 242 (interactive) |
248 (mouse-code (mouse-event-code hit loc))) | 248 (mouse-code (mouse-event-code hit loc))) |
249 (let ((form (eval-in-buffer (window-buffer *mouse-window*) | 249 (let ((form (eval-in-buffer (window-buffer *mouse-window*) |
250 (mouse-lookup mouse-code)))) | 250 (mouse-lookup mouse-code)))) |
251 (cond ((null form) | 251 (cond ((null form) |
252 (if (not (sm::hit-up-p hit)) ; undefined up hits are ok. | 252 (if (not (sm::hit-up-p hit)) ; undefined up hits are ok. |
253 (error "Undefined mouse event: %s" | 253 (error "Undefined mouse event: %s" |
254 (prin1-to-string | 254 (prin1-to-string |
255 (mouse-code-to-mouse-list mouse-code))))) | 255 (mouse-code-to-mouse-list mouse-code))))) |
256 ((symbolp form) | 256 ((symbolp form) |
257 (setq this-command form) | 257 (setq this-command form) |
258 (funcall form *mouse-window* *mouse-x* *mouse-y*)) | 258 (funcall form *mouse-window* *mouse-x* *mouse-y*)) |
259 ((listp form) | 259 ((listp form) |
274 (let ((hit1 (mouse-hit-read))) | 274 (let ((hit1 (mouse-hit-read))) |
275 (if (not (sm::hit-up-p hit1)) ; Up hits don't start doubles or chords. | 275 (if (not (sm::hit-up-p hit1)) ; Up hits don't start doubles or chords. |
276 (let ((hit2 (mouse-second-hit extra-click-wait))) | 276 (let ((hit2 (mouse-second-hit extra-click-wait))) |
277 (if hit2 ; we cons'd it, we can smash it. | 277 (if hit2 ; we cons'd it, we can smash it. |
278 ; (setf (sm::hit-code hit1) (logior (sm::hit-code hit1) ...)) | 278 ; (setf (sm::hit-code hit1) (logior (sm::hit-code hit1) ...)) |
279 (setcar hit1 (logior (sm::hit-code hit1) | 279 (setcar hit1 (logior (sm::hit-code hit1) |
280 (sm::hit-code hit2) | 280 (sm::hit-code hit2) |
281 (if (= (sm::hit-button hit1) | 281 (if (= (sm::hit-button hit1) |
282 (sm::hit-button hit2)) | 282 (sm::hit-button hit2)) |
283 sm::DoubleBits 0)))))) | 283 sm::DoubleBits 0)))))) |
284 hit1)) | 284 hit1)) |
285 | 285 |
286 (defun mouse-hit-read () | 286 (defun mouse-hit-read () |
287 "Read mouse-hit list from keyboard. Like (read 'read-char), | 287 "Read mouse-hit list from keyboard. Like (read 'read-char), |
288 but that uses minibuffer, and mucks up last-command." | 288 but that uses minibuffer, and mucks up last-command." |
289 (let ((char-list nil) (char nil)) | 289 (let ((char-list nil) (char nil)) |
290 (while (not (equal 13 ; Carriage return. | 290 (while (not (equal 13 ; Carriage return. |
291 (prog1 (setq char (read-char)) | 291 (prog1 (setq char (read-char)) |
292 (setq char-list (cons char char-list)))))) | 292 (setq char-list (cons char char-list)))))) |
293 (read (mapconcat 'char-to-string (nreverse char-list) "")) | 293 (read (mapconcat 'char-to-string (nreverse char-list) "")) |
294 )) | 294 )) |
295 | 295 |
296 ;;; Second Click Hackery.... | 296 ;;; Second Click Hackery.... |
337 (defun sm::window-xy (x y) | 337 (defun sm::window-xy (x y) |
338 "Find window containing screen coordinates X and Y. | 338 "Find window containing screen coordinates X and Y. |
339 Returns list (window x y) where x and y are relative to window." | 339 Returns list (window x y) where x and y are relative to window." |
340 (or | 340 (or |
341 (catch 'found | 341 (catch 'found |
342 (eval-in-windows | 342 (eval-in-windows |
343 (let ((we (window-edges (selected-window)))) | 343 (let ((we (window-edges (selected-window)))) |
344 (let ((le (nth 0 we)) | 344 (let ((le (nth 0 we)) |
345 (te (nth 1 we)) | 345 (te (nth 1 we)) |
346 (re (nth 2 we)) | 346 (re (nth 2 we)) |
347 (be (nth 3 we))) | 347 (be (nth 3 we))) |
353 ;; id est, if window is not multiple of char size. | 353 ;; id est, if window is not multiple of char size. |
354 (setq be (1+ be))) | 354 (setq be (1+ be))) |
355 | 355 |
356 (if (and (>= x le) (< x re) | 356 (if (and (>= x le) (< x re) |
357 (>= y te) (< y be)) | 357 (>= y te) (< y be)) |
358 (throw 'found | 358 (throw 'found |
359 (list (selected-window) (- x le) (- y te)))))) | 359 (list (selected-window) (- x le) (- y te)))))) |
360 t)) ; include minibuffer in eval-in-windows | 360 t)) ; include minibuffer in eval-in-windows |
361 ;;If x,y from a real mouse click, we shouldn't get here. | 361 ;;If x,y from a real mouse click, we shouldn't get here. |
362 (list nil x y) | 362 (list nil x y) |
363 )) | 363 )) |
388 | 388 |
389 ;;; | 389 ;;; |
390 ;;; The encoding of mouse events into a mousemap. | 390 ;;; The encoding of mouse events into a mousemap. |
391 ;;; These values must agree with coding in emacstool: | 391 ;;; These values must agree with coding in emacstool: |
392 ;;; | 392 ;;; |
393 (defconst sm::keyword-alist | 393 (defconst sm::keyword-alist |
394 '((left . 1) (middle . 2) (right . 4) | 394 '((left . 1) (middle . 2) (right . 4) |
395 (shift . 8) (control . 16) (meta . 32) (double . 64) (up . 128) | 395 (shift . 8) (control . 16) (meta . 32) (double . 64) (up . 128) |
396 (text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048) | 396 (text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048) |
397 )) | 397 )) |
398 | 398 |
590 of MENU. MENU (or its symbol-value) should be a menu defined by defmenu. | 590 of MENU. MENU (or its symbol-value) should be a menu defined by defmenu. |
591 A menu ITEM is a (STRING . FORM) pair; | 591 A menu ITEM is a (STRING . FORM) pair; |
592 the FORM associated with the selected STRING is evaluated, | 592 the FORM associated with the selected STRING is evaluated, |
593 and the resulting value is returned. Generally these FORMs are | 593 and the resulting value is returned. Generally these FORMs are |
594 evaluated for their side-effects rather than their values. | 594 evaluated for their side-effects rather than their values. |
595 If the selected form is a menu or a symbol whose value is a menu, | 595 If the selected form is a menu or a symbol whose value is a menu, |
596 then it is displayed and evaluated as a pullright menu item. | 596 then it is displayed and evaluated as a pullright menu item. |
597 If the FORM of the first ITEM is nil, the STRING of the item | 597 If the FORM of the first ITEM is nil, the STRING of the item |
598 is used as a label for the menu, i.e. it's inverted and not selectable." | 598 is used as a label for the menu, i.e. it's inverted and not selectable." |
599 | 599 |
600 (if (symbolp menu) (setq menu (symbol-value menu))) | 600 (if (symbolp menu) (setq menu (symbol-value menu))) |
601 (eval (sun-menu-internal *menu-window* *menu-x* *menu-y* 4 menu))) | 601 (eval (sun-menu-internal *menu-window* *menu-x* *menu-y* 4 menu))) |
602 | 602 |
603 (defun sun-get-frame-data (code) | 603 (defun sun-get-frame-data (code) |
604 "Sends the tty-sub-window escape sequence CODE to terminal, | 604 "Sends the tty-sub-window escape sequence CODE to terminal, |
605 and returns a cons of the two numbers in returned escape sequence. | 605 and returns a cons of the two numbers in returned escape sequence. |
606 That is it returns (cons <car> <cdr>) from \"\\E[n;<car>;<cdr>t\". | 606 That is it returns (cons <car> <cdr>) from \"\\E[n;<car>;<cdr>t\". |
607 CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars." | 607 CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars." |
608 (send-string-to-terminal (concat "\033[" (int-to-string code) "t")) | 608 (send-string-to-terminal (concat "\033[" (int-to-string code) "t")) |
609 (let (char str x y) | 609 (let (char str x y) |
610 (while (not (equal 116 (setq char (read-char)))) ; #\t = 116 | 610 (while (not (equal 116 (setq char (read-char)))) ; #\t = 116 |
611 (setq str (cons char str))) | 611 (setq str (cons char str))) |
621 "Returns font size in pixels: (cons Ysize Xsize)" | 621 "Returns font size in pixels: (cons Ysize Xsize)" |
622 (let ((pix (sun-get-frame-data 14)) ; returns size in pixels | 622 (let ((pix (sun-get-frame-data 14)) ; returns size in pixels |
623 (chr (sun-get-frame-data 18))) ; returns size in chars | 623 (chr (sun-get-frame-data 18))) ; returns size in chars |
624 (cons (/ (car pix) (car chr)) (/ (cdr pix) (cdr chr))))) | 624 (cons (/ (car pix) (car chr)) (/ (cdr pix) (cdr chr))))) |
625 | 625 |
626 (defvar sm::menu-kludge-x nil | 626 (defvar sm::menu-kludge-x nil |
627 "Cached frame-to-window X-Offset for sm::menu-kludge") | 627 "Cached frame-to-window X-Offset for sm::menu-kludge") |
628 (defvar sm::menu-kludge-y nil | 628 (defvar sm::menu-kludge-y nil |
629 "Cached frame-to-window Y-Offset for sm::menu-kludge") | 629 "Cached frame-to-window Y-Offset for sm::menu-kludge") |
630 | 630 |
631 (defun sm::menu-kludge () | 631 (defun sm::menu-kludge () |
632 "If sunfns.c uses <Menu_Base_Kludge> this function must be here!" | 632 "If sunfns.c uses <Menu_Base_Kludge> this function must be here!" |
633 (or sm::menu-kludge-y | 633 (or sm::menu-kludge-y |
659 ;;; This closes the window instead of stopping emacs. | 659 ;;; This closes the window instead of stopping emacs. |
660 ;;; | 660 ;;; |
661 (defun suspend-emacstool (&optional stuffstring) | 661 (defun suspend-emacstool (&optional stuffstring) |
662 "Suspend emacstool. | 662 "Suspend emacstool. |
663 If running under as a detached process emacstool, | 663 If running under as a detached process emacstool, |
664 you don't want to suspend (there is no way to resume), | 664 you don't want to suspend (there is no way to resume), |
665 just close the window, and wait for reopening." | 665 just close the window, and wait for reopening." |
666 (interactive) | 666 (interactive) |
667 (run-hooks 'suspend-hook) | 667 (run-hooks 'suspend-hook) |
668 (if stuffstring (send-string-to-terminal stuffstring)) | 668 (if stuffstring (send-string-to-terminal stuffstring)) |
669 (send-string-to-terminal "\033[2t") ; To close EmacsTool window. | 669 (send-string-to-terminal "\033[2t") ; To close EmacsTool window. |