Changeset - 811d54617711
[Not reviewed]
0 2 0
Sergey Pashinin - 12 years ago 2013-09-25 19:28:45
sergey@pashinin.com
new variable wg-mode-line-disable + powerline fix

wg-mode-line-disable is by default (featurep 'powerline)
2 files changed with 8 insertions and 2 deletions:
0 comments (0 inline, 0 general)
src/workgroups-functions.el
Show inline comments
 
@@ -855,1023 +855,1024 @@ Return VALUE."
 
  "Remove PARAMETER from WORKGROUP's parameters."
 
  (let ((workgroup (wg-get-workgroup workgroup)))
 
    (wg-flag-workgroup-modified workgroup)
 
    (wg-asetf (wg-workgroup-parameters workgroup) (wg-aremove it parameter))))
 

	
 
;; (defun wg-workgroup-local-value (variable &optional workgroup)
 
;;   "Return the value of VARIABLE in WORKGROUP.
 
;; WORKGROUP nil defaults to the current workgroup.  If there is no
 
;; current workgroup, or if VARIABLE does not have a workgroup-local
 
;; binding in WORKGROUP, resolve VARIABLE with `wg-session-local-value'."
 
;;   (let ((workgroup (wg-get-workgroup workgroup t)))
 
;;     (if (not workgroup) (wg-session-local-value variable)
 
;;       (let ((value (wg-workgroup-parameter workgroup variable 'default)))
 
;;         (if (not (eq value 'default)) value
 
;;           (wg-session-local-value variable))))))
 

	
 
(defun wg-workgroup-local-value (variable &optional workgroup)
 
  "Return the value of VARIABLE in WORKGROUP.
 
WORKGROUP nil defaults to the current workgroup.  If there is no
 
current workgroup, or if VARIABLE does not have a workgroup-local
 
binding in WORKGROUP, resolve VARIABLE with `wg-session-local-value'."
 
  (let ((workgroup (wg-get-workgroup workgroup t)))
 
    (if (not workgroup) (wg-session-local-value variable)
 
      (let* ((undefined (wg-gensym))
 
             (value (wg-workgroup-parameter workgroup variable undefined)))
 
        (if (not (eq value undefined)) value
 
          (wg-session-local-value variable))))))
 

	
 
(defalias 'wg-local-value 'wg-workgroup-local-value)
 

	
 

	
 

	
 
;;; workgroup associated buffers
 

	
 
(defun wg-workgroup-associated-buf-uids (workgroup)
 
  "Return a new list containing all of WORKGROUP's associated buf uids."
 
  (append (wg-workgroup-strong-buf-uids workgroup)
 
          (wg-workgroup-weak-buf-uids workgroup)))
 

	
 
(defun wg-workgroup-associated-bufs (workgroup)
 
  "Return a new list containing all of WORKGROUP's associated bufs."
 
  (delete nil (mapcar 'wg-find-buf-by-uid
 
                      (wg-workgroup-associated-buf-uids workgroup))))
 

	
 
(defun wg-workgroup-associated-buffers (workgroup &optional initial names)
 
  "Return a list of WORKGROUP's live associated buffers."
 
  (let ((assoc-bufs (wg-workgroup-associated-bufs workgroup)))
 
    (wg-remove-if-not
 
     (lambda (buffer) (wg-find-buffer-in-buf-list buffer assoc-bufs))
 
     (or initial (buffer-list)))))
 

	
 
