Changeset - 69ab704a7974
[Not reviewed]
0 5 0
Sergey Pashinin - 11 years ago 2014-08-23 16:57:04
sergey@pashinin.com
wg-when-let replaced
5 files changed with 19 insertions and 38 deletions:
0 comments (0 inline, 0 general)
src/workgroups-advice.el
Show inline comments
 
@@ -181,26 +181,26 @@ killed with `kill-buffer'."
 
See `wg-buffer-auto-association' for allowable values of ASSOC."
 
  (cond ((memq assoc '(weak strong))
 
         (wg-workgroup-associate-bufobj workgroup buffer (eq assoc 'weak)))
 
        ((functionp assoc)
 
         (wg-auto-associate-buffer-helper
 
          workgroup buffer (funcall assoc workgroup buffer)))
 
        (t nil)))
 

	
 
(defun wg-auto-associate-buffer (buffer &optional frame)
 
  "Conditionally associate BUFFER with the current workgroup in FRAME.
 
Frame defaults to `selected-frame'.  See `wg-buffer-auto-association'."
 
  (when wg-buffer-auto-association-on
 
    (wg-when-let ((wg (wg-current-workgroup t frame))
 
                  (b (get-buffer buffer)))
 
    (-when-let* ((wg (wg-current-workgroup t frame))
 
                 (b (get-buffer buffer)))
 
      (unless (or (wg-workgroup-bufobj-association-type wg buffer)
 
                  (member wg wg-deactivation-list)
 
                  (member (buffer-name b) wg-associate-blacklist)
 
                  (not (or (buffer-file-name b)
 
                           (eq (buffer-local-value 'major-mode b) 'dired-mode))))
 
        (wg-auto-associate-buffer-helper
 
         wg buffer (wg-local-value 'wg-buffer-auto-association wg))))))
 

	
 
(defadvice switch-to-buffer (after wg-auto-associate-buffer)
 
  "Automatically associate the buffer with the current workgroup."
 
  (wg-auto-associate-buffer ad-return-value))
 

	
src/workgroups-buf.el
Show inline comments
 
@@ -41,35 +41,35 @@ When a buffer can't be restored, when creating a blank wg."
 
(defmacro wg-buf-list ()
 
  "Setf'able `wg-current-session' buf-list slot accessor."
 
  `(wg-session-buf-list (wg-current-session)))
 

	
 
(defun wg-restore-default-buffer (&optional switch)
 
  "Return `wg-default-buffer' and maybe SWITCH to it."
 
  (if switch
 
      (switch-to-buffer wg-default-buffer t)
 
    (get-buffer-create wg-default-buffer)))
 

	
 
(defun wg-restore-existing-buffer (buf &optional switch)
 
  "Return existing buffer from BUF and maybe SWITCH to it."
 
  (wg-when-let ((b (wg-find-buf-in-buffer-list buf (wg-buffer-list-emacs))))
 
  (-when-let (b (wg-find-buf-in-buffer-list buf (wg-buffer-list-emacs)))
 
    (if switch (switch-to-buffer b t))
 
    (with-current-buffer b
 
      (wg-set-buffer-uid-or-error (wg-buf-uid buf))
 
      b)))
 

	
 
(defun wg-restore-file-buffer (buf &optional switch)
 
  "Restore BUF by finding its file and maybe SWITCH to it.
 
Return the created buffer.
 
If BUF's file doesn't exist, call `wg-restore-default-buffer'"
 
  ;;(wg-when-let ((file-name (wg-buf-file-name buf)))
 
  ;;(-when-let ((file-name (wg-buf-file-name buf)))
 
  (let ((file-name (wg-buf-file-name buf)))
 
    (when (and file-name
 
               (or wg-restore-remote-buffers
 
                   (not (file-remote-p file-name))))
 
      (cond ((file-exists-p file-name)
 
             ;; jit ignore errors
 
             ;;(ignore-errors
 
             (condition-case err
 
                 (let ((b (find-file-noselect file-name nil nil nil)))
 
                   (with-current-buffer b
 
                     (rename-buffer (wg-buf-name buf) t)
 
                     (wg-set-buffer-uid-or-error (wg-buf-uid buf))
 
@@ -85,25 +85,25 @@ If BUF's file doesn't exist, call `wg-restore-default-buffer'"
 
                nil)))
 
            (t
 
             ;; try directory
 
             (if (file-directory-p (file-name-directory file-name))
 
                 (dired (file-name-directory file-name))
 
               (progn
 
                 (message "Attempt to restore nonexistent file: %S" file-name)
 
                 nil))
 
             )))))
 

	
 
(defun wg-restore-special-buffer (buf &optional switch)
 
  "Restore a buffer BUF with DESERIALIZER-FN and maybe SWITCH to it."
 
  (wg-when-let
 
  (-when-let*
 
      ((special-data (wg-buf-special-data buf))
 
       (buffer (save-window-excursion
 
                 (condition-case err
 
                     (funcall (car special-data) buf)
 
                   (error (message "Error deserializing %S: %S" (wg-buf-name buf) err)
 
                          nil)))))
 
    (if switch (switch-to-buffer buffer t))
 
    (with-current-buffer buffer
 
      (wg-set-buffer-uid-or-error (wg-buf-uid buf)))
 
    buffer))
 

	
 
(defun wg-restore-buffer (buf &optional switch)
 
@@ -266,27 +266,27 @@ If BUFOBJ is a buffer or a buffer name, see `wg-buffer-uid-or-add'."
 
  "Return BUFFER.
 
Currently only sets BUFFER's `wg-buffer-uid' to nil."
 
  (with-current-buffer buffer (setq wg-buffer-uid nil)))
 

	
 

	
 

	
 
;;; buffer-list-filter commands
 

	
 
(defun wg-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)))
 
    (-when-let* ((uid (wg-buffer-uid buffer))
 
                 (old-buf (wg-find-buf-by-uid uid))
 
                 (new-buf (wg-buffer-to-buf buffer)))
 
      (setf (wg-buf-uid new-buf) (wg-buf-uid old-buf))
 
      (wg-asetf (wg-buf-list) (cons new-buf (remove old-buf it))))))
 

	
 
(defun wg-update-buf-list (&optional buffer-list)
 
  "Update all bufs in `wg-buf-list' corresponding to buffers in BUFFER-LIST."
 
  (mapc 'wg-update-buffer-in-buf-list (or buffer-list (wg-buffer-list-emacs))))
 

	
 
(defun wg-buffer-list-display (buffer-list)
 
  "Return the BUFFER-LIST display string."
 
  (wg-display-internal 'wg-buffer-display buffer-list))
 

	
 
;; buffer-list filters
src/workgroups-utils-basic.el
Show inline comments
 
;;; workgroups-utils.el --- Utilities used by Workgroups
 
;;; Commentary:
 
;;
 
;; A bunch of general purpose-ish utilities used by Workgroups.
 
;;
 
;;; Code:
 

	
 
;;; utils used in macros
 

	
 
(require 'dash)
 
(require 'cl-lib)
 
(require 'anaphora)
 
(require 'workgroups-faces)
 
(require 'workgroups-variables)
 

	
 
(defmacro wg-with-gensyms (syms &rest body)
 
  "Bind all symbols in SYMS to `gensym's, and eval BODY."
 
  (declare (indent 1))
 
  `(let (,@(mapcar (lambda (sym) `(,sym (cl-gensym))) syms)) ,@body))
 

	
 
(defmacro wg-dbind (args expr &rest body)
 
  "Bind the variables in ARGS to the result of EXPR and execute BODY.
 
@@ -28,34 +29,24 @@ Abbreviation of `destructuring-bind'."
 
N defaults to 2, and STEP defaults to N.
 
Iterative to prevent stack overflow."
 
  (let* ((n (or n 2)) (step (or step n)) acc)
 
    (while list
 
      (push (-take n list) acc)
 
      (setq list (nthcdr step list)))
 
    (nreverse acc)))
 

	
 

	
 

	
 
;;; bindings
 

	
 
(defmacro wg-when-let (binds &rest body)
 
  "Like `let*' but when all BINDS are non-nil - eval BODY."
 
  (declare (indent 1))
 
  (wg-dbind (bind . binds) binds
 
    (when (consp bind)
 
      `(let (,bind)
 
         (when ,(car bind)
 
           ,(if (not binds) `(progn ,@body)
 
              `(wg-when-let ,binds ,@body)))))))
 

	
 
(defmacro wg-when-boundp (symbols &rest body)
 
  "When all SYMBOLS are bound, `eval' BODY."
 
  (declare (indent 1))
 
  `(when (and ,@(mapcar (lambda (sym) `(boundp ',sym)) symbols))
 
     ,@body))
 

	
 

	
 

	
 
;;; do-style wrappers
 

	
 
(defmacro wg-docar (spec &rest body)
 
  "do-style wrapper for `mapcar'.
 
@@ -178,72 +169,61 @@ Otherwise return nil.  KEYS can be any keywords accepted by `remove*'."
 
(defmacro wg-pushnew-p (item seq-place &rest keys)
 
  "If ITEM is not a `member' of SEQ-PLACE, push it to SEQ-PLACE and return t.
 
Otherwise return nil.  KEYS can be any keyword args accepted by `pushnew'."
 
  `(< (length ,seq-place)
 
      (length (cl-pushnew ,item ,seq-place ,@keys))))
 

	
 
(defun wg-range (start end)
 
  "Return a list of integers from START up to but not including END."
 
  (let (accum)
 
    (dotimes (i (- end start) (nreverse accum))
 
      (push (+ start i) accum))))
 

	
 
(defun wg-rotate-list (list &optional offset)
 
  "Rotate LIST by OFFSET.  Positive OFFSET rotates left, negative right."
 
  (when list
 
    (let ((split (mod (or offset 1) (length list))))
 
      (append (nthcdr split list) (-take split list)))))
 

	
 
(defun wg-center-rotate-list (list)
 
  "Rotate LIST so it's first elt is in the center.  When LIST's
 
length is even, the first elt is left nearer the front."
 
  (wg-rotate-list list (- (/ (1- (length list)) 2))))
 

	
 
(defun wg-insert-after (elt list index)
 
  "Insert ELT into LIST after INDEX."
 
  (let ((new-list (cl-copy-list list)))
 
    (push elt (cdr (nthcdr index new-list)))
 
    new-list))
 

	
 
(defun wg-insert-before (elt list index)
 
  "Insert ELT into LIST before INDEX."
 
  (if (zerop index) (cons elt list)
 
    (wg-insert-after elt list (1- index))))
 

	
 
(defun wg-move-elt (elt list index &rest keys)
 
  "Move ELT before INDEX in LIST.
 
KEYS is passed to `remove*'."
 
  (wg-insert-before elt (apply 'cl-remove elt list keys) index))
 

	
 
(defun wg-cyclic-nth (list n)
 
  "Return the Nth element of LIST, modded by the length of list."
 
  (nth (mod n (length list)) list))
 

	
 
(defun wg-cyclic-offset-elt (elt list n)
 
  "Cyclically offset ELT's position in LIST by N."
 
  (wg-when-let ((pos (cl-position elt list)))
 
  (-when-let (pos (cl-position elt list))
 
    (wg-move-elt elt list (mod (+ n pos) (length list)))))
 

	
 
(defun wg-cyclic-nth-from-elt (elt list n &rest keys)
 
  "Return the elt in LIST N places cyclically from ELT.
 
If ELT is not present is LIST, return nil.
 
KEYS is passed to `position'."
 
  (wg-when-let ((pos (apply 'cl-position elt list keys)))
 
  (-when-let (pos (apply 'cl-position elt list keys))
 
    (wg-cyclic-nth list (+ pos n))))
 

	
 
(defun wg-util-swap (elt1 elt2 list)
 
  "Return a copy of LIST with ELT1 and ELT2 swapped.
 
Return nil when ELT1 and ELT2 aren't both present."
 
  (wg-when-let ((p1 (cl-position elt1 list))
 
                (p2 (cl-position elt2 list)))
 
  (-when-let* ((p1 (cl-position elt1 list))
 
               (p2 (cl-position elt2 list)))
 
    (wg-move-elt elt1 (wg-move-elt elt2 list p1) p2)))
 

	
 
(defun wg-dups-p (list &rest keys)
 
  "Return non-nil when LIST contains duplicate elements.
 

	
 
Keywords supported: :test :key
 

	
 
\(fn LIST [KEYWORD VALUE]...)"
 
  (let ((test (or (plist-get keys :test) 'eq))
 
        (key (or (plist-get keys :key) 'identity)))
 
    (cl-loop for (elt . rest) on list
 
             for elt = (funcall key elt)
src/workgroups-wconfig.el
Show inline comments
 
@@ -71,26 +71,26 @@ FRAME is deleted, so we don't lose its state."
 
  "Return WCONFIG's wtree's `wg-wtree-buf-uids'."
 
  (if (not (wg-wconfig-wtree wconfig))
 
      (error "WTREE is nil in `wg-wconfig-buf-uids'!"))
 
  (wg-wtree-unique-buf-uids (wg-wconfig-wtree wconfig)))
 

	
 

	
 

	
 

	
 

	
 
(defun wg-wconfig-restore-frame-position (wconfig &optional frame)
 
  "Use WCONFIG to restore FRAME's position.
 
If frame is nil then `selected-frame'."
 
  (wg-when-let ((left (wg-wconfig-left wconfig))
 
                (top (wg-wconfig-top wconfig)))
 
  (-when-let* ((left (wg-wconfig-left wconfig))
 
               (top (wg-wconfig-top wconfig)))
 
    ;; Check that arguments are integers
 
    ;; Problem: https://github.com/pashinin/workgroups2/issues/15
 
    (if (and (integerp left)
 
             (integerp top))
 
        (set-frame-position frame left top))))
 

	
 
(defun wg-wconfig-restore-scroll-bars (wconfig)
 
  "Restore `selected-frame's scroll-bar settings from WCONFIG."
 
  (set-frame-parameter
 
   nil 'vertical-scroll-bars (wg-wconfig-vertical-scroll-bars wconfig))
 
  (set-frame-parameter
 
   nil 'scroll-bar-width (wg-wconfig-scroll-bar-width wconfig)))
src/workgroups-workgroup.el
Show inline comments
 
;;; workgroups-workgroup.el --- workgroup functions
 
;;; Commentary:
 
;;; Code:
 

	
 
(require 'dash)
 
(require 'ring)
 
(require 'workgroups-wconfig)
 
(require 'workgroups-minibuffer)
 

	
 
;;
 
;; Variables
 
;;
 
(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.")
 

	
 
@@ -152,26 +153,26 @@ 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 (cl-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)))
 
  (-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)))
 

	
 

	
 

	
 
(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."
 
  (cl-reduce 'wg-string-list-union
 
@@ -768,25 +769,25 @@ WORKGROUP is current."
 
      (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
 
         wg-window-configuration-changed         ;; When the window config has changed,
 
         wg-undoify-window-configuration-change  ;; and undoification is still on for the current command
 
         (wg-minibuffer-inactive-p))             ;; and the change didn't occur while the minibuffer is active,
 
    (wg-when-let ((workgroup (wg-current-workgroup t)))  ;; and there's a current workgroup,
 
    (-when-let (workgroup (wg-current-workgroup t))  ;; and there's a current workgroup,
 
      ;; 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))
0 comments (0 inline, 0 general)