diff options
Diffstat (limited to 'lisp')
41 files changed, 659 insertions, 329 deletions
diff --git a/lisp/allout.el b/lisp/allout.el index 7b2707c45e0..32ecb35e07e 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -5,7 +5,7 @@ ;; Author: Ken Manheimer <klm@zope.com> ;; Maintainer: Ken Manheimer <klm@zope.com> ;; Created: Dec 1991 - first release to usenet -;; Version: $Id: allout.el,v 1.44 2003/09/01 15:45:04 miles Exp $|| +;; Version: $Id: allout.el,v 1.45 2003/10/16 16:28:30 eliz Exp $|| ;; Keywords: outlines mode wp languages ;; This file is part of GNU Emacs. @@ -508,7 +508,7 @@ behavior." ;;;_ : Version ;;;_ = allout-version (defvar allout-version - (let ((rcs-rev "$Revision: 1.44 $")) + (let ((rcs-rev "$Revision: 1.45 $")) (condition-case err (save-match-data (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) diff --git a/lisp/bindings.el b/lisp/bindings.el index 1f86f3b6fcb..280ca028842 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -214,7 +214,7 @@ Major modes that edit things other than ordinary files may change this (make-variable-buffer-local 'mode-line-buffer-identification) -(defvar mode-line-frame-identification '("-%F ") +(defvar mode-line-frame-identification '(window-system " " "-%F ") "Mode-line control to describe the current frame.") (defvar mode-line-process nil "\ diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 7962a446eab..f08be062a4d 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -5,7 +5,7 @@ ;; Author: Oliver Seidel <os10000@seidel-space.de> ;; [Not clear the above works, July 2000] ;; Created: 2 Aug 1997 -;; Version: $Id: todo-mode.el,v 1.50 2001/12/11 07:36:30 pj Exp $ +;; Version: $Id: todo-mode.el,v 1.51 2003/09/01 15:45:19 miles Exp $ ;; Keywords: calendar, todo ;; This file is part of GNU Emacs. @@ -97,7 +97,7 @@ ;; ;; Which version of todo-mode.el does this documentation refer to? ;; -;; $Id: todo-mode.el,v 1.50 2001/12/11 07:36:30 pj Exp $ +;; $Id: todo-mode.el,v 1.51 2003/09/01 15:45:19 miles Exp $ ;; ;; Pre-Requisites ;; diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 1ff07c4c361..b5716da161a 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -41,6 +41,7 @@ ;; If the user has already created the face, respect that. (let ((value (or (get face 'saved-face) spec)) (frames (frame-list)) + (have-window-system (memq initial-window-system '(x w32))) frame) ;; Create global face. (make-empty-face face) @@ -48,10 +49,12 @@ (while frames (setq frame (car frames) frames (cdr frames)) - (face-spec-set face value frame))) - ;; When making a face after frames already exist - (if (memq window-system '(x w32)) - (make-face-x-resource-internal face)))) + (face-spec-set face value frame) + (when (memq (window-system frame) '(x w32)) + (setq have-window-system t))) + ;; When making a face after frames already exist + (if have-window-system + (make-face-x-resource-internal face))))) ;; Don't record SPEC until we see it causes no errors. (put face 'face-defface-spec spec) (when (and doc (null (face-documentation face))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index a1ce848d9d7..6f7e838daf0 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -10,7 +10,7 @@ ;;; This version incorporates changes up to version 2.10 of the ;;; Zawinski-Furuseth compiler. -(defconst byte-compile-version "$Revision: 2.141 $") +(defconst byte-compile-version "$Revision: 2.142 $") ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/cl-specs.el b/lisp/emacs-lisp/cl-specs.el index 10aade7dc75..fe8e57dec8f 100644 --- a/lisp/emacs-lisp/cl-specs.el +++ b/lisp/emacs-lisp/cl-specs.el @@ -7,7 +7,7 @@ ;; LCD Archive Entry: ;; cl-specs.el|Daniel LaLiberte|liberte@holonexus.org ;; |Edebug specs for cl.el -;; |$Date: 2003/06/16 16:27:27 $|1.1| +;; |$Date: 2003/09/01 15:45:20 $|1.1| ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 650b385ff45..face9216417 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -7,7 +7,7 @@ ;; Keywords: extensions ;; Created: 1995-10-06 -;; $Id: eldoc.el,v 1.26 2003/09/01 15:45:22 miles Exp $ +;; $Id: eldoc.el,v 1.27 2003/09/06 17:32:31 fx Exp $ ;; This file is part of GNU Emacs. diff --git a/lisp/faces.el b/lisp/faces.el index a754b58c928..ba655df01db 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -905,7 +905,7 @@ an integer value." (let ((valid (case attribute (:family - (if window-system + (if (window-system frame) (mapcar #'(lambda (x) (cons (car x) (car x))) (x-font-family-list)) ;; Only one font on TTYs. @@ -914,7 +914,7 @@ an integer value." (mapcar #'(lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute))) ((:underline :overline :strike-through :box) - (if window-system + (if (window-system frame) (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute)) (mapcar #'(lambda (c) (cons c c)) @@ -927,7 +927,7 @@ an integer value." ((:height) 'integerp) (:stipple - (and (memq window-system '(x w32 mac)) + (and (memq (window-system frame) '(x w32 mac)) (mapcar #'list (apply #'nconc (mapcar (lambda (dir) @@ -1045,7 +1045,7 @@ of a global face. Value is the new attribute value." ;; explicitly in VALID, using color approximation code ;; in tty-colors.el. (when (and (memq attribute '(:foreground :background)) - (not (memq window-system '(x w32 mac))) + (not (memq (window-system frame) '(x w32 mac))) (not (member new-value '("unspecified" "unspecified-fg" "unspecified-bg")))) @@ -1298,14 +1298,14 @@ If FRAME is nil, the current FRAME is used." req (car conjunct) options (cdr conjunct) match (cond ((eq req 'type) - (or (memq window-system options) + (or (memq (window-system frame) options) ;; FIXME: This should be revisited to use ;; display-graphic-p, provided that the ;; color selection depends on the number ;; of supported colors, and all defface's ;; are changed to look at number of colors ;; instead of (type graphic) etc. - (and (null window-system) + (and (null (window-system frame)) (memq 'tty options)) (and (memq 'motif options) (featurep 'motif)) @@ -1539,14 +1539,14 @@ this won't have the expected effect." Display-dependent faces are those which have different definitions according to the `background-mode' and `display-type' frame parameters." (let* ((bg-resource - (and window-system + (and (window-system frame) (x-get-resource "backgroundMode" "BackgroundMode"))) (bg-color (frame-parameter frame 'background-color)) (bg-mode (cond (frame-background-mode) (bg-resource (intern (downcase bg-resource))) - ((and (null window-system) (null bg-color)) + ((and (null (window-system frame)) (null bg-color)) ;; No way to determine this automatically (?). 'dark) ;; Unspecified frame background color can only happen @@ -1563,7 +1563,7 @@ according to the `background-mode' and `display-type' frame parameters." 'light) (t 'dark))) (display-type - (cond ((null window-system) + (cond ((null (window-system frame)) (if (tty-display-color-p frame) 'color 'mono)) ((x-display-color-p frame) 'color) @@ -1660,7 +1660,7 @@ Value is the new frame created." (setq parameters (x-handle-named-frame-geometry parameters)) (let ((visibility-spec (assq 'visibility parameters)) (frame-list (frame-list)) - (frame (x-create-frame (cons '(visibility . nil) parameters))) + (frame (x-create-frame `((visibility . nil) . ,parameters))) success) (unwind-protect (progn @@ -1698,7 +1698,7 @@ Initialize colors of certain faces from frame parameters." (when (not (equal face 'default)) (face-spec-set face (face-user-default-spec face) frame) (internal-merge-in-global-face face frame) - (when (and (memq window-system '(x w32 mac)) + (when (and (memq (window-system frame) '(x w32 mac)) (or (not (boundp 'inhibit-default-face-x-resources)) (not (eq face 'default)))) (make-face-x-resource-internal face frame))) diff --git a/lisp/forms.el b/lisp/forms.el index 76d4bc48c4d..a7f4209fae8 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -301,10 +301,10 @@ (provide 'forms) ;;; official (provide 'forms-mode) ;;; for compatibility -(defconst forms-version (substring "$Revision: 2.48 $" 11 -2) +(defconst forms-version (substring "$Revision: 2.49 $" 11 -2) "The version number of forms-mode (as string). The complete RCS id is: - $Id: forms.el,v 2.48 2003/05/29 23:53:21 monnier Exp $") + $Id: forms.el,v 2.49 2003/09/01 15:45:12 miles Exp $") (defcustom forms-mode-hook nil "Hook run upon entering Forms mode." diff --git a/lisp/frame.el b/lisp/frame.el index a470fbc0f97..54bccd93970 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -27,10 +27,17 @@ ;;; Code: -(defvar frame-creation-function nil - "Window-system dependent function to call to create a new frame. -The window system startup file should set this to its frame creation -function, which should take an alist of parameters as its argument.") +(defvar frame-creation-function-alist + (list (cons nil + (if (fboundp 'tty-create-frame-with-faces) + 'tty-create-frame-with-faces + (function + (lambda (parameters) + (error "Can't create multiple frames without a window system")))))) + "Alist of window-system dependent functions to call to create a new frame. +The window system startup file should add its frame creation +function to this list, which should take an alist of parameters +as its argument.") ;; The initial value given here used to ask for a minibuffer. ;; But that's not necessary, because the default is to have one. @@ -186,7 +193,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." (defun frame-initialize () "Create an initial frame if necessary." ;; Are we actually running under a window system at all? - (if (and window-system (not noninteractive) (not (eq window-system 'pc))) + (if (and initial-window-system + (not noninteractive) + (not (eq initial-window-system 'pc))) (progn ;; Turn on special-display processing only if there's a window system. (setq special-display-function 'special-display-popup-frame) @@ -203,6 +212,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." (setq frame-initial-frame-alist (cons '(horizontal-scroll-bars . t) frame-initial-frame-alist))) + (setq frame-initial-frame-alist + (cons (cons 'window-system initial-window-system) + frame-initial-frame-alist)) (setq default-minibuffer-frame (setq frame-initial-frame (make-frame frame-initial-frame-alist))) @@ -215,18 +227,7 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." ;; At this point, we know that we have a frame open, so we ;; can delete the terminal frame. (delete-frame terminal-frame) - (setq terminal-frame nil)) - - ;; No, we're not running a window system. Use make-terminal-frame if - ;; we support that feature, otherwise arrange to cause errors. - (or (eq window-system 'pc) - (setq frame-creation-function - (if (fboundp 'tty-create-frame-with-faces) - 'tty-create-frame-with-faces - (function - (lambda (parameters) - (error - "Can't create multiple frames without a window system")))))))) + (setq terminal-frame nil)))) (defvar frame-notice-user-settings t "Non-nil means function `frame-notice-user-settings' wasn't run yet.") @@ -276,7 +277,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." ;; Can't modify the minibuffer parameter, so don't try. (setq parms (delq (assq 'minibuffer parms) parms)) (modify-frame-parameters nil - (if (null window-system) + (if (null initial-window-system) (append initial-frame-alist default-frame-alist parms @@ -285,7 +286,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." ;; default-frame-alist were already ;; applied in pc-win.el. parms)) - (if (null window-system) ;; MS-DOS does this differently in pc-win.el + (if (null initial-window-system) ;; MS-DOS does this differently in pc-win.el (let ((newparms (frame-parameters)) (frame (selected-frame))) (tty-handle-reverse-video frame newparms) @@ -569,7 +570,20 @@ The optional second argument PARAMETERS specifies additional frame parameters." (interactive "sMake frame on display: ") (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display) (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN")) - (make-frame (cons (cons 'display display) parameters))) + (unless x-initialized + (setq x-display-name display) + (x-initialize-window-system)) + (make-frame `((window-system . x) (display . ,display) . ,parameters))) + +(defun make-frame-on-tty (device type &optional parameters) + "Make a frame on terminal DEVICE which is of type TYPE (e.g., \"xterm\"). +The optional third argument PARAMETERS specifies additional frame parameters." + (interactive "fOpen frame on tty device: \nsTerminal type of %s: ") + (unless device + (error "Invalid terminal device")) + (unless type + (error "Invalid terminal type")) + (make-frame `((window-system . nil) (tty . ,device) (tty-type . ,type) . ,parameters))) (defun make-frame-command () "Make a new frame, and select it if the terminal displays only one frame." @@ -609,12 +623,22 @@ You cannot specify either `width' or `height', you must use neither or both. (minibuffer . only) The frame should contain only a minibuffer. (minibuffer . WINDOW) The frame should use WINDOW as its minibuffer window. -Before the frame is created (via `frame-creation-function'), functions on the + (window-system . nil) The frame should be displayed on a terminal device. + (window-system . x) The frame should be displayed in an X window. + +Before the frame is created (via `frame-creation-function-alist'), functions on the hook `before-make-frame-hook' are run. After the frame is created, functions on `after-make-frame-functions' are run with one arg, the newly created frame." (interactive) - (run-hooks 'before-make-frame-hook) - (let ((frame (funcall frame-creation-function parameters))) + (let* ((w (if (assq 'window-system parameters) + (cdr (assq 'window-system parameters)) + window-system)) + (frame-creation-function (cdr (assq w frame-creation-function-alist))) + frame) + (unless frame-creation-function + (error "Don't know how to create a frame on window system %s" w)) + (run-hooks 'before-make-frame-hook) + (setq frame (funcall frame-creation-function parameters)) (run-hook-with-args 'after-make-frame-functions frame) frame)) @@ -687,9 +711,9 @@ automatically." (select-frame frame) (raise-frame frame) ;; Ensure, if possible, that frame gets input focus. - (cond ((eq window-system 'x) + (cond ((eq (window-system frame) 'x) (x-focus-frame frame)) - ((eq window-system 'w32) + ((eq (window-system frame) 'w32) (w32-focus-frame frame))) (cond (focus-follows-mouse (set-mouse-position (selected-frame) (1- (frame-width)) 0)))) @@ -726,6 +750,22 @@ Otherwise, that variable should be nil." (iconify-frame) (make-frame-visible))) +(defun suspend-frame () + "Do whatever is right to suspend the current frame. +Calls `suspend-emacs' if invoked from the controlling terminal, +`suspend-tty' from a secondary terminal, and +`iconify-or-deiconify-frame' from an X frame." + (interactive) + (let ((type (framep (selected-frame)))) + (cond + ((eq type 'x) (iconify-or-deiconify-frame)) + ((eq type t) + (if (frame-tty-name) + (suspend-tty) + (suspend-emacs))) + (t (suspend-emacs))))) + + (defun make-frame-names-alist () (let* ((current-frame (selected-frame)) (falist @@ -759,9 +799,9 @@ If there is no frame by that name, signal an error." (raise-frame frame) (select-frame frame) ;; Ensure, if possible, that frame gets input focus. - (cond ((eq window-system 'x) + (cond ((eq (window-system frame) 'x) (x-focus-frame frame)) - ((eq window-system 'w32) + ((eq (window-system frame) 'w32) (w32-focus-frame frame))) (when focus-follows-mouse (set-mouse-position frame (1- (frame-width frame)) 0)))) @@ -1118,7 +1158,7 @@ the question is inapplicable to a certain kind of display." ((eq frame-type 'pc) 16) (t - (tty-display-color-cells))))) + (tty-display-color-cells display))))) (defun display-visual-class (&optional display) "Returns the visual class of DISPLAY. @@ -1350,6 +1390,8 @@ Use Custom to set this variable to get the display updated." (define-key ctl-x-5-map "0" 'delete-frame) (define-key ctl-x-5-map "o" 'other-frame) +(substitute-key-definition 'suspend-emacs 'suspend-frame global-map) + (provide 'frame) ;;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56 diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index cbdb4fcb911..595fdb7d499 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -78,7 +78,7 @@ name (autoload (quote ada-mode) "ada-mode" "\ Ada mode is the major mode for editing Ada code. -This version was built on $Date: 2003/09/30 12:54:32 $. +This version was built on $Date: 2003/11/17 19:02:52 $. Bindings are as follows: (Note: 'LFD' is control-j.) \\{ada-mode-map} diff --git a/lisp/loadup.el b/lisp/loadup.el index bd90fb7c53a..82f6b1d6641 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -67,6 +67,8 @@ (setq load-source-file-function 'load-with-code-conversion) (load "files") +(load "startup") + (load "cus-face") (load "faces") ; after here, `defface' may be used. @@ -146,7 +148,6 @@ (message "%s" (garbage-collect)) (load "menu-bar") (load "paths.el") ;Don't get confused if someone compiled paths by mistake. -(load "startup") (load "emacs-lisp/lisp") (load "textmodes/page") (load "register") @@ -189,6 +190,15 @@ (load "emacs-lisp/float-sup"))) (message "%s" (garbage-collect)) +;; Load auxiliary settings for X displays if we support them. +(when (fboundp 'x-create-frame) + (load "mouse") + (load "international/fontset") + (load "x-dnd") + (load "term/x-win")) + +(message "%s" (garbage-collect)) + (load "vc-hooks") (load "ediff-hook") (message "%s" (garbage-collect)) diff --git a/lisp/mail/metamail.el b/lisp/mail/metamail.el index d64616dba8e..df1a4314cac 100644 --- a/lisp/mail/metamail.el +++ b/lisp/mail/metamail.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1993, 1996 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp> -;; Version: $Id: metamail.el,v 1.15 2003/02/04 13:14:00 lektu Exp $ +;; Version: $Id: metamail.el,v 1.16 2003/09/01 15:45:30 miles Exp $ ;; Keywords: mail, news, mime, multimedia ;; This file is part of GNU Emacs. diff --git a/lisp/net/rlogin.el b/lisp/net/rlogin.el index 772756033eb..a69a51db82a 100644 --- a/lisp/net/rlogin.el +++ b/lisp/net/rlogin.el @@ -6,7 +6,7 @@ ;; Maintainer: Noah Friedman <friedman@splode.com> ;; Keywords: unix, comm -;; $Id: rlogin.el,v 1.4 2003/05/06 17:46:28 lektu Exp $ +;; $Id: rlogin.el,v 1.5 2003/09/01 15:45:33 miles Exp $ ;; This file is part of GNU Emacs. diff --git a/lisp/obsolete/rsz-mini.el b/lisp/obsolete/rsz-mini.el index f2f32964f5d..7c5ad9dd3a2 100644 --- a/lisp/obsolete/rsz-mini.el +++ b/lisp/obsolete/rsz-mini.el @@ -7,7 +7,7 @@ ;; Maintainer: Noah Friedman <friedman@splode.com> ;; Keywords: minibuffer, window, frame, display -;; $Id: rsz-mini.el,v 1.1 2001/08/30 07:29:18 gerd Exp $ +;; $Id: rsz-mini.el,v 1.2 2003/09/01 15:45:33 miles Exp $ ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 310e2bc8889..0fd7253eb73 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -1071,7 +1071,7 @@ name" ;;;###autoload (defun ada-mode () "Ada mode is the major mode for editing Ada code. -This version was built on $Date: 2003/09/01 15:45:34 $. +This version was built on $Date: 2003/09/30 12:54:32 $. Bindings are as follows: (Note: 'LFD' is control-j.) \\{ada-mode-map} diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index 30bdfc4ae41..badab8da919 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1998, 99, 2000-2003 Free Software Foundation, Inc. ;; Author: Emmanuel Briot <briot@gnat.com> -;; Ada Core Technologies's version: $Revision: 1.12 $ +;; Ada Core Technologies's version: $Revision: 1.13 $ ;; Keywords: languages, ada, project file ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ada-stmt.el b/lisp/progmodes/ada-stmt.el index 7b9f7649280..31b21bb9e34 100644 --- a/lisp/progmodes/ada-stmt.el +++ b/lisp/progmodes/ada-stmt.el @@ -3,7 +3,7 @@ ;; Copyright(C) 1987, 93, 94, 96, 97, 98, 99, 2000 ;; Free Software Foundation, Inc. -;; Ada Core Technologies's version: $Revision: 1.16 $ +;; Ada Core Technologies's version: $Revision: 1.17 $ ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index 09342e463c9..e8aa20540fa 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -4,7 +4,7 @@ ;; Author: Dave Love <fx@gnu.org> ;; Keywords: languages -;; $Revision: 1.5 $ +;; $Revision: 1.6 $ ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el index ee4ca4b5786..28d77df84f6 100644 --- a/lisp/progmodes/delphi.el +++ b/lisp/progmodes/delphi.el @@ -65,7 +65,7 @@ (provide 'delphi) (defconst delphi-version - (let ((revision "$Revision: 3.10 $")) + (let ((revision "$Revision: 3.11 $")) (string-match ": \\([^ ]+\\)" revision) (match-string 1 revision)) "Version of this delphi mode.") diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index af62d1e3e74..e0d2d1892c0 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -5,7 +5,7 @@ ;; Chris Chase <chase@att.com> ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> ;; Version: 4.15 -;; Date: $Date: 2002/10/17 15:41:01 $ +;; Date: $Date: 2003/09/01 15:45:35 $ ;; Keywords: processes ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el index 79ca7b8d75b..4ec9a1ebfc5 100644 --- a/lisp/progmodes/idlw-toolbar.el +++ b/lisp/progmodes/idlw-toolbar.el @@ -4,7 +4,7 @@ ;; Author: Carsten Dominik <dominik@astro.uva.nl> ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> ;; Version: 4.15 -;; Date: $Date: 2003/02/04 13:24:35 $ +;; Date: $Date: 2003/09/01 15:45:35 $ ;; Keywords: processes ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 83bf03f7c46..5850dad2988 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -5,7 +5,7 @@ ;; Chris Chase <chase@att.com> ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> ;; Version: 4.15 -;; Date: $Date: 2003/09/01 15:45:35 $ +;; Date: $Date: 2004/01/03 12:09:15 $ ;; Keywords: languages ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index db04986d54b..8999a5b1682 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -6,7 +6,7 @@ ;; Author: Tom Tromey <tromey@redhat.com> ;; Chris Lindblad <cjl@lcs.mit.edu> ;; Keywords: languages tcl modes -;; Version: $Revision: 1.75 $ +;; Version: $Revision: 1.76 $ ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 87ca4f11bd4..ae5396edfbb 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -5,7 +5,7 @@ ;; Authors: Reto Zimmermann <reto@gnu.org> ;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net> ;; Maintainer: Reto Zimmermann <reto@gnu.org> -;; RCS: $Id: vhdl-mode.el,v 1.20 2003/03/05 07:50:38 lektu Exp $ +;; RCS: $Id: vhdl-mode.el,v 1.21 2003/09/01 15:45:35 miles Exp $ ;; Keywords: languages vhdl ;; WWW: http://opensource.ethz.ch/emacs/vhdl-mode.html diff --git a/lisp/recentf.el b/lisp/recentf.el index f2700fcf210..0f80132c0b9 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -8,7 +8,7 @@ ;; Maintainer: FSF ;; Keywords: files -(defconst recentf-version "$Revision: 1.27 $") +(defconst recentf-version "$Revision: 1.28 $") ;; This file is part of GNU Emacs. diff --git a/lisp/server.el b/lisp/server.el index a6b2742190f..aac3da13e4f 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -106,6 +106,24 @@ Each element is (CLIENTID BUFFERS...) where CLIENTID is a string that can be given to the server process to identify a client. When a buffer is marked as \"done\", it is removed from this list.") +(defvar server-ttys nil + "List of current terminal devices used by the server. +Each element is (CLIENTID TTY) where CLIENTID is a string +that can be given to the server process to identify a client. +TTY is the name of the tty device. + +When all frames on the device are deleted, the server quits the +connection to the client, and vice versa.") + +(defvar server-frames nil + "List of current window-system frames used by the server. +Each element is (CLIENTID FRAME) where CLIENTID is a string +that can be given to the server process to identify a client. +FRAME is the frame that was opened by the client. + +When the frame is deleted, the server closes the connection to +the client, and vice versa.") + (defvar server-buffer-clients nil "List of client ids for clients requesting editing of current buffer.") (make-variable-buffer-local 'server-buffer-clients) @@ -168,10 +186,18 @@ are done with it in the server.") (with-current-buffer "*server*" (goto-char (point-max)) (insert (current-time-string) - (if client (format " %s:" client) " ") + (if client (format " %s: " client) " ") string) (or (bolp) (newline))))) +(defun server-tty-live-p (tty) + "Return non-nil if the tty device named TTY has a live frame." + (let (result) + (dolist (frame (frame-list) result) + (when (and (eq (frame-live-p frame) t) + (equal (frame-tty-name frame) tty)) + (setq result t))))) + (defun server-sentinel (proc msg) (let ((client (assq proc server-clients))) ;; Remove PROC from the list of clients. @@ -186,9 +212,54 @@ are done with it in the server.") (or (and server-kill-new-buffers (not server-existing-buffer)) (server-temp-file-p))) - (kill-buffer (current-buffer))))))) + (kill-buffer (current-buffer))))) + (let ((tty (assq (car client) server-ttys))) + (when tty + (setq server-ttys (delq tty server-ttys)) + (when (server-tty-live-p (cadr tty)) + (delete-tty (cadr tty))))))) (server-log (format "Status changed to %s" (process-status proc)) proc)) +(defun server-handle-delete-tty (tty) + "Delete the client connection when the emacsclient terminal device is closed." + (dolist (entry server-ttys) + (let ((proc (nth 0 entry)) + (term (nth 1 entry))) + (when (equal term tty) + (let ((client (assq proc server-clients))) + (server-log (format "server-handle-delete-tty, tty %s" tty) (car client)) + (setq server-ttys (delq entry server-ttys)) + (delete-process (car client)) + (when (assq proc server-clients) + ;; This seems to be necessary to handle + ;; `emacsclient -t -e '(delete-frame)'' correctly. + (setq server-clients (delq client server-clients)))))))) + +(defun server-handle-suspend-tty (tty) + "Notify the emacsclient process to suspend itself when its tty device is suspended." + (dolist (entry server-ttys) + (let ((proc (nth 0 entry)) + (term (nth 1 entry))) + (when (equal term tty) + (let ((process (car (assq proc server-clients)))) + (server-log (format "server-handle-suspend-tty, tty %s" tty) process) + (process-send-string process "-suspend \n")))))) + +(defun server-handle-delete-frame (frame) + "Delete the client connection when the emacsclient frame is deleted." + (dolist (entry server-frames) + (let ((proc (nth 0 entry)) + (f (nth 1 entry))) + (when (equal frame f) + (let ((client (assq proc server-clients))) + (server-log (format "server-handle-delete-frame, frame %s" frame) (car client)) + (setq server-frames (delq entry server-frames)) + (delete-process (car client)) + (when (assq proc server-clients) + ;; This seems to be necessary to handle + ;; `emacsclient -t -e '(delete-frame)'' correctly. + (setq server-clients (delq client server-clients)))))))) + (defun server-select-display (display) ;; If the current frame is on `display' we're all set. (unless (equal (frame-parameter (selected-frame) 'display) display) @@ -200,14 +271,14 @@ are done with it in the server.") ;; and select it. (unless (equal (frame-parameter (selected-frame) 'display) display) (select-frame - (make-frame-on-display - display + (make-frame-on-display display))))) ;; This frame is only there in place of an actual "current display" ;; setting, so we want it to be as unobtrusive as possible. That's ;; what the invisibility is for. The minibuffer setting is so that ;; we don't end up displaying a buffer in it (which noone would ;; notice). - '((visibility . nil) (minibuffer . only))))))) + ;; XXX I have found this behaviour to be surprising and annoying. -- Lorentey + ;; '((visibility . nil) (minibuffer . only))))))) (defun server-unquote-arg (arg) (replace-regexp-in-string @@ -219,6 +290,19 @@ are done with it in the server.") (t " "))) arg t t)) +(defun server-quote-arg (arg) + "In NAME, insert a & before each &, each space, each newline, and -. +Change spaces to underscores, too, so that the return value never +contains a space." + (replace-regexp-in-string + "[-&\n ]" (lambda (s) + (case (aref s 0) + (?& "&&") + (?- "&-") + (?\n "&n") + (?\s "&_"))) + arg t t)) + (defun server-ensure-safe-dir (dir) "Make sure DIR is a directory with no race-condition issues. Creates the directory if necessary and makes sure: @@ -256,10 +340,18 @@ Prefix arg means just kill any existing server communications subprocess." (while server-clients (let ((buffer (nth 1 (car server-clients)))) (server-buffer-done buffer))) + ;; Delete any remaining opened frames of the previous server. + (while server-ttys + (let ((tty (cadar server-ttys))) + (setq server-ttys (cdr server-ttys)) + (when (server-tty-live-p tty) (delete-tty tty)))) (unless leave-dead (if server-process (server-log (message "Restarting server"))) (letf (((default-file-modes) ?\700)) + (add-to-list 'delete-tty-after-functions 'server-handle-delete-tty) + (add-to-list 'suspend-tty-functions 'server-handle-suspend-tty) + (add-to-list 'delete-frame-functions 'server-handle-delete-frame) (setq server-process (make-network-process :name "server" :family 'local :server t :noquery t @@ -291,81 +383,186 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." (when prev (setq string (concat prev string)) (process-put proc 'previous-string nil))) - ;; If the input is multiple lines, - ;; process each line individually. - (while (string-match "\n" string) - (let ((request (substring string 0 (match-beginning 0))) - (coding-system (and default-enable-multibyte-characters - (or file-name-coding-system - default-file-name-coding-system))) - client nowait eval - (files nil) - (lineno 1) - (columnno 0)) - ;; Remove this line from STRING. - (setq string (substring string (match-end 0))) - (setq client (cons proc nil)) - (while (string-match "[^ ]* " request) - (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) - (setq request (substring request (match-end 0))) - (cond - ((equal "-nowait" arg) (setq nowait t)) - ((equal "-eval" arg) (setq eval t)) - ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) - (let ((display (server-unquote-arg (match-string 1 request)))) - (setq request (substring request (match-end 0))) - (condition-case err - (server-select-display display) - (error (process-send-string proc (nth 1 err)) - (setq request ""))))) - ;; ARG is a line number option. - ((string-match "\\`\\+[0-9]+\\'" arg) - (setq lineno (string-to-int (substring arg 1)))) - ;; ARG is line number:column option. - ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) - (setq lineno (string-to-int (match-string 1 arg)) - columnno (string-to-int (match-string 2 arg)))) - (t - ;; Undo the quoting that emacsclient does - ;; for certain special characters. - (setq arg (server-unquote-arg arg)) - ;; Now decode the file name if necessary. - (if coding-system - (setq arg (decode-coding-string arg coding-system))) - (if eval - (let ((v (eval (car (read-from-string arg))))) - (when v - (with-temp-buffer - (let ((standard-output (current-buffer))) - (pp v) - (process-send-region proc (point-min) (point-max)))))) - ;; ARG is a file name. - ;; Collapse multiple slashes to single slashes. - (setq arg (command-line-normalize-file-name arg)) - (push (list arg lineno columnno) files)) - (setq lineno 1) - (setq columnno 0))))) - (when files - (run-hooks 'pre-command-hook) - (server-visit-files files client nowait) - (run-hooks 'post-command-hook)) - ;; CLIENT is now a list (CLIENTNUM BUFFERS...) - (if (null (cdr client)) - ;; This client is empty; get rid of it immediately. - (progn - (delete-process proc) - (server-log "Close empty client" proc)) - ;; We visited some buffer for this client. - (or nowait (push client server-clients)) - (unless (or isearch-mode (minibufferp)) - (server-switch-buffer (nth 1 client)) - (run-hooks 'server-switch-hook) - (unless nowait - (message (substitute-command-keys - "When done with a buffer, type \\[server-edit]"))))))) - ;; Save for later any partial line that remains. - (when (> (length string) 0) - (process-put proc 'previous-string string))) + (condition-case err + (progn + ;; If the input is multiple lines, + ;; process each line individually. + (while (string-match "\n" string) + (let ((request (substring string 0 (match-beginning 0))) + (coding-system (and default-enable-multibyte-characters + (or file-name-coding-system + default-file-name-coding-system))) + client nowait newframe display version-checked + dontkill ; t if the client should not be killed. + registered ; t if the client is already added to server-clients. + (files nil) + (lineno 1) + (columnno 0)) + ;; Remove this line from STRING. + (setq string (substring string (match-end 0))) + (setq client (cons proc nil)) + (while (string-match "[^ ]* " request) + (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) + (setq request (substring request (match-end 0))) + (cond + ;; Check version numbers. + ((and (equal "-version" arg) (string-match "\\([0-9.]+\\) " request)) + (let* ((client-version (match-string 1 request)) + (truncated-emacs-version (substring emacs-version 0 (length client-version)))) + (setq request (substring request (match-end 0))) + (if (equal client-version truncated-emacs-version) + (progn + (process-send-string proc "-good-version \n") + (setq version-checked t)) + (error (concat "Version mismatch: Emacs is " truncated-emacs-version ", emacsclient is " client-version))))) + + ((equal "-nowait" arg) (setq nowait t)) + + ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) + (setq display (match-string 1 request) + request (substring request (match-end 0)))) + + ;; Open a new X frame. + ((equal "-window-system" arg) + (unless version-checked + (error "Protocol error; make sure to use the correct version of emacsclient")) + (let ((frame (make-frame-on-display + (or display + (frame-parameter nil 'display) + (getenv "DISPLAY") + (error "Please specify display"))))) + (push (list proc frame) server-frames) + (select-frame frame) + ;; This makes sure that `emacsclient -w -e '(delete-frame)'' works right. + (push client server-clients) + (setq registered t + newframe t + dontkill t))) + + ;; Resume a suspended tty frame. + ((equal "-resume" arg) + (let ((tty (cadr (assq (car client) server-ttys)))) + (setq dontkill t) + (when tty (resume-tty tty)))) + + ;; Suspend the client's frame. (In case we get out of + ;; sync, and a C-z sends a SIGTSTP to emacsclient.) + ((equal "-suspend" arg) + (let ((tty (cadr (assq (car client) server-ttys)))) + (setq dontkill t) + (when tty (suspend-tty tty)))) + + ;; Noop; useful for debugging emacsclient. + ((and (equal "-ignore" arg) (string-match "\\([^ ]*\\) " request)) + (setq dontkill t + request (substring request (match-end 0)))) + + ;; Open a new tty frame at the client. ARG is the name of the pseudo tty. + ((and (equal "-tty" arg) (string-match "\\([^ ]*\\) \\([^ ]*\\) " request)) + (let ((tty (server-unquote-arg (match-string 1 request))) + (type (server-unquote-arg (match-string 2 request)))) + (setq request (substring request (match-end 0))) + (unless version-checked + (error "Protocol error; make sure to use the correct version of emacsclient")) + (let ((frame (make-frame-on-tty tty type))) + (push (list (car client) (frame-tty-name frame)) server-ttys) + (process-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n")) + (select-frame frame) + ;; This makes sure that `emacsclient -t -e '(delete-frame)'' works right. + (push client server-clients) + (setq registered t + dontkill t + newframe t)))) + + ;; ARG is a line number option. + ((and (equal "-position" arg) (string-match "\\(\\+[0-9]+\\) " request)) + (setq request (substring request (match-end 0)) + lineno (string-to-int (substring (match-string 1 request) 1)))) + + ;; ARG is line number:column option. + ((and (equal "-position" arg) (string-match "\\+\\([0-9]+\\):\\([0-9]+\\) " request)) + (setq request (substring request (match-end 0)) + lineno (string-to-int (match-string 1 request)) + columnno (string-to-int (match-string 2 request)))) + + ;; ARG is a file to load. + ((and (equal "-file" arg) (string-match "\\([^ ]+\\) " request)) + (let ((file (server-unquote-arg (match-string 1 request)))) + (setq request (substring request (match-end 0))) + (if coding-system + (setq file (decode-coding-string file coding-system))) + (setq file (command-line-normalize-file-name file)) + (push (list file lineno columnno) files)) + (setq lineno 1 + columnno 0)) + + ;; ARG is a Lisp expression. + ((and (equal "-eval" arg) (string-match "\\([^ ]+\\) " request)) + (let ((expr (server-unquote-arg (match-string 1 request)))) + (setq request (substring request (match-end 0))) + (if coding-system + (setq expr (decode-coding-string expr coding-system))) + (let ((v (eval (car (read-from-string expr))))) + (when (and (not newframe) v) + (with-temp-buffer + (let ((standard-output (current-buffer))) + (pp v) + (process-send-string proc "-print ") + (process-send-string + proc (server-quote-arg + (buffer-substring-no-properties (point-min) + (point-max)))) + (process-send-string proc "\n"))))) + (setq lineno 1 + columnno 0))) + + ;; Unknown command. + (t (error "Unknown command: %s" arg))))) + + (when files + (run-hooks 'pre-command-hook) + (server-visit-files files client nowait) + (run-hooks 'post-command-hook)) + + ;; CLIENT is now a list (CLIENTNUM BUFFERS...) + + ;; Delete the client if necessary. + (cond + ;; Client requested nowait; return immediately. + (nowait + (delete-process proc) + (server-log "Close nowait client" proc)) + ;; This client is empty; get rid of it immediately. + ((and (not dontkill) (null (cdr client))) + (delete-process proc) + (server-log "Close empty client" proc)) + ((not registered) + (push client server-clients))) + + ;; We visited some buffer for this client. + (cond + ((or isearch-mode (minibufferp)) + nil) + ((and newframe (null (cdr client))) + (message (substitute-command-keys + "When done with this frame, type \\[delete-frame]"))) + ((not (null (cdr client))) + (server-switch-buffer (nth 1 client)) + (run-hooks 'server-switch-hook) + (unless nowait + (message (substitute-command-keys + "When done with a buffer, type \\[server-edit]"))))))) + + ;; Save for later any partial line that remains. + (when (> (length string) 0) + (process-put proc 'previous-string string))) + ;; condition-case + (error (ignore-errors + (process-send-string + proc (concat "-error " (server-quote-arg (error-message-string err)))) + (setq string "") + (server-log (error-message-string err) proc) + (delete-process proc))))) (defun server-goto-line-column (file-line-col) (goto-line (nth 1 file-line-col)) @@ -439,9 +636,17 @@ FOR-KILLING if non-nil indicates that we are called from `kill-buffer'." ;; If client now has no pending buffers, ;; tell it that it is done, and forget it entirely. (unless (cdr client) - (delete-process (car client)) - (server-log "Close" (car client)) - (setq server-clients (delq client server-clients)))) + (let ((tty (cadr (assq (car client) server-ttys))) + (frame (cadr (assq (car client) server-frames)))) + (cond + ;; Be careful, if we delete the process before the + ;; tty, then the terminal modes will not be restored + ;; correctly. + (tty (delete-tty tty)) + (frame (delete-frame frame)) + (t (delete-process (car client)) + (server-log "Close" (car client)) + (setq server-clients (delq client server-clients))))))) (setq old-clients (cdr old-clients))) (if (and (bufferp buffer) (buffer-name buffer)) ;; We may or may not kill this buffer; @@ -508,6 +713,11 @@ specifically for the clients and did not exist before their request for it." ;; using whatever is on disk in that file. -- rms. (defun server-kill-buffer-query-function () (or (not server-buffer-clients) + (let ((res t)) + (dolist (proc server-buffer-clients res) + (setq proc (assq proc server-clients)) + (when (and proc (eq (process-status (car proc)) 'open)) + (setq res nil)))) (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " (buffer-name (current-buffer)))))) @@ -569,7 +779,8 @@ Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it." ;; since we've already effectively done that. (if (null next-buffer) (if server-clients - (server-switch-buffer (nth 1 (car server-clients)) killed-one) + (let ((buffer (nth 1 (car server-clients)))) + (and buffer (server-switch-buffer buffer killed-one))) (unless (or killed-one (window-dedicated-p (selected-window))) (switch-to-buffer (other-buffer)) (message "No server buffers remain to edit"))) diff --git a/lisp/smerge-mode.el b/lisp/smerge-mode.el index 320c9eb1734..b9d6db81d23 100644 --- a/lisp/smerge-mode.el +++ b/lisp/smerge-mode.el @@ -4,7 +4,7 @@ ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: merge diff3 cvs conflict -;; Revision: $Id$ +;; Revision: $Id: smerge-mode.el,v 1.24 2003/10/06 16:34:59 fx Exp $ ;; This file is part of GNU Emacs. diff --git a/lisp/startup.el b/lisp/startup.el index 26671e50014..e79ea4407b1 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -36,6 +36,13 @@ (defvar command-line-processed nil "Non-nil once command line has been processed.") +(defvar window-system initial-window-system + "Name of window system the selected frame is displaying through. +The value is a symbol--for instance, `x' for X windows. +The value is nil if the selected frame is on a text-only-terminal.") + +(make-variable-frame-local 'window-system) + (defgroup initialization nil "Emacs start-up procedure" :group 'internal) @@ -420,9 +427,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; for instance due to a dense colormap. (when (or frame-initial-frame ;; If frame-initial-frame has no meaning, do this anyway. - (not (and window-system + (not (and initial-window-system (not noninteractive) - (not (eq window-system 'pc))))) + (not (eq initial-window-system 'pc))))) ;; Modify the initial frame based on what .emacs puts into ;; ...-frame-alist. (if (fboundp 'frame-notice-user-settings) @@ -435,7 +442,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (let ((frame-background-mode frame-background-mode) (frame (selected-frame)) term) - (when (and (null window-system) + (when (and (null initial-window-system) ;; Don't override a possibly customized value. (null frame-background-mode) ;; Don't override user specifications. @@ -491,6 +498,20 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (defvar tool-bar-originally-present nil "Non-nil if tool-bars are present before user and site init files are read.") +(defvar handle-args-function-alist '((nil . tty-handle-args)) + "Functions for processing window-system dependent command-line arguments. +Window system startup files should add their own function to this +alist, which should parse the command line arguments. Those +pertaining to the window system should be processed and removed +from the returned command line.") + +(defvar window-system-initialization-alist '((nil . ignore)) + "Alist of window-system initialization functions. +Window-system startup files should add their own initialization +function to this list. The function should take no arguments, +and initialize the window system environment to prepare for +opening the first frame (e.g. open a connection to the server).") + ;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc. (defun tty-handle-args (args) (let (rest) @@ -610,14 +631,21 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Read window system's init file if using a window system. (condition-case error - (if (and window-system (not noninteractive)) - (load (concat term-file-prefix - (symbol-name window-system) - "-win") - ;; Every window system should have a startup file; - ;; barf if we can't find it. - nil t)) - ;; If we can't read it, print the error message and exit. + (unless noninteractive + (if (and initial-window-system + (not (featurep + (intern (concat (symbol-name initial-window-system) + "-win"))))) + (error "Unsupported window system `%s'" initial-window-system)) + ;; Process window-system specific command line parameters. + (setq command-line-args + (funcall (or (cdr (assq initial-window-system handle-args-function-alist)) + (error "Unsupported window system `%s'" initial-window-system)) + command-line-args)) + ;; Initialize the window system. (Open connection, etc.) + (funcall (or (cdr (assq initial-window-system window-system-initialization-alist)) + (error "Unsupported window system `%s'" initial-window-system)))) + ;; If there was an error, print the error message and exit. (error (princ (if (eq (car error) 'error) @@ -633,13 +661,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (cdr error) ", ")))) 'external-debugging-output) (terpri 'external-debugging-output) - (setq window-system nil) + (setq initial-window-system nil) (kill-emacs))) - ;; Windowed displays do this inside their *-win.el. - (unless (or (display-graphic-p) noninteractive) - (setq command-line-args (tty-handle-args command-line-args))) - (set-locale-environment nil) ;; Convert the arguments to Emacs internal representation. @@ -716,7 +740,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; If frame was created with a menu bar, set menu-bar-mode on. (unless (or noninteractive - (and (memq window-system '(x w32)) + (and (memq initial-window-system '(x w32)) (<= (frame-parameter nil 'menu-bar-lines) 0))) (menu-bar-mode 1)) @@ -726,10 +750,10 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (<= (frame-parameter nil 'tool-bar-lines) 0)) (tool-bar-mode 1)) - ;; Can't do this init in defcustom because window-system isn't set. + ;; Can't do this init in defcustom because initial-window-system isn't set. (unless (or noninteractive (eq system-type 'ms-dos) - (not (memq window-system '(x w32)))) + (not (memq initial-window-system '(x w32)))) (setq-default blink-cursor t) (blink-cursor-mode 1)) @@ -737,13 +761,13 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; DOS/Windows systems have a PC-type keyboard which has both ;; <delete> and <backspace> keys. (when (or (memq system-type '(ms-dos windows-nt)) - (and (memq window-system '(x)) + (and (memq initial-window-system '(x)) (fboundp 'x-backspace-delete-keys-p) (x-backspace-delete-keys-p)) ;; If the terminal Emacs is running on has erase char ;; set to ^H, use the Backspace key for deleting ;; backward and, and the Delete key for deleting forward. - (and (null window-system) + (and (null initial-window-system) (eq tty-erase-char 8))) (setq-default normal-erase-is-backspace t) (normal-erase-is-backspace-mode 1))) @@ -756,11 +780,10 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Register default TTY colors for the case the terminal hasn't a ;; terminal init file. - (unless (memq window-system '(x w32)) - ;; We do this regardles of whether the terminal supports colors - ;; or not, since they can switch that support on or off in - ;; mid-session by setting the tty-color-mode frame parameter. - (tty-register-default-colors)) + ;; We do this regardles of whether the terminal supports colors + ;; or not, since they can switch that support on or off in + ;; mid-session by setting the tty-color-mode frame parameter. + (tty-register-default-colors) ;; Record whether the tool-bar is present before the user and site ;; init files are processed. frame-notice-user-settings uses this @@ -954,7 +977,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. (unless (or noninteractive - window-system + initial-window-system (null term-file-prefix)) (let ((term (getenv "TERM")) hyphend) diff --git a/lisp/talk.el b/lisp/talk.el index bbe9c949dde..6d542b0f99b 100644 --- a/lisp/talk.el +++ b/lisp/talk.el @@ -45,6 +45,20 @@ Each element has the form (DISPLAY FRAME BUFFER).") ;; Add the new buffers to all talk frames. (talk-update-buffers)) +;;;###autoload +(defun talk () + "Connect to the Emacs talk group from the current X display or tty frame." + (interactive) + (let ((type (frame-live-p (selected-frame)))) + (if (eq type t) + ;; Termcap frame + (talk-add-tty-frame (selected-frame)) + (if (eq type 'x) + ;; X frame + (talk-add-display (frame-parameter (selected-frame) 'display)) + (error "Could not determine frame type")))) + (talk-update-buffers)) + (defun talk-add-display (display) (let* ((elt (assoc display talk-display-alist)) (name (concat "*talk-" display "*")) @@ -56,6 +70,21 @@ Each element has the form (DISPLAY FRAME BUFFER).") (setq talk-display-alist (cons (list display frame buffer) (delq elt talk-display-alist))))) +(defun talk-add-tty-frame (frame) + (let* ((elt (assoc (frame-tty-name frame) talk-display-alist)) + (name (concat "*talk-" (frame-tty-name frame) "*")) + buffer) + (if (not (and elt (buffer-name (get-buffer (setq buffer (nth 2 elt)))))) + (setq buffer (get-buffer-create name))) + (add-to-list 'delete-tty-after-functions 'talk-handle-delete-tty) + (setq talk-display-alist + (cons (list (frame-tty-name frame) frame buffer) (delq elt talk-display-alist))))) + +(defun talk-handle-delete-tty (tty) + (let ((elt (assoc tty talk-display-alist))) + (setq talk-display-alist (delq elt talk-display-alist)) + (talk-update-buffers))) + (defun talk-disconnect () "Disconnect this display from the Emacs talk group." (interactive) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 4b419a57a97..da5ac04a6c9 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -24,10 +24,16 @@ ;;; Commentary: -;; X-win.el: this file is loaded from ../lisp/startup.el when it recognizes -;; that X windows are to be used. Command line switches are parsed and those -;; pertaining to X are processed and removed from the command line. The -;; X display is opened and hooks are set for popping up the initial window. +;; X-win.el: this file defines functions to initialize the X window +;; system and process X-specific command line parameters before +;; creating the first X frame. + +;; Note that contrary to previous Emacs versions, the act of loading +;; this file should not have the side effect of initializing the +;; window system or processing command line arguments (this file is +;; now loaded in loadup.el). See the variables +;; `handle-args-function-alist' and +;; `window-system-initialization-alist' for more details. ;; startup.el will then examine startup files, and eventually call the hooks ;; which create the first window(s). @@ -66,7 +72,7 @@ ;; An alist of X options and the function which handles them. See ;; ../startup.el. -(if (not (eq window-system 'x)) +(if (not (fboundp 'x-create-frame)) (error "%s: Loading x-win.el but not compiled for X" (invocation-name))) (require 'frame) @@ -1160,9 +1166,6 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") ;;;; Function keys -(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame - global-map) - ;; Map certain keypad keys into ASCII characters ;; that people usually expect. (define-key function-key-map [backspace] [127]) @@ -2237,7 +2240,7 @@ order until succeed.") (if text (remove-text-properties 0 (length text) '(foreign-selection nil) text)) text)) - + ;;; Return the value of the current X selection. ;;; Consult the selection, and the cut buffer. Treat empty strings ;;; as if they were unset. @@ -2328,146 +2331,153 @@ order until succeed.") (or clip-text primary-text cut-text) )) - -;;; Do the actual X Windows setup here; the above code just defines -;;; functions and variables that we use now. - -(setq command-line-args (x-handle-args command-line-args)) - -;;; Make sure we have a valid resource name. -(or (stringp x-resource-name) - (let (i) - (setq x-resource-name (invocation-name)) - - ;; Change any . or * characters in x-resource-name to hyphens, - ;; so as not to choke when we use it in X resource queries. - (while (setq i (string-match "[.*]" x-resource-name)) - (aset x-resource-name i ?-)))) - -(x-open-connection (or x-display-name - (setq x-display-name (getenv "DISPLAY"))) - x-command-line-resources - ;; Exit Emacs with fatal error if this fails. - t) - -(setq frame-creation-function 'x-create-frame-with-faces) - -(setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) - x-cut-buffer-max)) - -;; Setup the default fontset. -(setup-default-fontset) - -;; Create the standard fontset. -(create-fontset-from-fontset-spec standard-fontset-spec t) - -;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...). -(create-fontset-from-x-resource) - -;; Try to create a fontset from a font specification which comes -;; from initial-frame-alist, default-frame-alist, or X resource. -;; A font specification in command line argument (i.e. -fn XXXX) -;; should be already in default-frame-alist as a `font' -;; parameter. However, any font specifications in site-start -;; library, user's init file (.emacs), and default.el are not -;; yet handled here. - -(let ((font (or (cdr (assq 'font initial-frame-alist)) - (cdr (assq 'font default-frame-alist)) - (x-get-resource "font" "Font"))) - xlfd-fields resolved-name) - (if (and font - (not (query-fontset font)) - (setq resolved-name (x-resolve-font-name font)) - (setq xlfd-fields (x-decompose-font-name font))) - (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum)) - (new-fontset font (x-complement-fontset-spec xlfd-fields nil)) - ;; Create a fontset from FONT. The fontset name is - ;; generated from FONT. - (create-fontset-from-ascii-font font resolved-name "startup")))) - -;; Apply a geometry resource to the initial frame. Put it at the end -;; of the alist, so that anything specified on the command line takes -;; precedence. -(let* ((res-geometry (x-get-resource "geometry" "Geometry")) - parsed) - (if res-geometry - (progn - (setq parsed (x-parse-geometry res-geometry)) - ;; If the resource specifies a position, - ;; call the position and size "user-specified". - (if (or (assq 'top parsed) (assq 'left parsed)) - (setq parsed (cons '(user-position . t) - (cons '(user-size . t) parsed)))) - ;; All geometry parms apply to the initial frame. - (setq initial-frame-alist (append initial-frame-alist parsed)) - ;; The size parms apply to all frames. - (if (assq 'height parsed) - (setq default-frame-alist - (cons (cons 'height (cdr (assq 'height parsed))) - default-frame-alist))) - (if (assq 'width parsed) - (setq default-frame-alist - (cons (cons 'width (cdr (assq 'width parsed))) - default-frame-alist)))))) - -;; Check the reverseVideo resource. -(let ((case-fold-search t)) - (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) - (if (and rv - (string-match "^\\(true\\|yes\\|on\\)$" rv)) - (setq default-frame-alist - (cons '(reverse . t) default-frame-alist))))) +(defun x-clipboard-yank () + "Insert the clipboard contents, or the last stretch of killed text." + (interactive) + (let ((clipboard-text (x-get-selection 'CLIPBOARD)) + (x-select-enable-clipboard t)) + (if (and clipboard-text (> (length clipboard-text) 0)) + (kill-new clipboard-text)) + (yank))) -;; Set x-selection-timeout, measured in milliseconds. -(let ((res-selection-timeout - (x-get-resource "selectionTimeout" "SelectionTimeout"))) - (setq x-selection-timeout 20000) - (if res-selection-timeout - (setq x-selection-timeout (string-to-number res-selection-timeout)))) + +;;; Window system initialization. (defun x-win-suspend-error () (error "Suspending an Emacs running under X makes no sense")) -(add-hook 'suspend-hook 'x-win-suspend-error) -;;; Arrange for the kill and yank functions to set and check the clipboard. -(setq interprogram-cut-function 'x-select-text) -(setq interprogram-paste-function 'x-cut-buffer-or-selection-value) +(defvar x-initialized nil + "Non-nil if the X window system has been initialized.") + +(defun x-initialize-window-system () + "Initialize Emacs for X frames and open the first connection to an X server." + ;; Make sure we have a valid resource name. + (or (stringp x-resource-name) + (let (i) + (setq x-resource-name (invocation-name)) + + ;; Change any . or * characters in x-resource-name to hyphens, + ;; so as not to choke when we use it in X resource queries. + (while (setq i (string-match "[.*]" x-resource-name)) + (aset x-resource-name i ?-)))) + + (x-open-connection (or x-display-name + (setq x-display-name (getenv "DISPLAY"))) + x-command-line-resources + ;; Exit Emacs with fatal error if this fails and we + ;; are the initial display. + (eq initial-window-system 'x)) + + (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) + x-cut-buffer-max)) + + ;; Setup the default fontset. + (setup-default-fontset) + + ;; Create the standard fontset. + (create-fontset-from-fontset-spec standard-fontset-spec t) + + ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...). + (create-fontset-from-x-resource) + + ;; Try to create a fontset from a font specification which comes + ;; from initial-frame-alist, default-frame-alist, or X resource. + ;; A font specification in command line argument (i.e. -fn XXXX) + ;; should be already in default-frame-alist as a `font' + ;; parameter. However, any font specifications in site-start + ;; library, user's init file (.emacs), and default.el are not + ;; yet handled here. + + (let ((font (or (cdr (assq 'font initial-frame-alist)) + (cdr (assq 'font default-frame-alist)) + (x-get-resource "font" "Font"))) + xlfd-fields resolved-name) + (if (and font + (not (query-fontset font)) + (setq resolved-name (x-resolve-font-name font)) + (setq xlfd-fields (x-decompose-font-name font))) + (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum)) + (new-fontset font (x-complement-fontset-spec xlfd-fields nil)) + ;; Create a fontset from FONT. The fontset name is + ;; generated from FONT. + (create-fontset-from-ascii-font font resolved-name "startup")))) + + ;; Apply a geometry resource to the initial frame. Put it at the end + ;; of the alist, so that anything specified on the command line takes + ;; precedence. + (let* ((res-geometry (x-get-resource "geometry" "Geometry")) + parsed) + (if res-geometry + (progn + (setq parsed (x-parse-geometry res-geometry)) + ;; If the resource specifies a position, + ;; call the position and size "user-specified". + (if (or (assq 'top parsed) (assq 'left parsed)) + (setq parsed (cons '(user-position . t) + (cons '(user-size . t) parsed)))) + ;; All geometry parms apply to the initial frame. + (setq initial-frame-alist (append initial-frame-alist parsed)) + ;; The size parms apply to all frames. + (if (assq 'height parsed) + (setq default-frame-alist + (cons (cons 'height (cdr (assq 'height parsed))) + default-frame-alist))) + (if (assq 'width parsed) + (setq default-frame-alist + (cons (cons 'width (cdr (assq 'width parsed))) + default-frame-alist)))))) + + ;; Check the reverseVideo resource. + (let ((case-fold-search t)) + (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) + (if (and rv + (string-match "^\\(true\\|yes\\|on\\)$" rv)) + (setq default-frame-alist + (cons '(reverse . t) default-frame-alist))))) -;;; Turn off window-splitting optimization; X is usually fast enough -;;; that this is only annoying. -(setq split-window-keep-point t) + ;; Set x-selection-timeout, measured in milliseconds. + (let ((res-selection-timeout + (x-get-resource "selectionTimeout" "SelectionTimeout"))) + (setq x-selection-timeout 20000) + (if res-selection-timeout + (setq x-selection-timeout (string-to-number res-selection-timeout)))) -;; Don't show the frame name; that's redundant with X. -(setq-default mode-line-frame-identification " ") + ;; Don't let Emacs suspend under X. + (add-hook 'suspend-hook 'x-win-suspend-error) -;; Motif direct handling of f10 wasn't working right, -;; So temporarily we've turned it off in lwlib-Xm.c -;; and turned the Emacs f10 back on. -;; ;; Motif normally handles f10 itself, so don't try to handle it a second time. -;; (if (featurep 'motif) -;; (global-set-key [f10] 'ignore)) + ;; Arrange for the kill and yank functions to set and check the clipboard. + (setq interprogram-cut-function 'x-select-text) + (setq interprogram-paste-function 'x-cut-buffer-or-selection-value) -;; Turn on support for mouse wheels. -(mouse-wheel-mode 1) + ;; Turn off window-splitting optimization; X is usually fast enough + ;; that this is only annoying. + (setq split-window-keep-point t) + ;; Motif direct handling of f10 wasn't working right, + ;; So temporarily we've turned it off in lwlib-Xm.c + ;; and turned the Emacs f10 back on. + ;; ;; Motif normally handles f10 itself, so don't try to handle it a second time. + ;; (if (featurep 'motif) + ;; (global-set-key [f10] 'ignore)) -;; Enable CLIPBOARD copy/paste through menu bar commands. -(menu-bar-enable-clipboard) + ;; Turn on support for mouse wheels. + (mouse-wheel-mode 1) -;; Override Paste so it looks at CLIPBOARD first. -(defun x-clipboard-yank () - "Insert the clipboard contents, or the last stretch of killed text." - (interactive) - (let ((clipboard-text (x-get-selection 'CLIPBOARD)) - (x-select-enable-clipboard t)) - (if (and clipboard-text (> (length clipboard-text) 0)) - (kill-new clipboard-text)) - (yank))) + ;; Enable CLIPBOARD copy/paste through menu bar commands. + (menu-bar-enable-clipboard) + + ;; Override Paste so it looks at CLIPBOARD first. + (define-key menu-bar-edit-menu [paste] + (cons "Paste" (cons "Paste text from clipboard or kill ring" + 'x-clipboard-yank))) + + (setq x-initialized t)) + +(add-to-list 'handle-args-function-alist '(x . x-handle-args)) +(add-to-list 'frame-creation-function-alist '(x . x-create-frame-with-faces)) +(add-to-list 'window-system-initialization-alist '(x . x-initialize-window-system)) -(define-key menu-bar-edit-menu [paste] - (cons "Paste" (cons "Paste text from clipboard or kill ring" - 'x-clipboard-yank))) +(provide 'x-win) ;; Initiate drag and drop (add-hook 'after-make-frame-functions 'x-dnd-init-frame) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index d66646876b1..5c387cb4148 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -123,7 +123,7 @@ for the currently selected frame. The first 16 colors are taken from `xterm-standard-colors', which see, while the rest are computed assuming either the 88- or 256-color standard color scheme supported by latest versions of xterm." - (let* ((ncolors (display-color-cells)) + (let* ((ncolors (display-color-cells (selected-frame))) (colors xterm-standard-colors) (color (car colors))) (if (> ncolors 0) diff --git a/lisp/type-break.el b/lisp/type-break.el index 86e5199e730..83e6a4cebff 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -8,7 +8,7 @@ ;; Status: Works in GNU Emacs 19.25 or later, some versions of XEmacs ;; Created: 1994-07-13 -;; $Id: type-break.el,v 1.28 2003/05/28 11:25:44 rms Exp $ +;; $Id: type-break.el,v 1.29 2003/09/01 15:45:17 miles Exp $ ;; This file is part of GNU Emacs. diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index 400a1ffb105..feb73dd5c31 100644 --- a/lisp/vc-cvs.el +++ b/lisp/vc-cvs.el @@ -5,7 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> -;; $Id: vc-cvs.el,v 1.66 2003/10/01 13:22:53 fx Exp $ +;; $Id: vc-cvs.el,v 1.67 2004/01/20 17:41:18 uid65624 Exp $ ;; This file is part of GNU Emacs. diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index c9603d68e25..01c9e2f4289 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -6,7 +6,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> -;; $Id: vc-hooks.el,v 1.159 2003/08/30 10:56:38 eliz Exp $ +;; $Id: vc-hooks.el,v 1.160 2003/09/01 15:45:17 miles Exp $ ;; This file is part of GNU Emacs. diff --git a/lisp/vc-rcs.el b/lisp/vc-rcs.el index ba4905897ae..1e86d0a06df 100644 --- a/lisp/vc-rcs.el +++ b/lisp/vc-rcs.el @@ -5,7 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> -;; $Id: vc-rcs.el,v 1.37 2003/05/08 19:24:56 monnier Exp $ +;; $Id: vc-rcs.el,v 1.38 2003/09/01 15:45:17 miles Exp $ ;; This file is part of GNU Emacs. diff --git a/lisp/vc-sccs.el b/lisp/vc-sccs.el index c81d3e87aaa..ac867fc2f31 100644 --- a/lisp/vc-sccs.el +++ b/lisp/vc-sccs.el @@ -5,7 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> -;; $Id: vc-sccs.el,v 1.23 2003/08/12 18:01:21 spiegel Exp $ +;; $Id: vc-sccs.el,v 1.24 2003/09/01 15:45:17 miles Exp $ ;; This file is part of GNU Emacs. diff --git a/lisp/vc.el b/lisp/vc.el index 3c04dd98b9d..5ef5711331d 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -7,7 +7,7 @@ ;; Maintainer: Andre Spiegel <spiegel@gnu.org> ;; Keywords: tools -;; $Id: vc.el,v 1.366 2004/02/07 00:37:13 uid65598 Exp $ +;; $Id: vc.el,v 1.367 2004/02/08 22:42:42 uid65629 Exp $ ;; This file is part of GNU Emacs. diff --git a/lisp/version.el b/lisp/version.el index 42dbb3f9c25..6c99d8de1d6 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -55,8 +55,8 @@ to the system configuration; look at `system-configuration' instead." (interactive "P") (let ((version-string (format (if (not (interactive-p)) - "GNU Emacs %s (%s%s%s)\n of %s on %s" - "GNU Emacs %s (%s%s%s) of %s on %s") + "GNU Emacs %s (%s%s%s%s)\n of %s on %s" + "GNU Emacs %s (%s%s%s%s) of %s on %s") emacs-version system-configuration (cond ((featurep 'motif) @@ -70,6 +70,7 @@ to the system configuration; look at `system-configuration' instead." (format ", %s scroll bars" (capitalize (symbol-name x-toolkit-scroll-bars))) "") + (if (featurep 'multi-tty) ", multi-tty" "") (format-time-string "%Y-%m-%d" emacs-build-time) emacs-build-system))) (if here diff --git a/lisp/whitespace.el b/lisp/whitespace.el index edff77211e0..9858a5ad137 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -5,7 +5,7 @@ ;; Author: Rajesh Vaidheeswarran <rv@gnu.org> ;; Keywords: convenience -;; $Id: whitespace.el,v 1.26 2003/09/01 15:45:18 miles Exp $ +;; $Id: whitespace.el,v 1.27 2003/09/29 18:05:31 rv Exp $ ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 91ca053afa2..32645bd6012 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -142,8 +142,9 @@ any protocol specific data.") (defun x-dnd-init-frame (&optional frame) "Setup drag and drop for FRAME (i.e. create appropriate properties)." - (x-dnd-init-xdnd-for-frame frame) - (x-dnd-init-motif-for-frame frame)) + (when (eq 'x (window-system frame)) + (x-dnd-init-xdnd-for-frame frame) + (x-dnd-init-motif-for-frame frame))) (defun x-dnd-get-state-cons-for-frame (frame-or-window) "Return the entry in x-dnd-current-state for a frame or window." |