(list left top

              (+ left (wg-step-to (- r1 l1) (- r2 l2) hstep))

              (+ top  (wg-step-to (- b1 t1) (- b2 t2) vstep)))))))

(defun wg-w-edge-operation (w edges op)

  "Return a copy of W with its edges mapped against EDGES through OP."

  (wg-set-edges w (cl-mapcar op (wg-w-edges w) edges)))

(defun wg-first-win (w)

  "Return the first actual window in W."

  (if (wg-win-p w) w

    (wg-first-win (car (wg-wtree-wlist w)))))

(defun wg-last-win (w)

  "Return the last actual window in W."

  (if (wg-win-p w) w

    (wg-last-win (wg-last1 (wg-wtree-wlist w)))))

(defun wg-minify-win (w)

  "Set W's edges to the smallest allowable."

  (let* ((edges (wg-w-edges w))

         (left (car edges))

         (top (cadr edges)))

    (wg-set-edges w (list left top

                          (+ left wg-actual-min-width)

                          (+ top  wg-actual-min-height)))))

(defun wg-minified-copy-of-last-win (w)

  "Minify a copy of the last actual window in W."

  (wg-minify-win (wg-copy-win (wg-last-win w))))

(defun wg-w-size (w &optional height)

  "Return the width or height of W, calculated from its edge list."

  (wg-with-edges w (l1 t1 r1 b1)

    (if height (- b1 t1) (- r1 l1))))

(defun wg-adjust-w-size (w width-fn height-fn &optional new-left new-top)

  "Adjust W's width and height with WIDTH-FN and HEIGHT-FN."

  (wg-with-edges w (left top right bottom)

    (let ((left (or new-left left)) (top (or new-top top)))

      (wg-set-edges (wg-copy-w w)

                    (list left

                          top

                          (+ left (funcall width-fn  (- right  left)))

                          (+ top  (funcall height-fn (- bottom top))))))))

