Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/h-skip-bytec.lsp @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; FILE: h-skip-bytec.lsp
4 ;; SUMMARY: Functions that should not be byte-compiled.
5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: mouse, hypermedia
7 ;;
8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Motorola, Inc., PPG
10 ;;
11 ;; ORIG-DATE: 8-Oct-92 at 17:17:10
12 ;; LAST-MOD: 9-May-95 at 16:18:42 by Bob Weiner
13 ;;
14 ;; This file is part of Hyperbole.
15 ;; Available for use and distribution under the same terms as GNU Emacs.
16 ;;
17 ;; Copyright (C) 1992-1995, Free Software Foundation, Inc.
18 ;; Developed with support from Motorola Inc.
19 ;;
20 ;; DESCRIPTION:
21 ;;
22 ;; DON'T byte-compile this file or its functions may not work.
23 ;; If we knew why they won't work, they wouldn't be in here.
24 ;;
25 ;; DESCRIP-END.
26
27 ;;; ************************************************************************
28 ;;; Public functions
29 ;;; ************************************************************************
30
31 ;;; For some reason, using this in byte-compiled form causes first character
32 ;;; after mouse key depress to be dropped from input queue when running
33 ;;; Emacs under X. The non-byte-compiled form works fine.
34
35 (defun hmouse-set-point (args)
36 "Sets point to Smart Key press/release location given by ARGS.
37 Returns argument list including x and y frame coordinates in characters and
38 lines."
39 (and (car args) (listp (car args)) (setq args (car args)))
40 (if (not hyperb:window-system)
41 (point-marker)
42 (let ((point-args (hmouse-set-point-at args)))
43 (cond (hyperb:xemacs-p
44 (if (eventp current-mouse-event)
45 (copy-event current-mouse-event)))
46 (hyperb:lemacs-p
47 (cond ((and (fboundp 'mouse-position)
48 ;; mouse-position returns nil coords when not over
49 ;; existing text within a window, so we can only use
50 ;; its coordinates when non-nil. It returns a cons
51 ;; of (device X . Y) in chars. We drop the device
52 ;; and assume the selected frame.
53 (car (cdr (setq point-args (mouse-position)))))
54 (cdr point-args))
55 ((and (fboundp 'read-mouse-position)
56 ;; read-mouse-position returns nil coords when not
57 ;; over existing text within a window, so we can
58 ;; only use its coordinates when non-nil. It
59 ;; returns a cons of (X . Y) in chars.
60 (car (setq point-args (read-mouse-position
61 (selected-frame)))))
62 point-args)
63 (t
64 ;; We just compute X and Y from event's location.
65 (cons (event-x current-mouse-event)
66 (event-y current-mouse-event)))))
67 (hyperb:epoch-p
68 ;; Modeline clicks return nil for point position so we
69 ;; must compute it instead of using the arguments given.
70 (let ((x-char (/ (* mouse::x (window-width))
71 (window-pixwidth)))
72 (y-char (/ (* mouse::y (window-height))
73 (window-pixheight))))
74 (apply 'list x-char y-char args)))
75 ((or (equal hyperb:window-system "next")
76 (equal hyperb:window-system "sun"))
77 (let ((win (car args)))
78 (list win
79 (+ (nth 1 args) (nth 0 (window-edges win)))
80 (+ (nth 2 args) (nth 1 (window-edges win))))))
81 ((equal hyperb:window-system "apollo") point-args)
82 (t args)))))
83
84 (provide 'h-skip-bytec)