Changeset - 606efc7fe1a1
[Not reviewed]
0 2 0
Sergey Pashinin - 11 years ago 2014-08-23 13:54:14
sergey@pashinin.com
Removed unused functions
2 files changed with 0 insertions and 36 deletions:
0 comments (0 inline, 0 general)
src/workgroups-buf.el
Show inline comments
 
@@ -178,216 +178,192 @@ It works with Emacs buffer, Workgroups buffer object and a simple string."
 

	
 
(defun wg-find-buf-in-buf-list (buf buf-list)
 
  "Find BUF in BUF-LIST.
 
This is only here for completeness."
 
  (cl-find buf buf-list))
 

	
 
(defun wg-find-buffer-in-buffer-list (buffer-or-name buffer-list)
 
  "Find BUFFER-OR-NAME in BUFFER-LIST."
 
  (cl-find (wg-get-buffer buffer-or-name) buffer-list :key 'wg-get-buffer))
 

	
 
(defun wg-find-buffer-in-buf-list (buffer-or-name buf-list)
 
  "Find BUFFER-OR-NAME in BUF-LIST."
 
  (aif (wg-buffer-uid buffer-or-name)
 
      (wg-find-bufobj-by-uid it buf-list)
 
    (wg-find-bufobj buffer-or-name buf-list)))
 

	
 
(defun wg-find-buf-in-buffer-list (buf buffer-list)
 
  "Find BUF in BUFFER-LIST."
 
  (or (wg-find-bufobj-by-uid (wg-buf-uid buf) buffer-list)
 
      (wg-find-bufobj buf buffer-list)))
 

	
 
(defun wg-find-buf-by-uid (uid)
 
  "Find a buf in `wg-buf-list' by UID."
 
  (wg-find-bufobj-by-uid uid (wg-buf-list)))
 

	
 
(defun wg-set-buffer-uid-or-error (uid &optional buffer)
 
  "Set BUFFER's buffer local value of `wg-buffer-uid' to UID.
 
If BUFFER already has a buffer local value of `wg-buffer-uid',
 
and it's not equal to UID, error."
 
  (if wg-buffer-uid
 
      ;;(if (string= wg-buffer-uid uid) uid
 
      ;;  (error "uids don't match %S and %S" uid wg-buffer-uid))
 
      (setq wg-buffer-uid uid)))
 

	
 

	
 
(defun wg-buffer-special-data (buffer)
 
  "Return BUFFER's auxiliary serialization, or nil."
 
  (cl-some (lambda (fn) (funcall fn buffer)) wg-special-buffer-serdes-functions))
 

	
 

	
 
(defun wg-serialize-buffer-local-variables ()
 
  "Return an alist of buffer-local variable symbols and their values.
 
See `wg-buffer-local-variables-alist' for details."
 
  (wg-docar (entry wg-buffer-local-variables-alist)
 
    (wg-dbind (var ser des) entry
 
      (when (local-variable-p var)
 
        (cons var (if ser (funcall ser) (symbol-value var)))))))
 

	
 
(defun wg-buffer-to-buf (buffer)
 
  "Return the serialization (a wg-buf) of Emacs buffer BUFFER."
 
  (with-current-buffer buffer
 
    (wg-make-buf
 
     :name           (buffer-name)
 
     :file-name      (buffer-file-name)
 
     :point          (point)
 
     :mark           (mark)
 
     :local-vars     (wg-serialize-buffer-local-variables)
 
     :special-data   (wg-buffer-special-data buffer))))
 

	
 
(defun wg-add-buffer-to-buf-list (buffer)
 
  "Make a buf from BUFFER, and add it to `wg-buf-list' if necessary.
 
If there isn't already a buf corresponding to BUFFER in
 
`wg-buf-list', make one and add it.  Return BUFFER's uid
 
in either case."
 
  (with-current-buffer buffer
 
    (setq wg-buffer-uid
 
          (aif (wg-find-buffer-in-buf-list buffer (wg-buf-list))
 
              (wg-buf-uid it)
 
            (let ((buf (wg-buffer-to-buf buffer)))
 
              (push buf (wg-buf-list))
 
              (wg-buf-uid buf))))))
 

	
 
(defun wg-buffer-uid-or-add (buffer)
 
  "Return BUFFER's uid.
 
If there isn't already a buf corresponding to BUFFER in
 
`wg-buf-list', make one and add it."
 
  (or (wg-buffer-uid buffer) (wg-add-buffer-to-buf-list buffer)))
 

	
 
(defun wg-bufobj-uid-or-add (bufobj)
 
  "If BUFOBJ is a wg-buf, return its uid.
 
If BUFOBJ is a buffer or a buffer name, see `wg-buffer-uid-or-add'."
 
  (cl-etypecase bufobj
 
    (wg-buf (wg-buf-uid bufobj)) ;; possibly also add to `wg-buf-list'
 
    (buffer (wg-buffer-uid-or-add bufobj))
 
    (string (wg-bufobj-uid-or-add (wg-get-buffer bufobj)))))
 

	
 

	
 
(defun wg-reset-buffer (buffer)
 
  "Return BUFFER.
 
Currently only sets BUFFER's `wg-buffer-uid' to nil."
 
  (with-current-buffer buffer (setq wg-buffer-uid nil)))
 

	
 

	
 

	
 
;;; buffer-list-filter commands
 

	
 
(defun wg-next-buffer-internal (buffer-list &optional prev noerror)
 
  "Switch to the next buffer in Workgroups' filtered buffer list."
 
  (when buffer-list
 
    (let* ((cur (current-buffer))
 
           (next (or (wg-cyclic-nth-from-elt cur buffer-list (if prev -1 1))
 
                     (car buffer-list))))
 
      (unless (eq cur next)
 
        (switch-to-buffer next)
 
        (unless prev (bury-buffer cur))
 
        next))))
 

	
 
(defun wg-next-buffer (&optional prev)
 
  "Switch to the next buffer in Workgroups' filtered buffer list.
 
In the post-command message the current buffer is rotated to the
 
middle of the list to more easily see where `wg-previous-buffer'
 
will take you."
 
  (interactive)
 
  (let ((command (if prev 'previous-buffer 'next-buffer)))
 
    (if (not (wg-filter-buffer-list-p))
 
        (call-interactively (wg-prior-mapping workgroups-mode command))
 
      (wg-with-buffer-list-filters command
 
        (awhen (wg-filtered-buffer-list) (wg-next-buffer-internal it prev))
 
        (wg-message (wg-buffer-command-display))))))
 

	
 
(defun wg-update-buffer-in-buf-list (&optional buffer)
 
  "Update BUFFER's corresponding buf in `wg-buf-list'.
 
BUFFER nil defaults to `current-buffer'."
 
  (let ((buffer (or buffer (current-buffer))))
 
    (wg-when-let ((uid (wg-buffer-uid buffer))
 
                  (old-buf (wg-find-buf-by-uid uid))
 
                  (new-buf (wg-buffer-to-buf buffer)))
 
      (setf (wg-buf-uid new-buf) (wg-buf-uid old-buf))
 
      (wg-asetf (wg-buf-list) (cons new-buf (remove old-buf it))))))
 

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

	
 

	
 

	
 

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

	
 
(defun wg-buffer-list-filter-display (&optional workgroup blf-id)
 
  "Return a buffer-list-filter display string from WORKGROUP and BLF-ID."
 
  (wg-fontify
 
    "("
 
    (wg-workgroup-name (wg-get-workgroup workgroup))
 
    ":"
 
    (wg-get-buffer-list-filter-val blf-id 'indicator)
 
    ")"))
 

	
 
(defun wg-buffer-list-filter-prompt (prompt &optional workgroup blf-id)
 
  "Return a prompt string from PROMPT indicating WORKGROUP and BLF-ID."
 
  (wg-fontify
 
    prompt " "
 
    (wg-buffer-list-filter-display workgroup blf-id)
 
    ": "))
 

	
 
(defun wg-buffer-command-display (&optional buffer-list)
 
  "Return the buffer command display string."
 
  (concat
 
   (wg-buffer-list-filter-display) ": "
 
   (wg-buffer-list-display (or buffer-list (wg-filtered-buffer-list)))))
 

	
 

	
 
(defun wg-read-buffer (prompt &optional default require-match)
 
  "Workgroups' version of `read-buffer'.
 
Read with PROMT DEFAULT REQUIRE-MATCH."
 
  (if (not (wg-filter-buffer-list-p))
 
      (funcall (wg-read-buffer-function) prompt default require-match)
 
    (wg-with-buffer-list-filters 'read-buffer
 
      (funcall (wg-read-buffer-function)
 
               (wg-buffer-list-filter-prompt
 
                (aif (string-match ": *$" prompt)
 
                    (substring prompt 0 it) prompt))
 
               default require-match))))
 

	
 

	
 

	
 
;;; filtered buffer-list construction
 

	
 
(defun wg-get-buffer-list-filter-id-flexibly (blf-id)
 
  "Return a buffer-list-filter-id one way or another."
 
  (or blf-id wg-current-buffer-list-filter-id 'all))
 

	
 
(defun wg-get-buffer-list-filter-val (id key &optional noerror)
 
  "Return ID's KEY's value in `wg-buffer-list-filter-definitions'.
 
Lots of possible errors here because
 
`wg-buffer-list-filter-definitions' can be modified by the user."
 
  (let ((slot-num (cl-case key (symbol 0) (indicator 1) (constructor 2))))
 
    (if (not slot-num)
 
        (unless noerror
 
          (error "`%S' is not a valid buffer-list-filter definition slot" key))
 
      (let* ((id (wg-get-buffer-list-filter-id-flexibly id))
 
             (entry (assq id (wg-local-value
 
                              'wg-buffer-list-filter-definitions))))
 
        (if (not entry)
 
            (unless noerror
 
              (error "`%S' is an undefined buffer-list-filter" id))
 
          (or (nth slot-num entry)
 
              (unless noerror
 
                (error "Slot `%S' is undefined in `%S's definition"
 
                       key id))))))))
 

	
 
(defun wg-filtered-buffer-list (&optional names workgroup bfl-id initial)
 
  "Return a filtered buffer-list from NAMES, WORKGROUP, BLF-ID and INITIAL.
 
NAMES non-nil means return a list of buffer-names instead of buffer objects.
 
WORKGROUP non-nil should be any workgroup identifier accepted by
 
`wg-get-workgroup'.
 
BLF-ID non-nil should be the identifier of a defined buffer-list-filter.
 
It defaults to `wg-get-buffer-list-filter-val'.
 
INITIAL non-nil should be an initial buffer-list to filter.  It defaults to
 
`wg-interesting-buffers'."
 
  (let ((buffer-list (funcall (wg-get-buffer-list-filter-val
src/workgroups-utils-basic.el
Show inline comments
 
@@ -92,204 +92,192 @@ Iterative to prevent stack overflow."
 

	
 

	
 
;;; other control structures
 

	
 
(defmacro wg-destructuring-dolist (spec &rest body)
 
  "Loop over a list.
 
Evaluate BODY, destructuring LIST into SPEC, then evaluate RESULT
 
to get a return value, defaulting to nil.  The only hitch is that
 
spec must end in dotted style, collecting the rest of the list
 
into a var, like so: (a (b c) . rest)
 

	
 
\(fn (SPEC LIST [RESULT]) BODY...)"
 
  (declare (indent 1))
 
  (wg-dbind (loopspec list &optional result) spec
 
    (let ((rest (cdr (last loopspec))))
 
      (wg-with-gensyms (list-sym)
 
        `(let ((,list-sym ,list))
 
           (while ,list-sym
 
             (wg-dbind ,loopspec ,list-sym
 
               ,@body
 
               (setq ,list-sym ,rest)))
 
           ,result)))))
 

	
 

	
 
;;; numbers
 

	
 
(defun wg-step-to (n m step)
 
  "Increment or decrement N toward M by STEP.
 
Return M when the difference between N and M is less than STEP."
 
  (cond ((= n m) n)
 
        ((< n m) (min (+ n step) m))
 
        ((> n m) (max (- n step) m))))
 

	
 
(defun wg-within (num lo hi &optional hi-inclusive)
 
  "Return t when NUM is within bounds LO and HI.
 
HI-INCLUSIVE non-nil means the HI bound is inclusive."
 
  (and (>= num lo) (if hi-inclusive (<= num hi) (< num hi))))
 

	
 
(defun wg-int-to-b36-one-digit (i)
 
  "Return a character in 0..9 or A..Z from I, and integer 0<=I<32.
 
Cribbed from `org-id-int-to-b36-one-digit'."
 
  (cond ((not (wg-within i 0 36))
 
         (error "%s out of range" i))
 
        ((< i 10) (+ ?0 i))
 
        ((< i 36) (+ ?A i -10))))
 

	
 
(defun wg-b36-to-int-one-digit (i)
 
  "Turn a character 0..9, A..Z, a..z into a number 0..61.
 
The input I may be a character, or a single-letter string.
 
Cribbed from `org-id-b36-to-int-one-digit'."
 
  (and (stringp i) (setq i (string-to-char i)))
 
  (cond ((and (>= i ?0) (<= i ?9)) (- i ?0))
 
        ((and (>= i ?A) (<= i ?Z)) (+ (- i ?A) 10))
 
        (t (error "Invalid b36 character"))))
 

	
 
(defun wg-int-to-b36 (i &optional length)
 
  "Return a base 36 string from I."
 
  (let ((base 36) b36)
 
    (cl-labels ((add-digit () (push (wg-int-to-b36-one-digit (mod i base)) b36)
 
                         (setq i (/ i base))))
 
      (add-digit)
 
      (while (> i 0) (add-digit))
 
      (setq b36 (cl-map 'string 'identity b36))
 
      (if (not length) b36
 
        (concat (make-string (max 0 (- length (length b36))) ?0) b36)))))
 

	
 
(defun wg-b36-to-int (str)
 
  "Convert STR, a base-36 string, into the corresponding integer.
 
Cribbed from `org-id-b36-to-int'."
 
  (let ((result 0))
 
    (mapc (lambda (i)
 
            (setq result (+ (* result 36)
 
                            (wg-b36-to-int-one-digit i))))
 
          str)
 
    result))
 

	
 

	
 

	
 
;;; lists
 

	
 
(defmacro wg-removef-p (item seq-place &rest keys)
 
  "If ITEM is a `member*' of SEQ-PLACE, remove it from SEQ-PLACE and return t.
 
Otherwise return nil.  KEYS can be any keywords accepted by `remove*'."
 
  `(> (length ,seq-place)
 
      (length (setf ,seq-place (cl-remove ,item ,seq-place ,@keys)))))
 

	
 
(defmacro wg-pushnew-p (item seq-place &rest keys)
 
  "If ITEM is not a `member' of SEQ-PLACE, push it to SEQ-PLACE and return t.
 
Otherwise return nil.  KEYS can be any keyword args accepted by `pushnew'."
 
  `(< (length ,seq-place)
 
      (length (cl-pushnew ,item ,seq-place ,@keys))))
 

	
 
(defun wg-take (list n)
 
  "Return a list of the first N elts in LIST."
 
  (butlast list (- (length list) n)))
 

	
 
(defun wg-rnth (n list)
 
  "Return the Nth element of LIST, counting from the end."
 
  (nth (- (length list) n 1) list))
 

	
 
(defun wg-take-until-fail (pred list)
 
  "Take elements from LIST up to the first element on which PRED fails."
 
  (let (taken)
 
    (catch 'result
 
      (dolist (elt list (nreverse taken))
 
        (if (funcall pred elt) (push elt taken)
 
          (throw 'result (nreverse taken)))))))
 

	
 
(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) (wg-take list split)))))
 

	
 
(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)))
 
    (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)))
 
    (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)))
 
    (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)
 
             when (cl-find elt rest :test test :key key) return elt)))
 

	
 
(defun wg-string-list-union (&optional list1 list2)
 
  "Return the `union' of LIST1 and LIST2, using `string=' as the test.
 
This only exists to get rid of duplicate lambdas in a few reductions."
 
  (cl-union list1 list2 :test 'string=))
 

	
 

	
 

	
 
;;; alists
 

	
 
(defun wg-make-alist (&rest kvps)
 
  "Return a new alist from KVPS."
 
  (let (alist)
 
    (while kvps
 
      (push (cons (car kvps) (cadr kvps)) alist)
 
      (setq kvps (cddr kvps)))
 
    (nreverse alist)))
 

	
 
(defun wg-aget (alist key &optional default)
 
  "Return the value of KEY in ALIST. Uses `assq'.
 
If PARAM is not found, return DEFAULT which defaults to nil."
 
  (aif (assq key alist) (cdr it) default))
 

	
 
(defun wg-acopy (alist)
 
  "Return a copy of ALIST's toplevel list structure."
 
  (mapcar (lambda (kvp) (cons (car kvp) (cdr kvp))) alist))
 

	
 
(defun wg-aput (alist key value)
 
  "Return a new alist from ALIST with KEY's value set to VALUE."
0 comments (0 inline, 0 general)