${EMACS} -L src -batch -l workgroups-modeline.el --eval '(message (wg-mode-line-string))'

    ;;(setq wg-session-load-on-start nil)

    (setq wg-session-file "~/.emacs.d/.emacs_workgroups")

(require 'workgroups-session)

;;; workgroups-buf.el --- BUFFER class

;;; Commentary:

;;

;; Workgroups Data Structures:

;;   https://github.com/pashinin/workgroups2/wiki/Workgroups-data-structures

;;

;;

;; BUFFER is the most low level part Workgroups operates with (except

;; serializing Emacs objects functions).

;;

;; Different buffers we have:

;;  - live buffers     (just switch-to them)

;;  - files/dirs       (open them)

;;  - special buffers  (shells, unknown modes - write support for them)

;;

;; Another different types of "buffers":

;;  - standard Emacs buffer (as you know it)

;;  - Workgroups Buffer object (Elisp object, a representation of Emacs buffer)

;;; Code:

(require 'workgroups-pickel)

(require 'workgroups-specialbufs)

(require 'workgroups-structs)

;;; Variables

(defvar wg-buffer-workgroup nil

  "A workgroup in which this buffer most recently appeared.

Buffer-local.")

(make-variable-buffer-local 'wg-buffer-workgroup)

(defcustom wg-default-buffer "*scratch*"

  "Show this in case everything else fails.

When a buffer can't be restored, when creating a blank wg."

  :type 'string

  :group 'workgroups)

;;; Functions

(defmacro wg-buf-list ()

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

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

(defun wg-restore-default-buffer ()

  "Switch to `wg-default-buffer'."

  (switch-to-buffer wg-default-buffer t))

(defun wg-restore-existing-buffer (buf)

  "Just switch to and return existing buffer."

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

    (switch-to-buffer it t)

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

    it))

(defun wg-restore-file-buffer (buf)

  "Restore BUF by finding its file.  Return the created buffer.

If BUF's file doesn't exist, call `wg-restore-default-buffer'"

  (wg-when-let ((file-name (wg-buf-file-name buf)))

    (when (or wg-restore-remote-buffers

              (not (file-remote-p file-name)))

      (cond ((file-exists-p file-name)

             (find-file file-name)

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

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

             (when wg-restore-mark

               (set-mark (wg-buf-mark buf))

               (deactivate-mark))

             (wg-deserialize-buffer-local-variables buf)

             (current-buffer))

            (t

             ;; try directory

             (if (not (file-remote-p file-name))

                 (if (file-directory-p (file-name-directory file-name))

                     (progn

                       (dired (file-name-directory file-name))

                       (current-buffer))

                   (progn

                     (message "Attempt to restore nonexistent file: %S" file-name)

                     nil))

               nil)

             )))))

(defun wg-restore-special-buffer (buf)

  "Restore a buffer BUF with DESERIALIZER-FN."

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

    (switch-to-buffer buffer t)

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

    buffer))

(defun wg-restore-buffer (buf)

  "Restore BUF and return it."

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

      (wg-restore-special-buffer buf)

      (wg-restore-file-buffer buf)

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

;;; 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-aif (wg-buffer-uid buffer-or-name)

      (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-aif (wg-find-buffer-in-buf-list buffer (wg-buf-list))

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

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

  (interactive)

  (wg-next-buffer t))

(defun wg-bury-buffer (&optional buffer-or-name)

  "Remove BUFFER-OR-NAME from the current workgroup, bury it,

and switch to the next buffer in the buffer-list-filter."

  (interactive (list (current-buffer)))

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

      (call-interactively (wg-prior-mapping workgroups-mode 'bury-buffer))

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

      (wg-next-buffer-internal (wg-filtered-buffer-list))

      (bury-buffer buffer-or-name)

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

(defun wg-banish-buffer (&optional buffer-or-name)

  "Bury BUFFER-OR-NAME."

  (interactive)

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

    (wg-bury-buffer buffer)))

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

(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

                (wg-aif (string-match ": *$" 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)))

(defmacro wg-with-buffer-list-filters (command &rest body)

  "Create buffer-list filter context for COMMAND, and eval BODY.

Binds `wg-current-buffer-list-filter-id' in BODY."

  (declare (indent 1))

  (wg-with-gensyms (order status)

    `(let* ((wg-previous-minibuffer-contents nil)

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

       (catch 'wg-result

         (while 'your-mom

           (let* ((wg-current-buffer-list-filter-id (car ,order))

                  (,status (catch 'wg-action (list 'done (progn ,@body)))))

             (cl-case (car ,status)

               (done (throw 'wg-result (cadr ,status)))

               (next (setq ,order (wg-rotate-list ,order 1))

                     (setq wg-previous-minibuffer-contents (cadr ,status)))

               (prev (setq ,order (wg-rotate-list ,order -1))

                     (setq wg-previous-minibuffer-contents

                           (cadr ,status))))))))))

(defun wg-toggle-buffer-list-filtration ()

  "Toggle `wg-buffer-list-filtration-on'."

  (interactive)

  (wg-toggle-and-message 'wg-buffer-list-filtration-on))

(provide 'workgroups-buf)

;;; workgroups-buf.el ends here

;;; workgroups-faces.el --- Colors

;;; Commentary:

;; display customization

;;; Code:

(defcustom wg-use-faces t

  "Non-nil means use faces in various messages."

  :type 'boolean

  :group 'workgroups)

(defcustom wg-list-display-decor-left-brace "( "

  "String displayed to the left of the list display."

  :type 'string

  :group 'workgroups)

(defcustom wg-list-display-decor-right-brace " )"

  "String displayed to the right of the list display."

  :type 'string

  :group 'workgroups)

(defcustom wg-list-display-decor-divider " | "

  "String displayed between elements of the list display."

  :type 'string

  :group 'workgroups)

(defcustom wg-list-display-decor-current-left "-<{ "

  "String displayed to the left of the current element of the list display."

  :type 'string

  :group 'workgroups)

(defcustom wg-list-display-decor-current-right " }>-"

  "String displayed to the right of the current element of the list display."

  :type 'string

  :group 'workgroups)

(defcustom wg-list-display-decor-previous-left "< "

  "String displayed to the left of the previous element of the list display."

  :type 'string

  :group 'workgroups)

(defcustom wg-list-display-decor-previous-right " >"

  "String displayed to the right of the previous element of the list display."

  :type 'string

  :group 'workgroups)

(defvar wg-face-abbrevs nil

  "Assoc list mapping face abbreviations to face names.")

(defmacro wg-defface (face key spec doc &rest args)

  "`defface' wrapper adding a lookup key used by `wg-fontify'."

  (declare (indent 2))

  `(progn

     (cl-pushnew (cons ,key ',face) wg-face-abbrevs :test #'equal)

     (defface ,face ,spec ,doc ,@args)))

(wg-defface wg-current-workgroup-face :cur

  '((t :inherit font-lock-constant-face :bold nil))

  "Face used for current elements in list displays."

  :group 'workgroups)

(wg-defface wg-previous-workgroup-face :prev

  '((t :inherit font-lock-keyword-face :bold nil))

  "Face used for the name of the previous workgroup in the list display."

  :group 'workgroups)

(wg-defface wg-other-workgroup-face :other

  '((t :inherit font-lock-string-face :bold nil))

  "Face used for the names of other workgroups in the list display."

  :group 'workgroups)

(wg-defface wg-command-face :cmd

  '((t :inherit font-lock-function-name-face :bold nil))

  "Face used for command/operation strings."

  :group 'workgroups)

(wg-defface wg-divider-face :div

  '((t :inherit font-lock-builtin-face :bold nil))

  "Face used for dividers."

  :group 'workgroups)

(wg-defface wg-brace-face :brace

  '((t :inherit font-lock-builtin-face :bold nil))

  "Face used for left and right braces."

  :group 'workgroups)

(wg-defface wg-message-face :msg

  '((t :inherit font-lock-string-face :bold nil))

  "Face used for messages."

  :group 'workgroups)

(wg-defface wg-mode-line-face :mode

  '((t :inherit font-lock-doc-face :bold nil))

  "Face used for workgroup position and name in the mode-line display."

  :group 'workgroups)

(wg-defface wg-filename-face :file

  '((t :inherit font-lock-keyword-face :bold nil))

  "Face used for filenames."

  :group 'workgroups)

;;; fancy displays

(defun wg-element-display (elt elt-string &optional current-elt-p previous-elt-p)

  "Return display string for ELT."

  (cond ((and current-elt-p (funcall current-elt-p elt))

         (wg-fontify (:cur (concat wg-list-display-decor-current-left

                                   elt-string

                                   wg-list-display-decor-current-right))))

        ((and previous-elt-p (funcall previous-elt-p elt))

         (wg-fontify (:prev (concat wg-list-display-decor-previous-left

                                    elt-string

                                    wg-list-display-decor-previous-right))))

        (t (wg-fontify (:other elt-string)))))

(defun wg-workgroup-display (workgroup index)

  "Return display string for WORKGROUP at INDEX."

  (if (not workgroup) wg-nowg-string

    (wg-element-display

     workgroup

     (format "%d: %s" index (wg-workgroup-name workgroup))

     'wg-current-workgroup-p

     'wg-previous-workgroup-p)))

(defun wg-buffer-display (buffer index)

  "Return display string for BUFFER.  INDEX is ignored."

  (if (not buffer) "No buffers"

    (wg-element-display

     (wg-get-buffer buffer)

     (format "%s" (wg-buffer-name buffer))

     'wg-current-buffer-p)))

;; (defun wg-display-internal (elt-fn list)

;;   "Return display string built by calling ELT-FN on each element of LIST."

;;   (let ((div (wg-add-face :div wg-list-display-decor-divider))

;;         (i -1))

;;     (wg-fontify

;;       (:brace wg-list-display-decor-left-brace)

;;       (if (not list) (funcall elt-fn nil nil)

;;         (wg-doconcat (elt list div) (funcall elt-fn elt (cl-incf i))))

;;       (:brace wg-list-display-decor-right-brace))))

;;; messaging

(defun wg-message (format-string &rest args)

  "Call `message' with FORMAT-STRING and ARGS.

Also save the msg to `wg-last-message'."

  (setq wg-last-message (apply #'message format-string args)))

(defmacro wg-fontified-message (&rest format)

  "`wg-fontify' FORMAT and call `wg-message' on it."

  (declare (indent defun))

  `(wg-message (wg-fontify ,@format)))

(defun wg-toggle-and-message (symbol)

  "Toggle SYMBOL's truthiness and message the new value."

  (wg-fontified-message

    (:cmd (format "%s: " symbol))

    (:msg (format "%s" (wg-toggle symbol)))))

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

              ;; )

              ((consp spec) spec)

              ((stringp spec) spec)

              (t `(format "%s" ,spec))))))

(provide 'workgroups-faces)

;;; workgroups-faces.el ends here