(defun wg-scale-w-size (w width-scale height-scale)

  "Scale W's size by WIDTH-SCALE and HEIGHT-SCALE."

      ((wscale (width)  (truncate (* width  width-scale)))

       (hscale (height) (truncate (* height height-scale))))

    (wg-adjust-w-size w #'wscale #'hscale)))

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

          (cl-labels

              ((mapwl

                (wl)

                (wg-dbind (sw . rest) wl

                  (cons (wg-normalize-wtree

                         (wg-set-bounds

                          sw dir ls1 hs1 lb1

                          (setq lb1 (if (eq sw lastw) hb1

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

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

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

            (let ((new (mapwl wlist)))

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

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

                wtree))))))))

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

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

All WTREE's subwins are scaled as well."

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

    (if (wg-win-p wtree) scaled

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

  (cl-labels

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

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

                      (wg-make-wtree

                       :dir d1

                       :edges (wg-wtree-edges w)

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

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

                                    (nreverse wl2)

                                  wl2)))))))

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

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

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

  (cl-labels

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

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

                      (wg-make-wtree

                       :dir (wg-wtree-dir w)

                       :edges (wg-wtree-edges w)

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

      ((inner (w) (if (wg-win-p w) (list (if key (funcall key w) w))

    (inner wtree)))

(defun wg-win-list (wtree)

  "Construct and return a list of all wg-wins in WTREE."

  (wg-flatten-wtree wtree))

(require 'workgroups-specialbufs)

(require 'workgroups-restore)

;;; workgroup utils

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

  (interactive)

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

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

    (list wg-pickel-identifier

          (wg-pickel-serialize-objects binds)

          (wg-pickel-serialize-links binds)

          (gethash obj binds))))

(defun wg-pickel-to-string (obj)

  "Serialize OBJ to a string and return the string."

  (format "%S" (wg-pickel obj)))

(defun wg-pickel-to-file (file obj)

  "Serialize OBJ to FILE."

  (wg-write-sexp-to-file (wg-pickel obj) file))

;;; unpickeling

(defun wg-unpickel (pickel)

  "Return the deserialization of PICKEL."

  (unless (wg-pickel-p pickel)

    (error "Attempt to unpickel a non-pickel."))

  (wg-dbind (id serial-objects serial-links result) pickel

    (gethash

     result

     (wg-pickel-deserialize-links

      serial-links

      (wg-pickel-deserialize-objects serial-objects)))))

(defun wg-unpickel-file (file)

  "`unpickel' an object directly from FILE."

  (wg-unpickel (wg-lisp-object-from-file file)))

(defun wg-unpickel-string (str)

  "`unpickel' and object directly from STR."

  (wg-unpickel (read str)))

;;; parameter pickeling

  (defun wg-pickel-workgroup-parameters (workgroup)

    "If WORKGROUP's parameters are non-nil, return a copy of

WORKGROUP after pickeling its parameters. Otherwise return

WORKGROUP."

    (if (not (wg-workgroup-parameters workgroup)) workgroup

      (let ((copy (wg-copy-workgroup workgroup)))

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

        copy)))

  (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-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-workgroup-list copy)

                (cl-mapcar 'wg-unpickel-workgroup-parameters it))

      copy))

(provide 'workgroups-pickel)

;;; workgroups-pickel.el ends here

        (with-current-buffer org-agenda-buffer-name

          (let* ((p (or (and (looking-at "\\'") (1- (point))) (point)))

                 (series-redo-cmd (get-text-property p 'org-series-redo-cmd)))

            (if series-redo-cmd

                (get-text-property p 'org-series-redo-cmd)

              (get-text-property p 'org-redo-cmd)))))))

(defun wg-run-agenda-cmd (f)

  "Run commands F in Agenda buffer.

You can get these commands using `wg-get-org-agenda-view-commands'."

  (when (and (boundp 'org-agenda-buffer-name)

             (fboundp 'org-current-line)

             (fboundp 'org-goto-line))

    (if (get-buffer org-agenda-buffer-name)

        (save-window-excursion

          (with-current-buffer org-agenda-buffer-name

            (let* ((line (org-current-line)))

              (if f (eval f))

              (org-goto-line line)))))))

(wg-support 'org-agenda-mode 'org-agenda

            '((serialize . (lambda (buffer)

                             (wg-get-org-agenda-view-commands)))

              (deserialize . (lambda (buffer vars)

                               (org-agenda-list)

                               (wg-awhen (get-buffer org-agenda-buffer-name)

                                 (set-buffer it)

                                 (wg-run-agenda-cmd vars))

                               ))))

;; eshell

(wg-support 'eshell-mode 'esh-mode

            '((deserialize . (lambda (buffer vars)

                               (prog1 (eshell t)

                                 (rename-buffer (wg-buf-name buffer) t))))))

;; term-mode

;;

;; This should work for `ansi-term's, too, as there doesn't seem to

;; be any difference between the two except how the name of the

;; buffer is generated.

;;

(wg-support 'term-mode 'term

            `((serialize . ,(lambda (buffer)

                              (if (get-buffer-process buffer)

                                  (wg-last1 (process-command (get-buffer-process buffer)))

                                "/bin/bash")))

              (deserialize . ,(lambda (buffer vars)

                                            (window-height () 24))

                                  (prog1 (term vars)

                                    (rename-buffer (wg-buf-name buffer) t)))))))

;; Python

(wg-support 'inferior-python-mode 'python

            `((save . (python-shell-interpreter python-shell-interpreter-args))

              (deserialize . ,(lambda (buffer vars)

                                (wg-dbind (pythoncmd pythonargs) vars

                                  (save-window-excursion

                                    (run-python (concat pythoncmd " " pythonargs)))

                                  (wg-awhen (get-buffer (process-buffer (python-shell-get-or-create-process)))

                                    (set-buffer it)

                                    (switch-to-buffer (process-buffer (python-shell-get-or-create-process)))

                                    (goto-char (point-max)))

                                  )))))

;; Sage shell

(wg-support 'inferior-sage-mode 'sage-mode

            `((deserialize . ,(lambda (buffer vars)

                                (save-window-excursion

                                  (if (boundp' sage-command)

                                      (run-sage t sage-command t)))

                                (if (boundp 'sage-buffer)

                                    (wg-awhen (and

                                               sage-buffer)

                                      (set-buffer it)

                                      (switch-to-buffer sage-buffer)

                                      (goto-char (point-max))))))))

;; inferior-ess-mode   (ess-inf.el)

;; R shell, M-x R

(wg-support 'inferior-ess-mode 'ess-inf

            `((save . (inferior-ess-program))

              (deserialize . ,(lambda (buffer vars)

                                (wg-dbind (cmd) vars

                                  (let ((ess-ask-about-transfile nil)

                                        (ess-ask-for-ess-directory nil)

                                        (ess-history-file nil))

                                    (R)))))))

;; inferior-octave-mode

(wg-support 'inferior-octave-mode 'octave

            `((deserialize . ,(lambda (buffer vars)

                                (prog1 (run-octave)

                                  (rename-buffer (wg-buf-name buffer) t))))))

;; Prolog shell

  "Evaluate all CONDITIONS.  Return the first non-nil return value."

  (let ((syms (mapcar (lambda (x) (cl-gensym)) conditions)))

    `(let ,(cl-mapcar 'list syms conditions)

       (or ,@syms))))

(defmacro wg-eager-and (&rest conditions)

  "Evaluate all conditions.  If any return nil, return nil.

Otherwise return the return value of the last condition."

  (let ((syms (mapcar (lambda (x) (cl-gensym)) conditions)))

    `(let ,(cl-mapcar 'list syms conditions)

       (and ,@syms))))

;;; numbers

(defun wg-step-to (n m step)

  "Increment or decrement N toward M by STEP.

Return M when the difference between N and M is less than STEP."

  (cond ((= n m) n)

        ((< n m) (min (+ n step) m))

        ((> n m) (max (- n step) m))))

(defun wg-within (num lo hi &optional hi-inclusive)

  "Return t when NUM is within bounds LO and HI.

HI-INCLUSIVE non-nil means the HI bound is inclusive."

  (and (>= num lo) (if hi-inclusive (<= num hi) (< num hi))))

(defun wg-int-to-b36-one-digit (i)

  "Return a character in 0..9 or A..Z from I, and integer 0<=I<32.

Cribbed from `org-id-int-to-b36-one-digit'."

  (cond ((not (wg-within i 0 36))

         (error "%s out of range" i))

        ((< i 10) (+ ?0 i))

        ((< i 36) (+ ?A i -10))))

(defun wg-b36-to-int-one-digit (i)

  "Turn a character 0..9, A..Z, a..z into a number 0..61.

The input I may be a character, or a single-letter string.

Cribbed from `org-id-b36-to-int-one-digit'."

  (and (stringp i) (setq i (string-to-char i)))

  (cond ((and (>= i ?0) (<= i ?9)) (- i ?0))

        ((and (>= i ?A) (<= i ?Z)) (+ (- i ?A) 10))

        (t (error "Invalid b36 character"))))

(defun wg-int-to-b36 (i &optional length)

  "Return a base 36 string from I."

  (let ((base 36) b36)

                         (setq i (/ i base))))

      (add-digit)

      (while (> i 0) (add-digit))

      (setq b36 (cl-map 'string 'identity b36))

      (if (not length) b36

        (concat (make-string (max 0 (- length (length b36))) ?0) b36)))))

(defun wg-b36-to-int (str)

  "Convert STR, a base-36 string, into the corresponding integer.

Cribbed from `org-id-b36-to-int'."

  (let ((result 0))

    (mapc (lambda (i)

            (setq result (+ (* result 36)

                            (wg-b36-to-int-one-digit i))))

          str)

    result))

;;; lists

(defmacro wg-removef-p (item seq-place &rest keys)

  "If ITEM is a `member*' of SEQ-PLACE, remove it from SEQ-PLACE and return t.

Otherwise return nil.  KEYS can be any keywords accepted by `remove*'."

  `(> (length ,seq-place)

      (length (setf ,seq-place (cl-remove ,item ,seq-place ,@keys)))))

(defmacro wg-pushnew-p (item seq-place &rest keys)

  "If ITEM is not a `member' of SEQ-PLACE, push it to SEQ-PLACE and return t.

Otherwise return nil.  KEYS can be any keyword args accepted by `pushnew'."

  `(< (length ,seq-place)

      (length (cl-pushnew ,item ,seq-place ,@keys))))

(defun wg-last1 (list)

  "Return the last element of LIST."

  (car (last list)))

(defun wg-take (list n)

  "Return a list of the first N elts in LIST."

  (butlast list (- (length list) n)))

(defun wg-leave (list n)

  "Return a list of the last N elts in LIST."

  (nthcdr (- (length list) n) list))

(defun wg-rnth (n list)

  "Return the Nth element of LIST, counting from the end."

  (nth (- (length list) n 1) list))

  (cl-find regexp (or buffer-list (buffer-list))

           :test 'string-match :key 'wg-buffer-name))

;;; files

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

(defun wg-read-sexp-from-file (file)

  "Return a Lisp object from FILE."

  (with-temp-buffer

    (insert-file-contents file)

    (goto-char (point-min))

    (read (current-buffer))))

(defalias 'wg-lisp-object-from-file 'wg-read-sexp-from-file)

(defun wg-file-under-root-path-p (root-path file-path)

  "Return t when FILE-PATH is under ROOT-PATH, nil otherwise."

  (string-match (concat "^" (regexp-quote (expand-file-name root-path)))

                (expand-file-name file-path)))

;;; frames

(defun wg-cyclic-nth-from-frame (&optional n frame)

  "Return the frame N places away from FRAME in `frame-list' cyclically.

N defaults to 1, and FRAME defaults to `selected-frame'."

  (wg-cyclic-nth-from-elt

   (or frame (selected-frame)) (frame-list) (or n 1)))

;;; namespace-prefixed defstruct

(defmacro wg-defstruct (prefix name-form &rest slot-defs)

  "`defstruct' wrapper that namespace-prefixes all generated functions.

Note: this doesn't yet work with :conc-name, and possibly other

options."

  (declare (indent 2))

  (let* ((name (if (consp name-form) (car name-form) name-form))

         (prefixed-name (wg-symcat prefix "-" name)))

                      (let ((oldfnsym (wg-symcat opstr "-" prefix "-" name)))

                        `((fset ',(wg-symcat prefix "-" opstr "-" name)

                                (symbol-function ',oldfnsym))

                          (fmakunbound ',oldfnsym)))))

      ;; `eval-and-compile' gets rid of byte-comp warnings ("function `foo' not

      ;; known to be defined").  We can accomplish this with `declare-function'

      ;; too, but it annoyingly requires inclusion of the function's arglist,

      ;; which gets ugly.

      `(eval-and-compile

         (cl-defstruct ,(if (symbolp name-form) prefixed-name

                       `(,prefixed-name ,@(cdr name-form)))

           ,@slot-defs)

         ,@(rebind "make")

         ,@(rebind "copy")

         ',prefixed-name))))

(defmacro wg-with-slots (obj slot-bindings &rest body)

  "Bind OBJ's slot values to symbols in BINDS, then eval BODY.

The car of each element of SLOT-BINDINGS is the bound symbol, and

the cadr as the accessor function."

  (declare (indent 2))

  (wg-with-gensyms (objsym)

    `(let* ((,objsym ,obj)

            ,@(wg-docar (slot slot-bindings)

                `(,(car slot) (,(cadr slot) ,objsym))))

       ,@body)))

;;; misc

(defun wg-minibuffer-inactive-p ()

  "Return t when `minibuffer-depth' returns zero, nil otherwise."

  (zerop (minibuffer-depth)))

(defun wg-minibuffer-active-p ()

  "Return t when `minibuffer-depth' does not return zero, nil otherwise."

  (not (wg-minibuffer-inactive-p)))

(defun wg-fill-keymap (keymap &rest binds)

  "Return KEYMAP after defining in it all keybindings in BINDS."

  (while binds

    (define-key keymap (car binds) (cadr binds))

    (setq binds (cddr binds)))

  keymap)

(defun wg-add-or-remove-hooks (remove &rest pairs)

  "Add FUNCTION to or remove it from HOOK, depending on REMOVE."

  (dolist (pair (wg-partition pairs 2))

    (funcall (if remove 'remove-hook 'add-hook)

             (car pair) (cadr pair))))

(defun wg-read-object (prompt test warning &optional initial-contents keymap

                              read hist default-value inherit-input-method)

  "PROMPT for an object that satisfies TEST, WARNING if necessary.

ARGS are `read-from-minibuffer's args, after PROMPT."

                      prompt initial-contents keymap read hist

                      default-value inherit-input-method)))

    (let ((obj (read)))

      (when (and (equal obj "") default-value) (setq obj default-value))

      (while (not (funcall test obj))

        (message warning)

        (sit-for wg-minibuffer-message-timeout)

        (setq obj (read)))

      obj)))

(defvar wg-readable-types

  '(integer float cons symbol vector string char-table bool-vector)

  "List of types with readable printed representations.")

(defun wg-is-readable-p (obj)

  "Return non-nil if OBJ's printed representation is readable."

  (memq (type-of obj) wg-readable-types))

(defun wg-take-until-unreadable (list)

  "Return a new list of elements of LIST up to the first unreadable element."

  (wg-take-until-fail 'wg-is-readable-p list))

(defun wg-add-face (facekey string)

  "Return a copy of STRING fontified according to FACEKEY.

FACEKEY must be a key in `wg-face-abbrevs'."

  (let ((face (wg-aget wg-face-abbrevs facekey))

        (string  (copy-sequence string)))

    (unless face (error "No face with key %s" facekey))

    (if (not wg-use-faces) string

      (put-text-property 0 (length string) 'face face string)

      string)))

(defmacro wg-fontify (&rest specs)

  "A small fontification DSL.

The results of all SPECS are `concat'd together.

If a spec is a cons with a keyword car, apply `wg-add-face' to it.

Other conses get evaluated, and should produce a strings.

If a spec is a string it is used unmodified.

Anything else is formatted with %s to produce a string."

  (declare (indent defun))

  `(concat

    ,@(wg-docar (spec specs)

        (cond ((and (consp spec)

                    (keywordp (car spec)))

               `(wg-add-face ,@spec))

              ;;((listp spec) (cdr (eval spec)))

              ;;((listp spec)

              ;; ;;(prin1-to-string (nth 1 (eval spec)))