;;; workgroups-session.el --- Top level structure "session"

;;; Commentary:

;; Main function are: `wg-write-session-file'

;;; Code:

(require 'workgroups-variables)

(require 'workgroups-workgroup)

;;

;; Variables

;;

(defcustom wg-session-load-on-start (not (daemonp))

  "Load a session file on Workgroups start.

But only if Emacs is not started as daemon.  You don't want any

promts while Emacs is being started as daemon."

  :type 'boolean

  :group 'workgroups)

(defvaralias 'wg-use-default-session-file 'wg-session-load-on-start)

(defcustom wg-session-file "~/.emacs_workgroups"

  "Default filename to be used to save workgroups."

  :type 'file

  :group 'workgroups)

(defvaralias 'wg-default-session-file 'wg-session-file)

(defvar wg-incorrectly-restored-bufs nil

  "FIXME: docstring this.")

;; TODO: check it on switching WG

(defvar wg-record-incorrectly-restored-bufs nil

  "FIXME: docstring this.")

(defcustom wg-emacs-exit-save-behavior 'save

  "Determines save behavior on Emacs exit.

Possible values:

`ask'           Ask the user whether to save if there are unsaved changes

`save'          Call `wg-save-session' when there are unsaved changes

Anything else   Exit Emacs without saving changes"

  :type 'symbol

  :group 'workgroups)

(defcustom wg-workgroups-mode-exit-save-behavior 'save

  "Determines save behavior on `workgroups-mode' exit.

Possible values:

`ask'           Ask the user whether to saveif there are unsaved changes

`save'          Call `wg-save-session' when there are unsaved changes

Anything else   Exit `workgroups-mode' without saving changes"

  :type 'symbol

  :group 'workgroups)

;;

;; Function

;;

(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)

         (let ((session (wg-read-sexp-from-file 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)))

         (wg-awhen (and wg-switch-to-first-workgroup-on-find-session-file

                        (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 (wg-current-session t) 'last-workgroup)

                              (wg-workgroup-names)))

                 (wg-switch-to-workgroup

                  (wg-session-parameter (wg-current-session t) 'last-workgroup))

               (wg-switch-to-workgroup (car it)))

             ))

         (if wg-control-frames

             (wg-restore-frames))

         (wg-fontified-message (:cmd "Loaded: ") (:file filename)))

        (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-session-file (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.

Think of it as `write-file' for Workgroups sessions."

  (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)

  (if wg-control-frames

      (wg-save-frames))

  (wg-write-sexp-to-file

   (wg-pickel-all-session-parameters (wg-current-session))

   filename)

  (wg-mark-everything-unmodified)

  (wg-fontified-message (:cmd "Wrote: ") (:file filename)))

(defalias 'wg-save-session-as 'wg-write-session-file)

(defun wg-determine-session-save-file-name ()

  "Return the filename in which to save the session."

  (or (wg-session-file-name (wg-current-session))

      (and wg-session-load-on-start wg-session-file)))

(defun wg-save-session (&optional force)

  "Save the current Workgroups session if it's been modified.

Think of it as `save-buffer' for Workgroups sessions.  Optional

argument FORCE non-nil, or interactively with a prefix arg, save

the 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-write-session-file

     (or (wg-determine-session-save-file-name)

         (read-file-name "Save session as: ")))))

(defun wg-reset-internal (&optional session)

  "Reset Workgroups, setting `wg-current-session' to SESSION.

Resets all frame parameters, buffer-local vars, current

Workgroups session object, etc.  SESSION nil defaults to a new,

blank session object."

  (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-session-all-buf-uids (&optional session)

  "Return a new list of all unique buf uids in SESSION.

SESSION nil defaults to `wg-current-session'."

  (cl-reduce 'wg-string-list-union

             (wg-session-workgroup-list (or session (wg-current-session)))

             :key 'wg-workgroup-all-buf-uids))

(defun wg-buffer-list-all-uids (&optional buffer-list)

  "Return a list of the uids of all buffers in BUFFER-LIST in

which `wg-buffer-uid' is locally bound.

BUFFER-LIST nil defaults to `buffer-list'."

  (delq nil (mapcar 'wg-buffer-uid (or buffer-list (wg-buffer-list-emacs)))))

(defun wg-all-buf-uids (&optional session buffer-list)

  "Return the union of `wg-session-all-buf-uids' and `wg-buffer-list-all-uids'."

  (cl-union (wg-session-all-buf-uids session)

            (wg-buffer-list-all-uids buffer-list)

            :test 'string=))

(defun wg-gc-bufs ()

  "gc bufs from `wg-buf-list' that are no longer needed."

  (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))))

;; 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))

    (wg-awhen (wg-workgroup-selected-frame-wconfig workgroup)

      (setf (wg-workgroup-base-wconfig workgroup) it

            (wg-workgroup-selected-frame-wconfig workgroup) nil)))

  (wg-gc-bufs)

  (wg-gc-buf-uids)

  (wg-update-buf-list))

