home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / contrib / widgets / widgets.el
Encoding:
Text File  |  1995-07-03  |  3.6 KB  |  137 lines
  1. ;;; --------
  2. ;;; handlers
  3. ;;; --------
  4. ;;; last modified:  blk@mitre.org   Tue Jan 22 12:48:07 1991
  5. ;;; --------
  6.  
  7. ;;Author: Brian L. Kahn
  8. ;;Copyright 1992, MITRE Corporation
  9. ;;Not for sale or resale, distribution unlimited
  10.  
  11.  
  12. (require 'event)
  13. (require 'property)
  14. (provide 'widgets)
  15.  
  16.  
  17.  
  18. ;; widgets - Drop-menus, Pop-menus, and scrollbar
  19. ;; ==============================================
  20.  
  21. (defun widget:read-property (prop)
  22.   "Read a property, return a lisp obj."
  23.   (car (read-from-string (get-property prop))))
  24.  
  25.  
  26. ;;; WIDGET HANDLER
  27.  
  28. (setq epoch::event-handler-abort nil)
  29.  
  30. (push-property "gwm-result" 'widget:result-handler)
  31. (push-property "scrollbar" 'widget:scrollbar-handler)
  32. (push-property "Dmenu" 'widget:Dmenu-handler)
  33. (push-property "Pmenu" 'widget:Pmenu-handler)
  34.  
  35.  
  36. ;;; gwm-result
  37. ;; the gwm-return macro invokes a command via GWM_EXECUTE property
  38. ;; result goes into gwm-result property
  39.  
  40. (defun widget:result-handler (type xatom scr)
  41.   "Display result from gwm-result macro."
  42.   (message (get-property "gwm-result")))
  43.  
  44.  
  45. ;; Scroll bar
  46. (defconst widget:scrollbar-funcs
  47.   '((1 . scroll-up) (2 . line-up-point) (3 . scroll-down)))
  48.  
  49. (defun widget:scrollbar-handler (type xatom scr)
  50.   "scroll screen up and down"
  51.   (let* ((msg (widget:read-property "scrollbar"))
  52.      (why  (nth 3 msg))
  53.      (height (nth 3 (screen-information)))
  54.      (where (/ (* height why) 100))
  55.      (loc (epoch::coords-to-point 10 where scr))
  56.      )
  57.     ;; note that loc is nil if click next to mode line
  58.     (if loc 
  59.     (let* ((what (nth 1 msg))
  60.            (func (cdr-safe (assoc what widget:scrollbar-funcs)))
  61.            (win (nth 2 loc))
  62.            (font-size (nth 2 (font)))
  63.            (screen-line (/ where font-size))
  64.            (window-begin (nth 1 (window-edges win)))
  65.            (window-line (1+ (- screen-line window-begin)))
  66.            )
  67.       (eval-in-window win (funcall func window-line))
  68.       ))))
  69.  
  70.  
  71.  
  72. (defun line-up-point (line)
  73.   "Scrolls point to window LINE."
  74.   (scroll-down (- line (count-lines (window-start) (point)))))
  75.   
  76.  
  77. (defun widget:scroll-index (index scr)
  78.   "Jumps index% into the file."
  79.   (eval-in-screen scr
  80.    (if (>= index 98)
  81.        (goto-char (point-max))
  82.      (progn
  83.        (goto-char (+ (point-min)    ; For narrowed regions.
  84.              (/ (* (- (point-max) (point-min))
  85.                index) 100)))
  86.        (beginning-of-line))
  87.      )
  88.    (what-cursor-position)))
  89.     
  90.  
  91. ;;; Menu handlers
  92. ;; Dmenus are assumed to asynchronous.  Message is an elisp command.
  93. ;; Pmenus should be synchronous.  Message returned is menu selection.
  94.  
  95. (defun widget:Dmenu-handler (type xatom scr)
  96.   "Execute the function requested by user, mousing the Drop-menus."
  97.   (let* ((msg (widget:read-property "Dmenu"))
  98.      (act (nth 3 msg)))
  99.     (if (fboundp (car-safe act))
  100.     (eval act)
  101.       (message "Dmenu error: %s" act))
  102.     ))
  103.  
  104.  
  105. (defvar widget:Pmenu-return nil "Return value from popup menu")
  106.  
  107. (defun widget:Pmenu-handler (type xatom scr)
  108.   "Store value returned by popup menu in widget:Pmenu-return."
  109.   (let* ((msg (widget:read-property "Pmenu"))
  110.      (selection (nth 3 msg)))
  111.     (setq widget:Pmenu-return selection)
  112.     (throw 'widget:Pmenu-return selection)
  113.     ))
  114.  
  115. ;;; from sun-mouse.el
  116.  
  117. (defmacro eval-in-window (window &rest forms)
  118.   "Switch to WINDOW, evaluate FORMS, return to original window."
  119.   (` (let ((OriginallySelectedWindow (selected-window)))
  120.        (unwind-protect
  121.        (progn
  122.          (select-window (, window))
  123.          (,@ forms))
  124.      (select-window OriginallySelectedWindow)))))
  125.  
  126. ;;; adapted from eval-in-window
  127.  
  128. (defmacro eval-in-screen (screen &rest forms)
  129.   "Switch to SCREEN, evaluate FORMS, return to original screen."
  130.   (` (let ((OrigScreen (current-screen)))
  131.        (unwind-protect
  132.        (progn
  133.          (select-screen (, screen))
  134.          (,@ forms))
  135.      (select-screen OrigScreen)))))
  136.  
  137.