Changeset - dedff6f56350
[Not reviewed]
0 4 0
Sergey Pashinin - 12 years ago 2014-02-26 00:10:50
sergey@pashinin.com
Use cl-flet instead of dflet
4 files changed with 19 insertions and 19 deletions:
0 comments (0 inline, 0 general)
src/workgroups-functions.el
Show inline comments
 
@@ -260,25 +260,25 @@ If BUFOBJ is a buffer or a buffer name, see `wg-buffer-uid-or-add'."
 
       :edges              (window-edges window)
 
       :point              (wg-window-point window)
 
       :start              (window-start window)
 
       :hscroll            (window-hscroll window)
 
       :selected           selected
 
       :minibuffer-scroll  (eq window minibuffer-scroll-window)
 
       :dedicated          (window-dedicated-p window)
 
       :buf-uid            (wg-buffer-uid-or-add (window-buffer window))))))
 

	
 
(defun wg-window-tree-to-wtree (window-tree)
 
  "Return the serialization (a wg-wtree) of Emacs window tree WINDOW-TREE."
 
  (wg-barf-on-active-minibuffer)
 
  (dflet
 
  (cl-flet
 
      ((inner (w) (if (windowp w) (wg-window-to-win w)
 
                    (wg-dbind (dir edges . wins) w
 
                      (wg-make-wtree
 
                       :dir    dir
 
                       :edges  edges
 
                       :wlist  (mapcar #'inner wins))))))
 
    (let ((w (car window-tree)))
 
      (when (and (windowp w) (window-minibuffer-p w))
 
        (error "Workgroups can't operate on minibuffer-only frames."))
 
      (inner w))))
 

	
 
(defun wg-frame-to-wconfig (&optional frame)
 
@@ -422,25 +422,25 @@ BUFFER or `wg-default-buffer' is visible in the only window."
 
(defun wg-adjust-w-size (w width-fn height-fn &optional new-left new-top)
 
  "Adjust W's width and height with WIDTH-FN and HEIGHT-FN."
 
  (wg-with-edges w (left top right bottom)
 
    (let ((left (or new-left left)) (top (or new-top top)))
 
      (wg-set-edges (wg-copy-w w)
 
                    (list left
 
                          top
 
                          (+ left (funcall width-fn  (- right  left)))
 
                          (+ top  (funcall height-fn (- bottom top))))))))
 

	
 
