summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/allout.el2
-rw-r--r--lisp/bindings.el2
-rw-r--r--lisp/cus-face.el13
-rw-r--r--lisp/faces.el68
-rw-r--r--lisp/font-lock.el2
-rw-r--r--lisp/frame.el111
-rw-r--r--lisp/international/mule-cmds.el169
-rw-r--r--lisp/loadup.el13
-rw-r--r--lisp/server.el629
-rw-r--r--lisp/simple.el4
-rw-r--r--lisp/startup.el106
-rw-r--r--lisp/subr.el12
-rw-r--r--lisp/talk.el29
-rw-r--r--lisp/term/rxvt.el4
-rw-r--r--lisp/term/x-win.el286
-rw-r--r--lisp/term/xterm.el10
-rw-r--r--lisp/vc-cvs.el2
-rw-r--r--lisp/vc-hooks.el2
-rw-r--r--lisp/vc-rcs.el2
-rw-r--r--lisp/vc-sccs.el2
-rw-r--r--lisp/vc.el2
-rw-r--r--lisp/version.el5
-rw-r--r--lisp/x-dnd.el5
23 files changed, 998 insertions, 482 deletions
diff --git a/lisp/allout.el b/lisp/allout.el
index 903574e4ade..dd4495cfa84 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -507,7 +507,7 @@ behavior."
;;;_ : Version
;;;_ = allout-version
(defvar allout-version
- (let ((rcs-rev "$Revision: 1.49 $"))
+ (let ((rcs-rev "$Revision$"))
(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 b3ea8e562ac..68c4ec433f7 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/cus-face.el b/lisp/cus-face.el
index e3134e8f1ea..0bd3387d3c7 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -39,15 +39,18 @@
(when (fboundp 'facep)
(unless (facep face)
;; If the user has already created the face, respect that.
- (let ((value (or (get face 'saved-face) spec)))
+ (let ((value (or (get face 'saved-face) spec))
+ (have-window-system (memq initial-window-system '(x w32))))
;; Create global face.
(make-empty-face face)
;; Create frame-local faces
(dolist (frame (frame-list))
- (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/faces.el b/lisp/faces.el
index 06cf16e79c2..15e0f2549a8 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -902,7 +902,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.
@@ -911,7 +911,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))
@@ -924,7 +924,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)
@@ -1042,7 +1042,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"))))
@@ -1295,14 +1295,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))
@@ -1512,22 +1512,32 @@ 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))
+ (tty-type (frame-parameter frame 'tty-type))
(bg-mode
(cond (frame-background-mode)
(bg-resource
(intern (downcase bg-resource)))
- ((and (null window-system) (null bg-color))
- ;; No way to determine this automatically (?).
- 'dark)
- ;; Unspecified frame background color can only happen
- ;; on tty's.
- ((member bg-color '(unspecified "unspecified-bg"))
- 'dark)
+ ((and (null (window-system frame))
+ ;; Unspecified frame background color can only
+ ;; happen on tty's.
+ (member bg-color '(nil unspecified "unspecified-bg")))
+ ;; There is no way to determine the background mode
+ ;; automatically, so we make a guess based on the
+ ;; terminal type.
+ (if (and tty-type
+ (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
+ tty-type))
+ 'light
+ 'dark))
((equal bg-color "unspecified-fg") ; inverted colors
- 'light)
+ (if (and tty-type
+ (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
+ tty-type))
+ 'dark
+ 'light))
((>= (apply '+ (x-color-values bg-color frame))
;; Just looking at the screen, colors whose
;; values add up to .6 of the white total
@@ -1536,7 +1546,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)
@@ -1633,7 +1643,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
@@ -1643,6 +1653,11 @@ Value is the new frame created."
(if (or (null frame-list) (null visibility-spec))
(make-frame-visible frame)
(modify-frame-parameters frame (list visibility-spec)))
+ ;; Arrange for the kill and yank functions to set and check the clipboard.
+ (modify-frame-parameters
+ frame '((interprogram-cut-function . x-select-text)))
+ (modify-frame-parameters
+ frame '((interprogram-paste-function . x-cut-buffer-or-selection-value)))
(setq success t))
(unless success
(delete-frame frame)))
@@ -1671,7 +1686,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)))
@@ -1722,10 +1737,25 @@ created."
(let ((frame (make-terminal-frame parameters))
success)
(unwind-protect
- (progn
+ (with-selected-frame frame
(tty-handle-reverse-video frame (frame-parameters frame))
(frame-set-background-mode frame)
(face-set-after-frame-default frame)
+ ;; Load library for our terminal type.
+ ;; User init file can set term-file-prefix to nil to prevent this.
+ (unless (null term-file-prefix)
+ (let ((term (cdr (assq 'tty-type parameters)))
+ hyphend)
+ (while (and term
+ (not (load (concat term-file-prefix term) t t)))
+ ;; Strip off last hyphen and what follows, then try again
+ (setq term
+ (if (setq hyphend (string-match "[-_][^-_]+$" term))
+ (substring term 0 hyphend)
+ nil)))))
+ ;; Make sure the kill and yank functions do not touch the X clipboard.
+ (modify-frame-parameters frame '((interprogram-cut-function . nil)))
+ (modify-frame-parameters frame '((interprogram-paste-function . nil)))
(setq success t))
(unless success
(delete-frame frame)))
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 033bf20bf71..061ab23872b 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1932,7 +1932,7 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
"with-current-buffer" "with-electric-help"
"with-local-quit" "with-no-warnings"
"with-output-to-string" "with-output-to-temp-buffer"
- "with-selected-window" "with-syntax-table"
+ "with-selected-window" "with-selected-frame" "with-syntax-table"
"with-temp-buffer" "with-temp-file" "with-temp-message"
"with-timeout" "with-timeout-handler") t)
"\\>")
diff --git a/lisp/frame.el b/lisp/frame.el
index 446bda55775..ad88102af65 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -27,10 +27,28 @@
;;; 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.")
+
+(defvar window-system-default-frame-alist nil
+ "Alist of window-system dependent default frame parameters.
+These may be set in your init file, like this:
+
+ ;; Disable menubar and toolbar on the console, but enable them under X.
+ (setq window-system-default-frame-alist
+ '((x (menu-bar-lines . 1) (tool-bar-lines . 1))
+ (nil (menu-bar-lines . 0) (tool-bar-lines . 0))))
+
+Also see `default-frame-alist'.")
;; The initial value given here used to ask for a minibuffer.
;; But that's not necessary, because the default is to have one.
@@ -187,7 +205,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)
@@ -204,6 +224,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)))
@@ -216,18 +239,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.")
@@ -277,7 +289,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
@@ -286,7 +298,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)
@@ -570,7 +582,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."
@@ -610,12 +635,24 @@ 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))
+ (modify-frame-parameters frame
+ (cdr (assq w window-system-default-frame-alist)))
(run-hook-with-args 'after-make-frame-functions frame)
frame))
@@ -688,9 +725,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))))
@@ -727,6 +764,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
@@ -760,9 +813,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))))
@@ -1119,7 +1172,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.
@@ -1351,6 +1404,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/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 0d4abab120c..95177fdb954 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -2300,6 +2300,115 @@ is returned. Thus, for instance, if charset \"ISO8859-2\",
(pop cs)))
(if c (coding-system-base c)))))
+(defun set-locale-translation-file-name ()
+ "Set up the locale-translation-file-name on the current system.
+
+This needs to be done at runtime for the sake of binaries
+possibly transported to a system without X."
+ (setq locale-translation-file-name
+ (let ((files
+ '("/usr/lib/X11/locale/locale.alias" ; e.g. X11R6.4
+ "/usr/X11R6/lib/X11/locale/locale.alias" ; XFree86, e.g. RedHat 4.2
+ "/usr/openwin/lib/locale/locale.alias" ; e.g. Solaris 2.6
+ ;;
+ ;; The following name appears after the X-related names above,
+ ;; since the X-related names are what X actually uses.
+ "/usr/share/locale/locale.alias" ; GNU/Linux sans X
+ )))
+ (while (and files (not (file-exists-p (car files))))
+ (setq files (cdr files)))
+ (car files))))
+
+(defun get-locale-real-name (&optional locale-name)
+ "Return the canonicalized name of locale LOCALE-NAME.
+
+LOCALE-NAME should be a string which is the name of a locale supported
+by the system. Often it is of the form xx_XX.CODE, where xx is a
+language, XX is a country, and CODE specifies a character set and
+coding system. For example, the locale name \"ja_JP.EUC\" might name
+a locale for Japanese in Japan using the `japanese-iso-8bit'
+coding-system. The name may also have a modifier suffix, e.g. `@euro'
+or `@cyrillic'.
+
+If LOCALE-NAME is nil, its value is taken from the environment
+variables LC_ALL, LC_CTYPE and LANG (the first one that is set).
+On server frames, the environment of the emacsclient process is
+used.
+
+See also `set-locale-environment'."
+ (unless locale-name
+ ;; Use the first of these three environment variables
+ ;; that has a nonempty value.
+ (let ((vars '("LC_ALL" "LC_CTYPE" "LANG")))
+ (while (and vars
+ (= 0 (length locale-name))) ; nil or empty string
+ (setq locale-name (server-getenv (pop vars))))))
+
+ (when locale-name
+ ;; Translate "swedish" into "sv_SE.ISO8859-1", and so on,
+ ;; using the translation file that many systems have.
+ (when locale-translation-file-name
+ (with-temp-buffer
+ (insert-file-contents locale-translation-file-name)
+ (when (re-search-forward
+ (concat "^" (regexp-quote locale-name) ":?[ \t]+") nil t)
+ (setq locale-name (buffer-substring (point) (line-end-position)))))))
+ locale-name)
+
+(defun get-locale-coding-system (&optional locale)
+ "Return the coding system corresponding to locale LOCALE."
+ (setq locale (or locale (get-locale-real-name nil)))
+ (when locale
+ (or (locale-name-match locale locale-preferred-coding-systems)
+ (when locale
+ (if (string-match "\\.\\([^@]+\\)" locale)
+ (locale-charset-to-coding-system
+ (match-string 1 locale)))))))
+
+(defun configure-display-for-locale (&optional locale)
+ "Set up terminal for locale LOCALE.
+
+The display table, the terminal coding system and the keyboard
+coding system of the current display device are set up for the
+given locale."
+ (setq locale (or locale (get-locale-real-name nil)))
+
+ (when locale
+ (let ((language-name
+ (locale-name-match locale locale-language-names))
+ (charset-language-name
+ (locale-name-match locale locale-charset-language-names))
+ (coding-system
+ (get-locale-coding-system locale)))
+
+ ;; Give preference to charset-language-name over language-name.
+ (if (and charset-language-name
+ (not
+ (equal (get-language-info language-name 'charset)
+ (get-language-info charset-language-name 'charset))))
+ (setq language-name charset-language-name))
+
+ (when language-name
+
+ ;; If default-enable-multibyte-characters is nil,
+ ;; we are using single-byte characters,
+ ;; so the display table and terminal coding system are irrelevant.
+ (when default-enable-multibyte-characters
+ ;; Override default-terminal-coding-system in case the
+ ;; display coding can not be derived from the language
+ ;; environment.
+ (let ((default-terminal-coding-system coding-system))
+ (set-display-table-and-terminal-coding-system language-name)))
+
+ ;; Set the `keyboard-coding-system' if appropriate (tty
+ ;; only). At least X and MS Windows can generate
+ ;; multilingual input.
+ (unless window-system
+ (let ((kcs (or coding-system
+ (car (get-language-info language-name
+ 'coding-system)))))
+ (if kcs (set-keyboard-coding-system kcs))))))))
+
;; Fixme: This ought to deal with the territory part of the locale
;; too, for setting things such as calendar holidays, ps-print paper
;; size, spelling dictionary.
@@ -2319,6 +2428,8 @@ or `@cyrillic'.
If LOCALE-NAME is nil, its value is taken from the environment
variables LC_ALL, LC_CTYPE and LANG (the first one that is set).
+On server frames, the environment of the emacsclient process is
+used.
The locale names supported by your system can typically be found in a
directory named `/usr/share/locale' or `/usr/lib/locale'. LOCALE-NAME
@@ -2329,43 +2440,10 @@ See also `locale-charset-language-names', `locale-language-names',
`locale-preferred-coding-systems' and `locale-coding-system'."
(interactive "sSet environment for locale: ")
- ;; Do this at runtime for the sake of binaries possibly transported
- ;; to a system without X.
- (setq locale-translation-file-name
- (let ((files
- '("/usr/lib/X11/locale/locale.alias" ; e.g. X11R6.4
- "/usr/X11R6/lib/X11/locale/locale.alias" ; XFree86, e.g. RedHat 4.2
- "/usr/openwin/lib/locale/locale.alias" ; e.g. Solaris 2.6
- ;;
- ;; The following name appears after the X-related names above,
- ;; since the X-related names are what X actually uses.
- "/usr/share/locale/locale.alias" ; GNU/Linux sans X
- )))
- (while (and files (not (file-exists-p (car files))))
- (setq files (cdr files)))
- (car files)))
-
- (let ((locale locale-name))
-
- (unless locale
- ;; Use the first of these three environment variables
- ;; that has a nonempty value.
- (let ((vars '("LC_ALL" "LC_CTYPE" "LANG")))
- (while (and vars
- (= 0 (length locale))) ; nil or empty string
- (setq locale (getenv (pop vars))))))
+ (let ((locale (get-locale-real-name locale-name)))
(when locale
- ;; Translate "swedish" into "sv_SE.ISO8859-1", and so on,
- ;; using the translation file that many systems have.
- (when locale-translation-file-name
- (with-temp-buffer
- (insert-file-contents locale-translation-file-name)
- (when (re-search-forward
- (concat "^" (regexp-quote locale) ":?[ \t]+") nil t)
- (setq locale (buffer-substring (point) (line-end-position))))))
-
;; Leave the system locales alone if the caller did not specify
;; an explicit locale name, as their defaults are set from
;; LC_MESSAGES and LC_TIME, not LC_CTYPE, and the user might not
@@ -2376,16 +2454,14 @@ See also `locale-charset-language-names', `locale-language-names',
(setq locale (downcase locale))
+ (configure-display-for-locale locale)
+
(let ((language-name
(locale-name-match locale locale-language-names))
(charset-language-name
(locale-name-match locale locale-charset-language-names))
(coding-system
- (or (locale-name-match locale locale-preferred-coding-systems)
- (when locale
- (if (string-match "\\.\\([^@]+\\)" locale)
- (locale-charset-to-coding-system
- (match-string 1 locale)))))))
+ (get-locale-coding-system locale)))
;; Give preference to charset-language-name over language-name.
(if (and charset-language-name
@@ -2400,21 +2476,6 @@ See also `locale-charset-language-names', `locale-language-names',
;; to do it for both unibyte and multibyte modes.
(set-language-environment language-name)
- ;; If default-enable-multibyte-characters is nil,
- ;; we are using single-byte characters,
- ;; so the display table and terminal coding system are irrelevant.
- (when default-enable-multibyte-characters
- (set-display-table-and-terminal-coding-system language-name))
-
- ;; Set the `keyboard-coding-system' if appropriate (tty
- ;; only). At least X and MS Windows can generate
- ;; multilingual input.
- (unless window-system
- (let ((kcs (or coding-system
- (car (get-language-info language-name
- 'coding-system)))))
- (if kcs (set-keyboard-coding-system kcs))))
-
(setq locale-coding-system
(car (get-language-info language-name 'coding-priority))))
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 15f47440aed..bb00fe8fbbb 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")
@@ -162,6 +163,7 @@
(load "vmsproc")))
(load "abbrev")
(load "buff-menu")
+(load "server") ; server-getenv is used throughout the terminal initialization code
(if (eq system-type 'vax-vms)
(progn
(load "vms-patch")))
@@ -189,6 +191,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/server.el b/lisp/server.el
index fe2fc0f59f4..71db27cc20d 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -8,6 +8,7 @@
;; Keywords: processes
;; Changes by peck@sun.com and by rms.
+;; Overhaul by Karoly Lorentey <lorentey@elte.hu> for multi-tty support.
;; This file is part of GNU Emacs.
@@ -102,9 +103,8 @@
(defvar server-clients nil
"List of current server clients.
-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.")
+Each element is (PROC PROPERTIES...) where PROC is a process object,
+and PROPERTIES is an association list of client properties.")
(defvar server-buffer-clients nil
"List of client ids for clients requesting editing of current buffer.")
@@ -161,8 +161,95 @@ are done with it in the server.")
(defvar server-name "server")
-(defvar server-socket-dir
- (format "/tmp/emacs%d" (user-uid)))
+(defvar server-socket-dir nil
+ "The directory in which to place the server socket.
+Initialized by `server-start'.")
+
+(defun server-client (proc)
+ "Return the Emacs client corresponding to PROC.
+PROC must be a process object.
+The car of the result is PROC; the cdr is an association list.
+See `server-client-get' and `server-client-set'."
+ (assq proc server-clients))
+
+(defun server-client-get (client property)
+ "Get the value of PROPERTY in CLIENT.
+CLIENT may be a process object, or a client returned by `server-client'.
+Return nil if CLIENT has no such property."
+ (or (listp client) (setq client (server-client client)))
+ (cdr (assq property (cdr client))))
+
+(defun server-client-set (client property value)
+ "Set the PROPERTY to VALUE in CLIENT, and return VALUE.
+CLIENT may be a process object, or a client returned by `server-client'."
+ (let (p proc)
+ (if (listp client)
+ (setq proc (car client))
+ (setq proc client
+ client (server-client client)))
+ (setq p (assq property client))
+ (cond
+ (p (setcdr p value))
+ (client (setcdr client (cons (cons property value) (cdr client))))
+ (t (setq server-clients
+ `((,proc (,property . ,value)) . ,server-clients))))
+ value))
+
+(defun server-clients-with (property value)
+ "Return a list of clients with PROPERTY set to VALUE."
+ (let (result)
+ (dolist (client server-clients result)
+ (when (equal value (server-client-get client property))
+ (setq result (cons (car client) result))))))
+
+(defun server-add-client (proc)
+ "Create a client for process PROC, if it doesn't already have one.
+New clients have no properties."
+ (unless (server-client proc)
+ (setq server-clients (cons (cons proc nil)
+ server-clients))))
+
+(defun server-delete-client (client &optional noframe)
+ "Delete CLIENT, including its buffers, displays and frames.
+If NOFRAME is non-nil, let the frames live. (To be used from
+`delete-frame-functions'."
+ ;; Force a new lookup of client (prevents infinite recursion).
+ (setq client (server-client
+ (if (listp client) (car client) client)))
+ (let ((proc (car client))
+ (buffers (server-client-get client 'buffers)))
+ (when client
+ (setq server-clients (delq client server-clients))
+
+ (dolist (buf buffers)
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ ;; Remove PROC from the clients of each buffer.
+ (setq server-buffer-clients (delq proc server-buffer-clients))
+ ;; Kill the buffer if necessary.
+ (when (and (null server-buffer-clients)
+ (or (and server-kill-new-buffers
+ (not server-existing-buffer))
+ (server-temp-file-p)))
+ (kill-buffer (current-buffer))))))
+
+ ;; Delete the client's tty.
+ (let ((tty (server-client-get client 'tty)))
+ (when (and tty (server-tty-live-p tty))
+ (delete-tty tty)))
+
+ ;; Delete the client's frames.
+ (unless noframe
+ (dolist (frame (frame-list))
+ (if (and (frame-live-p frame)
+ (equal (car client) (frame-parameter frame 'client)))
+ (delete-frame frame))))
+
+ ;; Delete the client's process.
+ (if (eq (process-status (car client)) 'open)
+ (delete-process (car client)))
+
+ (server-log "Deleted" proc))))
(defun server-log (string &optional client)
"If a *server* buffer exists, write STRING to it for logging purposes."
@@ -170,26 +257,46 @@ are done with it in the server.")
(with-current-buffer "*server*"
(goto-char (point-max))
(insert (current-time-string)
- (if client (format " %s:" client) " ")
+ (cond
+ ((null client) " ")
+ ((listp client) (format " %s: " (car client)))
+ (t (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.
- (when client
- (setq server-clients (delq client server-clients))
- (dolist (buf (cdr client))
- (with-current-buffer buf
- ;; Remove PROC from the clients of each buffer.
- (setq server-buffer-clients (delq proc server-buffer-clients))
- ;; Kill the buffer if necessary.
- (when (and (null server-buffer-clients)
- (or (and server-kill-new-buffers
- (not server-existing-buffer))
- (server-temp-file-p)))
- (kill-buffer (current-buffer)))))))
- (server-log (format "Status changed to %s" (process-status proc)) proc))
+ "The process sentinel for Emacs server connections."
+ (server-log (format "Status changed to %s: %s" (process-status proc) msg) proc)
+ (server-delete-client proc))
+
+(defun server-handle-delete-tty (tty)
+ "Delete the client connection when the emacsclient terminal device is closed."
+ (dolist (proc (server-clients-with 'tty tty))
+ (server-log (format "server-handle-delete-tty, tty %s" tty) proc)
+ (server-delete-client proc)))
+
+(defun server-handle-delete-frame (frame)
+ "Delete the client connection when the emacsclient frame is deleted."
+ (let ((proc (frame-parameter frame 'client)))
+ (when (and proc (window-system frame))
+ ;; (Closing a terminal frame must not trigger a delete;
+ ;; we must wait for delete-tty-after-functions.)
+ (server-log (format "server-handle-delete-frame, frame %s" frame) proc)
+ (server-delete-client proc 'noframe)))) ; Let delete-frame delete the frame later.
+
+(defun server-handle-suspend-tty (tty)
+ "Notify the emacsclient process to suspend itself when its tty device is suspended."
+ (dolist (proc (server-clients-with 'tty tty))
+ (server-log (format "server-handle-suspend-tty, tty %s" tty) proc)
+ (process-send-string proc "-suspend \n")))
(defun server-select-display (display)
;; If the current frame is on `display' we're all set.
@@ -202,16 +309,17 @@ 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)
+ "Remove &-quotation from ARG."
(replace-regexp-in-string
"&." (lambda (s)
(case (aref s 1)
@@ -221,6 +329,19 @@ are done with it in the server.")
(t " ")))
arg t t))
+(defun server-quote-arg (arg)
+ "In ARG, 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:
@@ -247,32 +368,47 @@ Emacs distribution as your standard \"editor\".
Prefix arg means just kill any existing server communications subprocess."
(interactive "P")
- ;; Make sure there is a safe directory in which to place the socket.
- (server-ensure-safe-dir server-socket-dir)
- ;; kill it dead!
- (if server-process
- (condition-case () (delete-process server-process) (error nil)))
- ;; Delete the socket files made by previous server invocations.
- (condition-case ()
- (delete-file (expand-file-name server-name server-socket-dir))
- (error nil))
- ;; If this Emacs already had a server, clear out associated status.
- (while server-clients
- (let ((buffer (nth 1 (car server-clients))))
- (server-buffer-done buffer)))
- (unless leave-dead
+ (when (or
+ (not server-clients)
+ (yes-or-no-p
+ "The current server still has clients; delete them? "))
+ ;; It is safe to get the user id now.
+ (setq server-socket-dir (or server-socket-dir
+ (format "/tmp/emacs%d" (user-uid))))
+ ;; Make sure there is a safe directory in which to place the socket.
+ (server-ensure-safe-dir server-socket-dir)
+ ;; kill it dead!
(if server-process
- (server-log (message "Restarting server")))
- (letf (((default-file-modes) ?\700))
- (setq server-process
- (make-network-process
- :name "server" :family 'local :server t :noquery t
- :service (expand-file-name server-name server-socket-dir)
- :sentinel 'server-sentinel :filter 'server-process-filter
- ;; We must receive file names without being decoded.
- ;; Those are decoded by server-process-filter according
- ;; to file-name-coding-system.
- :coding 'raw-text)))))
+ (condition-case () (delete-process server-process) (error nil)))
+ ;; Delete the socket files made by previous server invocations.
+ (condition-case ()
+ (delete-file (expand-file-name server-name server-socket-dir))
+ (error nil))
+ ;; If this Emacs already had a server, clear out associated status.
+ (while server-clients
+ (server-delete-client (car server-clients)))
+ (if leave-dead
+ (progn
+ (server-log (message "Server stopped"))
+ (setq server-process nil))
+ (if server-process
+ (server-log (message "Restarting server"))
+ (server-log (message "Starting server")))
+ (letf (((default-file-modes) ?\700))
+ (add-hook 'delete-tty-after-functions 'server-handle-delete-tty)
+ (add-hook 'suspend-tty-functions 'server-handle-suspend-tty)
+ (add-hook 'delete-frame-functions 'server-handle-delete-frame)
+ (add-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function)
+ (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
+ (setq server-process
+ (make-network-process
+ :name "server" :family 'local :server t :noquery t
+ :service (expand-file-name server-name server-socket-dir)
+ :sentinel 'server-sentinel :filter 'server-process-filter
+ ;; We must receive file names without being decoded.
+ ;; Those are decoded by server-process-filter according
+ ;; to file-name-coding-system.
+ :coding 'raw-text))))))
;;;###autoload
(define-minor-mode server-mode
@@ -295,84 +431,211 @@ 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)
- (tmp-frame nil) ; Sometimes used to embody the selected display.
- (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
- (setq tmp-frame (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]")))))
- ;; Avoid preserving the connection after the last real frame is deleted.
- (if tmp-frame (delete-frame tmp-frame))))
- ;; Save for later any partial line that remains.
- (when (> (length string) 0)
- (process-put proc 'previous-string string)))
+ (condition-case err
+ (progn
+ (server-add-client proc)
+ ;; 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 (server-client proc))
+ nowait ; t if emacsclient does not want to wait for us.
+ frame ; The frame that was opened for the client (if any).
+ display ; Open the frame on this display.
+ dontkill ; t if the client should not be killed.
+ (files nil)
+ (lineno 1)
+ (columnno 0))
+ ;; Remove this line from STRING.
+ (setq string (substring string (match-end 0)))
+ (while (string-match " *[^ ]* " request)
+ (let ((arg (substring request (match-beginning 0) (1- (match-end 0)))))
+ (setq request (substring request (match-end 0)))
+ (cond
+ ;; -version CLIENT-VERSION:
+ ;; Check version numbers, signal an error if there is a mismatch.
+ ((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")
+ (server-client-set client 'version client-version))
+ (error (concat "Version mismatch: Emacs is "
+ truncated-emacs-version
+ ", emacsclient is " client-version)))))
+
+ ;; -nowait: Emacsclient won't wait for a result.
+ ((equal "-nowait" arg) (setq nowait t))
+
+ ;; -display DISPLAY:
+ ;; Open X frames on the given instead of the default.
+ ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
+ (setq display (match-string 1 request)
+ request (substring request (match-end 0))))
+
+ ;; -window-system: Open a new X frame.
+ ((equal "-window-system" arg)
+ (unless (server-client-get client 'version)
+ (error "Protocol error; make sure to use the correct version of emacsclient"))
+ (setq frame (make-frame-on-display
+ (or display
+ (frame-parameter nil 'display)
+ (getenv "DISPLAY")
+ (error "Please specify display"))
+ (list (cons 'client proc))))
+ ;; XXX We need to ensure the client parameter is
+ ;; really set because Emacs forgets initialization
+ ;; parameters for X frames at the moment.
+ (modify-frame-parameters frame (list (cons 'client proc)))
+ (select-frame frame)
+ (server-client-set client 'frame frame)
+ (setq dontkill t))
+
+ ;; -resume: Resume a suspended tty frame.
+ ((equal "-resume" arg)
+ (let ((tty (server-client-get client 'tty)))
+ (setq dontkill t)
+ (when tty (resume-tty tty))))
+
+ ;; -suspend: 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 (server-client-get client 'tty)))
+ (setq dontkill t)
+ (when tty (suspend-tty tty))))
+
+ ;; -ignore COMMENT: Noop; useful for debugging emacsclient.
+ ;; (The given comment appears in the server log.)
+ ((and (equal "-ignore" arg) (string-match "\\([^ ]*\\) " request))
+ (setq dontkill t
+ request (substring request (match-end 0))))
+
+ ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client.
+ ((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 (server-client-get client 'version)
+ (error "Protocol error; make sure you use the correct version of emacsclient"))
+ (setq frame (make-frame-on-tty tty type (list (cons 'client proc))))
+ (select-frame frame)
+ (server-client-set client 'frame frame)
+ (server-client-set client 'tty (frame-tty-name frame))
+ ;; Set up display for the remote locale.
+ (configure-display-for-locale)
+ ;; Reply with our pid.
+ (process-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
+ (setq dontkill t)))
+
+ ;; -position LINE: Go to the given line in the next file.
+ ((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))))
+
+ ;; -position LINE:COLUMN: Set point to the given position in the next file.
+ ((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))))
+
+ ;; -file FILENAME: Load the given file.
+ ((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))
+
+ ;; -eval EXPR: Evaluate 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 frame) 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)))
+
+ ;; -env NAME VALUE: An environment variable.
+ ((and (equal "-env" arg) (string-match "\\([^ ]+\\) \\([^ ]+\\) " request))
+ (let ((name (server-unquote-arg (match-string 1 request)))
+ (value (server-unquote-arg (match-string 2 request))))
+ (when coding-system
+ (setq name (decode-coding-string name coding-system))
+ (setq value (decode-coding-string value coding-system)))
+ (setq request (substring request (match-end 0)))
+ (server-client-set
+ client 'environment
+ (cons (cons name value)
+ (server-client-get client 'environment)))))
+
+ ;; 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))
+
+ ;; Delete the client if necessary.
+ (cond
+ (nowait
+ ;; Client requested nowait; return immediately.
+ (server-log "Close nowait client" proc)
+ (server-delete-client proc))
+ ((and (not dontkill)
+ (null (server-client-get client 'buffers)))
+ ;; This client is empty; get rid of it immediately.
+ (server-log "Close empty client" proc)
+ (server-delete-client proc))
+ (t
+ (let ((buffers (server-client-get client 'buffers)))
+ (when buffers
+ ;; We visited some buffer for this client.
+ (cond
+ ((or isearch-mode (minibufferp))
+ nil)
+ ((and frame (null buffers))
+ (message (substitute-command-keys
+ "When done with this frame, type \\[delete-frame]")))
+ ((not (null buffers))
+ (server-switch-buffer (car buffers))
+ (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))
@@ -405,8 +668,7 @@ so don't mark these buffers specially, just visit them normally."
(revert-buffer t nil)))
(t
(if (y-or-n-p
- (concat "File no longer exists: "
- filen
+ (concat "File no longer exists: " filen
", write buffer to file? "))
(write-file filen))))
(setq server-existing-buffer t)
@@ -419,7 +681,9 @@ so don't mark these buffers specially, just visit them normally."
(add-hook 'kill-buffer-hook 'server-kill-buffer nil t)
(push (car client) server-buffer-clients))
(push (current-buffer) client-record)))
- (nconc client client-record)))
+ (server-client-set
+ client 'buffers
+ (nconc (server-client-get client 'buffers) client-record))))
(defun server-buffer-done (buffer &optional for-killing)
"Mark BUFFER as \"done\" for its client(s).
@@ -429,27 +693,24 @@ or nil. KILLED is t if we killed BUFFER (typically, because it was visiting
a temp file).
FOR-KILLING if non-nil indicates that we are called from `kill-buffer'."
(let ((next-buffer nil)
- (killed nil)
- (old-clients server-clients))
- (while old-clients
- (let ((client (car old-clients)))
+ (killed nil))
+ (dolist (client server-clients)
+ (let ((buffers (server-client-get client 'buffers)))
(or next-buffer
- (setq next-buffer (nth 1 (memq buffer client))))
- (delq buffer client)
- ;; Delete all dead buffers from CLIENT.
- (let ((tail client))
- (while tail
- (and (bufferp (car tail))
- (null (buffer-name (car tail)))
- (delq (car tail) client))
- (setq tail (cdr tail))))
- ;; 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))))
- (setq old-clients (cdr old-clients)))
+ (setq next-buffer (nth 1 (memq buffer buffers))))
+ (when buffers ; Ignore bufferless clients.
+ (setq buffers (delq buffer buffers))
+ ;; Delete all dead buffers from CLIENT.
+ (dolist (b buffers)
+ (and (bufferp b)
+ (not (buffer-live-p b))
+ (setq buffers (delq b buffers))))
+ (server-client-set client 'buffers buffers)
+ ;; If client now has no pending buffers,
+ ;; tell it that it is done, and forget it entirely.
+ (unless buffers
+ (server-log "Close" client)
+ (server-delete-client client)))))
(if (and (bufferp buffer) (buffer-name buffer))
;; We may or may not kill this buffer;
;; if we do, do not call server-buffer-done recursively
@@ -514,25 +775,25 @@ specifically for the clients and did not exist before their request for it."
;; but I think that is dangerous--the client would proceed
;; using whatever is on disk in that file. -- rms.
(defun server-kill-buffer-query-function ()
+ "Ask before killing a server buffer."
(or (not server-buffer-clients)
+ (let ((res t))
+ (dolist (proc server-buffer-clients res)
+ (let ((client (server-client proc)))
+ (when (and client (eq (process-status proc) 'open))
+ (setq res nil)))))
(yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
(buffer-name (current-buffer))))))
-(add-hook 'kill-buffer-query-functions
- 'server-kill-buffer-query-function)
-
(defun server-kill-emacs-query-function ()
- (let (live-client
- (tail server-clients))
- ;; See if any clients have any buffers that are still alive.
- (while tail
- (if (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail)))))
- (setq live-client t))
- (setq tail (cdr tail)))
- (or (not live-client)
- (yes-or-no-p "Server buffers still have clients; exit anyway? "))))
-
-(add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
+ "Ask before exiting Emacs it has are live clients."
+ (or (not server-clients)
+ (let (live-client)
+ (dolist (client server-clients live-client)
+ (if (memq t (mapcar 'buffer-live-p (server-client-get
+ client 'buffers)))
+ (setq live-client t))))
+ (yes-or-no-p "This Emacs session has clients; exit anyway? ")))
(defvar server-kill-buffer-running nil
"Non-nil while `server-kill-buffer' or `server-buffer-done' is running.")
@@ -575,12 +836,19 @@ Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."
;; This means we should avoid the final "switch to some other buffer"
;; since we've already effectively done that.
(if (null next-buffer)
- (if server-clients
- (server-switch-buffer (nth 1 (car server-clients)) killed-one)
- (unless (or killed-one (window-dedicated-p (selected-window)))
- (switch-to-buffer (other-buffer))
+ (progn
+ (let ((rest server-clients))
+ (while (and rest (not next-buffer))
+ (let ((client (car rest)))
+ ;; Only look at frameless clients.
+ (when (not (server-client-get client 'frame))
+ (setq next-buffer (car (server-client-get client 'buffers))))
+ (setq rest (cdr rest)))))
+ (and next-buffer (server-switch-buffer next-buffer killed-one))
+ (unless (or next-buffer killed-one (window-dedicated-p (selected-window)))
+ ;; (switch-to-buffer (other-buffer))
(message "No server buffers remain to edit")))
- (if (not (buffer-name next-buffer))
+ (if (not (buffer-live-p next-buffer))
;; If NEXT-BUFFER is a dead buffer, remove the server records for it
;; and try the next surviving server buffer.
(apply 'server-switch-buffer (server-buffer-done next-buffer))
@@ -622,8 +890,31 @@ Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."
(global-set-key "\C-x#" 'server-edit)
+;;;###autoload
+(defun server-getenv (variable &optional frame)
+ "Get the value of VARIABLE in the client environment of frame FRAME.
+VARIABLE should be a string. Value is nil if VARIABLE is undefined in
+the environment. Otherwise, value is a string.
+
+If FRAME is an emacsclient frame, then the variable is looked up
+in the environment of the emacsclient process; otherwise the
+function consults the environment of the Emacs process.
+
+If FRAME is nil or missing, then the selected frame is used."
+ (when (not frame) (setq frame (selected-frame)))
+ (let ((client (frame-parameter frame 'client)) env)
+ (if (null client)
+ (getenv variable)
+ (setq env (server-client-get client 'environment))
+ (if (null env)
+ (getenv variable)
+ (cdr (assoc variable env))))))
+
(defun server-unload-hook ()
(server-start t)
+ (remove-hook 'delete-tty-after-functions 'server-handle-delete-tty)
+ (remove-hook 'suspend-tty-functions 'server-handle-suspend-tty)
+ (remove-hook 'delete-frame-functions 'server-handle-delete-frame)
(remove-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function)
(remove-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
(remove-hook 'kill-buffer-hook 'server-kill-buffer))
diff --git a/lisp/simple.el b/lisp/simple.el
index 66bc7c6b2ed..9cd630b94ec 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1957,6 +1957,8 @@ the text which should be made available.
The second, optional, argument PUSH, has the same meaning as the
similar argument to `x-set-cut-buffer', which see.")
+(make-variable-frame-local 'interprogram-cut-function)
+
(defvar interprogram-paste-function nil
"Function to call to get text cut from other programs.
@@ -1977,6 +1979,8 @@ most recent string, the function should return nil. If it is
difficult to tell whether Emacs or some other program provided the
current string, it is probably good enough to return nil if the string
is equal (according to `string=') to the last text Emacs provided.")
+
+(make-variable-frame-local 'interprogram-paste-function)
diff --git a/lisp/startup.el b/lisp/startup.el
index 2f0ca4b2c19..2b103aee2ce 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)
@@ -422,37 +429,19 @@ 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)
(frame-notice-user-settings))
+ ;; Set the faces for the initial background mode even if
+ ;; frame-notice-user-settings didn't (such as on a tty).
+ ;; frame-set-background-mode is idempotent, so it won't
+ ;; cause any harm if it's already been done.
(if (fboundp 'frame-set-background-mode)
- ;; Set the faces for the initial background mode even if
- ;; frame-notice-user-settings didn't (such as on a tty).
- ;; frame-set-background-mode is idempotent, so it won't
- ;; cause any harm if it's already been done.
- (let ((frame-background-mode frame-background-mode)
- (frame (selected-frame))
- term)
- (when (and (null window-system)
- ;; Don't override a possibly customized value.
- (null frame-background-mode)
- ;; Don't override user specifications.
- (null (frame-parameter frame 'reverse))
- (let ((bg (frame-parameter frame 'background-color)))
- (or (null bg)
- (member bg '(unspecified "unspecified-bg")))))
- (setq term (getenv "TERM"))
- ;; Some files in lisp/term do a better job with the
- ;; background mode, but we leave this here anyway, in
- ;; case they remove those files.
- (if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
- term)
- (setq frame-background-mode 'light)))
- (frame-set-background-mode (selected-frame)))))
+ (frame-set-background-mode (selected-frame))))
;; Now we know the user's default font, so add it to the menu.
(if (fboundp 'font-menu-add-default)
@@ -493,6 +482,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,16 +613,22 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(setq eol-mnemonic-dos "(DOS)"
eol-mnemonic-mac "(Mac)")))
- ;; Read window system's init file if using a window system.
+ ;; Make sure window system's init file was loaded in loadup.el 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)
@@ -635,13 +644,11 @@ 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)))
-
+ ;; Locale initialization.
+ (set-locale-translation-file-name)
(set-locale-environment nil)
;; Convert the arguments to Emacs internal representation.
@@ -724,7 +731,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
emacs-quick-startup
- (and (memq window-system '(x w32))
+ (and (memq initial-window-system '(x w32))
(<= (frame-parameter nil 'menu-bar-lines) 0)))
(menu-bar-mode 1))
@@ -735,11 +742,11 @@ 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
emacs-quick-startup
(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))
@@ -747,13 +754,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)))
@@ -767,11 +774,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
@@ -965,7 +971,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/subr.el b/lisp/subr.el
index cb825b3e8b3..50216bb7536 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1818,6 +1818,18 @@ See also `with-temp-buffer'."
(if (window-live-p save-selected-window-window)
(select-window save-selected-window-window 'norecord)))))
+(defmacro with-selected-frame (frame &rest body)
+ "Execute the forms in BODY with FRAME as the selected frame.
+The value returned is the value of the last form in BODY.
+See also `with-temp-buffer'."
+ (declare (indent 1) (debug t))
+ `(let ((save-selected-frame (selected-frame)))
+ (unwind-protect
+ (progn (select-frame ,frame)
+ ,@body)
+ (if (frame-live-p save-selected-frame)
+ (select-frame save-selected-frame)))))
+
(defmacro with-temp-file (file &rest body)
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
The value returned is the value of the last form in BODY.
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/rxvt.el b/lisp/term/rxvt.el
index 7839ebba95d..3dbea1d46b2 100644
--- a/lisp/term/rxvt.el
+++ b/lisp/term/rxvt.el
@@ -26,6 +26,8 @@
;;; Code:
+(eval-when-compile (require 'server))
+
;; Set up function-key-map entries that termcap and terminfo don't know.
(let ((map (make-sparse-keymap)))
(define-key map "\e[A" [up])
@@ -148,7 +150,7 @@ for the currently selected frame."
;; intelligent way than the default guesswork in startup.el.
(defun rxvt-set-background-mode ()
"Set background mode as appropriate for the default rxvt colors."
- (let ((fgbg (getenv "COLORFGBG"))
+ (let ((fgbg (server-getenv "COLORFGBG"))
bg rgb)
(setq frame-background-mode 'light) ; default
(when (and fgbg
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index d9700809413..55ad3800e0b 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)
@@ -78,6 +84,8 @@
(require 'fontset)
(require 'x-dnd)
+(eval-when-compile (require 'server))
+
(defvar x-invocation-args)
(defvar x-command-line-resources nil)
@@ -1160,9 +1168,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 +2242,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,149 +2333,152 @@ 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
+ (condition-case nil
+ (x-get-selection 'CLIPBOARD)
+ (error nil)))
+ (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 (server-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))
+ ;; Turn off window-splitting optimization; X is usually fast enough
+ ;; that this is only annoying.
+ (setq split-window-keep-point t)
-;; Turn on support for mouse wheels.
-(mouse-wheel-mode 1)
+ ;; 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))
+ ;; Turn on support for mouse wheels.
+ (mouse-wheel-mode 1)
-;; Enable CLIPBOARD copy/paste through menu bar commands.
-(menu-bar-enable-clipboard)
+ ;; Enable CLIPBOARD copy/paste through menu bar commands.
+ (menu-bar-enable-clipboard)
-;; 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
- (condition-case nil
- (x-get-selection 'CLIPBOARD)
- (error nil)))
- (x-select-enable-clipboard t))
- (if (and clipboard-text (> (length clipboard-text) 0))
- (kill-new clipboard-text))
- (yank)))
+ ;; 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..e05b2f27324 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -26,6 +26,8 @@
;;; Code:
+(eval-when-compile (require 'server))
+
(let ((map (make-sparse-keymap)))
(define-key map "\e[A" [up])
(define-key map "\e[B" [down])
@@ -123,7 +125,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)
@@ -208,7 +210,7 @@ versions of xterm."
;; intelligent way than the default guesswork in startup.el.
(defun xterm-rxvt-set-background-mode ()
"Set background mode as appropriate for the default rxvt colors."
- (let ((fgbg (getenv "COLORFGBG"))
+ (let ((fgbg (server-getenv "COLORFGBG"))
bg rgb)
(setq frame-background-mode 'light) ; default
(when (and fgbg
@@ -230,8 +232,8 @@ versions of xterm."
(xterm-register-default-colors)
;; If this xterm is actually a disguised rxvt, be more intelligent about
;; determining the background mode.
-(and (getenv "COLORTERM")
- (string-match "\\`rxvt" (getenv "COLORTERM"))
+(and (server-getenv "COLORTERM")
+ (string-match "\\`rxvt" (server-getenv "COLORTERM"))
(xterm-rxvt-set-background-mode))
;; This recomputes all the default faces given the colors we've just set up.
(tty-set-up-initial-frame-faces)
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index 0c1e6bc1745..87582f57683 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.67 2004/01/20 17:41:18 uid65624 Exp $
+;; $Id$
;; This file is part of GNU Emacs.
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index d6cd8208540..3f5a46c5bea 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.167 2004/04/16 10:21:51 spiegel Exp $
+;; $Id$
;; This file is part of GNU Emacs.
diff --git a/lisp/vc-rcs.el b/lisp/vc-rcs.el
index 02dc093ed5a..9b405246c29 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.38 2003/09/01 15:45:17 miles Exp $
+;; $Id$
;; This file is part of GNU Emacs.
diff --git a/lisp/vc-sccs.el b/lisp/vc-sccs.el
index 1649349e0bd..a630c1f3d67 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.24 2003/09/01 15:45:17 miles Exp $
+;; $Id$
;; This file is part of GNU Emacs.
diff --git a/lisp/vc.el b/lisp/vc.el
index f48cbe20b1c..1b4e2409550 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.376 2004/04/16 10:21:24 spiegel Exp $
+;; $Id$
;; This file is part of GNU Emacs.
diff --git a/lisp/version.el b/lisp/version.el
index d489eeea02e..9cae0d25702 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/x-dnd.el b/lisp/x-dnd.el
index 7d43a10556e..2ed5d807c36 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."
View Lorry Controller Status