home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / hyperbole / h-skip-bytec.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1995-05-10  |  3.1 KB  |  85 lines
  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)
  85.