Changeset - d49e33f7e3f1
[Not reviewed]
0 1 0
Sergey Pashinin - 11 years ago 2014-08-25 13:34:50
sergey@pashinin.com
minor changes
1 file changed with 12 insertions and 14 deletions:
0 comments (0 inline, 0 general)
src/workgroups2.el
Show inline comments
 
@@ -1946,408 +1946,406 @@ as Workgroups' command remappings."
 
  (let ((selwin (selected-window))
 
        (buf (wg-find-buf-by-uid (wg-win-buf-uid win))))
 
    (if (not buf)
 
        (wg-restore-default-buffer)
 
      (when (wg-restore-buffer buf t)
 

	
 
        ;; Restore various positions in WINDOW from their values in WIN
 
        ;; (wg-restore-window-positions win selwin)
 
        (let ((window (or selwin (selected-window))))
 
          (wg-with-slots win
 
              ((win-point wg-win-point)
 
               (win-start wg-win-start)
 
               (win-hscroll wg-win-hscroll))
 
            (set-window-start window win-start t)
 
            (set-window-hscroll window win-hscroll)
 
            (set-window-point
 
             window
 
             (cond ((not wg-restore-point) win-start)
 
                   ((eq win-point :max) (point-max))
 
                   (t win-point)))
 
            (when (>= win-start (point-max)) (recenter))))
 

	
 
        (when wg-restore-window-dedicated-p
 
          (set-window-dedicated-p selwin (wg-win-dedicated win)))))
 
    (ignore-errors
 
      (set-window-prev-buffers
 
       selwin (wg-unpickel (wg-win-parameter win 'prev-buffers)))
 
      (set-window-next-buffers
 
       selwin (wg-unpickel (wg-win-parameter win 'next-buffers)))
 
      )))
 

	
 

	
 
(defun wg-window-point (ewin)
 
  "Return `point' or :max.  See `wg-restore-point-max'.
 
EWIN should be an Emacs window object."
 
  (let ((p (window-point ewin)))
 
    (if (and wg-restore-point-max (= p (point-max))) :max p)))
 

	
 
(defun wg-win-parameter (win parameter &optional default)
 
  "Return WIN's value for PARAMETER.
 
If PARAMETER is not found, return DEFAULT which defaults to nil.
 
SESSION nil defaults to the current session."
 
  (wg-aget (wg-win-parameters win) parameter default))
 

	
 
(defun wg-set-win-parameter (win parameter value)
 
  "Set WIN's value of PARAMETER to VALUE.
 
SESSION nil means use the current session.
 
Return value."
 
  (wg-set-parameter (wg-win-parameters win) parameter value)
 
  value)
 
;; (wg-win-parameters (wg-window-to-win (selected-window)))
 

	
 
(defun wg-remove-win-parameter (win parameter)
 
  "Remove parameter PARAMETER from WIN's parameters."
 
  (wg-asetf (wg-win-parameters win) (wg-aremove it parameter)))
 

	
 
(defun wg-window-to-win (window)
 
  "Return the serialization (a wg-win) of Emacs window WINDOW."
 
  (let ((selected (eq window (selected-window)))
 
        win)
 
    (with-selected-window window
 
      (setq win
 
            (wg-make-win
 
             :edges              (window-edges window)
 
             :point              (wg-window-point window)
 
             :start              (window-start window)
 
             :hscroll            (window-hscroll window)
 
             :selected           selected
 
             :minibuffer-scroll  (eq window minibuffer-scroll-window)
 
             :dedicated          (window-dedicated-p window)
 
             :buf-uid            (wg-buffer-uid-or-add (window-buffer window))))
 
      (unless (version< emacs-version "24")
 
        (wg-set-win-parameter
 
         win 'next-buffers (wg-pickel (remove nil (cl-subseq (window-next-buffers window) 0 4))))
 
        (wg-set-win-parameter
 
         win 'prev-buffers (wg-pickel (remove nil (cl-subseq (window-prev-buffers window) 0 4))))))
 
    win))
 

	
 
(defun wg-toggle-window-dedicated-p ()
 
  "Toggle `window-dedicated-p' in `selected-window'."
 
  (interactive)
 
  (set-window-dedicated-p nil (not (window-dedicated-p)))
 
  (force-mode-line-update t)
 
  (wg-fontified-message
 
    (:cmd "Window:")
 
    (:cur (concat (unless (window-dedicated-p) " not") " dedicated"))))
 

	
 
(defun wg-w-edges (w)
 
  "Return W's edge list."
 
  (cl-etypecase w
 
    (wg-win (wg-win-edges w))
 
    (wg-wtree (wg-wtree-edges w))))
 

	
 
(defun wg-copy-w (w)
 
  "Return a copy of W.  W should be a wg-win or a wg-wtree."
 
  (cl-etypecase w
 
    (wg-win (wg-copy-win w))
 
    (wg-wtree (wg-copy-wtree w))))
 

	
 
(defun wg-set-edges (w edges)
 
  "Set W's EDGES list, and return W."
 
  (cl-etypecase w
 
    (wg-win (setf (wg-win-edges w) edges))
 
    (wg-wtree (setf (wg-wtree-edges w) edges)))
 
  w)
 

	
 
(defun wg-equal-wtrees (w1 w2)
 
  "Return t when W1 and W2 have equal structure."
 
  (cond ((and (wg-win-p w1) (wg-win-p w2))
 
         (equal (wg-w-edges w1) (wg-w-edges w2)))
 
        ((and (wg-wtree-p w1) (wg-wtree-p w2))
 
         (and (eq (wg-wtree-dir w1) (wg-wtree-dir w2))
 
              (equal (wg-wtree-edges w1) (wg-wtree-edges w2))
 
              (cl-every #'wg-equal-wtrees
 
                        (wg-wtree-wlist w1)
 
                        (wg-wtree-wlist w2))))))
 

	
 
(defun wg-normalize-wtree (wtree)
 
  "Clean up and return a new wtree from WTREE.
 
Recalculate the edge lists of all subwins, and remove subwins
 
outside of WTREE's bounds.  If there's only one element in the
 
new wlist, return it instead of a new wtree."
 
  (if (wg-win-p wtree) wtree
 
    (wg-with-slots wtree ((dir wg-wtree-dir)
 
                          (wlist wg-wtree-wlist))
 
      (wg-with-bounds wtree dir (ls1 hs1 lb1 hb1)
 
        (let* ((min-size (wg-min-size dir))
 
               (max (- hb1 1 min-size))
 
               (lastw (-last-item wlist)))
 
          (cl-labels
 
              ((mapwl
 
                (wl)
 
                (wg-dbind (sw . rest) wl
 
                  (cons (wg-normalize-wtree
 
                         (wg-set-bounds
 
                          sw dir ls1 hs1 lb1
 
                          (setq lb1 (if (eq sw lastw) hb1
 
                                      (let ((hb2 (+ lb1 (wg-w-size sw dir))))
 
                                        (if (>= hb2 max) hb1 hb2))))))
 
                        (when (< lb1 max) (mapwl rest))))))
 
            (let ((new (mapwl wlist)))
 
              (if (not (cdr new)) (car new)
 
                (setf (wg-wtree-wlist wtree) new)
 
                wtree))))))))
 

	
 
(defun wg-scale-wtree (wtree wscale hscale)
 
  "Return a copy of WTREE with its dimensions scaled by WSCALE and HSCALE.
 
All WTREE's subwins are scaled as well."
 
  (let ((scaled (wg-scale-w-size wtree wscale hscale)))
 
    (if (wg-win-p wtree) scaled
 
      (wg-asetf (wg-wtree-wlist scaled)
 
                (wg-docar (sw it) (wg-scale-wtree sw wscale hscale)))
 
      scaled)))
 

	
 

	
 
(defun wg-resize-frame-scale-wtree (wconfig)
 
  "Set FRAME's size to WCONFIG's, returning a possibly scaled wtree.
 
If the frame size was set correctly, return WCONFIG's wtree
 
unchanged.  If it wasn't, return a copy of WCONFIG's wtree scaled
 
with `wg-scale-wconfigs-wtree' to fit the frame as it exists."
 
  (let ((frame (selected-frame)))
 
    (wg-with-slots wconfig ((wcwidth wg-wconfig-width)
 
                            (wcheight wg-wconfig-height))
 
      (when window-system (set-frame-size frame wcwidth wcheight))
 
      (let ((fwidth  (frame-parameter frame 'width))
 
            (fheight (frame-parameter frame 'height)))
 
        (if (and (= wcwidth fwidth) (= wcheight fheight))
 
            (wg-wconfig-wtree wconfig)
 
          (wg-scale-wconfigs-wtree wconfig fwidth fheight))))))
 

	
 

	
 
(defun wg-wtree-buf-uids (wtree)
 
  "Return a new list of the buf uids of all wins in WTREE."
 
  (if (not wtree)
 
      (error "WTREE is nil in `wg-wtree-buf-uids'!"))
 
  (wg-flatten-wtree wtree 'wg-win-buf-uid))
 

	
 
(defun wg-wtree-unique-buf-uids (wtree)
 
  "Return a list of the unique buf uids of all wins in WTREE."
 
  (cl-remove-duplicates (wg-wtree-buf-uids wtree) :test 'string=))
 

	
 

	
 

	
 

	
 
(defun wg-reset-window-tree ()
 
  "Delete all but one window in `selected-frame', and reset
 
various parameters of that window in preparation for restoring
 
a wtree."
 
  (delete-other-windows)
 
  (set-window-dedicated-p nil nil))
 

	
 
(defun wg-restore-window-tree-helper (w)
 
  "Recursion helper for `wg-restore-window-tree'."
 
  "Recursion helper for `wg-restore-window-tree' W."
 
  (if (wg-wtree-p w)
 
      (cl-loop with dir = (wg-wtree-dir w)
 
               for (win . rest) on (wg-wtree-wlist w)
 
               do (when rest (split-window nil (wg-w-size win dir) (not dir)))
 
               do (wg-restore-window-tree-helper win))
 
    (wg-restore-window w)
 
    (when (wg-win-selected w)
 
      (setq wg-window-tree-selected-window (selected-window)))
 
    (when (wg-win-minibuffer-scroll w)
 
      (setq minibuffer-scroll-window (selected-window)))
 
    (other-window 1)))
 

	
 
(defun wg-restore-window-tree (wtree)
 
  "Restore WTREE in `selected-frame'."
 
  (let ((window-min-width wg-window-min-width)
 
        (window-min-height wg-window-min-height)
 
        (wg-window-tree-selected-window nil))
 
    (wg-reset-window-tree)
 
    (wg-restore-window-tree-helper wtree)
 
    (awhen wg-window-tree-selected-window (select-window it))))
 

	
 

	
 
;; (wg-window-tree-to-wtree (window-tree))
 
(defun wg-window-tree-to-wtree (window-tree)
 
  "Return the serialization (a wg-wtree) of Emacs window tree WINDOW-TREE."
 
  (wg-barf-on-active-minibuffer)
 
  (cl-labels
 
      ((inner (w) (if (windowp w) (wg-window-to-win w)
 
                    (wg-dbind (dir edges . wins) w
 
                      (wg-make-wtree
 
                       :dir    dir
 
                       :edges  edges
 
                       :wlist  (mapcar #'inner wins))))))
 
    (let ((w (car window-tree)))
 
      (when (and (windowp w) (window-minibuffer-p w))
 
        (error "Workgroups can't operate on minibuffer-only frames."))
 
      (inner w))))
 

	
 

	
 
(defun wg-flatten-wtree (wtree &optional key)
 
  "Return a new list by flattening WTREE.
 
KEY non returns returns a list of WTREE's wins.
 
KEY non-nil returns a list of the results of calling KEY on each win."
 
  (cl-labels
 
      ((inner (w) (if (wg-win-p w) (list (if key (funcall key w) w))
 
                    (cl-mapcan #'inner (wg-wtree-wlist w)))))
 
    (inner wtree)))
 

	
 
(defun wg-reverse-wlist (w &optional dir)
 
  "Reverse W's wlist and those of all its sub-wtrees in direction DIR.
 
If DIR is nil, reverse WTREE horizontally.
 
If DIR is 'both, reverse WTREE both horizontally and vertically.
 
Otherwise, reverse WTREE vertically."
 
  (cl-labels
 
      ((inner (w) (if (wg-win-p w) w
 
                    (wg-with-slots w ((d1 wg-wtree-dir))
 
                      (wg-make-wtree
 
                       :dir d1
 
                       :edges (wg-wtree-edges w)
 
                       :wlist (let ((wl2 (mapcar #'inner (wg-wtree-wlist w))))
 
                                (if (or (eq dir 'both) (eq dir d1))
 
                                    (nreverse wl2)
 
                                  wl2)))))))
 
    (wg-normalize-wtree (inner w))))
 

	
 
(defun wg-wtree-move-window (wtree offset)
 
  "Offset `selected-window' OFFSET places in WTREE."
 
  (cl-labels
 
      ((inner (w) (if (wg-win-p w) w
 
                    (wg-with-slots w ((wlist wg-wtree-wlist))
 
                      (wg-make-wtree
 
                       :dir (wg-wtree-dir w)
 
                       :edges (wg-wtree-edges w)
 
                       :wlist (aif (cl-find t wlist :key 'wg-win-selected)
 
                                  (wg-cyclic-offset-elt it wlist offset)
 
                                (mapcar #'inner wlist)))))))
 
    (wg-normalize-wtree (inner wtree))))
 

	
 
(defun wg-frame-to-wconfig (&optional frame)
 
  "Return the serialization (a wg-wconfig) of Emacs frame FRAME.
 
FRAME nil defaults to `selected-frame'."
 
  (let* ((frame (or frame (selected-frame)))
 
         (fullscrn (frame-parameter frame 'fullscreen)))
 
    (wg-make-wconfig
 
     :left                  (frame-parameter frame 'left)
 
     :top                   (frame-parameter frame 'top)
 
     :width                 (frame-parameter frame 'width)
 
     :height                (frame-parameter frame 'height)
 
     :parameters            `((fullscreen . ,fullscrn))
 
     :vertical-scroll-bars  (frame-parameter frame 'vertical-scroll-bars)
 
     :scroll-bar-width      (frame-parameter frame 'scroll-bar-width)
 
     :wtree                 (wg-window-tree-to-wtree (window-tree frame))
 
     )))
 

	
 
(defun wg-current-wconfig ()
 
  "Return the current wconfig.
 
If `wg-current-wconfig' is non-nil, return it.  Otherwise return
 
`wg-frame-to-wconfig'."
 
  (or (frame-parameter nil 'wg-current-wconfig)
 
      (wg-frame-to-wconfig)))
 

	
 
(defmacro wg-with-current-wconfig (frame wconfig &rest body)
 
  "Eval BODY with WCONFIG current in FRAME.
 
FRAME nil defaults to `selected-frame'."
 
  (declare (indent 2))
 
  (wg-with-gensyms (frame-sym old-value)
 
    `(let* ((,frame-sym (or ,frame (selected-frame)))
 
            (,old-value (frame-parameter ,frame-sym 'wg-current-wconfig)))
 
       (unwind-protect
 
           (progn
 
             (set-frame-parameter ,frame-sym 'wg-current-wconfig ,wconfig)
 
             ,@body)
 
         (when (frame-live-p ,frame-sym)
 
           (set-frame-parameter ,frame-sym 'wg-current-wconfig ,old-value))))))
 

	
 
(defun wg-make-blank-wconfig (&optional buffer)
 
  "Return a new blank wconfig.
 
BUFFER or `wg-default-buffer' is visible in the only window."
 
  (save-window-excursion
 
    (delete-other-windows)
 
    (switch-to-buffer (or buffer wg-default-buffer))
 
    (wg-frame-to-wconfig)))
 

	
 
(defun wg-wconfig-move-window (wconfig offset)
 
  "Offset `selected-window' OFFSET places in WCONFIG."
 
  (wg-asetf (wg-wconfig-wtree wconfig) (wg-wtree-move-window it offset))
 
  wconfig)
 

	
 

	
 
;;; base wconfig updating
 

	
 
(defun wg-update-working-wconfig-on-delete-frame (frame)
 
  "Update FRAME's current workgroup's working-wconfig before
 
FRAME is deleted, so we don't lose its state."
 
  (with-selected-frame frame
 
    (wg-update-current-workgroup-working-wconfig)))
 

	
 

	
 
(defun wg-wconfig-buf-uids (wconfig)
 
  "Return WCONFIG's wtree's `wg-wtree-buf-uids'."
 
  (if (not (wg-wconfig-wtree wconfig))
 
      (error "WTREE is nil in `wg-wconfig-buf-uids'!"))
 
  (wg-wtree-unique-buf-uids (wg-wconfig-wtree wconfig)))
 

	
 

	
 

	
 

	
 

	
 
(defun wg-wconfig-restore-frame-position (wconfig &optional frame)
 
  "Use WCONFIG to restore FRAME's position.
 
If frame is nil then `selected-frame'."
 
  (-when-let* ((left (wg-wconfig-left wconfig))
 
               (top (wg-wconfig-top wconfig)))
 
    ;; Check that arguments are integers
 
    ;; Problem: https://github.com/pashinin/workgroups2/issues/15
 
    (if (and (integerp left)
 
             (integerp top))
 
        (set-frame-position frame left top))))
 

	
 
(defun wg-wconfig-restore-scroll-bars (wconfig)
 
  "Restore `selected-frame's scroll-bar settings from WCONFIG."
 
  (set-frame-parameter
 
   nil 'vertical-scroll-bars (wg-wconfig-vertical-scroll-bars wconfig))
 
  (set-frame-parameter
 
   nil 'scroll-bar-width (wg-wconfig-scroll-bar-width wconfig)))
 

	
 
;;(defun wg-wconfig-restore-fullscreen (wconfig)
 
;;  "Restore `selected-frame's fullscreen settings from WCONFIG."
 
;;  (set-frame-parameter
 
;;   nil 'fullscreen (wg-wconfig-parameters wconfig))
 
;;  )
 

	
 
(defun wg-scale-wconfigs-wtree (wconfig new-width new-height)
 
  "Scale WCONFIG's wtree with NEW-WIDTH and NEW-HEIGHT.
 
Return a copy WCONFIG's wtree scaled with `wg-scale-wtree' by the
 
ratio or NEW-WIDTH to WCONFIG's width, and NEW-HEIGHT to
 
WCONFIG's height."
 
  (wg-normalize-wtree
 
   (wg-scale-wtree
 
    (wg-wconfig-wtree wconfig)
 
    (/ (float new-width)  (wg-wconfig-width wconfig))
 
    (/ (float new-height) (wg-wconfig-height wconfig)))))
 

	
 
(defun wg-scale-wconfig-to-frame (wconfig)
 
  "Scale WCONFIG buffers to fit current frame size.
 
Return a scaled copy of WCONFIG."
 
  (interactive)
 
  (wg-scale-wconfigs-wtree wconfig
 
                           (frame-parameter nil 'width)
 
                           (frame-parameter nil 'height)))
 

	
 
(defun wg-frame-resize-and-position (wconfig &optional frame)
 
  "Apply WCONFIG's size and position to a FRAME."
 
  (interactive)
 
  (unless frame (setq frame (selected-frame)))
 
  (let* ((params (wg-wconfig-parameters wconfig))
 
         fullscreen)
 
    (set-frame-parameter frame 'fullscreen (if (assoc 'fullscreen params)
 
                                               (cdr (assoc 'fullscreen params))
 
                                             nil))
 
    (when (and wg-restore-frame-position
 
               (not (frame-parameter frame 'fullscreen)))
 
      (wg-wconfig-restore-frame-position wconfig frame))
 
    ))
 

	
 
(defun wg-restore-frame-size-position (wconfig &optional fs)
 
  "Smart-restore of frame size and position.
 

	
 
Depending on `wg-remember-frame-for-each-wg' frame parameters may
 
be restored for each workgroup.
 

	
 
If `wg-remember-frame-for-each-wg' is nil (by default) then
 
current frame parameters are saved/restored to/from first
 
workgroup. And frame parameters for all other workgroups are just
 
ignored.
 
@@ -3119,395 +3117,395 @@ It works with Emacs buffer, Workgroups buffer object and a simple string."
 
    (wg-buf (wg-buf-major-mode bufobj))
 
    (string (wg-buffer-major-mode bufobj))))
 

	
 
;; `wg-equal-bufobjs' and `wg-find-bufobj' may need to be made a lot smarter
 
(defun wg-equal-bufobjs (bufobj1 bufobj2)
 
  "Return t if BUFOBJ1 is \"equal\" to BUFOBJ2."
 
  (let ((fname1 (wg-bufobj-file-name bufobj1))
 
        (fname2 (wg-bufobj-file-name bufobj2)))
 
    (cond ((and fname1 fname2) (string= fname1 fname2))
 
          ((or fname1 fname2) nil)
 
          ((string= (wg-bufobj-name bufobj1) (wg-bufobj-name bufobj2)) t))))
 

	
 
(defun wg-find-bufobj (bufobj bufobj-list)
 
  "Find BUFOBJ in BUFOBJ-LIST, testing with `wg-equal-bufobjs'."
 
  (cl-find bufobj bufobj-list :test 'wg-equal-bufobjs))
 

	
 
(defun wg-find-bufobj-by-uid (uid bufobj-list)
 
  "Find the bufobj in BUFOBJ-LIST with uid UID."
 
  (cl-find uid bufobj-list :test 'string= :key 'wg-bufobj-uid))
 

	
 
(defun wg-find-buf-in-buf-list (buf buf-list)
 
  "Find BUF in BUF-LIST.
 
This is only here for completeness."
 
  (cl-find buf buf-list))
 

	
 
(defun wg-find-buffer-in-buffer-list (buffer-or-name buffer-list)
 
  "Find BUFFER-OR-NAME in BUFFER-LIST."
 
  (cl-find (wg-get-buffer buffer-or-name) buffer-list :key 'wg-get-buffer))
 

	
 
(defun wg-find-buffer-in-buf-list (buffer-or-name buf-list)
 
  "Find BUFFER-OR-NAME in BUF-LIST."
 
  (aif (wg-buffer-uid buffer-or-name)
 
      (wg-find-bufobj-by-uid it buf-list)
 
    (wg-find-bufobj buffer-or-name buf-list)))
 

	
 
(defun wg-find-buf-in-buffer-list (buf buffer-list)
 
  "Find BUF in BUFFER-LIST."
 
  (or (wg-find-bufobj-by-uid (wg-buf-uid buf) buffer-list)
 
      (wg-find-bufobj buf buffer-list)))
 

	
 
(defun wg-find-buf-by-uid (uid)
 
  "Find a buf in `wg-buf-list' by UID."
 
  (wg-find-bufobj-by-uid uid (wg-buf-list)))
 

	
 
(defun wg-set-buffer-uid-or-error (uid &optional buffer)
 
  "Set BUFFER's buffer local value of `wg-buffer-uid' to UID.
 
If BUFFER already has a buffer local value of `wg-buffer-uid',
 
and it's not equal to UID, error."
 
  (if wg-buffer-uid
 
      ;;(if (string= wg-buffer-uid uid) uid
 
      ;;  (error "uids don't match %S and %S" uid wg-buffer-uid))
 
      (setq wg-buffer-uid uid)))
 

	
 

	
 
(defun wg-buffer-special-data (buffer)
 
  "Return BUFFER's auxiliary serialization, or nil."
 
  (cl-some (lambda (fn) (funcall fn buffer)) wg-special-buffer-serdes-functions))
 

	
 

	
 
(defun wg-serialize-buffer-local-variables ()
 
  "Return an alist of buffer-local variable symbols and their values.
 
See `wg-buffer-local-variables-alist' for details."
 
  (wg-docar (entry wg-buffer-local-variables-alist)
 
    (wg-dbind (var ser des) entry
 
      (when (local-variable-p var)
 
        (cons var (if ser (funcall ser) (symbol-value var)))))))
 

	
 
(defun wg-buffer-to-buf (buffer)
 
  "Return the serialization (a wg-buf) of Emacs buffer BUFFER."
 
  (with-current-buffer buffer
 
    (wg-make-buf
 
     :name           (buffer-name)
 
     :file-name      (buffer-file-name)
 
     :point          (point)
 
     :mark           (mark)
 
     :local-vars     (wg-serialize-buffer-local-variables)
 
     :special-data   (wg-buffer-special-data buffer))))
 

	
 
(defun wg-add-buffer-to-buf-list (buffer)
 
  "Make a buf from BUFFER, and add it to `wg-buf-list' if necessary.
 
If there isn't already a buf corresponding to BUFFER in
 
`wg-buf-list', make one and add it.  Return BUFFER's uid
 
in either case."
 
  (with-current-buffer buffer
 
    (setq wg-buffer-uid
 
          (aif (wg-find-buffer-in-buf-list buffer (wg-buf-list))
 
              (wg-buf-uid it)
 
            (let ((buf (wg-buffer-to-buf buffer)))
 
              (push buf (wg-buf-list))
 
              (wg-buf-uid buf))))))
 

	
 
(defun wg-buffer-uid-or-add (buffer)
 
  "Return BUFFER's uid.
 
If there isn't already a buf corresponding to BUFFER in
 
`wg-buf-list', make one and add it."
 
  (or (wg-buffer-uid buffer) (wg-add-buffer-to-buf-list buffer)))
 

	
 
(defun wg-bufobj-uid-or-add (bufobj)
 
  "If BUFOBJ is a wg-buf, return its uid.
 
If BUFOBJ is a buffer or a buffer name, see `wg-buffer-uid-or-add'."
 
  (cl-etypecase bufobj
 
    (wg-buf (wg-buf-uid bufobj)) ;; possibly also add to `wg-buf-list'
 
    (buffer (wg-buffer-uid-or-add bufobj))
 
    (string (wg-bufobj-uid-or-add (wg-get-buffer bufobj)))))
 

	
 
(defun wg-reset-buffer (buffer)
 
  "Return BUFFER.
 
Currently only sets BUFFER's `wg-buffer-uid' to nil."
 
  (with-current-buffer buffer (setq wg-buffer-uid nil)))
 

	
 
(defun wg-update-buffer-in-buf-list (&optional buffer)
 
  "Update BUFFER's corresponding buf in `wg-buf-list'.
 
BUFFER nil defaults to `current-buffer'."
 
  (let ((buffer (or buffer (current-buffer))))
 
    (-when-let* ((uid (wg-buffer-uid buffer))
 
                 (old-buf (wg-find-buf-by-uid uid))
 
                 (new-buf (wg-buffer-to-buf buffer)))
 
      (setf (wg-buf-uid new-buf) (wg-buf-uid old-buf))
 
      (wg-asetf (wg-buf-list) (cons new-buf (remove old-buf it))))))
 

	
 
(defvar wg-just-exited-minibuffer nil
 
  "Flag set by `minibuffer-exit-hook'.
 
To exempt from undoification those window-configuration changes
 
caused by exiting the minibuffer.  This is ugly, but necessary.
 
It may seem like we could just null out
 
`wg-undoify-window-configuration-change' in
 
`minibuffer-exit-hook', but that also prevents undoification of
 
window configuration changes triggered by commands called with
 
`execute-extended-command' -- i.e. it's just too coarse.")
 

	
 
(defcustom wg-no-confirm-on-destructive-operation nil
 
  "Do not request confirmation before various destructive operations."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-minibuffer-message-timeout 0.75
 
  "Bound to `minibuffer-message-timeout' when messaging while the
 
minibuffer is active."
 
  :type 'float
 
  :group 'workgroups)
 

	
 
(defun wg-read-object (prompt test warning &optional initial-contents keymap
 
                              read hist default-value inherit-input-method)
 
  "PROMPT for an object that satisfies TEST.  WARNING if necessary.
 
INITIAL-CONTENTS KEYMAP READ HIST DEFAULT-VALUE
 
INHERIT-INPUT-METHOD are `read-from-minibuffer's args."
 
  (cl-labels ((read () (read-from-minibuffer
 
                        prompt initial-contents keymap read hist
 
                        default-value inherit-input-method)))
 
    (let ((obj (read)))
 
      (when (and (equal obj "") default-value) (setq obj default-value))
 
      (while (not (funcall test obj))
 
        (message warning)
 
        (sit-for wg-minibuffer-message-timeout)
 
        (setq obj (read)))
 
      obj)))
 

	
 
(defun wg-read-new-workgroup-name (&optional prompt)
 
  "Read a non-empty name string from the minibuffer.
 
Print PROMPT"
 
  (let ((default (wg-new-default-workgroup-name)))
 
    (wg-read-object
 
     (or prompt (format "Name (default: %S): " default))
 
     (lambda (new) (and (stringp new)
 
                        (not (equal new ""))
 
                        (wg-unique-workgroup-name-p new)))
 
     "Please enter a unique, non-empty name"
 
     nil nil nil nil default)))
 

	
 
(defun wg-read-workgroup-index ()
 
  "Prompt for the index of a workgroup."
 
  (let ((max (1- (length (wg-workgroup-list-or-error)))))
 
    (wg-read-object
 
     (format "%s\n\nEnter [0-%d]: " (wg-workgroup-list-display) max)
 
     (lambda (obj) (and (integerp obj) (wg-within obj 0 max t)))
 
     (format "Please enter an integer [%d-%d]" 0 max)
 
     nil nil t)))
 

	
 
(defun wg-minibuffer-inactive-p ()
 
  "Return t when `minibuffer-depth' is zero, nil otherwise."
 
  (zerop (minibuffer-depth)))
 

	
 
(defun wg-barf-on-active-minibuffer ()
 
  "Throw an error when the minibuffer is active."
 
  (when (not (wg-minibuffer-inactive-p))
 
    (error "Exit minibuffer to use workgroups functions!")))
 

	
 
(defvar wg-deactivation-list nil
 
  "A stack of workgroups that are currently being switched away from.
 
Used to avoid associating the old workgroup's buffers with the
 
new workgroup during a switch.")
 

	
 
(defun wg-flag-workgroup-modified (workgroup)
 
  "Set WORKGROUP's and the current session's modified flags."
 
  (when wg-flag-modified
 
    (setf (wg-workgroup-modified workgroup) t)
 
    (setf (wg-session-modified (wg-current-session)) t)))
 

	
 
(defun wg-flag-session-modified (&optional session)
 
  "Set SESSION's modified flag."
 
  (when (and wg-flag-modified
 
             (or session (wg-current-session t)))
 
    (setf (wg-session-modified (or session (wg-current-session t))) t)))
 

	
 
(defun wg-flag-workgroup-modified (&optional workgroup)
 
  "Set WORKGROUP's and the current session's modified flags."
 
  (when wg-flag-modified
 
    (-when-let (or session (wg-current-session t))
 
      (setf (wg-session-modified it) t))))
 
    (setf (wg-workgroup-modified workgroup) t)
 
    (wg-flag-session-modified)))
 

	
 
(defun wg-current-workgroup (&optional noerror frame)
 
  "Return current workgroup in frame.
 
Error unless NOERROR, in FRAME if specified."
 
  (or wg-current-workgroup
 
      (aif (frame-parameter frame 'wg-current-workgroup-uid)
 
          (wg-find-workgroup-by :uid it noerror)
 
        (unless noerror (error "No current workgroup in this frame")))))
 

	
 
(defun wg-previous-workgroup (&optional noerror frame)
 
  "Return the previous workgroup in FRAME, or error unless NOERROR."
 
  (aif (frame-parameter frame 'wg-previous-workgroup-uid)
 
      (wg-find-workgroup-by :uid it noerror)
 
    (unless noerror (error "No previous workgroup in this frame"))))
 

	
 
(defun wg-set-current-workgroup (workgroup &optional frame)
 
  "Set the current workgroup to WORKGROUP in FRAME.
 
WORKGROUP should be a workgroup or nil."
 
  (set-frame-parameter frame 'wg-current-workgroup-uid
 
                       (when workgroup (wg-workgroup-uid workgroup))))
 

	
 
(defun wg-set-previous-workgroup (workgroup &optional frame)
 
  "Set the previous workgroup to WORKGROUP in FRAME.
 
WORKGROUP should be a workgroup or nil."
 
  (set-frame-parameter frame 'wg-previous-workgroup-uid
 
                       (when workgroup (wg-workgroup-uid workgroup))))
 

	
 
(defun wg-current-workgroup-p (workgroup &optional frame)
 
  "Return t when WORKGROUP is the current workgroup, nil otherwise."
 
  (awhen (wg-current-workgroup t frame)
 
    (eq workgroup it)))
 

	
 
(defun wg-previous-workgroup-p (workgroup &optional frame)
 
  "Return t when WORKGROUP is the previous workgroup, nil otherwise."
 
  (awhen (wg-previous-workgroup t frame)
 
    (eq workgroup it)))
 

	
 
(defun wg-get-workgroup (obj &optional noerror)
 
  "Return a workgroup from OBJ.
 
If OBJ is a workgroup, return it.
 
If OBJ is a string, return the workgroup named OBJ, or error unless NOERROR.
 
If OBJ is nil, return the current workgroup, or error unless NOERROR."
 
  (cond ((wg-workgroup-p obj) obj)
 
        ((stringp obj) (wg-find-workgroup-by :name obj noerror))
 
        ((null obj) (wg-current-workgroup noerror))
 
        (t (error "Can't get workgroup from type:: %S" (type-of obj)))))
 

	
 

	
 
;;; workgroup parameters
 
;;
 
;; Quick test:
 
;; (wg-workgroup-parameters (wg-current-workgroup))
 
;; (wg-set-workgroup-parameter (wg-current-workgroup) 'test1 t)
 
;; (wg-workgroup-parameter (wg-current-workgroup) 'test1)
 
(defun wg-workgroup-parameter (workgroup parameter &optional default)
 
  "Return WORKGROUP's value for PARAMETER.
 
If PARAMETER is not found, return DEFAULT which defaults to nil.
 
WORKGROUP should be accepted by `wg-get-workgroup'."
 
  (wg-aget (wg-workgroup-parameters (wg-get-workgroup workgroup))
 
           parameter default))
 

	
 
(defun wg-set-workgroup-parameter (parameter value &optional workgroup)
 
  "Set PARAMETER to VALUE in a WORKGROUP.
 
WORKGROUP should be a value accepted by `wg-get-workgroup'.
 
Return VALUE."
 
  (-when-let (workgroup (wg-get-workgroup (or workgroup (wg-current-workgroup t)) t))
 
    (wg-set-parameter (wg-workgroup-parameters workgroup) parameter value)
 
    (wg-flag-workgroup-modified workgroup)
 
    value))
 

	
 
(defun wg-remove-workgroup-parameter (parameter &optional workgroup)
 
  "Remove PARAMETER from WORKGROUP's parameters."
 
  (-when-let (workgroup (wg-get-workgroup workgroup t))
 
    (wg-flag-workgroup-modified workgroup)
 
    (wg-asetf (wg-workgroup-parameters workgroup) (wg-aremove it parameter))))
 

	
 
(defun wg-workgroup-local-value (variable &optional workgroup)
 
  "Return the value of VARIABLE in WORKGROUP.
 
WORKGROUP nil defaults to the current workgroup.  If there is no
 
current workgroup, or if VARIABLE does not have a workgroup-local
 
binding in WORKGROUP, resolve VARIABLE with `wg-session-local-value'."
 
  (let ((workgroup (wg-get-workgroup workgroup t)))
 
    (if (not workgroup) (wg-session-local-value variable)
 
      (let* ((undefined (cl-gensym))
 
             (value (wg-workgroup-parameter workgroup variable undefined)))
 
        (if (not (eq value undefined)) value
 
          (wg-session-local-value variable))))))
 
(defalias 'wg-local-value 'wg-workgroup-local-value)
 

	
 

	
 
(defun wg-workgroup-saved-wconfig-names (workgroup)
 
  "Return a new list of the names of all WORKGROUP's saved wconfigs."
 
  (mapcar 'wg-wconfig-name (wg-workgroup-saved-wconfigs workgroup)))
 

	
 
(defun wg-workgroup-get-saved-wconfig (wconfig-or-name &optional workgroup)
 
  "Return the wconfig by WCONFIG-OR-NAME from WORKGROUP's saved wconfigs.
 
WCONFIG-OR-NAME must be either a string or a wconfig.  If
 
WCONFIG-OR-NAME is a string and there is no saved wconfig with
 
that name, return nil.  If WCONFIG-OR-NAME is a wconfig, and it
 
is a member of WORKGROUP's saved wconfigs, return is as given.
 
Otherwise return nil."
 
  (let ((wconfigs (wg-workgroup-saved-wconfigs (or workgroup (wg-current-workgroup)))))
 
    (cl-etypecase wconfig-or-name
 
      (wg-wconfig (car (memq wconfig-or-name wconfigs)))
 
      (string (cl-find wconfig-or-name wconfigs
 
                       :key 'wg-wconfig-name
 
                       :test 'string=)))))
 

	
 
(defun wg-workgroup-save-wconfig (wconfig &optional workgroup)
 
  "Add WCONFIG to WORKGROUP's saved wconfigs.
 
WCONFIG must have a name.  If there's already a wconfig with the
 
same name in WORKGROUP's saved wconfigs, replace it."
 
  (let ((name (wg-wconfig-name wconfig)))
 
    (unless name (error "Attempt to save a nameless wconfig"))
 
    (setf (wg-workgroup-modified workgroup) t)
 
    (wg-asetf (wg-workgroup-saved-wconfigs workgroup)
 
              (cons wconfig (cl-remove name it
 
                                       :key 'wg-wconfig-name
 
                                       :test 'string=)))))
 

	
 
(defun wg-workgroup-kill-saved-wconfig (workgroup wconfig-or-name)
 
  "Delete WCONFIG-OR-NAME from WORKGROUP's saved wconfigs.
 
WCONFIG-OR-NAME is resolved with `wg-workgroup-get-saved-wconfig'."
 
  (-when-let (wconfig (wg-workgroup-get-saved-wconfig
 
                       workgroup wconfig-or-name))
 
    (wg-asetf (wg-workgroup-saved-wconfigs workgroup) (remq wconfig it)
 
              (wg-workgroup-modified workgroup) t)))
 

	
 

	
 

	
 
(defun wg-workgroup-base-wconfig-buf-uids (workgroup)
 
  "Return a new list of all unique buf uids in WORKGROUP's working wconfig."
 
  (wg-wconfig-buf-uids (wg-workgroup-base-wconfig workgroup)))
 

	
 
(defun wg-workgroup-saved-wconfigs-buf-uids (workgroup)
 
  "Return a new list of all unique buf uids in WORKGROUP's base wconfig."
 
  (cl-reduce 'wg-string-list-union
 
             (wg-workgroup-saved-wconfigs workgroup)
 
             :key 'wg-wconfig-buf-uids))
 

	
 
(defun wg-workgroup-all-wconfig-buf-uids (workgroup)
 
  "Return a new list of all unique buf uids in WORKGROUP's wconfigs."
 
  (cl-union (wg-workgroup-base-wconfig-buf-uids workgroup)
 
            (wg-workgroup-saved-wconfigs-buf-uids workgroup)
 
            :test 'string=))
 

	
 
(defun wg-workgroup-all-buf-uids (workgroup)
 
  "Return a new list of all unique buf uids in WORKGROUP."
 
  (cl-reduce 'wg-string-list-union
 
             (list (wg-workgroup-base-wconfig-buf-uids workgroup)
 
                   (wg-workgroup-saved-wconfigs-buf-uids workgroup))))
 

	
 
(defun wg-restore-workgroup (workgroup)
 
  "Restore WORKGROUP in `selected-frame'."
 
  (let (wg-flag-modified)
 
    (wg-restore-wconfig-undoably (wg-workgroup-working-wconfig workgroup) t)))
 

	
 
(defun wg-workgroup-list-or-error (&optional noerror)
 
  "Return the value of `wg-current-session's :workgroup-list slot.
 
Or scream unless NOERROR."
 
  (or (wg-workgroup-list)
 
      (unless noerror (error "No workgroups are defined"))))
 

	
 
(defun wg-find-workgroup-by (slotkey value &optional noerror)
 
  "Return the workgroup on which ACCESSOR returns VALUE or error."
 
  (let ((accessor (cl-ecase slotkey
 
                    (:name 'wg-workgroup-name)
 
                    (:uid  'wg-workgroup-uid))))
 
    (or (cl-find value (wg-workgroup-list-or-error noerror) :test 'equal :key accessor)
 
        (unless noerror
 
          (error "No are no workgroups with a %S of %S"
 
                 accessor value)))))
 

	
 
(defun wg-cyclic-nth-from-workgroup (workgroup &optional n)
 
  "Return the workgroup N places from WORKGROUP in `wg-workgroup-list'."
 
  (wg-cyclic-nth-from-elt workgroup (wg-workgroup-list-or-error) (or n 1)))
 

	
 
(defun wg-workgroup-names (&optional noerror)
 
  "Return a list of workgroup names or scream unless NOERROR."
 
  (mapcar 'wg-workgroup-name (wg-workgroup-list-or-error noerror)))
 

	
 
(defun wg-read-workgroup-name (&optional require-match)
 
  "Read a workgroup name from `wg-workgroup-names'.
 
REQUIRE-MATCH to match."
 
  (ido-completing-read "Workgroup: " (wg-workgroup-names) nil require-match nil nil
 
                       (awhen (wg-current-workgroup t) (wg-workgroup-name it))))
 

	
 
(defun wg-new-default-workgroup-name ()
 
  "Return a new, unique, default workgroup name."
 
  (let ((names (wg-workgroup-names t)) (index -1) result)
 
    (while (not result)
 
      (let ((new-name (format "wg%s" (cl-incf index))))
 
@@ -4077,452 +4075,452 @@ current and previous workgroups."
 

	
 
(defun wg-pickel-workgroup-parameters (workgroup)
 
  "Return a copy of WORKGROUP after pickeling its parameters.
 
If WORKGROUP's parameters are non-nil, otherwise return
 
WORKGROUP."
 
  (if (not (wg-workgroup-parameters workgroup)) workgroup
 
    (let ((copy (wg-copy-workgroup workgroup)))
 
      (wg-asetf (wg-workgroup-parameters copy) (wg-pickel it))
 
      copy)))
 

	
 
(defun wg-unpickel-workgroup-parameters (workgroup)
 
  "If WORKGROUP's parameters are non-nil, return a copy of
 
WORKGROUP after unpickeling its parameters. Otherwise return
 
WORKGROUP."
 
  (if (not (wg-workgroup-parameters workgroup)) workgroup
 
    (let ((copy (wg-copy-workgroup workgroup)))
 
      (wg-asetf (wg-workgroup-parameters copy) (wg-unpickel it))
 
      copy)))
 

	
 
(defun wg-delete-workgroup (workgroup)
 
  "Remove WORKGROUP from `wg-workgroup-list'.
 
Also delete all references to it by `wg-workgroup-state-table',
 
`wg-current-workgroup' and `wg-previous-workgroup'."
 
  (dolist (frame (frame-list))
 
    (remhash (wg-workgroup-uid workgroup) (wg-workgroup-state-table frame))
 
    (when (wg-current-workgroup-p workgroup frame)
 
      (wg-set-current-workgroup nil frame))
 
    (when (wg-previous-workgroup-p workgroup frame)
 
      (wg-set-previous-workgroup nil frame)))
 
  (setf (wg-workgroup-list) (remove workgroup (wg-workgroup-list-or-error)))
 
  (wg-flag-session-modified)
 
  workgroup)
 

	
 
(defun wg-add-workgroup (workgroup &optional index)
 
  "Add WORKGROUP to `wg-workgroup-list' at INDEX or the end.
 
If a workgroup with the same name exists, overwrite it."
 
  (awhen (wg-find-workgroup-by :name (wg-workgroup-name workgroup) t)
 
    (unless index (setq index (cl-position it (wg-workgroup-list-or-error))))
 
    (wg-delete-workgroup it))
 
  (wg-asetf (wg-workgroup-list)
 
            (wg-insert-before workgroup it (or index (length it))))
 
  (wg-flag-session-modified)
 
  workgroup)
 

	
 
(defun wg-check-and-add-workgroup (workgroup)
 
  "Add WORKGROUP to `wg-workgroup-list'.
 
Ask to overwrite if a workgroup with the same name exists."
 
  (let ((name (wg-workgroup-name workgroup))
 
        (uid (wg-workgroup-uid workgroup)))
 
    (when (wg-find-workgroup-by :uid uid t)
 
      (error "A workgroup with uid %S already exists" uid))
 
    (when (wg-find-workgroup-by :name name t)
 
      (unless (or wg-no-confirm-on-destructive-operation
 
                  (y-or-n-p (format "%S exists. Overwrite? " name)))
 
        (error "Cancelled"))))
 
  (wg-add-workgroup workgroup))
 

	
 
(defun wg-make-and-add-workgroup (name &optional blank)
 
  "Create a workgroup named NAME with current `window-tree'.
 
If BLANK - then just scratch buffer.
 
Add it with `wg-check-and-add-workgroup'."
 
  (wg-check-and-add-workgroup
 
   (wg-make-workgroup
 
    :name name
 
    :base-wconfig (if blank (wg-make-blank-wconfig)
 
                    (wg-current-wconfig)))))
 

	
 
(defun wg-get-workgroup-create (workgroup)
 
  "Return the workgroup specified by WORKGROUP, creating a new one if needed.
 
If `wg-get-workgroup' on WORKGROUP returns a workgroup, return it.
 
Otherwise, if WORKGROUP is a string, create a new workgroup with
 
that name and return it.  Otherwise error."
 
  (or (wg-get-workgroup workgroup t)
 
      (if (stringp workgroup)
 
          (wg-make-and-add-workgroup workgroup)
 
        (wg-get-workgroup workgroup))))  ; Call this again for its error message
 

	
 
(defun wg-cyclic-offset-workgroup (workgroup n)
 
  "Offset WORKGROUP's position in `wg-workgroup-list' by N."
 
  (let ((workgroup-list (wg-workgroup-list-or-error)))
 
    (unless (member workgroup workgroup-list)
 
      (error "Workgroup isn't present in `wg-workgroup-list'."))
 
    (setf (wg-workgroup-list) (wg-cyclic-offset-elt workgroup workgroup-list n)
 
          (wg-session-modified (wg-current-session)) t)))
 

	
 
(defun wg-swap-workgroups-in-workgroup-list (workgroup1 workgroup2)
 
  "Swap the positions of WORKGROUP1 and WORKGROUP2 in `wg-workgroup-list'."
 
  (let ((workgroup-list (wg-workgroup-list-or-error)))
 
    (when (eq workgroup1 workgroup2)
 
      (error "Can't swap a workgroup with itself"))
 
    (unless (and (memq workgroup1 workgroup-list)
 
                 (memq workgroup2 workgroup-list))
 
      (error "Both workgroups aren't present in `wg-workgroup-list'."))
 
    (setf (wg-workgroup-list) (wg-util-swap workgroup1 workgroup2 workgroup-list)
 
          (wg-session-modified (wg-current-session)) t)))
 

	
 
(defun wg-session-uids-consistent-p ()
 
  "Return t if there are no duplicate bufs or buf uids in the wrong places.
 
nil otherwise."
 
  (and (not (wg-dups-p (wg-buf-list) :key 'wg-buf-uid :test 'string=))
 
       (not (wg-dups-p (wg-workgroup-list) :key 'wg-workgroup-uid :test 'string=))))
 

	
 
(defun wg-find-session-file (filename)
 
  "Load a session visiting FILENAME, creating one if none already exists."
 
  (interactive "FFind session file: ")
 
  (cond ((file-exists-p filename)
 
         ;; TODO: handle errors when reading object
 
         (let ((session (read (f-read-text filename))))
 
           (unless (wg-session-p session)
 
             (error "%S is not a Workgroups session file." filename))
 
           (setf (wg-session-file-name session) filename)
 
           (wg-reset-internal (wg-unpickel-session-parameters session)))
 

	
 
         (if wg-control-frames (wg-restore-frames))
 

	
 
         (awhen (wg-workgroup-list)
 
           (if (and wg-open-this-wg
 
                    (member wg-open-this-wg (wg-workgroup-names)))
 
               (wg-switch-to-workgroup wg-open-this-wg)
 
             (if (and wg-load-last-workgroup
 
                      (member (wg-session-parameter 'last-workgroup) (wg-workgroup-names)))
 
                 (wg-switch-to-workgroup (wg-session-parameter 'last-workgroup))
 
               (wg-switch-to-workgroup (car it)))
 
             ))
 
         (wg-fontified-message (:cmd "Loaded: ") (:file filename))
 
         (wg-mark-everything-unmodified))
 
        (t
 
         (wg-query-and-save-if-modified)
 
         (wg-reset-internal (wg-make-session :file-name filename))
 
         (wg-fontified-message (:cmd "(New Workgroups session file)")))))
 
(defalias 'wg-open-session 'wg-find-session-file)
 

	
 
(defun wg-write-sexp-to-file (sexp file)
 
  "Write the printable representation of SEXP to FILE."
 
  (with-temp-buffer
 
    (let ((print-level nil)  (print-length nil))
 
      (insert (format "%S" sexp)))
 
    (write-file file)))
 

	
 
;; FIXME: Duplicate buf names probably shouldn't be allowed.  An unrelated error
 
;; causes two *scratch* buffers to be present, triggering the "uids don't match"
 
;; error.  Write something to remove bufs with duplicate names.
 
(defun wg-perform-session-maintenance ()
 
  "Perform various maintenance operations on the current Workgroups session."
 
  (wg-update-current-workgroup-working-wconfig)
 

	
 
  ;; Update every workgroup's base wconfig with `wg-workgroup-update-base-wconfig'
 
  (dolist (workgroup (wg-workgroup-list))
 
    (awhen (wg-workgroup-selected-frame-wconfig workgroup)
 
      (setf (wg-workgroup-base-wconfig workgroup) it
 
            (wg-workgroup-selected-frame-wconfig workgroup) nil)))
 

	
 
  ;; Garbage collection
 
  (let ((all-buf-uids (wg-all-buf-uids)))
 
    (wg-asetf (wg-buf-list)
 
              (cl-remove-if-not (lambda (uid) (member uid all-buf-uids)) it
 
                                :key 'wg-buf-uid)))
 
  (mapc 'wg-workgroup-gc-buf-uids (wg-workgroup-list))  ; Remove buf uids that have no referent in `wg-buf-list'
 
  (mapc 'wg-update-buffer-in-buf-list (wg-buffer-list-emacs)))
 

	
 
(defun wg-save-session-as (filename &optional confirm)
 
  "Write the current session into file FILENAME.
 
This makes the session visit that file, and marks it as not modified.
 

	
 
If optional second arg CONFIRM is non-nil, this function asks for
 
confirmation before overwriting an existing file.  Interactively,
 
confirmation is required unless you supply a prefix argument."
 
  (interactive (list (read-file-name "Save session as: ")
 
                     (not current-prefix-arg)))
 
  (when (and confirm (file-exists-p filename))
 
    (unless (y-or-n-p (format "File `%s' exists; overwrite? " filename))
 
      (error "Cancelled")))
 
  (unless (file-writable-p filename)
 
    (error "File %s can't be written to" filename))
 
  (wg-perform-session-maintenance)
 
  (setf (wg-session-file-name (wg-current-session)) filename)
 
  (setf (wg-session-version (wg-current-session)) wg-version)
 

	
 
  ;; Save opened frames as a session parameter "frame-list".
 
  ;; Exclude `selected-frame' and daemon one (if any).
 
  ;; http://stackoverflow.com/questions/21151992/why-emacs-as-daemon-gives-1-more-frame-than-is-opened
 
  (if wg-control-frames
 
      (let ((fl (frame-list)))
 
        ;; TODO: remove using dash
 
        (mapc (lambda (frame)
 
                (if (string-equal "initial_terminal" (terminal-name frame))
 
                    (delete frame fl))) fl)
 
        (setq fl (delete (selected-frame) fl))
 
        (let (wg-flag-modified)
 
          (if (wg-current-session t)
 
              (wg-set-session-parameter 'frame-list (mapcar 'wg-frame-to-wconfig fl))))))
 
  (wg-write-sexp-to-file (wg-pickel-all-session-parameters) filename)
 
  (wg-mark-everything-unmodified)
 
  (wg-fontified-message (:cmd "Wrote: ") (:file filename)))
 
  (wg-fontified-message (:cmd "Wrote: ") (:file filename))
 
  (wg-mark-everything-unmodified))
 
(defalias 'wg-write-session-file 'wg-save-session-as)
 

	
 
(defun wg-get-session-file ()
 
  "Return the filename in which to save the session."
 
  (or (aif (wg-current-session t) (wg-session-file-name it))
 
      wg-session-file))
 
;;(read-file-name (format "Save session as [%s]: " wg-session-file))
 

	
 
(defun wg-save-session (&optional force)
 
  "Save the current Workgroups session if it's been modified.
 
When FORCE - save session regardless of whether it's been modified."
 
  (interactive "P")
 
  (if (and (not (wg-modified-p)) (not force))
 
      (wg-message "(The session is unmodified)")
 
    (wg-save-session-as (wg-get-session-file))))
 

	
 
(defun wg-reset-internal (&optional session)
 
  "Reset Workgroups, setting `wg-current-session' to SESSION.
 
Resets all frame parameters, buffer-local vars, current session
 
object, etc.  SESSION nil defaults to a new, blank session."
 
  (mapc 'wg-reset-frame (frame-list))
 
  (mapc 'wg-reset-buffer (wg-buffer-list-emacs))
 
  (setq wg-wconfig-kill-ring nil)
 
  (setq wg-current-session (or session (wg-make-session))))
 

	
 
(defun wg-all-buf-uids (&optional session buffer-list)
 
  "Return the union of all SESSION buf-uids and BUFFER-LIST uids."
 
  (cl-union (cl-reduce 'wg-string-list-union  ; (wg-session-all-buf-uids session)
 
                       (wg-session-workgroup-list (or session (wg-current-session)))
 
                       :key 'wg-workgroup-all-buf-uids)
 
            ;; (wg-buffer-list-all-uids buffer-list)
 
            (delq nil (mapcar 'wg-buffer-uid (or buffer-list (wg-buffer-list-emacs))))
 
            :test 'string=))
 

	
 
(defun wg-modified-p ()
 
  "Return t when the current session or any of its workgroups are modified."
 
  (aif (wg-current-session t)
 
      (or (wg-session-modified it)
 
          (cl-some 'wg-workgroup-modified (wg-workgroup-list)))))
 

	
 
(defun wg-mark-everything-unmodified ()
 
  "Mark the session and all workgroups as unmodified."
 
  (setf (wg-session-modified (wg-current-session)) nil)
 
  (dolist (workgroup (wg-workgroup-list))
 
    (setf (wg-workgroup-modified workgroup) nil)))
 

	
 
(defun wg-session-parameter (parameter &optional default session)
 
  "Return session's value for PARAMETER.
 
If PARAMETER is not found, return DEFAULT which defaults to nil.
 
SESSION nil defaults to the current session."
 
  (wg-aget (wg-session-parameters (or session (wg-current-session)))
 
           parameter default))
 

	
 
(defun wg-set-session-parameter (parameter value &optional session)
 
  "Set PARAMETER to VALUE in SESSION.
 
SESSION nil means use the current session.  Return value."
 
  (let ((session (or session (wg-current-session))))
 
    (wg-set-parameter (wg-session-parameters session) parameter value)
 
    (wg-flag-session-modified session)
 
    value))
 

	
 
(defun wg-remove-session-parameter (parameter &optional session)
 
  "Remove parameter PARAMETER from SESSION's parameters."
 
  (let ((session (or session (wg-current-session))))
 
    (wg-asetf (wg-session-parameters session) (wg-aremove it parameter))
 
    (setf (wg-session-modified session) t)))
 
    (wg-flag-session-modified session)))
 

	
 
(defun wg-session-local-value (variable &optional session)
 
  "Return the value of VARIABLE in SESSION.
 
SESSION nil defaults to the current session.  If VARIABLE does
 
not have a session-local binding in SESSION, the value is
 
resolved by Emacs."
 
  (let* ((undefined (cl-gensym))
 
         (value (wg-session-parameter variable undefined session)))
 
    (if (not (eq value undefined)) value
 
      (symbol-value variable))))
 

	
 
(defun wg-reset-frame (frame)
 
  "Reset Workgroups' `frame-parameters' in FRAME to nil."
 
  (set-frame-parameter frame 'wg-workgroup-state-table nil)
 
  (set-frame-parameter frame 'wg-current-workgroup-uid nil)
 
  (set-frame-parameter frame 'wg-previous-workgroup-uid nil))
 

	
 
(defun wg-save-session-on-exit (behavior)
 
  "Perform session-saving operations based on BEHAVIOR."
 
  (cl-case behavior
 
    (ask (wg-query-and-save-if-modified))
 
    (save (wg-save-session))))
 

	
 
(defun wg-reload-session ()
 
  "Reload current workgroups session."
 
  (interactive)
 
  (let* ((file (wg-get-session-file))
 
         (exists (file-exists-p file)))
 
    (condition-case err
 
        (wg-open-session file)
 
      (progn
 
        (wg-create-first-wg)
 
        (message "Error loading session-file: %s" err))))
 
        ;; TODO: print what exactly happened
 
  (wg-create-first-wg))
 

	
 
(defun wg-save-session-on-emacs-exit ()
 
  "Call `wg-save-session-on-exit' with `wg-emacs-exit-save-behavior'.
 
Added to `kill-emacs-query-functions'."
 
  (wg-save-session-on-exit wg-emacs-exit-save-behavior) t)
 

	
 
(defun wg-save-session-on-workgroups-mode-exit ()
 
  "Call `wg-save-session-on-exit' with `wg-workgroups-mode-exit-save-behavior'.
 
Called when `workgroups-mode' is turned off."
 
  (wg-save-session-on-exit wg-workgroups-mode-exit-save-behavior) t)
 

	
 
(defun wg-pickel-all-session-parameters (&optional session)
 
  "Return a copy of SESSION after pickeling its parameters.
 
And the parameters of all its workgroups."
 
  (let ((copy (wg-copy-session (or session (wg-current-session)))))
 
    (when (wg-session-parameters copy)
 
      (wg-asetf (wg-session-parameters copy) (wg-pickel it)))
 
    (wg-asetf (wg-session-workgroup-list copy)
 
              (cl-mapcar 'wg-pickel-workgroup-parameters it))
 
    copy))
 

	
 
(defun wg-unpickel-session-parameters (session)
 
  "Return a copy of SESSION after unpickeling its parameters.
 
And the parameters of all its workgroups."
 
  (let ((copy (wg-copy-session session)))
 
    (when (wg-session-parameters copy)
 
      (wg-asetf (wg-session-parameters copy) (wg-unpickel it)))
 
    (wg-asetf (wg-session-workgroup-list copy)
 
              (cl-mapcar 'wg-unpickel-workgroup-parameters it))
 
    copy))
 

	
 
(defvar wg-buffer-workgroup nil
 
  "Associating each buffer with the workgroup.
 
In which it most recently appeared.")
 
(make-variable-buffer-local 'wg-buffer-workgroup)
 

	
 
(defun wg-workgroup-associated-buf-uids (&optional workgroup)
 
  "Return a new list containing all of WORKGROUP's associated buf uids."
 
  (awhen (or workgroup (wg-current-workgroup t))
 
    (append (wg-workgroup-strong-buf-uids it)
 
            (wg-workgroup-weak-buf-uids it))))
 

	
 
(defun wg-workgroup-associated-bufs (workgroup)
 
  "Return a new list containing all of WORKGROUP's associated bufs."
 
  (delete nil (mapcar 'wg-find-buf-by-uid
 
                      (wg-workgroup-associated-buf-uids workgroup))))
 

	
 
(defun wg-workgroup-associated-buffers (workgroup)
 
  "Return a new list containing all of WORKGROUP's associated buffer objects."
 
  (delete nil (mapcar 'wg-restore-buffer
 
                      (wg-workgroup-associated-bufs workgroup))))
 

	
 
(defun wg-workgroup-strongly-associate-bufobj (workgroup bufobj)
 
  "Strongly associate BUFOBJ with WORKGROUP."
 
  (let* ((uid (wg-bufobj-uid-or-add bufobj))
 
         (remp (wg-removef-p uid (wg-workgroup-weak-buf-uids workgroup)
 
                             :test 'string=))
 
         (addp (wg-pushnew-p uid (wg-workgroup-strong-buf-uids workgroup)
 
                             :test 'string=)))
 
    (when (or remp addp)
 
      (wg-flag-workgroup-modified workgroup)
 
      bufobj)))
 

	
 
(defun wg-workgroup-weakly-associate-bufobj (workgroup bufobj)
 
  "Weakly associate BUFOBJ with WORKGROUP."
 
  (let* ((uid (wg-bufobj-uid-or-add bufobj))
 
         (remp (wg-removef-p uid (wg-workgroup-strong-buf-uids workgroup)
 
                             :test 'string=))
 
         (addp (wg-pushnew-p uid (wg-workgroup-weak-buf-uids workgroup)
 
                             :test 'string=)))
 
    (when (or remp addp)
 
      (wg-flag-workgroup-modified workgroup)
 
      bufobj)))
 

	
 
(defun wg-workgroup-associate-bufobj (workgroup bufobj &optional weak)
 
  "Associate BUFOBJ with WORKGROUP.
 
WEAK non-nil means weakly associate it.  Otherwise strongly associate it."
 
  (if weak (wg-workgroup-weakly-associate-bufobj workgroup bufobj)
 
    (wg-workgroup-strongly-associate-bufobj workgroup bufobj)))
 

	
 
(defun wg-workgroup-dissociate-bufobj (workgroup bufobj)
 
  "Dissociate BUFOBJ from WORKGROUP."
 
  (let* ((uid (wg-bufobj-uid-or-add bufobj))
 
         (rem1p (wg-removef-p uid (wg-workgroup-strong-buf-uids workgroup)
 
                              :test 'string=))
 
         (rem2p (wg-removef-p uid (wg-workgroup-weak-buf-uids workgroup)
 
                              :test 'string=)))
 
    (when (or rem1p rem2p)
 
      (wg-flag-workgroup-modified workgroup)
 
      bufobj)))
 

	
 
(defun wg-workgroup-dissociate-weakly-associated-buffers (workgroup)
 
  "Dissociate from WORKGROUP all weakly associated buffers."
 
  (when (wg-workgroup-weak-buf-uids workgroup)
 
    (wg-flag-workgroup-modified workgroup)
 
    (setf (wg-workgroup-weak-buf-uids workgroup) nil)))
 

	
 
(defun wg-workgroup-dissociate-strongly-associated-buffers (workgroup)
 
  "Dissociate from WORKGROUP all strongly associated buffers."
 
  (when (wg-workgroup-strong-buf-uids workgroup)
 
    (wg-flag-workgroup-modified workgroup)
 
    (setf (wg-workgroup-strong-buf-uids workgroup) nil)))
 

	
 
(defun wg-workgroup-dissociate-all-buffers (workgroup)
 
  "Dissociate from WORKGROUP all its associated buffers."
 
  (wg-workgroup-dissociate-weakly-associated-buffers workgroup)
 
  (wg-workgroup-dissociate-strongly-associated-buffers workgroup))
 

	
 
(defun wg-auto-dissociate-buffer-hook ()
 
  "`kill-buffer-hook' that automatically dissociates buffers from workgroups."
 
  (when wg-dissociate-buffer-on-kill-buffer
 
    (awhen (wg-current-workgroup t)
 
      (wg-workgroup-dissociate-bufobj it (current-buffer)))))
 

	
 
(defun wg-associate-buffer-with-workgroup (&optional workgroup buffer weak)
 
  "Associate BUFFER with WORKGROUP.
 
WEAK non-nil means weakly associate BUFFER."
 
  (interactive (list nil nil current-prefix-arg))
 
  (let* ((workgroup (wg-get-workgroup workgroup))
 
         (buffer (or buffer (current-buffer)))
 
         (bname (buffer-name buffer))
 
         (wgname (wg-workgroup-name workgroup)))
 
    (if (wg-workgroup-associate-bufobj workgroup buffer weak)
 
        (wg-message "%s-associated %S with %s"
 
                    (if weak "Weakly" "Strongly") bname wgname)
 
      (wg-message "%S is already associated with %s" bname wgname))))
 

	
 
(defun wg-associate-visible-buffers-with-workgroup (&optional workgroup weak)
 
  "Associate all buffers visible in `selected-frame' with WORKGROUP.
 
WEAK non-nil means weakly associate them.  Otherwise strongly
 
associate them."
 
  (interactive (list nil current-prefix-arg))
 
  (let ((workgroup (wg-get-workgroup workgroup))
 
        (buffers (mapcar 'window-buffer (window-list))))
 
    (dolist (buffer buffers)
 
      (wg-workgroup-associate-bufobj workgroup buffer weak))
 
    (wg-fontified-message
 
      (:cmd (format "%s associated: " (if weak "Weakly" "Strongly")))
 
      (wg-display-internal 'wg-buffer-display buffers))))
 

	
 
(defun wg-dissociate-buffer-from-workgroup (&optional workgroup buffer)
 
  "Dissociate BUFFER from WORKGROUP."
 
  (interactive (list nil nil))
 
  (let ((workgroup (wg-get-workgroup workgroup))
 
        (buffer (or buffer (current-buffer))))
 
    (wg-message
 
     (if (wg-workgroup-dissociate-bufobj workgroup buffer)
 
         "Dissociated %S from %s" "%S isn't associated with %s")
 
     (wg-buffer-name buffer)
 
     (wg-workgroup-name workgroup))))
 

	
 
(defun wg-associate-buffers (workgroup window-or-emacs-window-tree)
 
  "Associate the buffers visible in window elements of
 
WINDOW-OR-EMACS-WINDOW-TREE with the given WORKGROUP.
 
WINDOW-OR-EMACS-WINDOW-TREE must be either a window or a tree of
 
the form produced by `(car (window-tree))'."
 
  (if (windowp window-or-emacs-window-tree)
0 comments (0 inline, 0 general)