Changeset - bee9a5ef4f9e
[Not reviewed]
0 1 0
Sergey Pashinin - 12 years ago 2013-07-07 18:16:48
sergey@pashinin.com
Rename remove-if to wg-remove-if, remove-if-not to wg-remove-if-not
1 file changed with 8 insertions and 8 deletions:
0 comments (0 inline, 0 general)
src/workgroups-functions.el
Show inline comments
 
@@ -805,349 +805,349 @@ WORKGROUP should be a workgroup or nil."
 
  "Return t when WORKGROUP is the current workgroup, nil otherwise."
 
  (wg-awhen (wg-current-workgroup t frame)
 
    (eq workgroup it)))
 

	
 
(defun wg-previous-workgroup-p (workgroup &optional frame)
 
  "Return t when WORKGROUP is the previous workgroup, nil otherwise."
 
  (wg-awhen (wg-previous-workgroup t frame)
 
    (eq workgroup it)))
 

	
 
(defmacro wg-with-current-workgroup (workgroup &rest body)
 
  "Execute forms in BODY with WORKGROUP temporarily current.
 
WORKGROUP should be any workgroup identifier accepted by
 
`wg-get-workgroup'.  The value returned is the last form
 
in BODY."
 
  (declare (indent 1))
 
  `(let ((wg-current-workgroup (wg-get-workgroup ,workgroup)))
 
     ,@body))
 

	
 
(defun wg-get-workgroup (obj &optional noerror)
 
  "Return a workgroup from OBJ.
 
If OBJ is a workgroup, return it.
 
If OBJ is a string, return the workgroup named OBJ, or error unless NOERROR.
 
If OBJ is nil, return the current workgroup, or error unless NOERROR."
 
  (cond ((wg-workgroup-p obj) obj)
 
        ((stringp obj) (wg-find-workgroup-by :name obj noerror))
 
        ((null obj) (wg-current-workgroup noerror))
 
        (t (error "Can't get workgroup from type:: %S" (type-of obj)))))
 

	
 

	
 

	
 
;;; workgroup parameters
 

	
 
(defun wg-workgroup-parameter (workgroup parameter &optional default)
 
  "Return WORKGROUP's value for PARAMETER.
 
If PARAMETER is not found, return DEFAULT which defaults to nil.
 
WORKGROUP should be accepted by `wg-get-workgroup'."
 
  (wg-aget (wg-workgroup-parameters (wg-get-workgroup workgroup))
 
           parameter default))
 

	
 
(defun wg-set-workgroup-parameter (workgroup parameter value)
 
  "Set WORKGROUP's value of PARAMETER to VALUE.
 
WORKGROUP should be a value accepted by `wg-get-workgroup'.
 
Return VALUE."
 
  (let ((workgroup (wg-get-workgroup workgroup)))
 
    (wg-set-parameter (wg-workgroup-parameters workgroup) parameter value)
 
    (wg-flag-workgroup-modified workgroup)
 
    value))
 

	
 
(defun wg-remove-workgroup-parameter (workgroup parameter)
 
  "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)))
 
    (remove-if-not
 
    (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)))
 
    (remove-if (lambda (buffer) (member buffer buffers)) 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."
 
  (remove-if-not (lambda (bname) (string-match regexp bname))
 
  (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."
 
  (remove-if-not (lambda (f) (when f (wg-file-under-root-path-p root-dir f)))
 
  (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."
 
  (remove-if-not (lambda (mm) (eq mm 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 ()
 
@@ -1236,262 +1236,262 @@ Added to `post-command-hook'."
 
(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 (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 (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)
 
            (remove-if-not 'wg-find-buf-by-uid it)
 
            (wg-remove-if-not 'wg-find-buf-by-uid it)
 
            (wg-workgroup-weak-buf-uids workgroup)
 
            (remove-if-not 'wg-find-buf-by-uid it)))
 
            (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."
 
  (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."
 
  (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."
 
  (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."
 
  (reduce 'wg-string-list-union
 
          (list (wg-workgroup-base-wconfig-buf-uids workgroup)
 
                (wg-workgroup-saved-wconfigs-buf-uids workgroup)
 
                (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'."
 
  (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'."
 
  (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)
 
              (remove-if-not (lambda (uid) (member uid all-buf-uids)) it
 
              (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 (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)))))
0 comments (0 inline, 0 general)