Changeset - 20ec9e5e67f0
[Not reviewed]
0 1 0
Sergey Pashinin - 11 years ago 2014-08-28 10:55:01
sergey@pashinin.com
Check session parameter
1 file changed with 2 insertions and 3 deletions:
0 comments (0 inline, 0 general)
src/workgroups2.el
Show inline comments
 
@@ -3493,1118 +3493,1117 @@ Or scream unless 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))))
 
        (unless (member new-name names)
 
          (setq result new-name))))
 
    result))
 

	
 
(defun wg-unique-workgroup-name-p (new-name)
 
  "Return t if NEW-NAME is unique in `wg-workgroup-list', nil otherwise."
 
  (cl-every (lambda (existing-name) (not (equal new-name existing-name)))
 
            (wg-workgroup-names t)))
 

	
 
(defun wg-read-saved-wconfig-name (workgroup &optional prompt require-match)
 
  "Read the name of a saved wconfig, completing on the names of
 
WORKGROUP's saved wconfigs."
 
  (ido-completing-read (or prompt "Saved wconfig name: ")
 
                       (wg-workgroup-saved-wconfig-names workgroup)
 
                       nil require-match))
 

	
 
(defun wg-read-saved-wconfig (workgroup)
 
  "Read the name of and return one of WORKGROUP's saved wconfigs."
 
  (wg-workgroup-get-saved-wconfig
 
   workgroup (wg-read-saved-wconfig-name workgroup nil t)))
 

	
 

	
 
;;; workgroup-list reorganization commands
 

	
 
(defun wg-swap-workgroups ()
 
  "Swap the previous and current workgroups."
 
  (interactive)
 
  (wg-swap-workgroups-in-workgroup-list
 
   (wg-current-workgroup) (wg-previous-workgroup))
 
  (wg-fontified-message
 
    (:cmd "Swapped:  ")
 
    (wg-workgroup-list-display)))
 

	
 
(defun wg-offset-workgroup-left (&optional workgroup n)
 
  "Offset WORKGROUP leftward in `wg-workgroup-list' cyclically."
 
  (interactive (list nil current-prefix-arg))
 
  (wg-cyclic-offset-workgroup (wg-get-workgroup workgroup) (or n -1))
 
  (wg-fontified-message
 
    (:cmd "Offset left: ")
 
    (wg-workgroup-list-display)))
 

	
 
(defun wg-offset-workgroup-right (&optional workgroup n)
 
  "Offset WORKGROUP rightward in `wg-workgroup-list' cyclically."
 
  (interactive (list nil current-prefix-arg))
 
  (wg-cyclic-offset-workgroup (wg-get-workgroup workgroup) (or n 1))
 
  (wg-fontified-message
 
    (:cmd "Offset right: ")
 
    (wg-workgroup-list-display)))
 

	
 

	
 
;;; undo/redo commands
 

	
 
(defun wg-undo-wconfig-change (&optional workgroup)
 
  "Undo a change to the current workgroup's window-configuration."
 
  (interactive)
 
  (let* ((workgroup (wg-get-workgroup workgroup))
 
         (undid? (wg-workgroup-offset-position-in-undo-list workgroup 1)))
 
    (wg-fontified-message
 
      (:cmd "Undo")
 
      (:cur (if undid? "" "  No more undo info")))))
 

	
 
(defun wg-redo-wconfig-change (&optional workgroup)
 
  "Redo a change to the current workgroup's window-configuration."
 
  (interactive)
 
  (let* ((workgroup (wg-get-workgroup workgroup))
 
         (redid? (wg-workgroup-offset-position-in-undo-list workgroup -1)))
 
    (wg-fontified-message
 
      (:cmd "Redo")
 
      (:cur (if redid? "" "  No more redo info")))))
 

	
 