;; session consistency testing

(defun wg-modified-p ()

  "Return t when the current session or any of its workgroups are modified."

  (or (wg-session-modified (wg-current-session))

      (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-workgroup-names (&optional noerror)

  "Return a list of workgroup names or scream unless NOERROR."

  (mapcar 'wg-workgroup-name (wg-workgroup-list-or-error noerror)))

;;; session parameters

(defun wg-session-parameter (session parameter &optional default)

  "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 (session parameter value)

  "Set SESSION's value of PARAMETER to VALUE.

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)

    (setf (wg-session-modified session) t)

    value))

(defun wg-remove-session-parameter (session parameter)

  "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)))

(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 session variable undefined)))

    (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

     (if (wg-determine-session-save-file-name)

         (wg-save-session)

       (wg-query-and-save-if-modified)))))

(defun wg-save-frames ()

  "Save opened frames as a session parameter.

Exclude `selected-frame' and daemon one (if any).

http://stackoverflow.com/questions/21151992/why-emacs-as-daemon-gives-1-more-frame-than-is-opened"

  (interactive)

  (let ((fl (frame-list)))

    (mapc (lambda (frame)

            (if (string-equal "initial_terminal" (terminal-name frame))

                (delete frame fl))) fl)

    (setq fl (delete (selected-frame) fl))

    (if (wg-current-session t)

        (wg-set-session-parameter (wg-current-session t)

                                  'frame-list

                                  (mapcar 'wg-frame-to-wconfig fl)))))

(defun wg-reload-session ()

  "Reload current workgroups session."

  (interactive)

  (let ((file (or (wg-determine-session-save-file-name)

                  wg-session-file)))

    (when (file-exists-p file)

      (condition-case err

          (wg-open-session wg-session-file)

        (progn

          (wg-create-first-wg)

          (error (message "Error finding session-file: %s" err)))))

    (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 (session)

  "Return a copy of SESSION after pickeling 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-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))

(provide 'workgroups-session)

;;; workgroups-session.el ends here

;;; workgroups-workgroup.el --- workgroup functions

;;; Commentary:

;;; Code:

(require 'ring)

(require 'workgroups-wconfig)

(require 'workgroups-minibuffer)

;;

;; Variables

;;

(defcustom wg-confirm-on-get-workgroup-create nil

  "Non-nil means request confirmation before creating a new

workgroup when `wg-get-workgroup-create' is called with a string

that doesn't name an existing workgroup."

  :type 'boolean

  :group 'workgroups)

(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-current-workgroup (&optional noerror frame)

  "Return the current workgroup in FRAME, or error unless NOERROR."

  (or wg-current-workgroup

      (wg-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."

  (wg-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.

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.

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."

  (wg-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."

  (wg-awhen (wg-previous-workgroup t frame)

    (eq workgroup it)))

(defmacro wg-with-current-workgroup (workgroup &rest body)

  "Execute forms in BODY with WORKGROUP temporarily current.

WORKGROUP should be any workgroup identifier accepted by

`wg-get-workgroup'.  The value returned is the last form

in BODY."

  (declare (indent 1))

  `(let ((wg-current-workgroup (wg-get-workgroup ,workgroup)))

     ,@body))

(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 (workgroup parameter value)

  "Set WORKGROUP's value of PARAMETER to VALUE.

WORKGROUP should be a value accepted by `wg-get-workgroup'.

Return VALUE."

  (let ((workgroup (wg-get-workgroup workgroup)))

    (wg-set-parameter (wg-workgroup-parameters workgroup) parameter value)

    (wg-flag-workgroup-modified workgroup)

    value))

(defun wg-remove-workgroup-parameter (workgroup parameter)

  "Remove PARAMETER from WORKGROUP's parameters."

  (let ((workgroup (wg-get-workgroup workgroup)))

    (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)

;;; workgroup saved wconfigs

(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 (workgroup wconfig-or-name)

  "Return the wconfig in WORKGROUP's saved wconfigs named WCONFIG-OR-NAME.

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 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 (workgroup wconfig)

  "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'."

  (wg-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))))

;;; workgroup restoration

(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-first-workgroup ()

  "Return a first workgroup."

  (car (wg-workgroup-list-or-error)))

(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-read-workgroup-name (&optional require-match)

  "Read a workgroup with `wg-completing-read'."

  (wg-completing-read

   "Workgroup: " (wg-workgroup-names) nil require-match nil nil

   (wg-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."

  (wg-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)))

;;; misc commands

(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))))

;;; workgroup creation commands

(defun wg-create-workgroup (name &optional blank)

  "Create and add a workgroup named NAME.