Mercurial > hg > xemacs-beta

comparison lisp/frame.el @ 5473:ac37a5f7e5be

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge with trunk.
author Mats Lidell <matsl@xemacs.org>
date Thu, 17 Mar 2011 23:42:59 +0100
parents 308d34e9f07d 8b70d37ab80e
children 9a046b2e6494
comparison
equal deleted inserted replaced
5472:e79980ee5efe 5473:ac37a5f7e5be
471 ;; If the initial frame is serving as a surrogate 471 ;; If the initial frame is serving as a surrogate
472 ;; minibuffer frame for any frames, we need to wean them 472 ;; minibuffer frame for any frames, we need to wean them
473 ;; onto a new frame. The default-minibuffer-frame 473 ;; onto a new frame. The default-minibuffer-frame
474 ;; variable must be handled similarly. 474 ;; variable must be handled similarly.
475 (let ((users-of-initial 475 (let ((users-of-initial
476 (filtered-frame-list 476 (remove-if-not
477 #'(lambda (frame) 477 #'(lambda (frame)
478 (and (not (eq frame frame-initial-frame)) 478 (and (not (eq frame frame-initial-frame))
479 (eq (window-frame 479 (eq (window-frame
480 (minibuffer-window frame)) 480 (minibuffer-window frame))
481 frame-initial-frame)))))) 481 frame-initial-frame)))
482 (frame-list))))
482 (if (or users-of-initial 483 (if (or users-of-initial
483 (eq default-minibuffer-frame frame-initial-frame)) 484 (eq default-minibuffer-frame frame-initial-frame))
484 485
485 ;; Choose an appropriate frame. Prefer frames which 486 ;; Choose an appropriate frame. Prefer frames which
486 ;; are only minibuffers. 487 ;; are only minibuffers.
487 (let* ((new-surrogate 488 (let* ((new-surrogate
488 (car 489 (car
489 (or (filtered-frame-list 490 (or (remove-if-not
490 #'(lambda (frame) 491 #'(lambda (frame)
491 (eq 'only 492 (eq 'only
492 (frame-property frame 'minibuffer)))) 493 (frame-property frame 'minibuffer)))
494 (frame-list))
493 (minibuffer-frame-list)))) 495 (minibuffer-frame-list))))
494 (new-minibuffer (minibuffer-window new-surrogate))) 496 (new-minibuffer (minibuffer-window new-surrogate)))
495 497
496 (if (eq default-minibuffer-frame frame-initial-frame) 498 (if (eq default-minibuffer-frame frame-initial-frame)
497 (setq default-minibuffer-frame new-surrogate)) 499 (setq default-minibuffer-frame new-surrogate))
670 (make-obsolete 'new-frame 'make-frame) 672 (make-obsolete 'new-frame 'make-frame)
671 673
672 ;; XEmacs change: Emacs has make-frame here. We have it in C, so no need for 674 ;; XEmacs change: Emacs has make-frame here. We have it in C, so no need for
673 ;; frame-creation-function. 675 ;; frame-creation-function.
674 676
675 ;; XEmacs addition: support optional DEVICE argument. 677 ;; XEmacs addition: support optional DEVICE argument, use delete-if-not.
676 (defun filtered-frame-list (predicate &optional device) 678 (defun filtered-frame-list (predicate &optional device)
677 "Return a list of all live frames which satisfy PREDICATE. 679 "Return a list of all live frames which satisfy PREDICATE.
678 If optional second arg DEVICE is non-nil, restrict the frames 680 If optional second arg DEVICE is non-nil, restrict the frames
679 returned to that device." 681 returned to that device."
680 (let ((frames (if device (device-frame-list device) 682 (delete-if-not predicate
681 (frame-list))) 683 (if device (device-frame-list device) (frame-list))))
682 good-frames)
683 (while (consp frames)
684 (if (funcall predicate (car frames))
685 (setq good-frames (cons (car frames) good-frames)))
686 (setq frames (cdr frames)))
687 good-frames))
688 684
689 ;; XEmacs addition: support optional DEVICE argument. 685 ;; XEmacs addition: support optional DEVICE argument.
690 (defun minibuffer-frame-list (&optional device) 686 (defun minibuffer-frame-list (&optional device)
691 "Return a list of all frames with their own minibuffers. 687 "Return a list of all frames with their own minibuffers.
692 If optional second arg DEVICE is non-nil, restrict the frames 688 If optional second arg DEVICE is non-nil, restrict the frames
693 returned to that device." 689 returned to that device."
694 (filtered-frame-list 690 (delete-if-not
695 #'(lambda (frame) 691 #'(lambda (frame) (eq frame (window-frame (minibuffer-window frame))))
696 (eq frame (window-frame (minibuffer-window frame)))) 692 (if device (device-frame-list device) (frame-list))))
697 device))
698 693
699 ;; XEmacs omission: Emacs has frames-on-display-list here, but that is 694 ;; XEmacs omission: Emacs has frames-on-display-list here, but that is
700 ;; essentially equivalent to supplying the optional DEVICE argument to 695 ;; essentially equivalent to supplying the optional DEVICE argument to
701 ;; filtered-frame-list. 696 ;; filtered-frame-list.
702 697
1741 ;; reusing the existing one. 1736 ;; reusing the existing one.
1742 (let* ((defname 1737 (let* ((defname
1743 (or (plist-get default-frame-plist 'name) 1738 (or (plist-get default-frame-plist 'name)
1744 default-frame-name)) 1739 default-frame-name))
1745 (frames 1740 (frames
1746 (sort (filtered-frame-list #'(lambda (x) 1741 (sort (remove-if-not #'(lambda (x)
1747 (or (frame-visible-p x) 1742 (or (frame-visible-p x)
1748 (frame-iconified-p x)))) 1743 (frame-iconified-p x)))
1744 (frame-list))
1749 #'(lambda (s1 s2) 1745 #'(lambda (s1 s2)
1750 (cond ((and (frame-visible-p s1) 1746 (cond ((and (frame-visible-p s1)
1751 (not (frame-visible-p s2)))) 1747 (not (frame-visible-p s2))))
1752 ((and (eq (frame-visible-p s1) t) 1748 ((and (eq (frame-visible-p s1) t)
1753 (eq (frame-visible-p s2) 'hidden))) 1749 (eq (frame-visible-p s2) 'hidden)))