(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

    (wg-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-buffer-list-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))'."

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

  (wg-awhen (wg-current-workgroup :noerror)

    (unless (member it wg-deactivation-list)

      (wg-associate-buffers it (car (window-tree))))))

;; (switch-to-buffer)   -> (read-buffer-to-switch "Asd")

;; -> internal-complete-buffer-except -> internal-complete-buffer

;; minibuffer-complete  minibuffer-completion-table

;; ido-switch-buffer  -> buffer-list

;;(global-set-key "\C-d" delete-char)

;; fdefinition

;; (buffer-list)

;; jit-lock-context-fontify

;; (wg-workgroup-weak-buf-uids (wg-current-workgroup))

;; (wg-workgroup-associated-buf-uids (wg-current-workgroup))

;; (wg-workgroup-associated-bufs (wg-current-workgroup))

;; (wg-workgroup-associated-buffers (wg-current-workgroup))

;; (wg-associate-frame-buffers)

;; (wg-workgroup-dissociate-all-buffers (wg-current-workgroup))

;;(fmakunbound 'buffer-list)

;;(define-key (current-global-map) [remap buffer-list] 'wg-buffer-list)

;; (wg-buffer-list)

;;(defun buffer-list (&optional frame)

;;  (list (current-buffer)))

(provide 'workgroups-association)

;;; workgroups-association.el ends here

(defun wg-restore-special-buffer (buf &optional switch)

  "Restore a buffer BUF with DESERIALIZER-FN and maybe SWITCH to it."

  (wg-when-let

      ((special-data (wg-buf-special-data buf))

       (buffer (save-window-excursion

                 (condition-case err

                     (funcall (car special-data) buf)

                   (error (message "Error deserializing %S: %S" (wg-buf-name buf) err)

                          nil)))))

    (if switch (switch-to-buffer buffer t))

    (with-current-buffer buffer

      (wg-set-buffer-uid-or-error (wg-buf-uid buf)))

    buffer))

(defun wg-restore-buffer (buf &optional switch)

  "Restore BUF, return it and maybe SWITCH to it."

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

  (prog1

      (or (wg-restore-existing-buffer buf switch)

          (wg-restore-special-buffer buf switch)  ;; non existent dired problem

          (wg-restore-file-buffer buf switch)

          (progn (wg-restore-default-buffer switch) nil))

    (if wg-mess-with-buffer-list

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

;;; buffer object utils

(defun wg-buffer-uid (buffer-or-name)

  "Return BUFFER-OR-NAME's buffer-local value of `wg-buffer-uid'."

  (buffer-local-value 'wg-buffer-uid (wg-get-buffer buffer-or-name)))

(defun wg-bufobj-uid (bufobj)

  "Return BUFOBJ's uid."

  (cl-etypecase bufobj

    (buffer (wg-buffer-uid bufobj))

    (wg-buf (wg-buf-uid bufobj))

    (string (wg-bufobj-uid (wg-get-buffer bufobj)))))

(defun wg-bufobj-name (bufobj)

  "Return BUFOBJ's buffer name."

  (cl-etypecase bufobj

    (buffer (buffer-name bufobj))

    (wg-buf (wg-buf-name bufobj))

    (string (wg-buffer-name bufobj))))

(defun wg-bufobj-file-name (bufobj)

  "Return BUFOBJ's filename."

  (cl-etypecase bufobj

    (buffer (buffer-file-name bufobj))

    (wg-buf (wg-buf-file-name bufobj))

    (string (wg-bufobj-file-name (wg-get-buffer bufobj)))))

(defun wg-buf-major-mode (buf)

  "Return BUF's `major-mode'.

It's stored in BUF's local-vars list, since it's a local variable."

  (wg-aget (wg-buf-local-vars buf) 'major-mode))

(defun wg-buffer-major-mode (bufobj)

  "Return BUFOBJ's `major-mode'.

It works with Emacs buffer, Workgroups buffer object and a simple string."

  (cl-etypecase bufobj

    (buffer (wg-buffer-major-mode bufobj))

    (wg-buf (wg-buf-major-mode bufobj))

    (string (wg-buffer-major-mode bufobj))))

;; `wg-equal-bufobjs' and `wg-find-bufobj' may need to be made a lot smarter

(defun wg-equal-bufobjs (bufobj1 bufobj2)

  "Return t if BUFOBJ1 is \"equal\" to BUFOBJ2."

  (let ((fname1 (wg-bufobj-file-name bufobj1))

        (fname2 (wg-bufobj-file-name bufobj2)))

    (cond ((and fname1 fname2) (string= fname1 fname2))

          ((or fname1 fname2) nil)

          ((string= (wg-bufobj-name bufobj1) (wg-bufobj-name bufobj2)) t))))

(defun wg-find-bufobj (bufobj bufobj-list)

  "Find BUFOBJ in BUFOBJ-LIST, testing with `wg-equal-bufobjs'."

  (cl-find bufobj bufobj-list :test 'wg-equal-bufobjs))

(defun wg-find-bufobj-by-uid (uid bufobj-list)

  "Find the bufobj in BUFOBJ-LIST with uid UID."

  (cl-find uid bufobj-list :test 'string= :key 'wg-bufobj-uid))

(defun wg-find-buf-in-buf-list (buf buf-list)

  "Find BUF in BUF-LIST.

This is only here for completeness."

  (cl-find buf buf-list))

(defun wg-find-buffer-in-buffer-list (buffer-or-name buffer-list)

  "Find BUFFER-OR-NAME in BUFFER-LIST."

  (cl-find (wg-get-buffer buffer-or-name) buffer-list :key 'wg-get-buffer))

(defun wg-find-buffer-in-buf-list (buffer-or-name buf-list)

  "Find BUFFER-OR-NAME in BUF-LIST."

      (wg-find-bufobj-by-uid it buf-list)

    (wg-find-bufobj buffer-or-name buf-list)))

(defun wg-find-buf-in-buffer-list (buf buffer-list)

  "Find BUF in BUFFER-LIST."

  (or (wg-find-bufobj-by-uid (wg-buf-uid buf) buffer-list)

      (wg-find-bufobj buf buffer-list)))

(defun wg-find-buf-by-uid (uid)

  "Find a buf in `wg-buf-list' by UID."

  (wg-find-bufobj-by-uid uid (wg-buf-list)))

(defun wg-set-buffer-uid-or-error (uid &optional buffer)

  "Set BUFFER's buffer local value of `wg-buffer-uid' to UID.

If BUFFER already has a buffer local value of `wg-buffer-uid',

and it's not equal to UID, error."

  (if wg-buffer-uid

      ;;(if (string= wg-buffer-uid uid) uid

      ;;  (error "uids don't match %S and %S" uid wg-buffer-uid))

      (setq wg-buffer-uid uid)))

(defun wg-buffer-special-data (buffer)

  "Return BUFFER's auxiliary serialization, or nil."

  (cl-some (lambda (fn) (funcall fn buffer)) wg-special-buffer-serdes-functions))

(defun wg-serialize-buffer-local-variables ()

  "Return an alist of buffer-local variable symbols and their values.

See `wg-buffer-local-variables-alist' for details."

  (wg-docar (entry wg-buffer-local-variables-alist)

    (wg-dbind (var ser des) entry

      (when (local-variable-p var)

        (cons var (if ser (funcall ser) (symbol-value var)))))))

(defun wg-buffer-to-buf (buffer)

  "Return the serialization (a wg-buf) of Emacs buffer BUFFER."

  (with-current-buffer buffer

    (wg-make-buf

     :name           (buffer-name)

     :file-name      (buffer-file-name)

     :point          (point)

     :mark           (mark)

     :local-vars     (wg-serialize-buffer-local-variables)

     :special-data   (wg-buffer-special-data buffer))))

(defun wg-add-buffer-to-buf-list (buffer)

  "Make a buf from BUFFER, and add it to `wg-buf-list' if necessary.

If there isn't already a buf corresponding to BUFFER in

`wg-buf-list', make one and add it.  Return BUFFER's uid

in either case."

  (with-current-buffer buffer

    (setq wg-buffer-uid

              (wg-buf-uid it)

            (let ((buf (wg-buffer-to-buf buffer)))

              (push buf (wg-buf-list))

              (wg-buf-uid buf))))))

(defun wg-buffer-uid-or-add (buffer)

  "Return BUFFER's uid.

If there isn't already a buf corresponding to BUFFER in

`wg-buf-list', make one and add it."

  (or (wg-buffer-uid buffer) (wg-add-buffer-to-buf-list buffer)))

(defun wg-bufobj-uid-or-add (bufobj)

  "If BUFOBJ is a wg-buf, return its uid.

If BUFOBJ is a buffer or a buffer name, see `wg-buffer-uid-or-add'."

  (cl-etypecase bufobj

    (wg-buf (wg-buf-uid bufobj)) ;; possibly also add to `wg-buf-list'

    (buffer (wg-buffer-uid-or-add bufobj))

    (string (wg-bufobj-uid-or-add (wg-get-buffer bufobj)))))

(defun wg-reset-buffer (buffer)

  "Return BUFFER.

Currently only sets BUFFER's `wg-buffer-uid' to nil."

  (with-current-buffer buffer (setq wg-buffer-uid nil)))

;;; buffer-list-filter commands

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

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

  (when buffer-list

    (let* ((cur (current-buffer))

           (next (or (wg-cyclic-nth-from-elt cur buffer-list (if prev -1 1))

                     (car buffer-list))))

      (unless (eq cur next)

        (switch-to-buffer next)

        (unless prev (bury-buffer cur))

        next))))

(defun wg-next-buffer (&optional prev)

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

In the post-command message the current buffer is rotated to the

middle of the list to more easily see where `wg-previous-buffer'

will take you."

  (interactive)

  (let ((command (if prev 'previous-buffer 'next-buffer)))

    (if (not (wg-filter-buffer-list-p))

        (call-interactively (wg-prior-mapping workgroups-mode command))

      (wg-with-buffer-list-filters command

        (wg-awhen (wg-filtered-buffer-list) (wg-next-buffer-internal it prev))

        (wg-message (wg-buffer-command-display))))))

(defun wg-update-buffer-in-buf-list (&optional buffer)

  "Update BUFFER's corresponding buf in `wg-buf-list'.

BUFFER nil defaults to `current-buffer'."

  (let ((buffer (or buffer (current-buffer))))

    (wg-when-let ((uid (wg-buffer-uid buffer))

                  (old-buf (wg-find-buf-by-uid uid))

                  (new-buf (wg-buffer-to-buf buffer)))

      (setf (wg-buf-uid new-buf) (wg-buf-uid old-buf))

      (wg-asetf (wg-buf-list) (cons new-buf (remove old-buf it))))))

(defun wg-update-buf-list (&optional buffer-list)

  "Update all bufs in `wg-buf-list' corresponding to buffers in BUFFER-LIST."

  (mapc 'wg-update-buffer-in-buf-list (or buffer-list (wg-buffer-list-emacs))))

(defun wg-buffer-list-display (buffer-list)

  "Return the BUFFER-LIST display string."

  (wg-display-internal

   'wg-buffer-display

   (if wg-center-rotate-buffer-list-display

       (wg-center-rotate-list buffer-list) buffer-list)))

(defun wg-buffer-list-filter-display (&optional workgroup blf-id)

  "Return a buffer-list-filter display string from WORKGROUP and BLF-ID."

  (wg-fontify

    "("

    (wg-workgroup-name (wg-get-workgroup workgroup))

    ":"

    (wg-get-buffer-list-filter-val blf-id 'indicator)

    ")"))

(defun wg-buffer-list-filter-prompt (prompt &optional workgroup blf-id)

  "Return a prompt string from PROMPT indicating WORKGROUP and BLF-ID."

  (wg-fontify

    prompt " "

    (wg-buffer-list-filter-display workgroup blf-id)

    ": "))

(defun wg-buffer-command-display (&optional buffer-list)

  "Return the buffer command display string."

  (concat

   (wg-buffer-list-filter-display) ": "

   (wg-buffer-list-display (or buffer-list (wg-filtered-buffer-list)))))

(defun wg-read-buffer (prompt &optional default require-match)

  "Workgroups' version of `read-buffer'.

Read with PROMT DEFAULT REQUIRE-MATCH."

  (if (not (wg-filter-buffer-list-p))

      (funcall (wg-read-buffer-function) prompt default require-match)

    (wg-with-buffer-list-filters 'read-buffer

      (funcall (wg-read-buffer-function)

               (wg-buffer-list-filter-prompt

                    (substring prompt 0 it) prompt))

               default require-match))))

;;; filtered buffer-list construction

(defun wg-get-buffer-list-filter-id-flexibly (blf-id)

  "Return a buffer-list-filter-id one way or another."

  (or blf-id wg-current-buffer-list-filter-id 'all))

(defun wg-get-buffer-list-filter-val (id key &optional noerror)

  "Return ID's KEY's value in `wg-buffer-list-filter-definitions'.

Lots of possible errors here because

`wg-buffer-list-filter-definitions' can be modified by the user."

  (let ((slot-num (cl-case key (symbol 0) (indicator 1) (constructor 2))))

    (if (not slot-num)

        (unless noerror

          (error "`%S' is not a valid buffer-list-filter definition slot" key))

      (let* ((id (wg-get-buffer-list-filter-id-flexibly id))

             (entry (assq id (wg-local-value

                              'wg-buffer-list-filter-definitions))))

        (if (not entry)

            (unless noerror

              (error "`%S' is an undefined buffer-list-filter" id))

          (or (nth slot-num entry)

              (unless noerror

                (error "Slot `%S' is undefined in `%S's definition"

                       key id))))))))

(defun wg-filtered-buffer-list (&optional names workgroup bfl-id initial)

  "Return a filtered buffer-list from NAMES, WORKGROUP, BLF-ID and INITIAL.

NAMES non-nil means return a list of buffer-names instead of buffer objects.

WORKGROUP non-nil should be any workgroup identifier accepted by

`wg-get-workgroup'.

BLF-ID non-nil should be the identifier of a defined buffer-list-filter.

It defaults to `wg-get-buffer-list-filter-val'.

INITIAL non-nil should be an initial buffer-list to filter.  It defaults to

`wg-interesting-buffers'."

  (let ((buffer-list (funcall (wg-get-buffer-list-filter-val

                               (wg-get-buffer-list-filter-id-flexibly bfl-id)

                               'constructor)

                              (wg-get-workgroup workgroup)

                              (or initial (wg-interesting-buffers)))))

    (if names (mapcar 'wg-buffer-name buffer-list) buffer-list)))

;; buffer-list filters

(defun wg-buffer-list-filter-all (workgroup initial)

  "Return all buffers in INITIAL."

  initial)

(defun wg-filter-buffer-list-by-regexp (regexp buffer-list)

  "Return only those buffers in BUFFER-LIST with names matching REGEXP."

  (cl-remove-if-not (lambda (bname) (string-match regexp bname))

                    buffer-list :key 'buffer-name))

(defun wg-filter-buffer-list-by-root-dir (root-dir buffer-list)

  "Return only those buffers in BUFFER-LIST visiting files undo ROOT-DIR."

  (cl-remove-if-not (lambda (f) (when f (wg-file-under-root-path-p root-dir f)))

                    buffer-list :key 'buffer-file-name))

(defun wg-filter-buffer-list-by-major-mode (major-mode buffer-list)

  "Return only those buffers in BUFFER-LIST in major-mode MAJOR-MODE."

  (cl-remove-if-not (lambda (mm) (eq mm major-mode))

                    buffer-list :key 'wg-buffer-major-mode))

;; Example custom buffer-list-filters

(defun wg-buffer-list-filter-irc (workgroup buffer-list)

  "Return only those buffers in BUFFER-LIST with names starting in \"#\"."

  (wg-filter-buffer-list-by-regexp "^#" buffer-list))

(defun wg-buffer-list-filter-home-dir (workgroup buffer-list)

  "Return only those buffers in BUFFER-LIST visiting files under ~/."

  (wg-filter-buffer-list-by-root-dir "~/" buffer-list))

;; buffer-list-filter context

(defun wg-buffer-list-filter-order (command)

  "Return WORKGROUP's buffer-list-filter order for COMMAND, or a default."

  (let ((bfo (wg-local-value 'wg-buffer-list-filter-order-alist)))

    (or (wg-aget bfo command) (wg-aget bfo 'default))))

(defmacro wg-prior-mapping (mode command)

  "Return whatever COMMAND would call if MODE wasn't on."

  `(or (let (,mode) (command-remapping ,command)) ,command))

(defun wg-filter-buffer-list-p ()

  "Return the current workgroup when buffer-list-filters are on."

  (and workgroups-mode wg-buffer-list-filtration-on (wg-current-workgroup t)))

;;; workgroups-specialbufs --- special buffers serialization

;;; Commentary:

;;

;; TODO:

;;  1. Add more special buffers support (that you use)

;;  2. Improve existing

;;

;;; Code:

(require 'workgroups-variables)

(require 'workgroups-utils-basic)

(defcustom wg-special-buffer-serdes-functions

  '(wg-serialize-comint-buffer

    wg-serialize-speedbar-buffer)

  "Functions providing serialization/deserialization for complex buffers.

Use `wg-support' macro and this variable will be filled

automatically.

An entry should be either a function symbol or a lambda, and should

accept a single Emacs buffer object as an argument.

When a buffer is to be serialized, it is passed to each of these

functions in turn until one returns non-nil, or the list ends.  A

return value of nil indicates that the function can't handle

buffers of that type.  A non-nil return value indicates that it

can.  The first non-nil return value becomes the buffer's special

serialization data.  The return value should be a cons, with a

deserialization function (a function symbol or a lambda) as the car,

and any other serialization data as the cdr.

When it comes time to deserialize the buffer, the deserialization

function (the car of the cons mentioned above) is passed the

wg-buf object, from which it should restore the buffer.  The

special serialization data itself can be accessed

with (cdr (wg-buf-special-data <wg-buf>)).  The deserialization

function must return the restored Emacs buffer object.

See the definitions of the functions in this list for examples of

how to write your own."

  :type 'alist

  :group 'workgroups)

;; Dired

(wg-support 'dired-mode 'dired

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

                                (when (or wg-restore-remote-buffers

                                          (not (file-remote-p default-directory)))

                                  (let ((d (wg-get-first-existing-dir)))

                                    (if (file-directory-p d) (dired d))))))))

;; `Info-mode'     C-h i

(wg-support 'Info-mode 'info

            `((save . (Info-current-file Info-current-node))

              (deserialize . ,(lambda (buffer vars)

                                ;;(with-current-buffer

                                ;;    (get-buffer-create (wg-buf-name buffer))

                                    (if (fboundp 'Info-find-node)

                                        (apply #'Info-find-node it))

                                  (info)

                                  (get-buffer (wg-buf-name buffer)))))))

;; `help-mode'

;; Bug: https://github.com/pashinin/workgroups2/issues/29

(if nil

(wg-support 'help-mode 'help-mode

            `((save . (help-xref-stack-item help-xref-stack help-xref-forward-stack))

              (deserialize . ,(lambda (buffer vars)

                               (wg-dbind (item stack forward-stack) vars

                                 (condition-case err

                                     (apply (car item) (cdr item))

                                   (error (message "%s" err)))

                                 (wg-awhen (get-buffer "*Help*")

                                   (set-buffer it)

                                   (wg-when-boundp (help-xref-stack help-xref-forward-stack)

                                     (setq help-xref-stack stack

                                           help-xref-forward-stack forward-stack))))))))

)

;; ielm

(wg-support 'inferior-emacs-lisp-mode 'ielm

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

                                (ielm) (get-buffer "*ielm*")))))

;; Magit status

(wg-support 'magit-status-mode 'magit

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

                                (if (file-directory-p default-directory)

                                    (magit-status default-directory)

                                  (let ((d (wg-get-first-existing-dir)))

                                    (if (file-directory-p d) (dired d))))))))

;; Shell

(wg-support 'shell-mode 'shell

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

                                (shell (wg-buf-name buffer))))))

;; org-agenda buffer

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

  "Return commands to restore the state of Agenda buffer.

Can be restored using \"(eval commands)\"."

  (interactive)

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

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

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

                                 (with-current-buffer it

                                   (wg-run-agenda-cmd vars))

                                 it)))))

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

                                (cl-labels ((term-window-width () 80)

;;; workgroups-utils.el --- Utilities used by Workgroups

;;; Commentary:

;;

;; A bunch of general purpose-ish utilities used by Workgroups.

;;

;;; Code:

;;; utils used in macros

(require 'cl-lib)

(require 'workgroups-faces)

(require 'workgroups-variables)

(defmacro wg-with-gensyms (syms &rest body)

  "Bind all symbols in SYMS to `gensym's, and eval BODY."

  (declare (indent 1))

  `(let (,@(mapcar (lambda (sym) `(,sym (cl-gensym))) syms)) ,@body))

(defmacro wg-dbind (args expr &rest body)

  "Bind the variables in ARGS to the result of EXPR and execute BODY.

Abbreviation of `destructuring-bind'."

  (declare (indent 2))

  `(cl-destructuring-bind ,args ,expr ,@body))

(defun wg-partition (list &optional n step)

  "Take LIST, return a list of N length sublists, offset by STEP.

N defaults to 2, and STEP defaults to N.

Iterative to prevent stack overflow."

  (let* ((n (or n 2)) (step (or step n)) acc)

    (while list

      (push (wg-take list n) acc)

      (setq list (nthcdr step list)))

    (nreverse acc)))

;;; bindings

(defmacro wg-if-let (cond-form then &rest else)

  "Bind VAR to the return value of COND.  If VAR is non-nil, do THEN.

Else do ELSE...

\(fn ((VAR COND) THEN ELSE...)"

  (declare (indent 2))

  `(let (,cond-form)

     (if ,(car cond-form) ,then ,@else)))

(defmacro wg-when-let (binds &rest body)

  "Like `let*' but when all BINDS are non-nil - eval BODY."

  (declare (indent 1))

  (wg-dbind (bind . binds) binds

    (when (consp bind)

      `(let (,bind)

         (when ,(car bind)

           ,(if (not binds) `(progn ,@body)

              `(wg-when-let ,binds ,@body)))))))

(defmacro wg-when-boundp (symbols &rest body)

  "When all SYMBOLS are bound, `eval' BODY."

  (declare (indent 1))

  `(when (and ,@(mapcar (lambda (sym) `(boundp ',sym)) symbols))

     ,@body))

;;; do-style wrappers

(defmacro wg-docar (spec &rest body)

  "do-style wrapper for `mapcar'.

\(fn (VAR LIST) BODY...)"

  (declare (indent 1))

  `(mapcar (lambda (,(car spec)) ,@body) ,(cadr spec)))

(defmacro wg-dohash (spec &rest body)

  "do-style wrapper for `maphash'.

\(fn (KEY VALUE TABLE [RESULT]) BODY...)"

  (declare (indent 1))

  (wg-dbind (key val table &optional result) spec

    `(progn (maphash (lambda (,key ,val) ,@body) ,table) ,result)))

(defmacro wg-doconcat (spec &rest body)

  "do-style wrapper for `mapconcat'.

\(fn (VAR SEQ [SEPARATOR]) BODY...)"

  (declare (indent 1))

  (wg-dbind (elt seq &optional sep) spec

    `(mapconcat (lambda (,elt) ,@body) ,seq (or ,sep ""))))

;;; anaphora

(defmacro wg-awhen (test &rest body)

  "Anaphoric `when'."

  (declare (indent 1))

(defmacro wg-asetf (&rest places-and-values)

  "Anaphoric `setf'."

  `(progn ,@(mapcar (lambda (pv) `(let ((it ,(car pv))) (setf ,@pv)))

                    (wg-partition places-and-values 2))))

;;; other control structures

(defmacro wg-destructuring-dolist (spec &rest body)

  "Loop over a list.

Evaluate BODY, destructuring LIST into SPEC, then evaluate RESULT

to get a return value, defaulting to nil.  The only hitch is that

spec must end in dotted style, collecting the rest of the list

into a var, like so: (a (b c) . rest)

\(fn (SPEC LIST [RESULT]) BODY...)"

  (declare (indent 1))

  (wg-dbind (loopspec list &optional result) spec

    (let ((rest (cdr (last loopspec))))

      (wg-with-gensyms (list-sym)

        `(let ((,list-sym ,list))

           (while ,list-sym

             (wg-dbind ,loopspec ,list-sym

               ,@body

               (setq ,list-sym ,rest)))

           ,result)))))

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

    (cl-labels ((add-digit () (push (wg-int-to-b36-one-digit (mod i base)) 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)

(defun wg-take-until-fail (pred list)

  "Take elements from LIST up to the first element on which PRED fails."

  (let (taken)

    (catch 'result

      (dolist (elt list (nreverse taken))

        (if (funcall pred elt) (push elt taken)