wm.lisp

   1 ;;; window configuration code
   2
   3 (in-package "LICE")
   4
   5 (defstruct window-bk
   6   "A structure that stores the vital data needed to restore a window."
   7   x y w h seperator top bpoint buffer)
   8
   9 (defstruct frame-bk
  10   current-window
  11   window-tree)
  12
  13 (defun current-window-configuration (&optional (frame (selected-frame)))
  14   "Return the vital components of the window configuration of FRAME."
  15   (let ((frame frame)
  16         cw)
  17     (labels ((bk-window (window)
  18                         (with-slots (x y w h seperator top bpoint buffer) window
  19                           (let ((bk (make-window-bk :x x
  20                                                     :y y
  21                                                     :w w
  22                                                     :h h
  23                                                     :seperator seperator
  24                                                     :top (copy-marker top)
  25                                                     :bpoint (copy-marker bpoint)
  26                                                     :buffer buffer)))
  27                             ;; record the current window
  28                             (when (eq window (frame-selected-window frame))
  29                               (setf cw bk))
  30                             bk)))
  31              (dup-tree (tree)
  32                        (cond ((typep tree 'window)
  33                               (bk-window tree))
  34                              (t (list (dup-tree (first tree))
  35                                       (dup-tree (second tree)))))))
  36       (make-frame-bk :window-tree (dup-tree (first (frame-window-tree frame)))
  37                      :current-window cw))))
  38
  39 (defun set-window-configuration (configuration &optional (frame (selected-frame)))
  40   "CONFIGURATION must have been generated from FRAME. Otherwise, Bad Things could happen."
  41   (let ((frame frame)
  42         cw)
  43     (labels ((restore-window (bk)
  44                (let ((w (make-window :frame frame
  45                                      :x (window-bk-x bk)
  46                                      :y (window-bk-y bk)
  47                                      :cols (window-bk-w bk)
  48                                      :rows (window-bk-h bk)
  49                                      :buffer (window-bk-buffer bk)
  50                                      :top (window-bk-top bk)
  51                                      :bpoint (window-bk-bpoint bk))))
  52                  (unless (get-buffer (window-bk-buffer bk))
  53                    ;; default to scratch for deleted buffers
  54                    (let ((scratch (get-buffer-create "*scratch*")))
  55                      (setf (window-buffer w) scratch
  56                            (window-top w) (set-marker (make-marker) 0 scratch)
  57                            (window-bpoint w) (set-marker (make-marker) 0 scratch))))
  58                  (setf (window-seperator w) (window-bk-seperator bk))
  59                  (when (eq bk (frame-bk-current-window configuration))
  60                    (setf cw w))
  61                  w))
  62              (restore-tree (tree)
  63                (cond ((typep tree 'window-bk)
  64                       (restore-window tree))
  65                      (t (list (restore-tree (first tree))
  66                               (restore-tree (second tree)))))))
  67       (setf (frame-window-tree frame) (cons (restore-tree (frame-bk-window-tree configuration))
  68                                             (cdr (frame-window-tree frame)))
  69             (frame-selected-window frame) cw)
  70       (set-buffer (window-buffer cw)))))
  71
  72 (defmacro save-window-excursion (&body body)
  73   "Execute body, preserving window sizes and contents.
  74 Restore which buffer appears in which window, where display starts,
  75 and the value of point and mark for each window.
  76 Also restore the choice of selected window.
  77 Also restore which buffer is current.
  78 **Does not restore the value of point in current buffer."
  79   (let ((wc (gensym "WINDOW-CONFIGURATION")))
  80     `(let ((,wc (current-window-configuration)))
  81        (unwind-protect
  82            (progn
  83              ,@body)
  84          (set-window-configuration ,wc)))))
  85
  86 (provide :lice-0.1/wm)