;;; workgroups-functions --- Functions you might find useful

;;; Commentary:

;;; Code:

(require 'workgroups-compat)

(require 'workgroups-variables)

(require 'workgroups-utils-basic)

(require 'workgroups-structs)

;;; session ops

(defun wg-current-session (&optional noerror)

  "Return `wg-current-session', setting it first if necessary."

  (or wg-current-session

      (unless noerror

        (error "No session is defined"))))

(defmacro wg-buf-list ()

  "setf'able `wg-current-session' buf-list slot accessor."

  `(wg-session-buf-list (wg-current-session)))

(defmacro wg-workgroup-list ()

  "setf'able `wg-current-session' modified slot accessor."

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

(defun wg-workgroup-list-or-error (&optional noerror)

  "Return the value of `wg-current-session's :workgroup-list slot."

  (or (wg-workgroup-list)

;; in some-window unless some-buffer is also current.

;;

;; window-start and window-hscroll are properties of buffer/window pairs.

;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun wg-window-to-win (window)

  "Return the serialization (a wg-win) of Emacs window WINDOW."

  (let ((selected (eq window (selected-window))))

    (with-selected-window window

      (wg-make-win

       :edges              (window-edges window)

       :point              (wg-window-point window)

       :start              (window-start window)

       :hscroll            (window-hscroll window)

       :selected           selected

       :minibuffer-scroll  (eq window minibuffer-scroll-window)

       :dedicated          (window-dedicated-p window)

       :buf-uid            (wg-buffer-uid-or-add (window-buffer window))))))

(defun wg-window-tree-to-wtree (window-tree)

  "Return the serialization (a wg-wtree) of Emacs window tree WINDOW-TREE."

  (wg-barf-on-active-minibuffer)

      ((inner (w) (if (windowp w) (wg-window-to-win w)

                    (wg-dbind (dir edges . wins) w

                      (wg-make-wtree

                       :dir    dir

                       :edges  edges

                       :wlist  (mapcar #'inner wins))))))

    (let ((w (car window-tree)))

      (when (and (windowp w) (window-minibuffer-p w))

        (error "Workgroups can't operate on minibuffer-only frames."))

      (inner w))))

(defun wg-frame-to-wconfig (&optional frame)

  "Return the serialization (a wg-wconfig) of Emacs frame FRAME.

FRAME nil defaults to `selected-frame'."

  (let* ((frame (or frame (selected-frame)))

         (fullscrn (frame-parameter frame 'fullscreen)))

    (wg-make-wconfig

     :left                  (frame-parameter frame 'left)

     :top                   (frame-parameter frame 'top)

     :width                 (frame-parameter frame 'width)

     :height                (frame-parameter frame 'height)

     :parameters            `((fullscreen . ,fullscrn))

     :vertical-scroll-bars  (frame-parameter frame 'vertical-scroll-bars)

     :scroll-bar-width      (frame-parameter frame 'scroll-bar-width)

(defun wg-equal-wtrees (w1 w2)

  "Return t when W1 and W2 have equal structure."

  (cond ((and (wg-win-p w1) (wg-win-p w2))

         (equal (wg-w-edges w1) (wg-w-edges w2)))

        ((and (wg-wtree-p w1) (wg-wtree-p w2))

         (and (eq (wg-wtree-dir w1) (wg-wtree-dir w2))

              (equal (wg-wtree-edges w1) (wg-wtree-edges w2))

              (cl-every #'wg-equal-wtrees

                     (wg-wtree-wlist w1)

                     (wg-wtree-wlist w2))))))

(defun wg-normalize-wtree (wtree)

  "Clean up and return a new wtree from WTREE.

Recalculate the edge lists of all subwins, and remove subwins

outside of WTREE's bounds.  If there's only one element in the

new wlist, return it instead of a new wtree."

  (if (wg-win-p wtree) wtree

    (wg-with-slots wtree ((dir wg-wtree-dir)

                          (wlist wg-wtree-wlist))

      (wg-with-bounds wtree dir (ls1 hs1 lb1 hb1)

        (let* ((min-size (wg-min-size dir))

               (max (- hb1 1 min-size))

               (lastw (wg-last1 wlist)))

              ((mapwl

                (wl)

                (wg-dbind (sw . rest) wl

                  (cons (wg-normalize-wtree

                         (wg-set-bounds

                          sw dir ls1 hs1 lb1

                          (setq lb1 (if (eq sw lastw) hb1

                                      (let ((hb2 (+ lb1 (wg-w-size sw dir))))

                                        (if (>= hb2 max) hb1 hb2))))))

                        (when (< lb1 max) (mapwl rest))))))

            (let ((new (mapwl wlist)))

              (if (not (cdr new)) (car new)

                (setf (wg-wtree-wlist wtree) new)

                wtree))))))))

(defun wg-scale-wtree (wtree wscale hscale)

  "Return a copy of WTREE with its dimensions scaled by WSCALE and HSCALE.

All WTREE's subwins are scaled as well."

  (let ((scaled (wg-scale-w-size wtree wscale hscale)))

    (if (wg-win-p wtree) scaled

      (wg-asetf (wg-wtree-wlist scaled)

                (wg-docar (sw it) (wg-scale-wtree sw wscale hscale)))

      scaled)))

    (/ (float new-width)  (wg-wconfig-width wconfig))

    (/ (float new-height) (wg-wconfig-height wconfig)))))

;; (wg-wconfig-width (wg-current-wconfig))

(defun wg-resize-frame-scale-wtree (wconfig)

  "Set FRAME's size to WCONFIG's, returning a possibly scaled wtree.

If the frame size was set correctly, return WCONFIG's wtree

unchanged.  If it wasn't, return a copy of WCONFIG's wtree scaled

with `wg-scale-wconfigs-wtree' to fit the frame as it exists."

  (let ((frame (selected-frame)))

    (wg-with-slots wconfig ((wcwidth wg-wconfig-width)

                            (wcheight wg-wconfig-height))

      (when window-system (set-frame-size frame wcwidth wcheight))

      (let ((fwidth  (frame-parameter frame 'width))

            (fheight (frame-parameter frame 'height)))

        (if (and (= wcwidth fwidth) (= wcheight fheight))

            (wg-wconfig-wtree wconfig)

          (wg-scale-wconfigs-wtree wconfig fwidth fheight))))))

(defun wg-reverse-wlist (w &optional dir)

  "Reverse W's wlist and those of all its sub-wtrees in direction DIR.

If DIR is nil, reverse WTREE horizontally.

If DIR is 'both, reverse WTREE both horizontally and vertically.

Otherwise, reverse WTREE vertically."

      ((inner (w) (if (wg-win-p w) w

                    (wg-with-slots w ((d1 wg-wtree-dir))

                      (wg-make-wtree

                       :dir d1

                       :edges (wg-wtree-edges w)

                       :wlist (let ((wl2 (mapcar #'inner (wg-wtree-wlist w))))

                                (if (or (eq dir 'both) (eq dir d1))

                                    (nreverse wl2)

                                  wl2)))))))

    (wg-normalize-wtree (inner w))))

(defun wg-wtree-move-window (wtree offset)

  "Offset `selected-window' OFFSET places in WTREE."

      ((inner (w) (if (wg-win-p w) w

                    (wg-with-slots w ((wlist wg-wtree-wlist))

                      (wg-make-wtree

                       :dir (wg-wtree-dir w)

                       :edges (wg-wtree-edges w)

                       :wlist (wg-aif (cl-find t wlist :key 'wg-win-selected)

                                  (wg-cyclic-offset-elt it wlist offset)

                                (mapcar #'inner wlist)))))))

    (wg-normalize-wtree (inner wtree))))

(defun wg-reverse-wconfig (wconfig &optional dir)

  "Reverse WCONFIG's wtree's wlist in direction DIR."

  (wg-asetf (wg-wconfig-wtree wconfig) (wg-reverse-wlist it dir))

  wconfig)

(defun wg-wconfig-move-window (wconfig offset)

  "Offset `selected-window' OFFSET places in WCONFIG."

  (wg-asetf (wg-wconfig-wtree wconfig) (wg-wtree-move-window it offset))

  wconfig)

(defun wg-flatten-wtree (wtree &optional key)

  "Return a new list by flattening WTREE.

KEY non returns returns a list of WTREE's wins.

KEY non-nil returns a list of the results of calling KEY on each win."

      (error "Invalid type: %S" (type-of obj))))

(defun wg-pickel-link-serializer (obj)

  "Return the link serializer for the `type-of' OBJ."

  (wg-aget wg-pickel-link-serializers (type-of obj)))

(defun wg-pickel-object-deserializer (key)

  "Return the object deserializer for type key KEY, or error."

  (or (wg-aget wg-pickel-object-deserializers key)

      (error "Invalid object deserializer key: %S" key)))

(defun wg-pickel-link-deserializer (key)

  "Return the link deserializer for type key KEY, or error."

  (or (wg-aget wg-pickel-link-deserializers key)

      (error "Invalid link deserializer key: %S" key)))

;;; bindings

(defun wg-pickel-make-bindings-table (obj)

  "Return a table binding unique subobjects of OBJ to ids."

  (let ((binds (make-hash-table :test 'eq))

        (id -1))

     ((inner (obj)

           (unless (gethash obj binds)

              (puthash obj (cl-incf id) binds)

              (cl-case (type-of obj)

                (cons

                 (inner (car obj))

                 (inner (cdr obj)))

                (vector

                 (dotimes (idx (length obj))

                   (inner (aref obj idx))))

                (hash-table

                 (wg-dohash (key val obj)

                   (inner key)

                   (inner val)))))))

      (inner obj)

      binds)))

;;; object serialization

(defun wg-pickel-symbol-serializer (symbol)

  "Return SYMBOL's serialization."

  (cond ((eq symbol t) t)