(defun wg-scale-w-size (w width-scale height-scale)
 
  "Scale W's size by WIDTH-SCALE and HEIGHT-SCALE."
 
  (dflet
 
  (cl-flet
 
      ((wscale (width)  (truncate (* width  width-scale)))
 
       (hscale (height) (truncate (* height height-scale))))
 
    (wg-adjust-w-size w #'wscale #'hscale)))
 

	
 
(defun wg-equal-wtrees (w1 w2)
 
  "Return t when W1 and W2 have equal structure."
 
  (cond ((and (wg-win-p w1) (wg-win-p w2))
 
         (equal (wg-w-edges w1) (wg-w-edges w2)))
 
        ((and (wg-wtree-p w1) (wg-wtree-p w2))
 
         (and (eq (wg-wtree-dir w1) (wg-wtree-dir w2))
 
              (equal (wg-wtree-edges w1) (wg-wtree-edges w2))
 
              (cl-every #'wg-equal-wtrees
 
@@ -451,25 +451,25 @@ BUFFER or `wg-default-buffer' is visible in the only window."
 
  "Clean up and return a new wtree from WTREE.
 
Recalculate the edge lists of all subwins, and remove subwins
 
outside of WTREE's bounds.  If there's only one element in the
 
new wlist, return it instead of a new wtree."
 
  (if (wg-win-p wtree) wtree
 
    (wg-with-slots wtree ((dir wg-wtree-dir)
 
                          (wlist wg-wtree-wlist))
 
      (wg-with-bounds wtree dir (ls1 hs1 lb1 hb1)
 
        (let* ((min-size (wg-min-size dir))
 
               (max (- hb1 1 min-size))
 
               (lastw (wg-last1 wlist)))
 
          ;;(wg--with-temporary-redefinitions
 
          (dflet
 
          (cl-flet
 
              ((mapwl
 
                (wl)
 
                (wg-dbind (sw . rest) wl
 
                  (cons (wg-normalize-wtree
 
                         (wg-set-bounds
 
                          sw dir ls1 hs1 lb1
 
                          (setq lb1 (if (eq sw lastw) hb1
 
                                      (let ((hb2 (+ lb1 (wg-w-size sw dir))))
 
                                        (if (>= hb2 max) hb1 hb2))))))
 
                        (when (< lb1 max) (mapwl rest))))))
 
            (let ((new (mapwl wlist)))
 
              (if (not (cdr new)) (car new)
 
@@ -508,64 +508,64 @@ with `wg-scale-wconfigs-wtree' to fit the frame as it exists."
 
      (when window-system (set-frame-size frame wcwidth wcheight))
 
      (let ((fwidth  (frame-parameter frame 'width))
 
            (fheight (frame-parameter frame 'height)))
 
        (if (and (= wcwidth fwidth) (= wcheight fheight))
 
            (wg-wconfig-wtree wconfig)
 
          (wg-scale-wconfigs-wtree wconfig fwidth fheight))))))
 

	
 
(defun wg-reverse-wlist (w &optional dir)
 
  "Reverse W's wlist and those of all its sub-wtrees in direction DIR.
 
If DIR is nil, reverse WTREE horizontally.
 
If DIR is 'both, reverse WTREE both horizontally and vertically.
 
Otherwise, reverse WTREE vertically."
 
  (dflet
 
  (cl-flet
 
      ((inner (w) (if (wg-win-p w) w
 
                    (wg-with-slots w ((d1 wg-wtree-dir))
 
                      (wg-make-wtree
 
                       :dir d1
 
                       :edges (wg-wtree-edges w)
 
                       :wlist (let ((wl2 (mapcar #'inner (wg-wtree-wlist w))))
 
                                (if (or (eq dir 'both) (eq dir d1))
 
                                    (nreverse wl2)
 
                                  wl2)))))))
 
    (wg-normalize-wtree (inner w))))
 

	
 
(defun wg-wtree-move-window (wtree offset)
 
  "Offset `selected-window' OFFSET places in WTREE."
 
  (dflet
 
  (cl-flet
 
      ((inner (w) (if (wg-win-p w) w
 
                    (wg-with-slots w ((wlist wg-wtree-wlist))
 
                      (wg-make-wtree
 
                       :dir (wg-wtree-dir w)
 
                       :edges (wg-wtree-edges w)
 
                       :wlist (wg-aif (cl-find t wlist :key 'wg-win-selected)
 
                                  (wg-cyclic-offset-elt it wlist offset)
 
                                (mapcar #'inner wlist)))))))
 
    (wg-normalize-wtree (inner wtree))))
 

	
 
(defun wg-reverse-wconfig (wconfig &optional dir)
 
  "Reverse WCONFIG's wtree's wlist in direction DIR."
 
  (wg-asetf (wg-wconfig-wtree wconfig) (wg-reverse-wlist it dir))
 
  wconfig)
 

	
 
(defun wg-wconfig-move-window (wconfig offset)
 
  "Offset `selected-window' OFFSET places in WCONFIG."
 
  (wg-asetf (wg-wconfig-wtree wconfig) (wg-wtree-move-window it offset))
 
  wconfig)
 

	
 
(defun wg-flatten-wtree (wtree &optional key)
 
  "Return a new list by flattening WTREE.
 
KEY non returns returns a list of WTREE's wins.
 
KEY non-nil returns a list of the results of calling KEY on each win."
 
  (dflet
 
  (cl-flet
 
      ((inner (w) (if (wg-win-p w) (list (if key (funcall key w) w))
 
                    (cl-mapcan 'inner (wg-wtree-wlist w)))))
 
    (inner wtree)))
 

	
 
(defun wg-win-list (wtree)
 
  "Construct and return a list of all wg-wins in WTREE."
 
  (wg-flatten-wtree wtree))
 

	
 

	
 
(require 'workgroups-specialbufs)
 
(require 'workgroups-restore)
 

	
src/workgroups-pickel.el
Show inline comments
 
@@ -128,25 +128,25 @@
 
  "Return the link deserializer for type key KEY, or error."
 
  (or (wg-aget wg-pickel-link-deserializers key)
 
      (error "Invalid link deserializer key: %S" key)))
 

	
 

	
 

	
 
;;; bindings
 

	
 
(defun wg-pickel-make-bindings-table (obj)
 
  "Return a table binding unique subobjects of OBJ to ids."
 
  (let ((binds (make-hash-table :test 'eq))
 
        (id -1))
 
    (dflet
 
    (cl-flet
 
     ((inner (obj)
 
           (unless (gethash obj binds)
 
              (puthash obj (cl-incf id) binds)
 
              (cl-case (type-of obj)
 
                (cons
 
                 (inner (car obj))
 
                 (inner (cdr obj)))
 
                (vector
 
                 (dotimes (idx (length obj))
 
                   (inner (aref obj idx))))
 
                (hash-table
 
                 (wg-dohash (key val obj)
src/workgroups-specialbufs.el
Show inline comments
 
@@ -104,26 +104,26 @@ You can get these commands using `wg-get-org-agenda-view-commands'."
 
;; term-mode
 
;;
 
;; This should work for `ansi-term's, too, as there doesn't seem to
 
;; be any difference between the two except how the name of the
 
;; buffer is generated.
 
;;
 
(wg-support 'term-mode 'term
 
            `((serialize . ,(lambda (buffer)
 
                              (if (get-buffer-process buffer)
 
                                  (wg-last1 (process-command (get-buffer-process buffer)))
 
                                "/bin/bash")))
 
              (deserialize . ,(lambda (buffer vars)
 
                                (dflet ((term-window-width () 80)
 
                                        (window-height () 24))
 
                                (cl-flet ((term-window-width () 80)
 
                                          (window-height () 24))
 
                                  (prog1 (term vars)
 
                                    (rename-buffer (wg-buf-name buffer) t)))))))
 

	
 
;; Python
 
(wg-support 'inferior-python-mode 'python
 
            `((save . (python-shell-interpreter python-shell-interpreter-args))
 
              (deserialize . ,(lambda (buffer vars)
 
                                (wg-dbind (pythoncmd pythonargs) vars
 
                                  (save-window-excursion
 
                                    (run-python (concat pythoncmd " " pythonargs)))
 
                                  (wg-awhen (get-buffer (process-buffer (python-shell-get-or-create-process)))
 
                                    (set-buffer it)
src/workgroups-utils-basic.el
Show inline comments
 
@@ -213,26 +213,26 @@ Cribbed from `org-id-int-to-b36-one-digit'."
 
(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)
 
    (dflet ((add-digit () (push (wg-int-to-b36-one-digit (mod i base)) b36)
 
                      (setq i (/ i base))))
 
    (cl-flet ((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)
 
@@ -505,29 +505,29 @@ N defaults to 1, and FRAME defaults to `selected-frame'."
 

	
 

	
 

	
 
;;; namespace-prefixed defstruct
 

	
 
(defmacro wg-defstruct (prefix name-form &rest slot-defs)
 
  "`defstruct' wrapper that namespace-prefixes all generated functions.
 
Note: this doesn't yet work with :conc-name, and possibly other
 
options."
 
  (declare (indent 2))
 
  (let* ((name (if (consp name-form) (car name-form) name-form))
 
         (prefixed-name (wg-symcat prefix "-" name)))
 
    (dflet ((rebind (opstr)
 
                   (let ((oldfnsym (wg-symcat opstr "-" prefix "-" name)))
 
                     `((fset ',(wg-symcat prefix "-" opstr "-" name)
 
                             (symbol-function ',oldfnsym))
 
                       (fmakunbound ',oldfnsym)))))
 
    (cl-flet ((rebind (opstr)
 
                      (let ((oldfnsym (wg-symcat opstr "-" prefix "-" name)))
 
                        `((fset ',(wg-symcat prefix "-" opstr "-" name)
 
                                (symbol-function ',oldfnsym))
 
                          (fmakunbound ',oldfnsym)))))
 
      ;; `eval-and-compile' gets rid of byte-comp warnings ("function `foo' not
 
      ;; known to be defined").  We can accomplish this with `declare-function'
 
      ;; too, but it annoyingly requires inclusion of the function's arglist,
 
      ;; which gets ugly.
 
      `(eval-and-compile
 
         (cl-defstruct ,(if (symbolp name-form) prefixed-name
 
                       `(,prefixed-name ,@(cdr name-form)))
 
           ,@slot-defs)
 
         ,@(rebind "make")
 
         ,@(rebind "copy")
 
         ',prefixed-name))))
 

	
 
@@ -563,27 +563,27 @@ the cadr as the accessor function."
 

	
 
(defun wg-add-or-remove-hooks (remove &rest pairs)
 
  "Add FUNCTION to or remove it from HOOK, depending on REMOVE."
 
  (dolist (pair (wg-partition pairs 2))
 
    (funcall (if remove 'remove-hook 'add-hook)
 
             (car pair) (cadr pair))))
 

	
 

	
 
(defun wg-read-object (prompt test warning &optional initial-contents keymap
 
                              read hist default-value inherit-input-method)
 
  "PROMPT for an object that satisfies TEST, WARNING if necessary.
 
ARGS are `read-from-minibuffer's args, after PROMPT."
 
  (dflet ((read () (read-from-minibuffer
 
                    prompt initial-contents keymap read hist
 
                    default-value inherit-input-method)))
 
  (cl-flet ((read () (read-from-minibuffer
 
                      prompt initial-contents keymap read hist
 
                      default-value inherit-input-method)))
 
    (let ((obj (read)))
 
      (when (and (equal obj "") default-value) (setq obj default-value))
 
      (while (not (funcall test obj))
 
        (message warning)
 
        (sit-for wg-minibuffer-message-timeout)
 
        (setq obj (read)))
 
      obj)))
 

	
 
(defvar wg-readable-types
 
  '(integer float cons symbol vector string char-table bool-vector)
 
  "List of types with readable printed representations.")
 

	
0 comments (0 inline, 0 general)