(defun wg-undo-once-all-workgroups ()
 
  "Do what the name says.  Useful for instance when you
 
accidentally call `wg-revert-all-workgroups' and want to return
 
all workgroups to their un-reverted state."
 
  (interactive)
 
  (mapc 'wg-undo-wconfig-change (wg-workgroup-list-or-error))
 
  (wg-message "Undid once on all workgroups."))
 

	
 
(defun wg-redo-once-all-workgroups ()
 
  "Do what the name says.  Probably useless.  Included for
 
symetry with `wg-undo-once-all-workgroups'."
 
  (interactive)
 
  (mapc 'wg-redo-wconfig-change (wg-workgroup-list-or-error))
 
  (wg-message "Redid once on all workgroups."))
 

	
 

	
 

	
 
;;; window-tree commands
 
;;
 
;; TODO: These are half-hearted.  Clean them up; allow specification of the
 
;; window-tree depth at which to operate; add complex window creation commands;
 
;; and add window splitting, deletion and locking commands.
 

	
 
(defun wg-reverse-frame-horizontally (&optional workgroup)
 
  "Reverse the order of all horizontally split wtrees."
 
  (interactive)
 
  (wg-restore-wconfig-undoably
 
   (wg-reverse-wconfig
 
    (wg-workgroup-working-wconfig
 
     (wg-get-workgroup workgroup)))))
 

	
 
(defun wg-reverse-frame-vertically (&optional workgroup)
 
  "Reverse the order of all vertically split wtrees."
 
  (interactive)
 
  (wg-restore-wconfig-undoably
 
   (wg-reverse-wconfig
 
    (wg-workgroup-working-wconfig
 
     (wg-get-workgroup workgroup))
 
    t)))
 

	
 
(defun wg-reverse-frame-horizontally-and-vertically (&optional workgroup)
 
  "Reverse the order of all wtrees."
 
  (interactive)
 
  (wg-restore-wconfig-undoably
 
   (wg-reverse-wconfig
 
    (wg-workgroup-working-wconfig
 
     (wg-get-workgroup workgroup))
 
    'both)))
 

	
 
(defun wg-rename-workgroup (workgroup newname)
 
  "Rename WORKGROUP to NEWNAME."
 
  (interactive (list nil (wg-read-new-workgroup-name "New name: ")))
 
  (let* ((workgroup (wg-get-workgroup workgroup))
 
         (oldname (wg-workgroup-name workgroup)))
 
    (setf (wg-workgroup-name workgroup) newname)
 
    (wg-flag-workgroup-modified workgroup)
 
    (wg-fontified-message
 
      (:cmd "Renamed: ")
 
      (:cur oldname)
 
      (:msg " to ")
 
      (:cur (wg-workgroup-name workgroup)))))
 

	
 
(defun wg-reset (&optional force)
 
  "Reset Workgroups.
 
Resets all frame parameters, buffer-local vars, the current
 
Workgroups session object, etc."
 
  (interactive "P")
 
  (unless (or force wg-no-confirm-on-destructive-operation
 
              (y-or-n-p "Really reset Workgroups? "))
 
    (error "Canceled"))
 
  (wg-reset-internal)
 
  (wg-fontified-message (:cmd "Reset: ") (:msg "Workgroups")))
 

	
 
(defun wg-query-and-save-if-modified ()
 
  "Query for save when `wg-modified-p'."
 
  (or (not (wg-modified-p))
 
      (when (y-or-n-p "Save modified workgroups? ")
 
        (wg-save-session))))
 

	
 
(defun wg-create-workgroup (name &optional blank)
 
  "Create and add a workgroup named NAME.
 
Optional argument BLANK non-nil (set interactively with a prefix
 
arg) means use a blank, one window window-config.  Otherwise use
 
the current window-configuration.  Keep in mind that even though
 
the current window-config may be used, other parameters of the
 
current workgroup are not copied to the created workgroup.  For
 
that, use `wg-clone-workgroup'."
 
  (interactive (list (wg-read-new-workgroup-name) current-prefix-arg))
 
  (wg-switch-to-workgroup (wg-make-and-add-workgroup name blank))
 
  (wg-fontified-message
 
    (:cmd "Created: ") (:cur name) "  " (wg-workgroup-list-display)))
 

	
 
(defun wg-clone-workgroup (workgroup name)
 
  "Create and add a clone of WORKGROUP named NAME.
 
Keep in mind that only WORKGROUP's top level alist structure is
 
copied, so destructive operations on the keys or values of
 
WORKGROUP will be reflected in the clone, and vice-versa.  Be
 
safe -- don't mutate them."
 
  (interactive (list nil (wg-read-new-workgroup-name)))
 
  (let* ((workgroup (wg-get-workgroup workgroup))
 
         (clone (wg-copy-workgroup workgroup)))
 
    (setf (wg-workgroup-name clone) name
 
          (wg-workgroup-uid clone) (wg-generate-uid))
 
    (when (wg-check-and-add-workgroup clone)
 
      (wg-flag-workgroup-modified clone))
 
    (wg-set-workgroup-working-wconfig
 
     clone (wg-workgroup-working-wconfig workgroup))
 
    (wg-switch-to-workgroup clone)
 
    (wg-fontified-message
 
      (:cmd "Cloned: ")
 
      (:cur (wg-workgroup-name workgroup))
 
      (:msg " to ")
 
      (:cur name) "  "
 
      (wg-workgroup-list-display))))
 

	
 
(defun wg-switch-to-workgroup (workgroup &optional noerror)
 
  "Switch to WORKGROUP.
 
NOERROR means fail silently."
 
  (interactive (list (wg-read-workgroup-name)))
 

	
 
  (fset 'buffer-list wg-buffer-list-original)
 

	
 
  ;; Mark if ECB is active
 
  (let (wg-flag-modified)
 
    (wg-set-workgroup-parameter 'ecb (and (boundp 'ecb-minor-mode)
 
                                          ecb-minor-mode)))
 
  ;;(wg-set-workgroup-parameter (wg-current-workgroup t) 'ecb-win-config (ecb-current-window-configuration))
 
  ;; (type-of (ecb-current-window-configuration))
 
  ;; (type-of (car (ecb-current-window-configuration)))
 
  ;; (type-of (car (nthcdr 3 (ecb-current-window-configuration))))
 
  ;; (wg-pickelable-or-error (ecb-current-window-configuration))
 
  ;;(ecb-current-window-configuration)
 
  ;;)
 

	
 
  (let ((workgroup (wg-get-workgroup-create workgroup))
 
        (current (wg-current-workgroup t)))
 
    (when (and (eq workgroup current) (not noerror))
 
      (error "Already on: %s" (wg-workgroup-name current)))
 
    (when current (push current wg-deactivation-list))
 
    (unwind-protect
 
        (progn
 
          ;; Before switching - turn off ECB
 
          ;; https://github.com/pashinin/workgroups2/issues/34
 
          (if (and (boundp 'ecb-minor-mode)
 
                   (boundp 'ecb-frame)
 
                   (fboundp 'ecb-deactivate)
 
                   ecb-minor-mode
 
                   (equal ecb-frame (selected-frame)))
 
              (let ((ecb-split-edit-window-after-start 'before-deactivation))
 
                (ecb-deactivate)))
 

	
 
          (wg-restore-workgroup workgroup)
 
          (wg-set-previous-workgroup current)
 
          (wg-set-current-workgroup workgroup)
 

	
 
          ;; Save "last-workgroup" to the session params
 
          (let (wg-flag-modified)
 
            (if (wg-current-workgroup t)
 
                (wg-set-session-parameter 'last-workgroup
 
                                          (wg-workgroup-name (wg-current-workgroup)))))
 

	
 
          ;; If a workgroup had ECB - turn it on
 
          (if (and (boundp 'ecb-minor-mode)
 
                   (not ecb-minor-mode)
 
                   (fboundp 'ecb-activate)
 
                   (wg-workgroup-parameter (wg-current-workgroup t) 'ecb nil))
 
              (let ((ecb-split-edit-window-after-start 'before-deactivation))
 
                (ecb-activate)))
 
          ;;(ecb-last-window-config-before-deactivation
 
          ;; (wg-workgroup-parameter (wg-current-workgroup t) 'ecb-win-config nil)))
 

	
 
          (run-hooks 'wg-switch-to-workgroup-hook)
 

	
 
          (if wg-mess-with-buffer-list
 
              (fset 'buffer-list wg-buffer-list-function))
 
          (wg-fontified-message
 
            (:cmd "Switched: ")
 
            (wg-workgroup-name (wg-current-workgroup t))
 
            ))
 
      (when current (pop wg-deactivation-list)))))
 

	
 
(defun wg-switch-to-workgroup-at-index (index)
 
  "Switch to the workgroup at INDEX in `wg-workgroup-list'."
 
  (interactive (list (or current-prefix-arg (wg-read-workgroup-index))))
 
  (let ((wl (wg-workgroup-list-or-error)))
 
    (wg-switch-to-workgroup
 
     (or (nth index wl) (error "There are only %d workgroups" (length wl))))))
 

	
 
(cl-macrolet
 
    ((define-range-of-switch-to-workgroup-at-index (num)
 
       `(progn
 
          ,@(wg-docar (i (wg-range 0 num))
 
              `(defun ,(intern (format "wg-switch-to-workgroup-at-index-%d" i)) ()
 
                 ,(format "Switch to the workgroup at index %d." i)
 
                 (interactive)
 
                 (wg-switch-to-workgroup-at-index ,i))))))
 
  (define-range-of-switch-to-workgroup-at-index 10))
 

	
 
(defun wg-switch-to-cyclic-nth-from-workgroup (workgroup n)
 
  "Switch N workgroups cyclically from WORKGROUP in `wg-workgroup-list.'"
 
  (let ((workgroup-list (wg-workgroup-list-or-error))
 
        (workgroup (wg-get-workgroup workgroup t)))
 
    (wg-switch-to-workgroup
 
     (cond ((not workgroup) (car workgroup-list))
 
           ((= 1 (length workgroup-list)) (error "There's only one workgroup"))
 
           (t (wg-cyclic-nth-from-workgroup workgroup n))))))
 

	
 
(defun wg-switch-to-workgroup-left (&optional workgroup n)
 
  "Switch to WORKGROUP that is (- N) places away from WORKGROUP in `wg-workgroup-list'.
 
Use `current-prefix-arg' for N if non-nil.  Otherwise N defaults to 1."
 
  (interactive (list nil current-prefix-arg))
 
  (wg-switch-to-cyclic-nth-from-workgroup workgroup (- (or n 1))))
 

	
 
(defun wg-switch-to-workgroup-right (&optional workgroup n)
 
  "Switch to the workgroup N places from WORKGROUP in `wg-workgroup-list'.
 
Use `current-prefix-arg' for N if non-nil.  Otherwise N defaults to 1."
 
  (interactive (list nil current-prefix-arg))
 
  (wg-switch-to-cyclic-nth-from-workgroup workgroup (or n 1)))
 

	
 
(defun wg-switch-to-previous-workgroup ()
 
  "Switch to the previous workgroup."
 
  (interactive)
 
  (wg-switch-to-workgroup (wg-previous-workgroup)))
 

	
 
(defun wg-wconfig-kill-ring ()
 
  "Return `wg-wconfig-kill-ring', creating it first if necessary."
 
  (or wg-wconfig-kill-ring
 
      (setq wg-wconfig-kill-ring (make-ring wg-wconfig-kill-ring-max))))
 

	
 
(defun wg-add-to-wconfig-kill-ring (wconfig)
 
  "Add WCONFIG to `wg-wconfig-kill-ring'."
 
  (ring-insert (wg-wconfig-kill-ring) wconfig))
 

	
 
(defun wg-kill-workgroup (&optional workgroup)
 
  "Kill WORKGROUP, saving its working-wconfig to the kill ring."
 
  (interactive)
 
  (let* ((workgroup (wg-get-workgroup workgroup))
 
         (to (or (wg-previous-workgroup t)
 
                 (wg-cyclic-nth-from-workgroup workgroup))))
 
    (wg-add-to-wconfig-kill-ring (wg-workgroup-working-wconfig workgroup))
 
    (wg-delete-workgroup workgroup)
 
    (if (eq workgroup to) (wg-restore-wconfig (wg-make-blank-wconfig))
 
      (wg-switch-to-workgroup to))
 
    (wg-fontified-message
 
      (:cmd "Killed: ")
 
      (:cur (wg-workgroup-name workgroup)) "  "
 
      (wg-workgroup-list-display))))
 

	
 
(defun wg-kill-ring-save-base-wconfig (&optional workgroup)
 
  "Save WORKGROUP's base wconfig to the kill ring."
 
  (interactive)
 
  (let ((workgroup (wg-get-workgroup workgroup)))
 
    (wg-add-to-wconfig-kill-ring (wg-workgroup-base-wconfig workgroup))
 
    (wg-fontified-message
 
      (:cmd "Saved: ") (:cur (wg-workgroup-name workgroup))
 
      (:cur "'s ") (:msg "base wconfig to the kill ring"))))
 

	
 
(defun wg-kill-ring-save-working-wconfig (&optional workgroup)
 
  "Save WORKGROUP's working-wconfig to `wg-wconfig-kill-ring'."
 
  (interactive)
 
  (let ((workgroup (wg-get-workgroup workgroup)))
 
    (wg-add-to-wconfig-kill-ring (wg-workgroup-working-wconfig workgroup))
 
    (wg-fontified-message
 
      (:cmd "Saved: ") (:cur (wg-workgroup-name workgroup))
 
      (:cur "'s ") (:msg "working-wconfig to the kill ring"))))
 

	
 
(defun wg-yank-wconfig ()
 
  "Restore a wconfig from `wg-wconfig-kill-ring'.
 
Successive yanks restore wconfigs sequentially from the kill
 
ring, starting at the front."
 
  (interactive)
 
  (when (zerop (ring-length (wg-wconfig-kill-ring)))
 
    (error "The kill-ring is empty"))
 
  (let ((pos (if (not (eq real-last-command 'wg-yank-wconfig)) 0
 
               (1+ (or (get 'wg-yank-wconfig :position) 0)))))
 
    (put 'wg-yank-wconfig :position pos)
 
    (wg-restore-wconfig-undoably (ring-ref (wg-wconfig-kill-ring) pos))
 
    (wg-fontified-message
 
      (:cmd "Yanked: ")
 
      (:msg (format "%S" pos)) "  "
 
      (wg-workgroup-list-display))))
 

	
 
(defun wg-kill-workgroup-and-buffers (&optional workgroup)
 
  "Kill WORKGROUP and the buffers in its working-wconfig."
 
  (interactive)
 
  (let* ((workgroup (wg-get-workgroup workgroup))
 
         (bufs (save-window-excursion
 
                 (wg-restore-workgroup workgroup)
 
                 (mapcar #'window-buffer (window-list)))))
 
    (wg-kill-workgroup workgroup)
 
    (mapc #'kill-buffer bufs)
 
    (wg-fontified-message
 
      (:cmd "Killed: ")
 
      (:cur (wg-workgroup-name workgroup))
 
      (:msg " and its buffers ") "\n"
 
      (wg-workgroup-list-display))))
 

	
 
(defun wg-delete-other-workgroups (&optional workgroup)
 
  "Delete all workgroups but WORKGROUP."
 
  (interactive)
 
  (let ((workgroup (wg-get-workgroup workgroup)))
 
    (unless (or wg-no-confirm-on-destructive-operation
 
                (y-or-n-p "Really delete all other workgroups? "))
 
      (error "Cancelled"))
 
    (dolist (w (wg-workgroup-list-or-error))
 
      (unless (eq w workgroup)
 
        (wg-delete-workgroup w)))
 
    (unless (wg-current-workgroup-p workgroup)
 
      (wg-switch-to-workgroup workgroup))
 
    (wg-fontified-message
 
      (:cmd "Deleted: ")
 
      (:msg "All workgroups but ")
 
      (:cur (wg-workgroup-name workgroup)))))
 

	
 
(defun wg-revert-workgroup (&optional workgroup)
 
  "Restore WORKGROUP's window configuration to its state at the last save."
 
  (interactive)
 
  (let* ((workgroup (wg-get-workgroup workgroup))
 
         (base-wconfig (wg-workgroup-base-wconfig workgroup)))
 
    (if (wg-current-workgroup-p workgroup)
 
        (wg-restore-wconfig-undoably base-wconfig)
 
      (wg-add-wconfig-to-undo-list workgroup base-wconfig))
 
    (wg-fontified-message
 
      (:cmd "Reverted: ")
 
      (:cur (wg-workgroup-name workgroup)))))
 

	
 
(defun wg-revert-all-workgroups ()
 
  "Revert all workgroups to their base wconfigs.
 
Only workgroups' working-wconfigs in `selected-frame' are
 
reverted."
 
  (interactive)
 
  (mapc #'wg-revert-workgroup (wg-workgroup-list-or-error))
 
  (wg-fontified-message
 
    (:cmd "Reverted: ")
 
    (:msg "All")))
 

	
 
(defun wg-workgroup-state-table (&optional frame)
 
  "Return FRAME's workgroup table, creating it first if necessary."
 
  (or (frame-parameter frame 'wg-workgroup-state-table)
 
      (let ((wtree (make-hash-table :test 'equal)))
 
        (set-frame-parameter frame 'wg-workgroup-state-table wtree)
 
        wtree)))
 

	
 
(defun wg-get-workgroup-state (workgroup &optional frame)
 
  "Return WORKGROUP's state table in a FRAME."
 
  (let ((uid (wg-workgroup-uid workgroup))
 
        (state-table (wg-workgroup-state-table frame)))
 
    (or (gethash uid state-table)
 
        (let ((wgs (wg-make-workgroup-state
 
                    :undo-pointer 0
 
                    :undo-list
 
                    (list (or (wg-workgroup-selected-frame-wconfig workgroup)
 
                              (wg-workgroup-base-wconfig workgroup))))))
 
          (puthash uid wgs state-table)
 
          wgs))))
 

	
 
(defmacro wg-with-undo (workgroup spec &rest body)
 
  "Bind WORKGROUP's undo state to SPEC and eval BODY."
 
  (declare (indent 2))
 
  (wg-dbind (state undo-pointer undo-list) spec
 
    `(let* ((,state (wg-get-workgroup-state ,workgroup))
 
            (,undo-pointer (wg-workgroup-state-undo-pointer ,state))
 
            (,undo-list (wg-workgroup-state-undo-list ,state)))
 
       ,@body)))
 

	
 
(defun wg-flag-just-exited-minibuffer ()
 
  "Added to `minibuffer-exit-hook'."
 
  (setq wg-just-exited-minibuffer t))
 

	
 
(defun wg-flag-window-configuration-changed ()
 
  "Set `wg-window-configuration-changed' to t.
 
But only if not the minibuffer was just exited.  Added to
 
`window-configuration-change-hook'."
 
  (if wg-just-exited-minibuffer
 
      (setq wg-just-exited-minibuffer nil)
 
    (progn
 
      (wg-flag-workgroup-modified)
 
      (setq wg-window-configuration-changed t))))
 

	
 
(defun wg-unflag-undoify-window-configuration-change ()
 
  "Set `wg-undoify-window-configuration-change' to nil, exempting
 
from undoification any window-configuration changes caused by the
 
current command."
 
  (setq wg-undoify-window-configuration-change nil))
 

	
 
(defun wg-set-workgroup-working-wconfig (workgroup wconfig)
 
  "Set the working-wconfig of WORKGROUP to WCONFIG."
 
  (wg-flag-workgroup-modified workgroup)
 
  (setf (wg-workgroup-selected-frame-wconfig workgroup) wconfig)
 
  (wg-with-undo workgroup (state undo-pointer undo-list)
 
    (setcar (nthcdr undo-pointer undo-list) wconfig)))
 

	
 
(defun wg-add-wconfig-to-undo-list (workgroup wconfig)
 
  "Add WCONFIG to WORKGROUP's undo list, truncating its future if necessary."
 
  (wg-with-undo workgroup (state undo-pointer undo-list)
 
    (let ((undo-list (cons nil (nthcdr undo-pointer undo-list))))
 
      (awhen (nthcdr wg-wconfig-undo-list-max undo-list) (setcdr it nil))
 
      (setf (wg-workgroup-state-undo-list state) undo-list))
 
    (setf (wg-workgroup-state-undo-pointer state) 0))
 
  (wg-set-workgroup-working-wconfig workgroup wconfig))
 

	
 
(defun wg-workgroup-working-wconfig (workgroup &optional noupdate)
 
  "Return WORKGROUP's working-wconfig.
 
If WORKGROUP is the current workgroup in `selected-frame', and
 
NOUPDATE is nil, set its working wconfig in `selected-frame' to
 
`wg-current-wconfig' and return the updated wconfig.  Otherwise
 
return WORKGROUP's current undo state."
 
  (if (and (not noupdate) (wg-current-workgroup-p workgroup))
 
      (wg-set-workgroup-working-wconfig workgroup (wg-current-wconfig))
 
    (wg-with-undo workgroup (state undo-pointer undo-list)
 
      (nth undo-pointer undo-list))))
 

	
 
(defun wg-update-current-workgroup-working-wconfig ()
 
  "Update `selected-frame's current workgroup's working-wconfig with `wg-current-wconfig'."
 
  (when (wg-current-workgroup t)
 
    (wg-set-workgroup-working-wconfig (wg-current-workgroup t) (wg-current-wconfig))))
 

	
 
(defun wg-restore-wconfig-undoably (wconfig &optional noundo)
 
  "Restore WCONFIG in `selected-frame', saving undo information.
 
Skip undo when NOUNDO."
 
  (when noundo (wg-unflag-undoify-window-configuration-change))
 
  (wg-update-current-workgroup-working-wconfig)
 
  (wg-restore-wconfig wconfig))
 

	
 
(defun wg-workgroup-offset-position-in-undo-list (workgroup increment)
 
  "Increment WORKGROUP's undo-pointer by INCREMENT.
 
Also restore the wconfig at the incremented undo-pointer if
 
WORKGROUP is current."
 
  (wg-with-undo workgroup (state undo-pointer undo-list)
 
    (let ((new-pointer (+ undo-pointer increment)))
 
      (when (wg-within new-pointer 0 (length undo-list))
 
        (when (wg-current-workgroup-p workgroup)
 
          (wg-restore-wconfig-undoably (nth new-pointer undo-list) t))
 
        (setf (wg-workgroup-state-undo-pointer state) new-pointer)))))
 

	
 
(defun wg-undoify-window-configuration-change ()
 
  "Conditionally `wg-add-wconfig-to-undo-list'.
 
Added to `post-command-hook'."
 
  (when (and
 
         wg-window-configuration-changed         ;; When the window config has changed,
 
         wg-undoify-window-configuration-change  ;; and undoification is still on for the current command
 
         (wg-minibuffer-inactive-p))             ;; and the change didn't occur while the minibuffer is active,
 
    (-when-let (workgroup (wg-current-workgroup t))  ;; and there's a current workgroup,
 
      ;; add the current wconfig to that workgroup's undo list:
 
      (wg-add-wconfig-to-undo-list workgroup (wg-current-wconfig))))
 
  ;; Reset all flags no matter what:
 
  (setq wg-window-configuration-changed nil
 
        wg-undoify-window-configuration-change t
 
        wg-already-updated-working-wconfig nil))
 

	
 
(defun wg-update-working-wconfig-hook ()
 
  "Used in before advice on all functions that trigger `window-configuration-change-hook'.
 
To save up to date undo info before the change."
 
  (when (and (not wg-already-updated-working-wconfig)
 
             (wg-minibuffer-inactive-p))
 
    (wg-update-current-workgroup-working-wconfig)
 
    (setq wg-already-updated-working-wconfig t)))
 

	
 
(defun wg-workgroup-gc-buf-uids (workgroup)
 
  "Remove buf uids from WORKGROUP that have no referent in `wg-buf-list'."
 
  (wg-asetf (wg-workgroup-strong-buf-uids workgroup)
 
            (cl-remove-if-not 'wg-find-buf-by-uid it)
 
            (wg-workgroup-weak-buf-uids workgroup)
 
            (cl-remove-if-not 'wg-find-buf-by-uid it)))
 

	
 
(defun wg-display-internal (elt-fn list)
 
  "Return display string built by calling ELT-FN on each element of LIST."
 
  (let ((div (wg-add-face :div wg-list-display-decor-divider))
 
        (wwidth (window-width (minibuffer-window)))
 
        (i -1)
 
        (str))
 
    (setq str
 
          (wg-fontify
 
            (:brace wg-list-display-decor-left-brace)
 
            (if (not list) (funcall elt-fn nil nil)
 
              (wg-doconcat (elt list div) (funcall elt-fn elt (cl-incf i))))
 
            (:brace wg-list-display-decor-right-brace)))
 
    ;; (subseq str 0 wwidth)
 
    ))
 

	
 
(defun wg-workgroup-list-display (&optional workgroup-list)
 
  "Return the WORKGROUP-LIST display string.
 
The string contains the names of all workgroups in `wg-workgroup-list',
 
decorated with faces, dividers and strings identifying the
 
current and previous workgroups."
 
  (wg-display-internal 'wg-workgroup-display
 
                       (or workgroup-list (wg-workgroup-list))))
 

	
 
(defun wg-create-first-wg ()
 
  "Create a first workgroup if needed."
 
  (when (and workgroups-mode
 
             wg-session-load-on-start
 
             (= (length (wg-workgroup-list)) 0))
 
    (wg-create-workgroup wg-first-wg-name)
 
    (wg-mark-everything-unmodified)))
 

	
 
(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-set-session-parameter 'frame-list (mapcar 'wg-frame-to-wconfig fl)))))
 
  (wg-write-sexp-to-file (wg-pickel-all-session-parameters) 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))))
 
  (-when-let (session (or session (wg-current-session t)))
 
    (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))
 
    (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)
 
      (with-current-buffer (window-buffer window-or-emacs-window-tree)
 
        (setq wg-buffer-workgroup workgroup))
 
    (dolist (w (cddr window-or-emacs-window-tree))
 
      (when w (wg-associate-buffers workgroup w)))))
 

	
 
(defun wg-workgroup-bufobj-association-type (workgroup bufobj)
 
  "Return BUFOBJ's association-type in WORKGROUP, or nil if unassociated."
 
  (let ((uid (wg-bufobj-uid-or-add bufobj)))
 
    (or (and (member uid (wg-workgroup-strong-buf-uids workgroup)) 'strong)
 
        (and (member uid (wg-workgroup-weak-buf-uids workgroup)) 'weak))))
 

	
 
(defun wg-associate-frame-buffers ()
 
  "Associate visible buffers with the current workgroup.
 
Unless it is currently being deactivated."
 
  (awhen (wg-current-workgroup :noerror)
 
    (unless (member it wg-deactivation-list)
 
      (wg-associate-buffers it (car (window-tree))))))
 

	
 
(defun wg-add-or-remove-workgroups-hooks (remove)
 
  "Add or remove all of Workgroups' hooks, depending on REMOVE."
 
  (wg-add-or-remove-hooks
 
   remove
 
   'kill-emacs-query-functions       'wg-save-session-on-emacs-exit
 
   'delete-frame-hook                'wg-update-working-wconfig-on-delete-frame
 
   'wg-pre-window-configuration-change-hook 'wg-update-working-wconfig-hook
 
   'window-configuration-change-hook 'wg-flag-window-configuration-changed
 
   'post-command-hook                'wg-undoify-window-configuration-change
 
   'minibuffer-exit-hook             'wg-flag-just-exited-minibuffer
 
   'kill-buffer-hook                 'wg-update-buffer-in-buf-list
 
   'kill-buffer-hook                 'wg-auto-dissociate-buffer-hook
 
   ;;'window-configuration-change-hook 'wg-associate-frame-buffers
 
   ))
 

	
 
;;;###autoload
 
(defun workgroups-mode (&optional arg)
 
  "Turn `workgroups-mode' on and off.
 
ARG is nil - toggle
 
ARG >= 1   - turn on
 
ARG == 0   - turn off
 
ARG is anything else, turn on `workgroups-mode'."
 
  (interactive (list current-prefix-arg))
 
  (setq workgroups-mode
 
        (cond ((not arg) (not workgroups-mode))
 
              ((integerp arg) (if (> arg 0) t nil))
 
              (t)))
 
  (cond
 
   (workgroups-mode
 
    (if (boundp 'desktop-restore-frames)
 
        (setq desktop-restore-frames nil))
 
    (wg-reset-internal)
 
    (wg-add-workgroups-mode-minor-mode-entries)
 
    (wg-enable-all-advice)
 
    (wg-add-or-remove-workgroups-hooks nil)
 
    (wg-change-modeline)
 

	
 
    ;; Load session
 
    (when (and wg-session-load-on-start
 
               (file-exists-p wg-session-file))
 
      (condition-case err
 
          (wg-open-session wg-session-file)
 
        (error (message "Error finding `wg-session-file': %s" err))))
 
    (run-hooks 'workgroups-mode-hook))
 
   (t
 
    (wg-save-session-on-workgroups-mode-exit)
 
    (wg-disable-all-advice)
 
    (wg-add-or-remove-workgroups-hooks t)
 
    (wg-remove-mode-line-display)
 
    (run-hooks 'workgroups-mode-exit-hook)))
 
  (wg-fontified-message
 
    (:cmd "Workgroups Mode: ") (:msg (if workgroups-mode "on" "off")))
 
  (wg-create-first-wg)
 
  workgroups-mode)
 

	
 
;;;###autoload
 
(defun wg-help ()
 
  "Just call `apropos-command' on \"^wg-\".
 
There used to be a bunch of help-buffer construction stuff here,
 
including a `wg-help' variable that basically duplicated every
 
command's docstring;  But why, when there's `apropos-command'?"
 
  (interactive)
 
  (apropos-command "^wg-"))
 

	
 
;; Remove after some time
 
(defalias 'wg-switch-to-buffer 'switch-to-buffer)
 

	
 
(provide 'workgroups2)
 
;;; workgroups2.el ends here
0 comments (0 inline, 0 general)