;;; workgroups-commands --- main commands

;;; Commentary:

;;; Code:

(require 'cl-lib)

(eval-when-compile

  (require 'ido)

  (require 'iswitchb))

(require 'ring)

(require 'workgroups-variables)

(require 'workgroups-utils-basic)

(require 'workgroups-pickel)

(require 'workgroups-functions)

;;; workgroup switching commands

(defun wg-switch-to-workgroup (workgroup &optional noerror)

  "Switch to WORKGROUP."

  (interactive (list (wg-read-workgroup-name)))

  (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

          (wg-restore-workgroup workgroup)

          (wg-set-previous-workgroup current)

          (wg-set-current-workgroup workgroup)

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

          (wg-fontified-message

            (:cmd "Switched: ")

            (wg-workgroup-name (wg-current-workgroup t))

            ))

      (when current (pop wg-deactivation-list)))))

(defun wg-switch-to-workgroup-other-frame (workgroup &optional n)

  "Switch to WORKGROUP in the frame N places cyclically from `selected-frame'.

Use `current-prefix-arg' for N if non-nil.  Otherwise N defaults to 1."

  (interactive (list (wg-read-workgroup-name) current-prefix-arg))

  (with-selected-frame (wg-cyclic-nth-from-frame (or n 1))

    (wg-switch-to-workgroup workgroup)))

(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 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-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-workgroup-left-other-frame (&optional n)

  "Like `wg-switch-to-workgroup-left', but operates on the next frame."

  (interactive "p")

  (with-selected-frame (wg-cyclic-nth-from-frame (or n 1))

    (call-interactively 'wg-switch-to-workgroup-left)))

(defun wg-switch-to-workgroup-right-other-frame (&optional n)

  "Like `wg-switch-to-workgroup-right', but operates on the next frame."

  (interactive "p")

  (with-selected-frame (wg-cyclic-nth-from-frame (or n -1))

    (call-interactively 'wg-switch-to-workgroup-right)))

(defun wg-switch-to-previous-workgroup ()

  "Switch to the previous workgroup."

  (interactive)

  (wg-switch-to-workgroup (wg-previous-workgroup)))

;;; workgroup creation commands

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

;;; workgroup killing commands

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

;;; workgroup updating and reverting commands

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

;;; saved wconfig commands

(defun wg-save-wconfig ()

  "Save the current wconfig to the current workgroup's saved wconfigs."

  (interactive)

  (let* ((workgroup (wg-current-workgroup))

         (name (wg-read-saved-wconfig-name workgroup))

         (wconfig (wg-current-wconfig)))

    (setf (wg-wconfig-name wconfig) name)

    (wg-workgroup-save-wconfig workgroup wconfig)

    (wg-fontified-message

      (:cmd "Saved: ")

      (:cur name))))

(defun wg-restore-saved-wconfig ()

  "Restore one of the current workgroup's saved wconfigs in `selected-frame'."

  (interactive)

  (let ((workgroup (wg-current-workgroup)))

    (wg-restore-wconfig-undoably

     (wg-workgroup-get-saved-wconfig

      workgroup

      (wg-completing-read

       "Saved wconfig: "

       (mapcar 'wg-wconfig-name (wg-workgroup-saved-wconfigs workgroup))

       nil t)))))

(defun wg-kill-saved-wconfig ()

  "Kill one of the current workgroup's saved wconfigs.

Also add it to the wconfig kill-ring."

  (interactive)

  (let* ((workgroup (wg-current-workgroup))

         (wconfig (wg-read-saved-wconfig workgroup)))

    (wg-workgroup-kill-saved-wconfig workgroup wconfig)

    (wg-add-to-wconfig-kill-ring wconfig)

    (wg-fontified-message

      (:cmd "Deleted: ")

      (:cur (wg-wconfig-name wconfig)))))

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

      (wg-undo-timeline-display workgroup)

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

      (wg-undo-timeline-display workgroup)

      (: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."))

;;; buffer-list-filter commands

(defun wg-switch-to-buffer ()

  "Workgroups' version of `switch-to-buffer'."

  (interactive)

  (wg-buffer-internal 'switch-to-buffer "Buffer"))

(defun wg-switch-to-buffer-other-window ()

  "Workgroups' version of `switch-to-buffer-other-window'."

  (interactive)

  (wg-buffer-internal

   'switch-to-buffer-other-window "Switch to buffer in other window"))

(defun wg-switch-to-buffer-other-frame ()

  "Workgroups' version of `switch-to-buffer-other-frame'."

  (interactive)

  (wg-buffer-internal

   'switch-to-buffer-other-frame "Switch to buffer in other frame"))

(defun wg-kill-buffer ()

  "Workgroups' version of `kill-buffer'."

  (interactive)

  (wg-buffer-internal

   'kill-buffer "Kill buffer" (buffer-name (current-buffer))))

(defun wg-display-buffer ()

  "Workgroups' version of `display-buffer'."

  (interactive)

  (wg-buffer-internal 'display-buffer "Display buffer"))

(defun wg-insert-buffer ()

  "Workgroups' version of `insert-buffer'."

  (interactive)

  (wg-buffer-internal 'insert-buffer "Insert buffer"))

;; FIXME: If you C-h i for info, then wg-next-buffer, you occasionally don't

;; switch to the buffer you were on previously.

(defun wg-next-buffer-internal (buffer-list &optional prev noerror)

  "Switch to the next buffer in Workgroups' filtered buffer list."