Mercurial > hg > xemacs-beta

comparison lisp/frame.el @ 5367:8b70d37ab80e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use Common Lisp-derived builtins in a few more places in core Lisp. 2011-03-08 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el: * cl-macs.el (loop): * cl-macs.el (cl-expand-do-loop): * cl-macs.el (shiftf): * cl-macs.el (rotatef): * cl-macs.el (assert): * cl-macs.el (cl-defsubst-expand): * etags.el (buffer-tag-table-list): * frame.el: * frame.el (frame-notice-user-settings): * frame.el (minibuffer-frame-list): * frame.el (get-frame-for-buffer-noselect): Use Common Lisp-derived builtins in a few more places, none of them performance-critical, but the style is better.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 08 Mar 2011 23:57:21 +0000
parents 0d43872986b6
children ac37a5f7e5be
comparison
equal deleted inserted replaced
5366:f00192e1cd49 5367:8b70d37ab80e
473 ;; If the initial frame is serving as a surrogate 473 ;; If the initial frame is serving as a surrogate
474 ;; minibuffer frame for any frames, we need to wean them 474 ;; minibuffer frame for any frames, we need to wean them
475 ;; onto a new frame. The default-minibuffer-frame 475 ;; onto a new frame. The default-minibuffer-frame
476 ;; variable must be handled similarly. 476 ;; variable must be handled similarly.
477 (let ((users-of-initial 477 (let ((users-of-initial
478 (filtered-frame-list 478 (remove-if-not
479 #'(lambda (frame) 479 #'(lambda (frame)
480 (and (not (eq frame frame-initial-frame)) 480 (and (not (eq frame frame-initial-frame))
481 (eq (window-frame 481 (eq (window-frame
482 (minibuffer-window frame)) 482 (minibuffer-window frame))
483 frame-initial-frame)))))) 483 frame-initial-frame)))
484 (frame-list))))
484 (if (or users-of-initial 485 (if (or users-of-initial
485 (eq default-minibuffer-frame frame-initial-frame)) 486 (eq default-minibuffer-frame frame-initial-frame))
486 487
487 ;; Choose an appropriate frame. Prefer frames which 488 ;; Choose an appropriate frame. Prefer frames which
488 ;; are only minibuffers. 489 ;; are only minibuffers.
489 (let* ((new-surrogate 490 (let* ((new-surrogate
490 (car 491 (car
491 (or (filtered-frame-list 492 (or (remove-if-not
492 #'(lambda (frame) 493 #'(lambda (frame)
493 (eq 'only 494 (eq 'only
494 (frame-property frame 'minibuffer)))) 495 (frame-property frame 'minibuffer)))
496 (frame-list))
495 (minibuffer-frame-list)))) 497 (minibuffer-frame-list))))
496 (new-minibuffer (minibuffer-window new-surrogate))) 498 (new-minibuffer (minibuffer-window new-surrogate)))
497 499
498 (if (eq default-minibuffer-frame frame-initial-frame) 500 (if (eq default-minibuffer-frame frame-initial-frame)
499 (setq default-minibuffer-frame new-surrogate)) 501 (setq default-minibuffer-frame new-surrogate))
672 (make-obsolete 'new-frame 'make-frame) 674 (make-obsolete 'new-frame 'make-frame)
673 675
674 ;; XEmacs change: Emacs has make-frame here. We have it in C, so no need for 676 ;; XEmacs change: Emacs has make-frame here. We have it in C, so no need for
675 ;; frame-creation-function. 677 ;; frame-creation-function.
676 678
677 ;; XEmacs addition: support optional DEVICE argument. 679 ;; XEmacs addition: support optional DEVICE argument, use delete-if-not.
678 (defun filtered-frame-list (predicate &optional device) 680 (defun filtered-frame-list (predicate &optional device)
679 "Return a list of all live frames which satisfy PREDICATE. 681 "Return a list of all live frames which satisfy PREDICATE.
680 If optional second arg DEVICE is non-nil, restrict the frames 682 If optional second arg DEVICE is non-nil, restrict the frames
681 returned to that device." 683 returned to that device."
682 (let ((frames (if device (device-frame-list device) 684 (delete-if-not predicate
683 (frame-list))) 685 (if device (device-frame-list device) (frame-list))))
684 good-frames)
685 (while (consp frames)
686 (if (funcall predicate (car frames))
687 (setq good-frames (cons (car frames) good-frames)))
688 (setq frames (cdr frames)))
689 good-frames))
690 686
691 ;; XEmacs addition: support optional DEVICE argument. 687 ;; XEmacs addition: support optional DEVICE argument.
692 (defun minibuffer-frame-list (&optional device) 688 (defun minibuffer-frame-list (&optional device)
693 "Return a list of all frames with their own minibuffers. 689 "Return a list of all frames with their own minibuffers.
694 If optional second arg DEVICE is non-nil, restrict the frames 690 If optional second arg DEVICE is non-nil, restrict the frames
695 returned to that device." 691 returned to that device."
696 (filtered-frame-list 692 (delete-if-not
697 #'(lambda (frame) 693 #'(lambda (frame) (eq frame (window-frame (minibuffer-window frame))))
698 (eq frame (window-frame (minibuffer-window frame)))) 694 (if device (device-frame-list device) (frame-list))))
699 device))
700 695
701 ;; XEmacs omission: Emacs has frames-on-display-list here, but that is 696 ;; XEmacs omission: Emacs has frames-on-display-list here, but that is
702 ;; essentially equivalent to supplying the optional DEVICE argument to 697 ;; essentially equivalent to supplying the optional DEVICE argument to
703 ;; filtered-frame-list. 698 ;; filtered-frame-list.
704 699
1743 ;; reusing the existing one. 1738 ;; reusing the existing one.
1744 (let* ((defname 1739 (let* ((defname
1745 (or (plist-get default-frame-plist 'name) 1740 (or (plist-get default-frame-plist 'name)
1746 default-frame-name)) 1741 default-frame-name))
1747 (frames 1742 (frames
1748 (sort (filtered-frame-list #'(lambda (x) 1743 (sort (remove-if-not #'(lambda (x)
1749 (or (frame-visible-p x) 1744 (or (frame-visible-p x)
1750 (frame-iconified-p x)))) 1745 (frame-iconified-p x)))
1746 (frame-list))
1751 #'(lambda (s1 s2) 1747 #'(lambda (s1 s2)
1752 (cond ((and (frame-visible-p s1) 1748 (cond ((and (frame-visible-p s1)
1753 (not (frame-visible-p s2)))) 1749 (not (frame-visible-p s2))))
1754 ((and (eq (frame-visible-p s1) t) 1750 ((and (eq (frame-visible-p s1) t)
1755 (eq (frame-visible-p s2) 'hidden))) 1751 (eq (frame-visible-p s2) 'hidden)))