diff options
Diffstat (limited to 'lisp/winner.el')
| -rw-r--r-- | lisp/winner.el | 87 |
1 files changed, 42 insertions, 45 deletions
diff --git a/lisp/winner.el b/lisp/winner.el index 10595ed4b5a..d808a54a10e 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -38,20 +38,17 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - - -(defmacro winner-active-region () +(eval-when-compile (require 'cl-lib)) + +(defun winner-active-region () + (declare (gv-setter (lambda (store) + (if (featurep 'xemacs) + `(if ,store (zmacs-activate-region) + (zmacs-deactivate-region)) + `(setq mark-active ,store))))) (if (boundp 'mark-active) - 'mark-active - '(region-active-p))) - -(defsetf winner-active-region () (store) - (if (featurep 'xemacs) - `(if ,store (zmacs-activate-region) - (zmacs-deactivate-region)) - `(setq mark-active ,store))) + mark-active + (region-active-p))) (defalias 'winner-edges (if (featurep 'xemacs) 'window-pixel-edges 'window-edges)) @@ -107,15 +104,15 @@ You may want to include buffer names such as *Help*, *Apropos*, (defun winner-sorted-window-list () (sort (winner-window-list) (lambda (x y) - (loop for a in (winner-edges x) - for b in (winner-edges y) - while (= a b) - finally return (< a b))))) + (cl-loop for a in (winner-edges x) + for b in (winner-edges y) + while (= a b) + finally return (< a b))))) (defun winner-win-data () ;; Essential properties of the windows in the selected frame. - (loop for win in (winner-sorted-window-list) - collect (cons (winner-edges win) (window-buffer win)))) + (cl-loop for win in (winner-sorted-window-list) + collect (cons (winner-edges win) (window-buffer win)))) ;; This variable is updated with the current window configuration ;; every time it changes. @@ -240,8 +237,8 @@ You may want to include buffer names such as *Help*, *Apropos*, (let* ((miniwin (minibuffer-window)) (chosen (selected-window)) (minisize (window-height miniwin))) - (letf (((window-buffer miniwin)) - ((window-point miniwin))) + (cl-letf (((window-buffer miniwin)) + ((window-point miniwin))) (set-window-configuration winconf)) (cond ((window-live-p chosen) (select-window chosen)) @@ -262,16 +259,16 @@ You may want to include buffer names such as *Help*, *Apropos*, (defun winner-make-point-alist () (save-current-buffer - (loop with alist - for win in (winner-window-list) - for entry = - (or (assq (window-buffer win) alist) - (car (push (list (set-buffer (window-buffer win)) - (cons (mark t) (winner-active-region))) - alist))) - do (push (cons win (window-point win)) - (cddr entry)) - finally return alist))) + (cl-loop with alist + for win in (winner-window-list) + for entry = + (or (assq (window-buffer win) alist) + (car (push (list (set-buffer (window-buffer win)) + (cons (mark t) (winner-active-region))) + alist))) + do (push (cons win (window-point win)) + (cddr entry)) + finally return alist))) (defun winner-get-point (buf win) ;; Consult (and possibly extend) `winner-point-alist'. @@ -302,11 +299,11 @@ You may want to include buffer names such as *Help*, *Apropos*, (let* ((buffers nil) (alive ;; Possibly update `winner-point-alist' - (loop for buf in (mapcar 'cdr (cdr conf)) - for pos = (winner-get-point buf nil) - if (and pos (not (memq buf buffers))) - do (push buf buffers) - collect pos))) + (cl-loop for buf in (mapcar 'cdr (cdr conf)) + for pos = (winner-get-point buf nil) + if (and pos (not (memq buf buffers))) + do (push buf buffers) + collect pos))) (winner-set-conf (car conf)) (let (xwins) ; to be deleted @@ -321,11 +318,11 @@ You may want to include buffer names such as *Help*, *Apropos*, ;; Restore marks (save-current-buffer - (loop for buf in buffers - for entry = (cadr (assq buf winner-point-alist)) - do (progn (set-buffer buf) - (set-mark (car entry)) - (setf (winner-active-region) (cdr entry))))) + (cl-loop for buf in buffers + for entry = (cadr (assq buf winner-point-alist)) + do (progn (set-buffer buf) + (set-mark (car entry)) + (setf (winner-active-region) (cdr entry))))) ;; Delete windows, whose buffers are dead or boring. ;; Return t if this is still a possible configuration. (or (null xwins) @@ -422,7 +419,7 @@ In other words, \"undo\" changes in window configuration." (setq winner-pending-undo-ring (winner-ring (selected-frame))) (setq winner-undo-counter 0) (setq winner-undone-data (list (winner-win-data)))) - (incf winner-undo-counter) ; starting at 1 + (cl-incf winner-undo-counter) ; starting at 1 (when (and (winner-undo-this) (not (window-minibuffer-p (selected-window)))) (message "Winner undo (%d / %d)" @@ -433,11 +430,11 @@ In other words, \"undo\" changes in window configuration." (defun winner-undo-this () ; The heart of winner undo. - (loop + (cl-loop (cond ((>= winner-undo-counter (ring-length winner-pending-undo-ring)) (message "No further window configuration undo information") - (return nil)) + (cl-return nil)) ((and ; If possible configuration (winner-set (ring-ref winner-pending-undo-ring @@ -446,7 +443,7 @@ In other words, \"undo\" changes in window configuration." (let ((data (winner-win-data))) (and (not (member data winner-undone-data)) (push data winner-undone-data)))) - (return t)) ; .. then everything is fine. + (cl-return t)) ; .. then everything is fine. (t ;; Otherwise, discharge it (and try the next one). (ring-remove winner-pending-undo-ring winner-undo-counter))))) |