]> code.delx.au - gnu-emacs/blobdiff - lisp/frame.el
(log-view-goto-rev): New function for the new VC.
[gnu-emacs] / lisp / frame.el
index 5d06e5473f39522d6b4968e7bc7c319a4feed202..5b7709b69b489a14b102535c9d5e3ebed0049467 100644 (file)
@@ -1,6 +1,6 @@
 ;;; frame.el --- multi-frame management independent of window systems.
 
-;; Copyright (C) 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1996, 1997, 2000 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
@@ -211,6 +211,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args."
                   (error
                    "Can't create multiple frames without a window system"))))))))
 
+(defvar frame-notice-user-settings t
+  "Non-nil means function `frame-notice-user-settings' wasn't run yet.")
+
 ;;; startup.el calls this function after loading the user's init
 ;;; file.  Now default-frame-alist and initial-frame-alist contain
 ;;; information to which we must react; do what needs to be done.
@@ -233,6 +236,20 @@ React to settings of `default-frame-alist', `initial-frame-alist' there."
   ;; window is the minibuffer.
   (let ((old-buffer (current-buffer)))
 
+    (when (and frame-notice-user-settings
+              (null frame-initial-frame))
+      ;; This case happens when we don't have a window system.
+      (let ((parms (frame-parameters frame-initial-frame)))
+       ;; Don't change the frame names.
+       (setq parms (delq (assq 'name parms) parms))
+       ;; Can't modify the minibuffer parameter, so don't try.
+       (setq parms (delq (assq 'minibuffer parms) parms))
+       (modify-frame-parameters nil
+                                (append initial-frame-alist
+                                        default-frame-alist
+                                        parms
+                                        nil))))
+
     ;; If the initial frame is still around, apply initial-frame-alist
     ;; and default-frame-alist to it.
     (if (frame-live-p frame-initial-frame)
@@ -273,13 +290,13 @@ React to settings of `default-frame-alist', `initial-frame-alist' there."
              ;; when we first made the frame.
              (setq parms (cons '(reverse) (delq (assq 'reverse parms) parms)))
              (if (assq 'height frame-initial-geometry-arguments)
-                 (setq parms (assoc-delete-all 'height parms)))
+                 (setq parms (assq-delete-all 'height parms)))
              (if (assq 'width frame-initial-geometry-arguments)
-                 (setq parms (assoc-delete-all 'width parms)))
+                 (setq parms (assq-delete-all 'width parms)))
              (if (assq 'left frame-initial-geometry-arguments)
-                 (setq parms (assoc-delete-all 'left parms)))
+                 (setq parms (assq-delete-all 'left parms)))
              (if (assq 'top frame-initial-geometry-arguments)
-                 (setq parms (assoc-delete-all 'top parms)))
+                 (setq parms (assq-delete-all 'top parms)))
              (setq new
                    (make-frame
                     ;; Use the geometry args that created the existing
@@ -345,13 +362,13 @@ React to settings of `default-frame-alist', `initial-frame-alist' there."
            (setq allparms (append initial-frame-alist
                                   default-frame-alist))
            (if (assq 'height frame-initial-geometry-arguments)
-               (setq allparms (assoc-delete-all 'height allparms)))
+               (setq allparms (assq-delete-all 'height allparms)))
            (if (assq 'width frame-initial-geometry-arguments)
-               (setq allparms (assoc-delete-all 'width allparms)))
+               (setq allparms (assq-delete-all 'width allparms)))
            (if (assq 'left frame-initial-geometry-arguments)
-               (setq allparms (assoc-delete-all 'left allparms)))
+               (setq allparms (assq-delete-all 'left allparms)))
            (if (assq 'top frame-initial-geometry-arguments)
-               (setq allparms (assoc-delete-all 'top allparms)))
+               (setq allparms (assq-delete-all 'top allparms)))
            (setq tail allparms)
            ;; Find just the parms that have changed since we first
            ;; made this frame.  Those are the ones actually set by
@@ -387,6 +404,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there."
 
     ;; Make sure the initial frame can be GC'd if it is ever deleted.
     ;; Make sure frame-notice-user-settings does nothing if called twice.
+    (setq frame-notice-user-settings nil)
     (setq frame-initial-frame nil)))
 
 (defun make-initial-minibuffer-frame (display)
@@ -490,6 +508,27 @@ on `after-make-frame-functions' are run with one arg, the newly created frame."
    (function (lambda (frame)
               (eq frame (window-frame (minibuffer-window frame)))))))
 
+(defun frames-on-display-list (&optional display)
+  "Return a list of all frames on DISPLAY.
+DISPLAY is a name of a display, a string of the form HOST:SERVER.SCREEN.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
+  (let* ((display (or display
+                     (cdr (assoc 'display (frame-parameters)))))
+        (func
+         (function (lambda (frame)
+                     (eq (cdr (assoc 'display (frame-parameters frame)))
+                         display)))))
+    (filtered-frame-list func)))
+
+(defun framep-on-display (&optional display)
+  "Return the type of frames on DISPLAY.
+DISPLAY may be a display name or a frame.  If it is a frame, its type is
+returned.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display.
+All frames on a given display are of the same type."
+  (or (framep display)
+      (framep (car (frames-on-display-list display)))))
+
 (defun frame-remove-geometry-params (param-list)
   "Return the parameter list PARAM-LIST, but with geometry specs removed.
 This deletes all bindings in PARAM-LIST for `top', `left', `width',
@@ -535,13 +574,17 @@ A negative ARG moves in the opposite order."
       (while (not (eq (frame-visible-p frame) t))
        (setq frame (previous-frame frame)))
       (setq arg (1+ arg)))
-    (raise-frame frame)
     (select-frame frame)
+    (raise-frame frame)
     ;; Ensure, if possible, that frame gets input focus.
-    (if (eq window-system 'w32)
-       (w32-focus-frame frame)
-      (when focus-follows-mouse
-       (set-mouse-position (selected-frame) (1- (frame-width)) 0)))))
+    (when (eq window-system 'w32)
+      (w32-focus-frame frame))
+    (cond (focus-follows-mouse
+          (unless (eq window-system 'w32)
+            (set-mouse-position (selected-frame) (1- (frame-width)) 0)))
+         (t
+          (when (eq window-system 'x)
+            (x-focus-frame frame))))))
 
 (defun make-frame-names-alist ()
   (let* ((current-frame (selected-frame))
@@ -750,6 +793,161 @@ one frame, otherwise the name is displayed on the frame's caption bar."
   (modify-frame-parameters (selected-frame)
                           (list (cons 'name name))))
 \f
+;;;; Frame/display capabilities.
+(defun display-mouse-p (&optional display)
+  "Return non-nil if DISPLAY has a mouse available.
+DISPLAY can be a display name, a frame, or nil (meaning the selected
+frame's display)."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((eq frame-type 'pc)
+      (msdos-mouse-p))
+     ((eq system-type 'windows-nt)
+      (> w32-num-mouse-buttons 0))
+     ((memq frame-type '(x mac))
+      t)    ;; We assume X and Mac *always* have a pointing device
+     (t
+      (or (and (featurep 'xt-mouse)
+              xterm-mouse-mode)
+         ;; t-mouse is distributed with the GPM package.  It doesn't have
+         ;; a toggle.
+         (featurep 't-mouse))))))
+
+(defun display-popup-menus-p (&optional display)
+  "Return non-nil if popup menus are supported on DISPLAY.
+DISPLAY can be a display name, a frame, or nil (meaning the selected
+frame's display).
+Support for popup menus requires that the mouse be available."
+  (and
+   (let ((frame-type (framep-on-display display)))
+     (memq frame-type '(x w32 pc mac)))
+   (display-mouse-p display)))
+
+(defun display-graphic-p (&optional display)
+  "Return non-nil if DISPLAY is a graphic display.
+Graphical displays are those which are capable of displaying several
+frames and several different fonts at once.  This is true for displays
+that use a window system such as X, and false for text-only terminals.
+DISPLAY can be a display name, a frame, or nil (meaning the selected
+frame's display)."
+  (not (null (memq (framep-on-display display) '(x w32 mac)))))
+
+(defun display-selections-p (&optional display)
+  "Return non-nil if DISPLAY supports selections.
+A selection is a way to transfer text or other data between programs
+via special system buffers called `selection' or `cut buffer' or
+`clipboard'.
+DISPLAY can be a display name, a frame, or nil (meaning the selected
+frame's display)."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((eq frame-type 'pc)
+      ;; MS-DOG frames support selections when Emacs runs inside
+      ;; the Windows' DOS Box.
+      (not (null dos-windows-version)))
+     ((memq frame-type '(x w32 mac))
+      t)    ;; FIXME?
+     (t
+      nil))))
+
+(defun display-screens (&optional display)
+  "Return the number of screens associated with DISPLAY."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32))
+      (x-display-screens display))
+     (t        ;; FIXME: is this correct for the Mac?
+      1))))
+
+(defun display-pixel-height (&optional display)
+  "Return the height of DISPLAY's screen in pixels.
+For character terminals, each character counts as a single pixel."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-pixel-height display))
+     (t
+      (frame-height (if (framep display) display (selected-frame)))))))
+
+(defun display-pixel-width (&optional display)
+  "Return the width of DISPLAY's screen in pixels.
+For character terminals, each character counts as a single pixel."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-pixel-width display))
+     (t
+      (frame-width (if (framep display) display (selected-frame)))))))
+
+(defun display-mm-height (&optional display)
+  "Return the height of DISPLAY's screen in millimeters.
+If the information is unavailable, value is nil."
+  (and (memq (framep-on-display display) '(x w32 mac))
+       (x-display-mm-height display)))
+
+(defun display-mm-width (&optional display)
+  "Return the width of DISPLAY's screen in millimeters.
+If the information is unavailable, value is nil."
+  (and (memq (framep-on-display display) '(x w32 mac))
+       (x-display-mm-width display)))
+
+(defun display-backing-store (&optional display)
+  "Return the backing store capability of DISPLAY's screen.
+The value may be `always', `when-mapped', `not-useful', or nil if
+the question is inapplicable to a certain kind of display."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-backing-store display))
+     (t
+      'not-useful))))
+
+(defun display-save-under (&optional display)
+  "Return non-nil if DISPLAY's screen supports the SaveUnder feature."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-save-under display))
+     (t
+      'not-useful))))
+
+(defun display-planes (&optional display)
+  "Return the number of planes supported by DISPLAY."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-planes display))
+     ((eq frame-type 'pc)
+      4)
+     (t
+      (truncate (log (length (tty-color-alist)) 2))))))
+
+(defun display-color-cells (&optional display)
+  "Return the number of color cells supported by DISPLAY."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-color-cells display))
+     ((eq frame-type 'pc)
+      16)
+     (t
+      (length (tty-color-alist))))))
+
+(defun display-visual-class (&optional display)
+  "Returns the visual class of DISPLAY.
+The value is one of the symbols `static-gray', `gray-scale',
+`static-color', `pseudo-color', `true-color', or `direct-color'."
+  (let ((frame-type (framep-on-display display)))
+    (cond
+     ((memq frame-type '(x w32 mac))
+      (x-display-visual-class display))
+     ((and (memq frame-type '(pc t))
+          (tty-display-color-p display))
+      'static-color)
+     (t
+      'static-gray))))
+
+\f
 ;;;; Aliases for backward compatibility with Emacs 18.
 (defalias 'screen-height 'frame-height)
 (defalias 'screen-width 'frame-width)
@@ -770,6 +968,15 @@ This function is provided only for compatibility with Emacs 18; new code
 should use `set-frame-height' instead."
   (set-frame-height (selected-frame) lines pretend))
 
+(defun delete-other-frames (&optional frame)
+  "Delete all frames except FRAME.
+FRAME nil or omitted means delete all frames except the selected frame."
+  (interactive)
+  (unless frame
+    (setq frame (selected-frame)))
+  (mapcar 'delete-frame (delq frame (frame-list))))
+
+
 (make-obsolete 'screen-height 'frame-height)
 (make-obsolete 'screen-width  'frame-width)
 (make-obsolete 'set-screen-width 'set-frame-width)
@@ -788,6 +995,22 @@ should use `set-frame-height' instead."
   :group 'font-lock)
 
 
+\f
+;;; Scrolling
+
+(defgroup scrolling nil
+  "Scrolling windows."
+  :version "21.1"
+  :group 'frames)
+
+(defcustom automatic-hscrolling t
+  "*Allow or disallow autmatic scrolling windows horizontally.
+If non-nil, windows are automatically scrolled horizontally to make
+point visible."
+  :version "21.1"
+  :type 'boolean
+  :group 'scrolling)
+
 \f
 ;;; Blinking cursor
 
@@ -838,12 +1061,13 @@ window blinks."
     (if on-p
        (progn
          ;; Hide the cursor.
-         (internal-show-cursor 0)
+         (internal-show-cursor nil nil)
          (setq blink-cursor-idle-timer
                (run-with-idle-timer blink-cursor-delay
                                     blink-cursor-delay
                                     'blink-cursor-start))
-         (setq blink-cursor-mode t)))))
+         (setq blink-cursor-mode t))
+      (internal-show-cursor nil t))))
 
 (defcustom blink-cursor (not (eq system-type 'ms-dos))
   "*Non-nil means blinking cursor mode is active."
@@ -863,7 +1087,11 @@ command starts, by installing a pre-command hook."
     (add-hook 'pre-command-hook 'blink-cursor-end)
     (setq blink-cursor-timer
          (run-with-timer blink-cursor-interval blink-cursor-interval
-                         'internal-show-cursor))))
+                         'blink-cursor-timer-function))))
+
+(defun blink-cursor-timer-function ()
+  "Timer function of timer `blink-cursor-timer'."
+  (internal-show-cursor nil (not (internal-show-cursor-p))))
 
 (defun blink-cursor-end ()
   "Stop cursor blinking.
@@ -871,7 +1099,7 @@ This is installed as a pre-command hook by `blink-cursor-start'.
 When run, it cancels the timer `blink-cursor-timer' and removes 
 itself as a pre-command hook."
   (remove-hook 'pre-command-hook 'blink-cursor-end)
-  (internal-show-cursor 0)
+  (internal-show-cursor nil t)
   (cancel-timer blink-cursor-timer)
   (setq blink-cursor-timer nil))
 
@@ -889,11 +1117,34 @@ itself as a pre-command hook."
           (set-default symbol value)
           (setq display-busy-cursor value)))
 
+(defcustom busy-cursor-delay-seconds 1
+  "*Seconds to wait before displaying a busy-cursor."
+  :tag "Busy-cursor delay"
+  :type 'number
+  :group 'cursor
+  :get #'(lambda (symbol) busy-cursor-delay)
+  :set #'(lambda (symbol value)
+          (set-default symbol value)
+          (setq busy-cursor-delay value)))
 
+\f
+(defcustom show-cursor-in-non-selected-windows t
+  "*Non-nil means show a hollow box cursor in non-selected-windows.
+If nil, don't show a cursor except in the selected window."
+  :tag "Cursor in non-selected windows"
+  :type 'boolean
+  :group 'cursor
+  :get #'(lambda (symbol) cursor-in-non-selected-windows)
+  :set #'(lambda (symbol value)
+          (set-default symbol value)
+          (setq cursor-in-non-selected-windows value)
+          (force-mode-line-update t)))
+  
 \f
 ;;;; Key bindings
 
 (define-key ctl-x-5-map "2" 'make-frame-command)
+(define-key ctl-x-5-map "1" 'delete-other-frames)
 (define-key ctl-x-5-map "0" 'delete-frame)
 (define-key ctl-x-5-map "o" 'other-frame)