(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-workgroup-strongly-associate-bufobj (workgroup bufobj)
 
  "Strongly associate BUFOBJ with WORKGROUP."
 
  (let* ((uid (wg-bufobj-uid-or-add bufobj))
 
         (remp (wg-removef-p uid (wg-workgroup-weak-buf-uids workgroup)
 
                             :test 'string=))
 
         (addp (wg-pushnew-p uid (wg-workgroup-strong-buf-uids workgroup)
 
                             :test 'string=)))
 
    (when (or remp addp)
 
      (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-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=)))
 
    (wg-awhen (or rem1p rem2p)
 
      (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-cycle-bufobj-association-type (workgroup bufobj)
 
  "Cycle the BUFOBJ's association type in WORKGROUP.
 
If it's strongly associated with the workgroup, weakly associate it.
 
If it's weakly associated with the workgroup, dissociate it.
 
If it's unassociated with the workgroup, mark it as strongly associated."
 
  (case (wg-workgroup-bufobj-association-type workgroup bufobj)
 
    (strong (wg-workgroup-weakly-associate-bufobj workgroup bufobj) 'weak)
 
    (weak (wg-workgroup-dissociate-bufobj workgroup bufobj) nil)
 
    (otherwise (wg-workgroup-strongly-associate-bufobj workgroup bufobj) 'strong)))
 

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

	
 

	
 

	
 
;;; 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 (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-buffer-list-filter-associated (workgroup initial)
 
  "Return only those buffers associated with WORKGROUP."
 
  (wg-workgroup-associated-buffers workgroup initial))
 

	
 
(defun wg-buffer-list-filter-unassociated (workgroup initial)
 
  "Return only those buffer unassociated with WORKGROUP."
 
  (let ((buffers (wg-workgroup-associated-buffers workgroup initial)))
 
    (wg-remove-if (lambda (buffer) (member buffer buffers)) initial)))
 

	
 

	
 
;; buffer-list filtration utils
 

	
 
(defun wg-filter-buffer-list-by-regexp (regexp buffer-list)
 
  "Return only those buffers in BUFFER-LIST with names matching REGEXP."
 
  (wg-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."
 
  (wg-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."
 
  (wg-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))
 

	
 
(defun wg-buffer-list-filter-elisp (workgroup buffer-list)
 
  "Return only those buffers in BUFFER-LIST in `emacs-lisp-mode'."
 
  (wg-filter-buffer-list-by-major-mode 'emacs-lisp-mode buffer-list))
 

	
 
(defun wg-buffer-list-filter-home-dir->elisp (workgroup buffer-list)
 
  "Example of chaining buffer-list filters.
 
This returns all buffers under \"~/\" that are also in `emacs-lisp-mode'."
 
  (wg-buffer-list-filter-elisp
 
   nil (wg-buffer-list-filter-home-dir nil 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)))))
 
             (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))))))))))
 

	
 

	
 

	
 
;;; workgroup working-wconfig and wconfig undo/redo
 

	
 
(defun wg-workgroup-state-table (&optional frame)
 
  "Return FRAME's workgroup table, creating it first if necessary."
 
  (or (frame-parameter frame 'wg-workgroup-state-table)
 
      (let ((wtree (make-hash-table :test 'equal)))
 
        (set-frame-parameter frame 'wg-workgroup-state-table wtree)
 
        wtree)))
 

	
 
(defun wg-get-workgroup-state (workgroup &optional frame)
 
  "Return FRAME's WORKGROUP's state table."
 
  (let ((uid (wg-workgroup-uid workgroup))
 
        (state-table (wg-workgroup-state-table frame)))
 
    (or (gethash uid state-table)
 
        (let ((wgs (wg-make-workgroup-state
 
                    :undo-pointer 0
 
                    :undo-list
 
                    (list (or (wg-workgroup-selected-frame-wconfig workgroup)
 
                              (wg-workgroup-base-wconfig workgroup))))))
 
          (puthash uid wgs state-table)
 
          wgs))))
 

	
 
(defmacro wg-with-undo (workgroup spec &rest body)
 
  "Bind WORKGROUP's undo state to SPEC and eval BODY."
 
  (declare (indent 2))
 
  (wg-dbind (state undo-pointer undo-list) spec
 
    `(let* ((,state (wg-get-workgroup-state ,workgroup))
 
            (,undo-pointer (wg-workgroup-state-undo-pointer ,state))
 
            (,undo-list (wg-workgroup-state-undo-list ,state)))
 
       ,@body)))
 

	
 
(defun wg-flag-just-exited-minibuffer ()
 
  "Added to `minibuffer-exit-hook'."
 
  (setq wg-just-exited-minibuffer t))
 

	
 
(defun wg-flag-window-configuration-changed ()
 
  "Set `wg-window-configuration-changed' to t unless the
 
minibuffer was just exited.  Added to
 
`window-configuration-change-hook'."
 
  (if wg-just-exited-minibuffer
 
      (setq wg-just-exited-minibuffer nil)
 
    (setq wg-window-configuration-changed t)))
 

	
 
(defun wg-unflag-undoify-window-configuration-change ()
 
  "Set `wg-undoify-window-configuration-change' to nil, exempting
 
from undoification any window-configuration changes caused by the
 
current command."
 
  (setq wg-undoify-window-configuration-change nil))
 

	
 
(defun wg-set-workgroup-working-wconfig (workgroup wconfig)
 
  "Set the working-wconfig of WORKGROUP to WCONFIG."
 
  (wg-flag-workgroup-modified workgroup)
 
  (setf (wg-workgroup-selected-frame-wconfig workgroup) wconfig)
 
  (wg-with-undo workgroup (state undo-pointer undo-list)
 
    (setcar (nthcdr undo-pointer undo-list) wconfig)))
 

	
 
(defun wg-add-wconfig-to-undo-list (workgroup wconfig)
 
  "Add WCONFIG to WORKGROUP's undo list, truncating its future if necessary."
 
  (wg-with-undo workgroup (state undo-pointer undo-list)
 
    (let ((undo-list (cons nil (nthcdr undo-pointer undo-list))))
 
      (wg-awhen (nthcdr wg-wconfig-undo-list-max undo-list) (setcdr it nil))
 
      (setf (wg-workgroup-state-undo-list state) undo-list))
 
    (setf (wg-workgroup-state-undo-pointer state) 0))
 
  (wg-set-workgroup-working-wconfig workgroup wconfig))
 

	
 
(defun wg-workgroup-working-wconfig (workgroup &optional noupdate)
 
  "Return WORKGROUP's working-wconfig.
 
If WORKGROUP is the current workgroup in `selected-frame', and
 
NOUPDATE is nil, set its working wconfig in `selected-frame' to
 
`wg-current-wconfig' and return the updated wconfig.  Otherwise
 
return WORKGROUP's current undo state."
 
  (if (and (not noupdate) (wg-current-workgroup-p workgroup))
 
      (wg-set-workgroup-working-wconfig workgroup (wg-current-wconfig))
 
    (wg-with-undo workgroup (state undo-pointer undo-list)
 
      (nth undo-pointer undo-list))))
 

	
 
(defun wg-update-current-workgroup-working-wconfig ()
 
  "Update `selected-frame's current workgroup's working-wconfig
 
with `wg-current-wconfig'."
 
  (wg-awhen (wg-current-workgroup t)
 
    (wg-set-workgroup-working-wconfig it (wg-current-wconfig))))
 

	
 
(defun wg-restore-wconfig-undoably (wconfig &optional noundo)
 
  "Restore WCONFIG in `selected-frame', saving undo information."
 
  (when noundo (wg-unflag-undoify-window-configuration-change))
 
  (wg-update-current-workgroup-working-wconfig)
 
  (wg-restore-wconfig wconfig))
 

	
 
(defun wg-workgroup-offset-position-in-undo-list (workgroup increment)
 
  "Increment WORKGROUP's undo-pointer by INCREMENT.
 
Also restore the wconfig at the incremented undo-pointer if
 
WORKGROUP is current."
 
  (wg-with-undo workgroup (state undo-pointer undo-list)
 
    (let ((new-pointer (+ undo-pointer increment)))
 
      (when (wg-within new-pointer 0 (length undo-list))
 
        (when (wg-current-workgroup-p workgroup)
 
          (wg-restore-wconfig-undoably (nth new-pointer undo-list) t))
 
        (setf (wg-workgroup-state-undo-pointer state) new-pointer)))))
 

	
 
(defun wg-undoify-window-configuration-change ()
 
  "Conditionally `wg-add-wconfig-to-undo-list'.
 
Added to `post-command-hook'."
 
  (when (and
 
         ;; When the window config has changed,
 
         wg-window-configuration-changed
 
         ;; and undoification is still on for the current command
 
         wg-undoify-window-configuration-change
 
         ;; and the change didn't occur while the minibuffer is active,
 
         (wg-minibuffer-inactive-p))
 
    ;; and there's a current workgroup,
 
    (wg-when-let ((workgroup (wg-current-workgroup t)))
 
      ;; add the current wconfig to that workgroup's undo list:
 
      (wg-add-wconfig-to-undo-list workgroup (wg-current-wconfig))))
 
  ;; Reset all flags no matter what:
 
  (setq wg-window-configuration-changed nil
 
        wg-undoify-window-configuration-change t
 
        wg-already-updated-working-wconfig nil))
 

	
 
(defun wg-update-working-wconfig-hook ()
 
  "Used in before advice on all functions that trigger
 
`window-configuration-change-hook' to save up to date undo info
 
before the change."
 
  (when (and (not wg-already-updated-working-wconfig)
 
             (wg-minibuffer-inactive-p))
 
    (wg-update-current-workgroup-working-wconfig)
 
    (setq wg-already-updated-working-wconfig t)))
 

	
 

	
 

	
 
;;; base wconfig updating
 

	
 
(defun wg-update-all-base-wconfigs ()
 
  "Update every workgroup's base wconfig with
 
`wg-workgroup-update-base-wconfig'."
 
  (dolist (workgroup (wg-workgroup-list))
 
    (wg-awhen (wg-workgroup-selected-frame-wconfig workgroup)
 
      (setf (wg-workgroup-base-wconfig workgroup) it
 
            (wg-workgroup-selected-frame-wconfig workgroup) nil))))
 

	
 
(defun wg-update-working-wconfig-on-delete-frame (frame)
 
  "Update FRAME's current workgroup's working-wconfig before
 
FRAME is deleted, so we don't lose its state."
 
  (with-selected-frame frame
 
    (wg-update-current-workgroup-working-wconfig)))
 

	
 

	
 

	
 
;;; workgroup saved wconfigs
 

	
 
(defun wg-workgroup-saved-wconfig-names (workgroup)
 
  "Return a new list of the names of all WORKGROUP's saved wconfigs."
 
  (mapcar 'wg-wconfig-name (wg-workgroup-saved-wconfigs workgroup)))
 

	
 
(defun wg-workgroup-get-saved-wconfig (workgroup wconfig-or-name)
 
  "Return the wconfig in WORKGROUP's saved wconfigs named WCONFIG-OR-NAME.
 
WCONFIG-OR-NAME must be either a string or a wconfig.  If
 
WCONFIG-OR-NAME is a string and there is no saved wconfig with
 
that name, return nil.  If WCONFIG-OR-NAME is a wconfig, and it
 
is a member of WORKGROUP's saved wconfigs, return is as given.
 
Otherwise return nil."
 
  (let ((wconfigs (wg-workgroup-saved-wconfigs workgroup)))
 
    (etypecase wconfig-or-name
 
      (wg-wconfig (car (memq wconfig-or-name wconfigs)))
 
      (string (wg-find wconfig-or-name wconfigs
 
                    :key 'wg-wconfig-name
 
                    :test 'string=)))))
 

	
 
(defun wg-workgroup-save-wconfig (workgroup wconfig)
 
  "Add WCONFIG to WORKGROUP's saved wconfigs.  WCONFIG must have
 
a name.  If there's already a wconfig with the same name in
 
WORKGROUP's saved wconfigs, replace it."
 
  (let ((name (wg-wconfig-name wconfig)))
 
    (unless name (error "Attempt to save a nameless wconfig"))
 
    (setf (wg-workgroup-modified workgroup) t)
 
    (wg-asetf (wg-workgroup-saved-wconfigs workgroup)
 
              (cons wconfig (wg-remove* name it
 
                                     :key 'wg-wconfig-name
 
                                     :test 'string=)))))
 

	
 
(defun wg-workgroup-kill-saved-wconfig (workgroup wconfig-or-name)
 
  "Delete WCONFIG-OR-NAME from WORKGROUP's saved wconfigs.
 
WCONFIG-OR-NAME is resolved with `wg-workgroup-get-saved-wconfig'."
 
  (wg-when-let ((wconfig (wg-workgroup-get-saved-wconfig
 
                          workgroup wconfig-or-name)))
 
    (wg-asetf (wg-workgroup-saved-wconfigs workgroup) (remq wconfig it)
 
              (wg-workgroup-modified workgroup) t)))
 

	
 

	
 

	
 

	
 
;;; garbage collection
 

	
 
;; update buf list
 

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

	
 

	
 
;; gc buf uids
 

	
 
(defun wg-workgroup-gc-buf-uids (workgroup)
 
  "Remove buf uids from WORKGROUP that have no referent in `wg-buf-list'."
 
  (wg-asetf (wg-workgroup-strong-buf-uids workgroup)
 
            (wg-remove-if-not 'wg-find-buf-by-uid it)
 
            (wg-workgroup-weak-buf-uids workgroup)
 
            (wg-remove-if-not 'wg-find-buf-by-uid it)))
 

	
 
(defun wg-gc-buf-uids ()
 
  "Remove from all workgroups those buf uids that have no referent in `wg-buf-list'."
 
  (mapc 'wg-workgroup-gc-buf-uids (wg-workgroup-list)))
 

	
 

	
 
;; gc bufs
 

	
 
(defun wg-wtree-buf-uids (wtree)
 
  "Return a new list of the buf uids of all wins in wtree."
 
  (wg-flatten-wtree wtree 'wg-win-buf-uid))
 

	
 
(defun wg-wtree-unique-buf-uids (wtree)
 
  "Return a list of the unique buf uids of all wins in wtree."
 
  (wg-remove-duplicates (wg-wtree-buf-uids wtree) :test 'string=))
 

	
 
(defun wg-wconfig-buf-uids (wconfig)
 
  "Return WCONFIG's wtree's `wg-wtree-buf-uids'."
 
  (wg-wtree-unique-buf-uids (wg-wconfig-wtree wconfig)))
 

	
 
(defun wg-workgroup-base-wconfig-buf-uids (workgroup)
 
  "Return a new list of all unique buf uids in WORKGROUP's working wconfig."
 
  (wg-wconfig-buf-uids (wg-workgroup-base-wconfig workgroup)))
 

	
 
(defun wg-workgroup-saved-wconfigs-buf-uids (workgroup)
 
  "Return a new list of all unique buf uids in WORKGROUP's base wconfig."
 
  (wg-reduce 'wg-string-list-union
 
          (wg-workgroup-saved-wconfigs workgroup)
 
          :key 'wg-wconfig-buf-uids))
 

	
 
(defun wg-workgroup-all-wconfig-buf-uids (workgroup)
 
  "Return a new list of all unique buf uids in WORKGROUP's wconfigs."
 
  (wg-union (wg-workgroup-base-wconfig-buf-uids workgroup)
 
         (wg-workgroup-saved-wconfigs-buf-uids workgroup)
 
         :test 'string=))
 

	
 
(defun wg-workgroup-all-buf-uids (workgroup)
 
  "Return a new list of all unique buf uids in WORKGROUP."
 
  (wg-reduce 'wg-string-list-union
 
          (list (wg-workgroup-base-wconfig-buf-uids workgroup)
 
                (wg-workgroup-saved-wconfigs-buf-uids workgroup)
 
                (if wg-restore-associated-buffers
 
                    (wg-workgroup-associated-buf-uids workgroup))
 
                )))
 

	
 
(defun wg-session-all-buf-uids (&optional session)
 
  "Return a new list of all unique buf uids in SESSION.
 
SESSION nil defaults to `wg-current-session'."
 
  (wg-reduce 'wg-string-list-union
 
          (wg-session-workgroup-list (or session (wg-current-session)))
 
          :key 'wg-workgroup-all-buf-uids))
 

	
 
(defun wg-buffer-list-all-uids (&optional buffer-list)
 
  "Return a list of the uids of all buffers in BUFFER-LIST in
 
which `wg-buffer-uid' is locally bound.
 
BUFFER-LIST nil defaults to `buffer-list'."
 
  (delq nil (mapcar 'wg-buffer-uid (or buffer-list (buffer-list)))))
 

	
 
(defun wg-all-buf-uids (&optional session buffer-list)
 
  "Return the union of `wg-session-all-buf-uids' and `wg-buffer-list-all-uids'."
 
  (wg-union (wg-session-all-buf-uids session)
 
         (wg-buffer-list-all-uids buffer-list)
 
         :test 'string=))
 

	
 
(defun wg-gc-bufs ()
 
  "gc bufs from `wg-buf-list' that are no longer needed."
 
  (let ((all-buf-uids (wg-all-buf-uids)))
 
    (wg-asetf (wg-buf-list)
 
              (wg-remove-if-not (lambda (uid) (member uid all-buf-uids)) it
 
                             :key 'wg-buf-uid))))
 

	
 

	
 
;; FIXME: Duplicate buf names probably shouldn't be allowed.  An unrelated error
 
;; causes two *scratch* buffers to be present, triggering the "uids don't match"
 
;; error.  Write something to remove bufs with duplicate names.
 

	
 

	
 
(defun wg-perform-session-maintenance ()
 
  "Perform various maintenance operations on the current Workgroups session."
 
  (wg-update-current-workgroup-working-wconfig)
 
  (wg-update-all-base-wconfigs)
 
  (wg-gc-bufs)
 
  (wg-gc-buf-uids)
 
  (wg-update-buf-list))
 

	
 

	
 
;; session consistency testing
 

	
 
(defun wg-session-uids-consistent-p ()
 
  "Return t if there are no duplicate bufs or buf uids in the wrong places,
 
nil otherwise."
 
  (and (wg-every (lambda (wg)
 
                (not (wg-dups-p (wg-workgroup-associated-buf-uids wg)
 
                                :test 'string=)))
 
              (wg-workgroup-list))
 
       (not (wg-dups-p (wg-buf-list) :key 'wg-buf-uid :test 'string=))
 
       (not (wg-dups-p (wg-workgroup-list) :key 'wg-workgroup-uid :test 'string=))))
 

	
 

	
 

	
 
;;; workgroup restoration
 

	
 
(defun wg-restore-workgroup-associated-buffers-internal (workgroup)
 
  "Restore all the buffers associated with WORKGROUP that can be restored."
 
  (save-window-excursion
 
    (delete nil (mapcar 'wg-restore-buffer
 
                        (wg-workgroup-associated-bufs workgroup)))))
 

	
 
(defun wg-restore-workgroup (workgroup)
 
  "Restore WORKGROUP in `selected-frame'."
 
  (when wg-restore-associated-buffers
 
    (wg-restore-workgroup-associated-buffers-internal workgroup))
 
  (let (wg-flag-modified)
 
    (wg-restore-wconfig-undoably
 
     (wg-workgroup-working-wconfig workgroup) t)))
 

	
 

	
 

	
 
;;; workgroup-list ops
 

	
 
(defun wg-delete-workgroup (workgroup)
 
  "Remove WORKGROUP from `wg-workgroup-list'.
 
Also delete all references to it by `wg-workgroup-state-table',
 
`wg-current-workgroup' and `wg-previous-workgroup'."
 
  (dolist (frame (frame-list))
 
    (remhash (wg-workgroup-uid workgroup) (wg-workgroup-state-table frame))
 
    (when (wg-current-workgroup-p workgroup frame)
 
      (wg-set-current-workgroup nil frame))
 
    (when (wg-previous-workgroup-p workgroup frame)
 
      (wg-set-previous-workgroup nil frame)))
 
  (setf (wg-workgroup-list) (remove workgroup (wg-workgroup-list-or-error)))
 
  (setf (wg-session-modified (wg-current-session)) t)
 
  workgroup)
 

	
 
(defun wg-add-workgroup (workgroup &optional index)
 
  "Add WORKGROUP to `wg-workgroup-list' at INDEX or the end.
 
If a workgroup with the same name exists, overwrite it."
 
  (wg-awhen (wg-find-workgroup-by :name (wg-workgroup-name workgroup) t)
 
    (unless index (setq index (wg-position it (wg-workgroup-list-or-error))))
 
    (wg-delete-workgroup it))
 
  (wg-asetf (wg-workgroup-list)
 
            (wg-insert-before workgroup it (or index (length it))))
 
  (setf (wg-session-modified (wg-current-session)) t)
 
  workgroup)
 

	
 
(defun wg-check-and-add-workgroup (workgroup)
 
  "Add WORKGROUP to `wg-workgroup-list'.
 
Ask to overwrite if a workgroup with the same name exists."
 
  (let ((name (wg-workgroup-name workgroup))
 
        (uid (wg-workgroup-uid workgroup)))
 
    (when (wg-find-workgroup-by :uid uid t)
 
      (error "A workgroup with uid %S already exists" uid))
 
    (when (wg-find-workgroup-by :name name t)
 
      (unless (or wg-no-confirm-on-destructive-operation
 
                  (y-or-n-p (format "%S exists. Overwrite? " name)))
 
        (error "Cancelled"))))
 
  (wg-add-workgroup workgroup))
 

	
 
(defun wg-make-and-add-workgroup (name &optional blank)
 
  "Create a workgroup named NAME and add it with `wg-check-and-add-workgroup'."
 
  (wg-check-and-add-workgroup
 
   (wg-make-workgroup
 
    :name name
 
    :base-wconfig (if blank (wg-make-blank-wconfig)
 
                    (wg-current-wconfig)))))
 

	
 
(defun wg-get-workgroup-create (workgroup)
 
  "Return the workgroup specified by WORKGROUP, creating a new one if needed.
 
If `wg-get-workgroup' on WORKGROUP returns a workgroup, return it.
 
Otherwise, if WORKGROUP is a string, create a new workgroup with
 
that name and return it. Otherwise error."
 
  (or (wg-get-workgroup workgroup t)
 
      (if (stringp workgroup)
 
          (when (or (not wg-confirm-on-get-workgroup-create)
 
                    (y-or-n-p (format "%S doesn't exist.  Create it? "
 
                                      workgroup)))
 
            (wg-make-and-add-workgroup workgroup))
 
        ;; Call this again for its error message
 
        (wg-get-workgroup workgroup))))
 

	
 
(defun wg-cyclic-offset-workgroup (workgroup n)
 
  "Offset WORKGROUP's position in `wg-workgroup-list' by N."
 
  (let ((workgroup-list (wg-workgroup-list-or-error)))
 
    (unless (member workgroup workgroup-list)
 
      (error "Workgroup isn't present in `wg-workgroup-list'."))
 
    (setf (wg-workgroup-list) (wg-cyclic-offset-elt workgroup workgroup-list n)
 
          (wg-session-modified (wg-current-session)) t)))
 

	
 
(defun wg-swap-workgroups-in-workgroup-list (workgroup1 workgroup2)
 
  "Swap the positions of WORKGROUP1 and WORKGROUP2 in `wg-workgroup-list'."
 
  (let ((workgroup-list (wg-workgroup-list-or-error)))
 
    (when (eq workgroup1 workgroup2)
 
      (error "Can't swap a workgroup with itself"))
 
    (unless (and (memq workgroup1 workgroup-list)
 
                 (memq workgroup2 workgroup-list))
 
      (error "Both workgroups aren't present in `wg-workgroup-list'."))
 
    (setf (wg-workgroup-list) (wg-util-swap workgroup1 workgroup2 workgroup-list)
 
          (wg-session-modified (wg-current-session)) t)))
 

	
 
(defun wg-cyclic-nth-from-workgroup (workgroup &optional n)
 
  "Return the workgroup N places from WORKGROUP in `wg-workgroup-list'."
 
  (wg-cyclic-nth-from-elt workgroup (wg-workgroup-list-or-error) (or n 1)))
 

	
 

	
 

	
 
;;; buffer association
 

	
 
(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))'."
 
  (wg-aif (windowp window-or-emacs-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-associate-frame-buffers ()
 
  "Associate the buffers visible in the current frame 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))))))
 

	
 
(defun wg-associate-all-frame-buffers ()
 
  "Associate all visible buffers with the current
 
workgroup (unless it is currently being deactivated)."
 
  (mapcar 'wg-associate-frame-buffers (frame-list)))
 

	
 
(defun wg-buffer-predicate (buffer)
 
  "Return t iff the given BUFFER should be considered a candidate
 
for display by `other-buffer' in the current workgroup."
 
  (or (not wg-associate-buffers)
 
      (wg-awhen (wg-current-workgroup :noerror)
 
        (with-current-buffer buffer
 
          (eq wg-buffer-workgroup it)))))
 

	
 
(defun wg-after-make-frame (frame)
 
  (set-frame-parameter frame 'buffer-predicate
 
                       'wg-buffer-predicate))
 

	
 
;;; mode-line
 

	
 
(defun wg-mode-line-buffer-association-indicator (workgroup)
 
  "Return a string indicating `current-buffer's association-type in WORKGROUP."
 
  (case (wg-workgroup-bufobj-association-type workgroup (current-buffer))
 
    (strong wg-mode-line-decor-strongly-associated)
 
    (weak wg-mode-line-decor-weakly-associated)
 
    (otherwise wg-mode-line-decor-unassociated)))
 

	
 
(defun wg-mode-line-string ()
 
  "Return the string to be displayed in the mode-line."
 
  (let ((wg (wg-current-workgroup t))
 
        (wg-use-faces wg-mode-line-use-faces))
 
    (cond (wg (wg-fontify " "
 
                ;;(consp (cons :div wg-mode-line-decor-left-brace))
 
                ;;(keywordp (car (cons :div wg-mode-line-decor-left-brace)))
 
                ;;(:div wg-mode-line-decor-left-brace)
 
                wg-mode-line-decor-left-brace
 
                (wg-workgroup-name wg)
 
                (if (not wg-mode-line-only-name)
 
                    (progn
 
                      wg-mode-line-decor-divider
 
                      (wg-mode-line-buffer-association-indicator wg)
 
                      wg-mode-line-decor-divider
 
                      (if (window-dedicated-p)
 
                                 wg-mode-line-decor-window-dedicated
 
                               wg-mode-line-decor-window-undedicated)
 
                      wg-mode-line-decor-divider
 
                      (if (wg-session-modified (wg-current-session))
 
                                 wg-mode-line-decor-session-modified
 
                               wg-mode-line-decor-session-unmodified)
 
                      (if (wg-workgroup-modified wg)
 
                          wg-mode-line-decor-workgroup-modified
 
                        wg-mode-line-decor-workgroup-unmodified)))
 
                wg-mode-line-decor-right-brace))
 
          (t (if wg-display-nowg
 
                 (progn
 
                   (wg-fontify " "
 
                     wg-mode-line-decor-left-brace
 
                     wg-nowg-string
 
                     wg-mode-line-decor-right-brace))
 
               "")))))
 

	
 
(defun wg-add-mode-line-display ()
 
  "Add Workgroups' mode-line format to `mode-line-format'."
 
  (unless (assq 'wg-mode-line-display-on mode-line-format)
 
  (unless (or (assq 'wg-mode-line-display-on mode-line-format)
 
              wg-mode-line-disable)
 
    (let ((format '(wg-mode-line-display-on (:eval (wg-mode-line-string))))
 
          (pos (wg-position 'mode-line-position mode-line-format)))
 
          (pos (or (wg-position 'mode-line-position mode-line-format) 10)))
 
      (set-default 'mode-line-format
 
                   (wg-insert-after format mode-line-format pos))
 
      (force-mode-line-update))))
 

	
 
(defun wg-remove-mode-line-display ()
 
  "Remove Workgroups' mode-line format from `mode-line-format'."
 
  (wg-awhen (assq 'wg-mode-line-display-on mode-line-format)
 
    (set-default 'mode-line-format (remove it mode-line-format))
 
    (force-mode-line-update)))
 

	
 

	
 

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

	
 

	
 

	
 
;;; fancy displays
 

	
 
;; FIXME: add `wg-display-max-lines' to chop long display strings at max-line
 
;; and element-name boundaries
 

	
 
(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 (incf i))))
 
;;       (:brace wg-list-display-decor-right-brace))))
 

	
 
(defcustom wg-display-max-lines 1
 
  "FIXME: docstring this"
 
  :type 'integer
 
  :group 'workgroups)
 

	
 

	
 

	
 
(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))
 
        (wwidth (window-width (minibuffer-window)))
 
        (i -1)
 
        (str))
 
    (setq str
 
          (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 (incf i))))
 
            (:brace wg-list-display-decor-right-brace)))
 
    ;; (subseq str 0 wwidth)
 
    ))
 

	
 
(defun wg-workgroup-list-display (&optional workgroup-list)
 
  "Return the Workgroups list display string.
 
The string contains the names of all workgroups in `wg-workgroup-list',
 
decorated with faces, dividers and strings identifying the
 
current and previous workgroups."
 
  (wg-display-internal 'wg-workgroup-display
 
                       (or workgroup-list (wg-workgroup-list))))
 

	
 
;; TODO: Possibly add scroll animation for the buffer list display during
 
;; `wg-next-buffer' and `wg-previous-buffer'
 
(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-timeline-display (position length)
 
  "Return a timeline visualization string from POSITION and LENGTH."
 
  (wg-fontify
 
    ;;(cons :div "-<{")
 
    "-<{"
 
    (wg-make-string (- length position) "-" "=")
 
    "O"
 
    (wg-make-string (1+ position) "-" "=")
 
    "}>-"))
 

	
 
(defun wg-undo-timeline-display (workgroup)
 
  "Return WORKGROUP's undo timeline string."
 
  (wg-with-undo workgroup (state undo-pointer undo-list)
 
    (wg-timeline-display undo-pointer (length undo-list))))
 

	
 

	
 

	
 
(require 'workgroups-ido)
 

	
 

	
 
;;; minibuffer reading
 

	
 
(defun wg-read-buffer (prompt &optional default require-match)
 
  "Workgroups' version of `read-buffer'."
 
  (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))))
 

	
 
;; TODO: Add minibuffer commands for killing, cloning, etc.
 
(defun wg-read-workgroup-name (&optional require-match)
 
  "Read a workgroup with `wg-completing-read'."
 
  (wg-completing-read
 
   "Workgroup: " (wg-workgroup-names) nil require-match nil nil
 
   (wg-awhen (wg-current-workgroup t) (wg-workgroup-name it))))
 

	
 
(defun wg-new-default-workgroup-name ()
 
  "Return a new, unique, default workgroup name."
 
  (let ((names (wg-workgroup-names t)) (index -1) result)
 
    (while (not result)
 
      (let ((new-name (format "wg%s" (incf index))))
 
        (unless (member new-name names)
 
          (setq result new-name))))
 
    result))
 

	
 
(defun wg-unique-workgroup-name-p (new-name)
 
  "Return t if NEW-NAME is unique in `wg-workgroup-list', nil otherwise."
 
  (wg-every (lambda (existing-name) (not (equal new-name existing-name)))
 
         (wg-workgroup-names t)))
 

	
 
(defun wg-read-new-workgroup-name (&optional prompt)
 
  "Read a non-empty name string from the minibuffer."
 
  (let ((default (wg-new-default-workgroup-name)))
 
    (wg-read-object
 
     (or prompt (format "Name (default: %S): " default))
 
     (lambda (new) (and (stringp new)
 
                        (not (equal new ""))
 
                        (wg-unique-workgroup-name-p new)))
 
     "Please enter a unique, non-empty name"
 
     nil nil nil nil default)))
 

	
 
(defun wg-read-workgroup-index ()
 
  "Prompt for the index of a workgroup."
 
  (let ((max (1- (length (wg-workgroup-list-or-error)))))
 
    (wg-read-object
 
     (format "%s\n\nEnter [0-%d]: " (wg-workgroup-list-display) max)
 
     (lambda (obj) (and (integerp obj) (wg-within obj 0 max t)))
 
     (format "Please enter an integer [%d-%d]" 0 max)
 
     nil nil t)))
 

	
 
(defun wg-read-saved-wconfig-name (workgroup &optional prompt require-match)
 
  "Read the name of a saved wconfig, completing on the names of
 
WORKGROUP's saved wconfigs."
 
  (wg-completing-read
 
   (or prompt "Saved wconfig name: ")
 
   (wg-workgroup-saved-wconfig-names workgroup)
 
   nil require-match))
 

	
 
(defun wg-read-saved-wconfig (workgroup)
 
  "Read the name of and return one of WORKGROUP's saved wconfigs."
 
  (wg-workgroup-get-saved-wconfig
 
   workgroup (wg-read-saved-wconfig-name workgroup nil t)))
 

	
 

	
 

	
 
;;; session resetting
 

	
 
(defun wg-reset-frame (frame)
 
  "Reset Workgroups' frame-parameters in FRAME to nil."
 
  (set-frame-parameter frame 'wg-workgroup-state-table nil)
 
  (set-frame-parameter frame 'wg-current-workgroup-uid nil)
 
  (set-frame-parameter frame 'wg-previous-workgroup-uid nil))
 

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

	
 
(defun wg-reset-internal (&optional session)
 
  "Reset Workgroups, setting `wg-current-session' to SESSION.
 
Resets all frame parameters, buffer-local vars, current
 
Workgroups session object, etc.  SESSION nil defaults to a new,
 
blank session object."
 
  (mapc 'wg-reset-frame (frame-list))
 
  (mapc 'wg-reset-buffer (buffer-list))
 
  (setq wg-wconfig-kill-ring nil)
 
  (setq wg-current-session (or session (wg-make-session))))
 

	
 

	
 
;; Local Variables:
 
;; byte-compile-warnings: (not cl-functions)
 
;; End:
 

	
 
(provide 'workgroups-functions)
 
;;; workgroups-functions.el ends here
src/workgroups-variables.el
Show inline comments
 
;;; workgroups-variables --- Workgroups vars and consts
 
;;; Commentary:
 
;;; Code:
 

	
 
(defconst wg-version "1.0.0"
 
  "Current version of workgroups.")
 

	
 
;;; customization
 

	
 
(defgroup workgroups nil
 
  "Workgroups for Emacs -- Emacs session manager"
 
  :group 'convenience
 
  :version wg-version)
 

	
 
(defcustom workgroups-mode nil
 
  "Non-nil if Workgroups mode is enabled."
 
  :set 'custom-set-minor-mode
 
  :initialize 'custom-initialize-default
 
  :group 'workgroups
 
  :type 'boolean)
 

	
 

	
 

	
 
(defcustom wg-load-last-workgroup nil
 
  "Load last active, not first, workgroup from all your workgroups."
 
  :group 'workgroups
 
  :type 'boolean)
 

	
 
(defvar wg-key-current-workgroup   "_current_workgroup")
 
(defvar wg-key-load-last-workgroup "_load-last-workgroup")
 

	
 
;; keybinding customization
 

	
 
(defcustom wg-prefix-key (kbd "C-c z")
 
  "Workgroups' prefix key.
 
Setting this variable requires that `workgroups-mode' be turned
 
off and then on again to take effect."
 
  :type 'string
 
  :group 'workgroups)
 

	
 

	
 
;; hooks
 

	
 
(defcustom workgroups-mode-hook nil
 
  "Hook run when `workgroups-mode' is turned on."
 
  :type 'hook
 
  :group 'workgroups)
 

	
 
(defcustom workgroups-mode-exit-hook nil
 
  "Hook run when `workgroups-mode' is turned off."
 
  :type 'hook
 
  :group 'workgroups)
 

	
 
(defcustom wg-switch-to-workgroup-hook nil
 
  "Hook run by `wg-switch-to-workgroup'."
 
  :type 'hook
 
  :group 'workgroups)
 

	
 
(defcustom wg-buffer-list-finalization-hook nil
 
  "Functions in this hook can modify `wg-temp-buffer-list'
 
arbitrarily, provided its final value is still a list of the
 
names of live buffer.  Any final adjustments the user wishes to
 
make to the filtered buffer list before ido/iswitchb get ahold of
 
it should be made here."
 
  :type 'hook
 
  :group 'workgroups)
 

	
 
(defcustom wg-pre-window-configuration-change-hook nil
 
  "Hook run before any function that triggers
 
`window-configuration-change-hook'."
 
  :type 'hook
 
  :group 'workgroups)
 

	
 

	
 
;; save and load customization
 
(defcustom wg-use-default-session-file (not (daemonp))
 
  "Generally, non-nil means take care of saving and loading automatically,
 
and nil means leave it up to the user.
 

	
 
FIXME: docstring this"
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-default-session-file
 
  "~/.emacs_workgroups"
 
  "Default filename to be used to save workgroups."
 
  :type 'file
 
  :group 'workgroups)
 

	
 
(defcustom wg-switch-to-first-workgroup-on-find-session-file t
 
  "Non-nil means switch to the first workgroup in a session file
 
when it's found with `wg-find-session-file'."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-emacs-exit-save-behavior 'save
 
  "Determines save behavior on Emacs exit.
 
Possible values:
 

	
 
`ask'           Ask the user whether to save if there are unsaved changes
 

	
 
`save'          Call `wg-save-session' when there are unsaved changes
 

	
 
Anything else   Exit Emacs without saving changes"
 
  :type 'symbol
 
  :group 'workgroups)
 

	
 
(defcustom wg-workgroups-mode-exit-save-behavior 'save
 
  "Determines save behavior on `workgroups-mode' exit.
 
Possible values:
 

	
 
`ask'           Ask the user whether to saveif there are unsaved changes
 

	
 
`save'          Call `wg-save-session' when there are unsaved changes
 

	
 
Anything else   Exit `workgroups-mode' without saving changes"
 
  :type 'symbol
 
  :group 'workgroups)
 

	
 

	
 
;; minibuffer customization
 

	
 
(defcustom wg-confirm-on-get-workgroup-create nil
 
  "Non-nil means request confirmation before creating a new
 
workgroup when `wg-get-workgroup-create' is called with a string
 
that doesn't name an existing workgroup."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-no-confirm-on-destructive-operation nil
 
  "Non-nil means don't request confirmation before various
 
destructive operations, like `wg-reset'."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-minibuffer-message-timeout 0.75
 
  "Bound to `minibuffer-message-timeout' when messaging while the
 
minibuffer is active."
 
  :type 'float
 
  :group 'workgroups)
 

	
 

	
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
;;
 
;; FIXME:
 
;;
 
;; Only set `wg-workgroup-base-wconfig' on `wg-write-session-file' or
 
;; `delete-frame' and only with the most recently changed working-wconfig.
 
;; Then, since it's not overwritten on every call to
 
;; `wg-workgroup-working-wconfig', its restoration can be retried after manually
 
;; recreating buffers that couldn't be restored.  So it takes over the
 
;; 'incorrect restoration' portion of the base wconfig's duty.  All that leaves
 
;; to base wconfigs is that they're a saved wconfig the user felt was important.
 
;; So why not allow more of of them?  A workgroup could stash an unlimited
 
;; number of wconfigs.
 
;;
 
;; TODO:
 
;;
 
;;   * Write new commands for restoring stashed wconfigs
 
;;
 
;;   * Add this message on improper restoration of `base-wconfig':
 
;;
 
;;       "Unable to restore 'buf1', 'buf2'... Hit C-whatever to retry after
 
;;        manually recreating these buffers."
 
;;
 
;;
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

	
 

	
 
;; workgroup restoration customization
 

	
 
;; TODO: possibly add `buffer-file-coding-system', `text-scale-mode-amount'
 
(defcustom wg-buffer-local-variables-alist
 
  `((major-mode nil wg-deserialize-buffer-major-mode)
 
    (mark-ring wg-serialize-buffer-mark-ring wg-deserialize-buffer-mark-ring)
 
    (left-fringe-width nil nil)
 
    (right-fringe-width nil nil)
 
    (fringes-outside-margins nil nil)
 
    (left-margin-width nil nil)
 
    (right-margin-width nil nil)
 
    (vertical-scroll-bar nil nil))
 
  "Alist mapping buffer-local variable symbols to serdes functions.
 

	
 
The `car' of each entry should be a buffer-local variable symbol.
 

	
 
The `cadr' of the entry should be either nil or a function of no
 
arguments.  If nil, the variable's value is used as-is, and
 
should have a readable printed representation.  If a function,
 
`funcall'ing it should yield a serialization of the value of the
 
variable.
 

	
 
The `caddr' of the entry should be either nil or a function of
 
one argument.  If nil, the serialized value from above is
 
assigned to the variable as-is.  It a function, `funcall'ing it
 
on the serialized value from above should do whatever is
 
necessary to properly restore the original value of the variable.
 
For example, in the case of `major-mode' it should funcall the
 
value (a major-mode function symbol) rather than just assigning
 
it to `major-mode'."
 
  :type 'alist
 
  :group 'workgroups)
 

	
 
(defcustom wg-special-buffer-serdes-functions
 
  '(wg-serialize-Info-buffer
 
    wg-serialize-dired-buffer
 
    wg-serialize-org-agenda-buffer
 
    wg-serialize-help-buffer
 
    wg-serialize-ielm-buffer
 
    wg-serialize-shell-buffer
 
    wg-serialize-eshell-buffer
 
    wg-serialize-term-buffer
 
    wg-serialize-magit-buffer
 
    wg-serialize-ess-shell-buffer
 
    wg-serialize-python-shell-buffer
 
    wg-serialize-prolog-shell-buffer
 
    wg-serialize-grep-buffer
 

	
 
    wg-serialize-wl-folders-buffer
 
    ;;wg-serialize-wl-summary-buffer
 
    ;;wg-serialize-mime-view-buffer
 
    )
 
  "List of functions providing special buffer serialization/deserialization.
 
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)
 

	
 
(defcustom wg-default-buffer "*scratch*"
 
  "Buffer made visible a window when the window's actual buffer
 
can't be restored.  Also used when a blank workgroup is created."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-nowg-string "No workgroups"
 
  "Display this string if there are no workgroups and
 
`wg-display-nowg' is t."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-display-nowg nil
 
  "Display something if there are no workgroups."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
;; What to restore:
 

	
 
(defcustom wg-restore-remote-buffers t
 
  "nil means do not restore buffers that get \"t\" with
 
`wg-is-file-remote'"
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-restore-associated-buffers nil
 
  "Non-nil means restore ALL buffers associated (opened in) with
 
the workgroup on workgroup restore.  \"nil\" means to restore
 
only needed buffers to show them to you."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-restore-frame-position nil
 
  "Non-nil means restore frame position on workgroup restore."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-restore-scroll-bars t
 
  "Non-nil means restore scroll-bar settings on workgroup restore."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-restore-fringes t
 
  "Non-nil means restore fringe settings on workgroup restore."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-restore-margins t
 
  "Non-nil means restore margin settings on workgroup restore."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-restore-point t
 
  "Non-nil means restore `point' on workgroup restore.
 
This is included mainly so point restoration can be suspended
 
during `wg-morph' -- you probably want this non-nil."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-restore-point-max t
 
  "Controls point restoration when point is at `point-max'.
 
If `point' is at `point-max' when a wconfig is created, put
 
`point' back at `point-max' when the wconfig is restored, even if
 
`point-max' has increased in the meantime.  This is useful in,
 
say, irc buffers where `point-max' is constantly increasing."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-restore-mark t
 
  "Non-nil means restore mark data on workgroup restore."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-restore-window-dedicated-p t
 
  "Non-nil means restore `window-dedicated-p' on workgroup restore."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 

	
 
;; wconfig undo/redo customization
 

	
 
(defcustom wg-wconfig-undo-list-max 20
 
  "Number of past window configs to retain for undo."
 
  :type 'integer
 
  :group 'workgroups)
 

	
 

	
 
;; wconfig kill-ring customization
 

	
 
(defcustom wg-wconfig-kill-ring-max 20
 
  "Maximum length of the `wg-wconfig-kill-ring'."
 
  :type 'integer
 
  :group 'workgroups)
 

	
 

	
 
;; buffer-list filtration customization
 

	
 
(defcustom wg-buffer-list-filtration-on t
 
  "Non-nil means Workgroups' buffer-list filtration feature is on.
 
Nil means ido and iswitchb behave normally.  See
 
`wg-buffer-list-filter-definitions' for more info."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-buffer-list-filter-definitions
 
  '((all "all" wg-buffer-list-filter-all)
 
    (associated "associated" wg-buffer-list-filter-associated)
 
    (unassociated "unassociated" wg-buffer-list-filter-unassociated)
 
    (fallback "fallback" nil))
 
  "List of buffer list filter definitions.
 
Each entry should be a list containing an identifier symbol, a
 
prompt string, and a function form that's funcall'd to produce
 
the filtered buffer-list.
 

	
 
The prompt string is displayed as part of the minibuffer prompt
 
when its filter is active.
 

	
 
The function form should be either a function-symbol or a lambda, and
 
should take two arguments: a workgroup and a list of live Emacs
 
buffers.  The function should return a new list of live buffers,
 
typically by filtering its second argument in some way.
 

	
 
Default buffer-list-filters include:
 

	
 
`all'           All buffer names
 

	
 
`associated'    Only the names of those live buffers that have
 
                been associated with the current workgroup
 

	
 
`unassociated'  Only the names of those live buffers that are
 
                unassociated with the current workgroup
 

	
 
`fallback'      A special case used to fallback to the
 
                original (non-ido/iswitchb) Emacs command.
 
                `fallback' isn't actually a buffer-list-filter
 
                itself, but can be used in
 
                `wg-buffer-list-filter-order-alist' just the
 
                same.
 

	
 
A few example custom buffer-list filtration functions are
 
included, like `wg-buffer-list-filter-home-dir',
 
`wg-buffer-list-filter-irc' and `wg-buffer-list-filter-elisp'.
 
See their definitions for more info on how they're defined, and
 
the utilities they're built on.
 

	
 
Here's an example of how to add an `elisp' buffer-list-filter
 
definition to `wg-buffer-list-filter-definitions' using the
 
example function `wg-buffer-list-filter-elisp':
 

	
 
(add-to-list
 
 'wg-buffer-list-filter-definitions
 
 '(elisp \"elisp\" wg-buffer-list-filter-elisp))
 

	
 
After this form has been evaluated, `elisp' can be used wherever
 
other buffer-list-filter identifiers are used, like in
 
`wg-buffer-list-filter-order-alist'.
 

	
 
Becomes workgroup-local when set with `wg-set-workgroup-parameter'.
 
Becomes session-local when set with `wg-set-session-parameter'."
 
  :type 'list
 
  :group 'workgroups)
 

	
 
(defcustom wg-buffer-list-filter-order-alist
 
  '((default associated unassociated all fallback))
 
  "Alist defining the order in which filtered buffer-lists are presented.
 

	
 
The car of each entry should be the symbol of the original Emacs
 
command (not the ido or iswitchb remappings) -- i.e. one of
 
`switch-to-buffer', `switch-to-buffer-other-window',
 
`switch-to-buffer-other-frame', `kill-buffer', `next-buffer',
 
`previous-buffer', `display-buffer', `insert-buffer',
 
`read-buffer', or the special symbol `default', which defines the
 
buffer-list-filter order for all commands not present in this
 
alist.
 

	
 
The cdr of each entry should be a list of buffer-list-filter
 
identifiers defining the order in which filtered buffer-lists are
 
presented for the command.  See
 
`wg-buffer-list-filter-definitions'.
 

	
 
Becomes workgroup-local when set with `wg-set-workgroup-parameter'.
 
Becomes session-local when set with `wg-set-session-parameter'."
 
  :type 'alist
 
  :group 'workgroups)
 

	
 
(defcustom wg-center-rotate-buffer-list-display nil
 
  "Non-nil means rotate the buffer list display so that the
 
current buffer is in the center of the list.  This can make it
 
easier to see the where `wg-previous-buffer' will take you, but
 
it doesn't look right if the buffer list display is long enough
 
to wrap in the miniwindow."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-buffer-auto-association-on t
 
  "Non-nil means buffer auto-association is on.
 
nil means it's off.  See `wg-buffer-auto-association'."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-buffer-auto-association 'weak
 
  "Specifies the behavior for auto-associating buffers with workgroups.
 

	
 
When a buffer is made visible in a window it can be automatically
 
associated with the current workgroup in the window's frame.
 
This setting determines whether and how that happens.
 

	
 
Allowable values:
 

	
 
`weak' - weakly associate the buffer with the workgroup
 

	
 
`strong' - strongly associate the buffer with the workgroup
 

	
 
A function (a function-symbol or a lambda) - `funcall' the function to
 
determine whether and how to associate the buffer with the
 
workgroup.  The function should accept two arguments -- the
 
buffer and the workgroup -- and should return one of the
 
allowable values for this variable.
 

	
 
`nil' or any other value - don't associate the buffer with the
 
workgroup.
 

	
 
Becomes workgroup-local when set with `wg-set-workgroup-parameter'.
 
Becomes session-local when set with `wg-set-session-parameter'."
 
  :type 'sexp
 
  :group 'workgroups)
 

	
 
(defcustom wg-dissociate-buffer-on-kill-buffer t
 
  "Non-nil means dissociate from the current workgroup buffers
 
killed with `kill-buffer'."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-remap-switch-to-buffer nil
 
  "Non-nil means remap `switch-to-buffer' to `wg-switch-to-buffer'."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-remap-switch-to-buffer-other-window nil
 
  "Non-nil means remap `switch-to-buffer-other-window' to
 
`wg-switch-to-buffer-other-window'.  Otherwise, don't remap."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-remap-switch-to-buffer-other-frame nil
 
  "Non-nil means remap `switch-to-buffer-other-frame' to
 
`wg-switch-to-buffer-other-frame'.  Otherwise, don't remap."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-remap-kill-buffer nil
 
  "Non-nil means remap `kill-buffer' to `wg-kill-buffer'.
 
Otherwise, don't remap."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-remap-display-buffer nil
 
  "Non-nil means remap `display-buffer' to `wg-display-buffer'.
 
Otherwise, don't remap."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-remap-insert-buffer nil
 
  "Non-nil means remap `insert-buffer' to `wg-insert-buffer'.
 
Otherwise, don't remap."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-remap-next-buffer nil
 
  "Non-nil means remap `next-buffer' to `wg-next-buffer'.
 
Otherwise, don't remap."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-remap-previous-buffer nil
 
  "Non-nil means remap `previous-buffer' to `wg-previous-buffer'.
 
Otherwise, don't remap."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-remap-bury-buffer 'bury
 
  "Non-nil means remap `bury-buffer'.
 
`banish' means remap `bury-buffer' to `wg-banish-buffer'.
 
`bury' or other non-nil means remap `bury-buffer' to
 
`wg-bury-buffer'.  Otherwise, don't remap."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-ido-entry-buffer-replacement-regexp "^ .*Minibuf.*$"
 
  "Regexp matching the name of a buffer to replace `ido-entry-buffer'.
 
The regexp should match the name of a live buffer that will never
 
be a completion candidate under normal circumstances.  You
 
probably don't want to change this.  See
 
`wg-get-sneaky-ido-entry-buffer-replacement'."
 
  :type 'regexp
 
  :group 'workgroups)
 

	
 

	
 
;; morph customization
 

	
 
(defcustom wg-morph-on nil
 
  "Non-nil means use `wg-morph' when restoring wconfigs."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-morph-hsteps 9
 
  "Columns/iteration to step window edges during `wg-morph'.
 
Values lower than 1 are invalid."
 
  :type 'integer
 
  :group 'workgroups)
 

	
 
(defcustom wg-morph-vsteps 3
 
  "Rows/iteration to step window edges during `wg-morph'.
 
Values lower than 1 are invalid."
 
  :type 'integer
 
  :group 'workgroups)
 

	
 
(defcustom wg-morph-terminal-hsteps 3
 
  "Used instead of `wg-morph-hsteps' in terminal frames.
 
If nil, `wg-morph-hsteps' is used."
 
  :type 'integer
 
  :group 'workgroups)
 

	
 
(defcustom wg-morph-terminal-vsteps 1
 
  "Used instead of `wg-morph-vsteps' in terminal frames.
 
If nil, `wg-morph-vsteps' is used."
 
  :type 'integer
 
  :group 'workgroups)
 

	
 
(defcustom wg-morph-truncate-partial-width-windows t
 
  "Bound to `truncate-partial-width-windows' during `wg-morph'.
 
Non-nil, this prevents weird-looking continuation line behavior,
 
and can speed up morphing a little.  Lines jump back to their
 
wrapped status when `wg-morph' is complete."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 

	
 
;; mode-line customization
 

	
 
(defcustom wg-mode-line-display-on t
 
  "Toggles Workgroups' mode-line display."
 
  :type 'boolean
 
  :group 'workgroups
 
  :set (lambda (sym val)
 
         (custom-set-default sym val)
 
         (force-mode-line-update)))
 

	
 
(defcustom wg-mode-line-use-faces nil
 
  "Non-nil means use faces in the mode-line display.
 
It can be tricky to choose faces that are visible in both active
 
and inactive mode-lines, so this feature defaults to off."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-disable (featurep 'powerline)
 
  "Do not do any modeline modifications."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-only-name t
 
  "Display only workgroup name in modeline without any flags."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-decor-left-brace "("
 
  "String displayed at the left of the mode-line display."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-decor-right-brace ")"
 
  "String displayed at the right of the mode-line display."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-decor-divider ":"
 
  "String displayed between elements of the mode-line display."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-decor-strongly-associated
 
  #("@" 0 1 (help-echo "This buffer is strongly associated with the \
 
current workgroup"))
 
  "Indicates that a buffer is strongly associated with the current workgroup."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-decor-weakly-associated
 
  #("~" 0 1 (help-echo "This buffer is weakly associated with the \
 
current workgroup"))
 
  "Indicates that a buffer is weakly associated with the current workgroup."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-decor-unassociated
 
  #("-" 0 1 (help-echo "This buffer is unassociated with the \
 
current workgroup"))
 
  "Indicates that a buffer is unassociated with the current workgroup."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-decor-window-dedicated
 
  #("#" 0 1 (help-echo "This window is dedicated to its buffer."))
 
  "Indicates that the window is dedicated to its buffer."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-decor-window-undedicated
 
  #("-" 0 1 (help-echo "This window is not dedicated to its buffer."))
 
  "Indicates that the window is not dedicated to its buffer."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-decor-session-modified
 
  #("*" 0 1 (help-echo "The session is modified"))
 
  "Indicates that the session is modified."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-decor-session-unmodified
 
  #("-" 0 1 (help-echo "The session is unmodified"))
 
  "Indicates that the session is unmodified."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-decor-workgroup-modified
 
  #("*" 0 1 (help-echo "The current workgroup is modified"))
 
  "Indicates that the current workgroup is modified."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-mode-line-decor-workgroup-unmodified
 
  #("-" 0 1 (help-echo "The current workgroup is unmodified"))
 
  "Indicates that the current workgroup is unmodified."
 
  :type 'string
 
  :group 'workgroups)
 

	
 

	
 
;; display customization
 

	
 
(defcustom wg-use-faces t
 
  "Non-nil means use faces in various displays."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
(defcustom wg-time-format "%H:%M:%S %A, %B %d %Y"
 
  "Format string for time display.  Passed to `format-time-string'."
 
  :type 'string
 
  :group 'workgroups)
 

	
 
(defcustom wg-display-battery t
 
  "Non-nil means include `battery', when available, in the time display."
 
  :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)
 

	
 
(defcustom wg-associate-buffers t
 
  "Non-nil means when emacs chooses a buffer to display in a
 
workgroup, prefer buffers whose most recent appearance was in
 
that workgroup."
 
  :type 'boolean
 
  :group 'workgroups)
 

	
 
;;; vars
 

	
 
(defvar workgroups-mode-map nil
 
  "Workgroups Mode's keymap")
 

	
 
(defvar wg-current-session nil
 
  "Current session object.")
 

	
 
(defvar wg-workgroups-mode-minor-mode-map-entry nil
 
  "Workgroups' minor-mode-map entry.")
 

	
 
(defvar wg-wconfig-kill-ring nil
 
  "Ring of killed or kill-ring-saved wconfigs.")
 

	
 
(defvar wg-last-message nil
 
  "Holds the last message Workgroups sent to the echo area.")
 

	
 
(defvar wg-face-abbrevs nil
 
  "Assoc list mapping face abbreviations to face names.")
 

	
 
(defvar wg-buffer-uid nil
 
  "Symbol for the current buffer's wg-buf's uid.
 
Every Workgroups buffer object (wg-buf) has a uid.  When
 
Workgroups creates or encounters an Emacs buffer object
 
corresponding to a wg-buf, it tags it with the wg-buf's uid to
 
unambiguously pair the two.")
 
(make-variable-buffer-local 'wg-buffer-uid)
 

	
 

	
 
;; file and modified flag vars
 

	
 
(defvar wg-flag-modified t
 
  "Dynamically bound to nil around destructive operations to
 
temporarily disable flagging `modified'.")
 

	
 

	
 
;; undo vars
 

	
 
(defvar wg-window-configuration-changed nil
 
  "Flag set by `window-configuration-change-hook'.")
 

	
 
(defvar wg-already-updated-working-wconfig nil
 
  "Flag set by `wg-update-working-wconfig-hook'.")
 

	
 
(defvar wg-undoify-window-configuration-change t
 
  "Flag unset when changes to the window config shouldn't cause
 
workgroups' undo info to be updated.")
 

	
 
(defvar wg-just-exited-minibuffer nil
 
  "Flag set by `minibuffer-exit-hook' to exempt from
 
undoification those window-configuration changes caused by
 
exiting the minibuffer.  This is ugly, but necessary.  It may
 
seem like we could just null out
 
`wg-undoify-window-configuration-change' in
 
`minibuffer-exit-hook', but that also prevents undoification of
 
window configuration changes triggered by commands called with
 
`execute-extended-command' -- i.e. it's just too coarse.")
 

	
 

	
 
;; buffer-list-filter vars
 

	
 
(defvar wg-current-workgroup nil
 
  "Bound to the current workgroup in `wg-with-buffer-list-filters'.")
 

	
 
;; (defvar wg-current-buffer-command nil
 
;;   "Bound to the current buffer command in `wg-with-buffer-list-filters'.")
 

	
 
(defvar wg-current-buffer-list-filter-id nil
 
  "Bound to the current buffer-list-filter symbol in `wg-with-buffer-list-filters'.")
 

	
 
(defvar wg-previous-minibuffer-contents nil
 
  "Holds the previous minibuffer contents for re-insertion when
 
the buffer-list-filter is cycled.")
 

	
 
(defvar wg-ido-method-translations
 
  `((switch-to-buffer              . selected-window)
 
    (switch-to-buffer-other-window . other-window)
 
    (switch-to-buffer-other-frame  . other-frame)
 
    (kill-buffer                   . kill)
 
    (insert-buffer                 . insert)
 
    (display-buffer                . display))
 
  "Alist mapping buffer commands to ido buffer methods.")
 

	
 
(defvar wg-iswitchb-method-translations
 
  `((switch-to-buffer              . samewindow)
 
    (switch-to-buffer-other-window . otherwindow)
 
    (switch-to-buffer-other-frame  . otherframe)
 
    (kill-buffer                   . kill)
 
    (insert-buffer                 . insert)
 
    (display-buffer                . display))
 
  "Alist mapping buffer commands to iswitchb buffer methods.")
 

	
 
(defvar wg-buffer-internal-default-buffer nil
 
  "Bound to `wg-buffer-internal's optional DEFAULT argument for
 
use by buffer list filtration hooks.")
 

	
 
(defvar wg-temp-buffer-list nil
 
  "Dynamically bound to the filtered buffer list in
 
`wg-finalize-buffer-list'.  Functions in
 
`wg-buffer-list-finalization-hook' should modify this variable.")
 

	
 

	
 
;; wconfig restoration and morph vars
 

	
 
(defvar wg-window-min-width 2
 
  "Bound to `window-min-width' when restoring wtrees. ")
 

	
 
(defvar wg-window-min-height 1
 
  "Bound to `window-min-height' when restoring wtrees.")
 

	
 
(defvar wg-window-min-pad 2
 
  "Added to `wg-window-min-foo' to produce the actual minimum window size.")
 

	
 
(defvar wg-actual-min-width (+ wg-window-min-width wg-window-min-pad)
 
  "Actual minimum window width when creating windows.")
 

	
 
(defvar wg-actual-min-height (+ wg-window-min-height wg-window-min-pad)
 
  "Actual minimum window height when creating windows.")
 

	
 
(defvar wg-min-edges `(0 0 ,wg-actual-min-width ,wg-actual-min-height)
 
  "Smallest allowable edge list of windows created by Workgroups.")
 

	
 
(defvar wg-null-edges '(0 0 0 0)
 
  "Null edge list.")
 

	
 
(defvar wg-morph-max-steps 200
 
  "Maximum `wg-morph' iterations before forcing exit.")
 

	
 
(defvar wg-window-tree-selected-window nil
 
  "Used during wconfig restoration to hold the selected window.")
 

	
 
(defvar wg-update-current-workgroup-working-wconfig-on-select-frame t
 
  "Non-nil means update `selected-frame's current workgroup's
 
working wconfig before `select-frame' selects a new frame.
 
let-bind this to nil around forms in which you don't want this to
 
happen.")
 

	
 

	
 
(defvar wg-buffer-workgroup nil
 
  "Buffer-local variable associating each buffer with the
 
  workgroup in which it most recently appeared.")
 
(make-variable-buffer-local 'wg-buffer-workgroup)
 

	
 
(defvar wg-deactivation-list nil
 
  "A stack of workgroups that are currently being switched away from.
 
Used to avoid associating the old workgroup's buffers with the
 
new workgroup during a switch.")
 

	
 
;;; faces
 

	
 
(defmacro wg-defface (face key spec doc &rest args)
 
  "`defface' wrapper adding a lookup key used by `wg-fontify'."
 
  (declare (indent 2))
 
  `(progn
 
     (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)
 

	
 

	
 
(provide 'workgroups-variables)
 
;;; workgroups-variables.el ends here
0 comments (0 inline, 0 general)