home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / epoch / auto-unmap-screens.el next >
Encoding:
Text File  |  1991-03-30  |  3.5 KB  |  98 lines
  1. ; Date: Tue, 9 Oct 90 14:57:37 EDT
  2. ; From: Ken Laprade <laprade@trantor.harris-atd.com>
  3. ; Subject: Map handler to get rid of minibuffer
  4. ; 
  5. ; Here is a map handler that will unmap the minibuffer (and any other special
  6. ; screens such as a mouse-helper) when the last normal screen is unmapped and
  7. ; will remap the minibuffer (and others) when any window is mapped.  Maybe
  8. ; nobody else cares, but when I close my last epoch screen, I want everything
  9. ; else to go away; I have no need for a lone minibuffer.
  10. ; 
  11. ; -- 
  12. ; Ken Laprade            INTERNET: laprade@trantor.harris-atd.com
  13. ; Harris Corporation         Usenet:  ...!uunet!x102a!trantor!laprade
  14. ; PO Box 37, MS 3A/1912        Voice: (407)727-4433
  15. ; Melbourne, FL 32902        FAX: (407)729-2537
  16. ; 
  17. ; --------------------
  18. ; 
  19. ;;; Add a map event handler that gets rid of auto-unmap-screens when the
  20. ;;; last normal screen is closed and brings them back when any screen is
  21. ;;; opened.  auto-unmap-screens is a list of symbols that eval to screens.
  22. ;;; The last size and position is remembered for each window because
  23. ;;; mapping seems to resize screens to their creation size.
  24.  
  25. (defvar auto-unmap-screens nil
  26.   "*List of symbols referring to screens that will be automatically unmapped
  27. when the last normal screen is closed and remapped when any screen is opened.")
  28. (defvar auto-unmap-screens-geometry nil
  29.   "Alist of saved geometries for screens referenced by auto-unmap-screens.")
  30.  
  31. (defun normal-screens (screens)
  32.   "Return a list of all screens in SCREENS that are not referenced by
  33. auto-unmap-screens."
  34.   (let (l)
  35.     (while screens
  36.       (let ((scrn (car screens))
  37.         isone)
  38.     (mapcar
  39.      (function (lambda (scr)
  40.              (setq isone (or isone (eq scrn (eval scr))))))
  41.      auto-unmap-screens)
  42.     (or isone
  43.         (setq l (append l (list scrn)))))
  44.       (setq screens (cdr screens)))
  45.     l))
  46.  
  47. (defun my-map-event-handler (type value screen)
  48.   "Map event handler.  Will unmap auto-unmap-screens if this is the last
  49. normal screen being unmapped.  Will remap auto-unmap-screens if mapping a
  50. screen.  Calls on-event::handler first."
  51.   (on-event::handler type value screen)
  52.   (if value
  53.       ;; Mapping.
  54.       (mapcar
  55.        (function
  56.     (lambda (scr)
  57.       (setq scr (eval scr))
  58.       (or (not (screen-p scr))
  59.           (eq scr screen)
  60.           (screen-mapped-p scr)
  61.           (progn
  62.         (map-screen scr)
  63.         ;; Unmapped screens can forget their geometry, so we have to restore it.
  64.         (let* ((geom (cdr (assq scr auto-unmap-screens-geometry))))
  65.           (if geom
  66.               (progn
  67.             (change-screen-size (car geom) (nth 1 geom) scr)
  68.             (move-screen (nth 2 geom) (nth 3 geom) scr))))))))
  69.        auto-unmap-screens)
  70.     ;; Unmapping.
  71.     (or (normal-screens (screen-list))
  72.     ;; No more normal screens are mapped: unmap all others.
  73.     (mapcar
  74.      (function
  75.       (lambda (scr)
  76.         (setq scr (eval scr))
  77.         (or (not (screen-p scr))
  78.         (not (screen-mapped-p scr))
  79.         ;; Unmapped screens can forget their geometry, so we have to remember it.
  80.         (let* ((entry (assq scr auto-unmap-screens-geometry))
  81.                (info (epoch::screen-information scr))
  82.                (border (nth 5 info))
  83.                (x (- (car info) border))
  84.                (y (- (nth 1 info) border))
  85.                (geom (list (epoch::screen-width scr)
  86.                    (epoch::screen-height scr)
  87.                    x y)))
  88.           (if entry
  89.               (setcdr entry geom)
  90.             (setq auto-unmap-screens-geometry
  91.               (append auto-unmap-screens-geometry
  92.                   (list (cons scr geom)))))
  93.           (unmap-screen scr)))))
  94.      auto-unmap-screens))))
  95.     
  96. (setq auto-unmap-screens (append auto-unmap-screens (list '(minibuf-screen))))
  97. (push-event 'map 'my-map-event-handler)
  98.