;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 1993, 1994, 2001, 2002, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals, i18n
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; -font *font
;; -foreground *foreground
;; -geometry .geometry
-;; -i .iconType
-;; -itype .iconType
;; -iconic .iconic
;; -name .name
;; -reverse *reverseVideo
(require 'x-dnd)
(defvar x-invocation-args)
+(defvar x-keysym-table)
+(defvar x-selection-timeout)
+(defvar x-session-id)
+(defvar x-session-previous-id)
(defvar x-command-line-resources nil)
(let ((param (nth 3 aelt)))
(setq default-frame-alist
(cons (cons param
- (string-to-int (car x-invocation-args)))
+ (string-to-number (car x-invocation-args)))
default-frame-alist)
x-invocation-args
(cdr x-invocation-args))))))
initial-frame-alist)
x-invocation-args (cdr x-invocation-args)))))))
+(defun x-handle-no-bitmap-icon (switch)
+ (setq default-frame-alist (cons '(icon-type) default-frame-alist)))
+
;; Make -iconic apply only to the initial frame!
(defun x-handle-iconic (switch)
(setq initial-frame-alist
initial-frame-alist)))
(defvar x-display-name nil
- "The X display name specifying server and X frame.")
+ "The name of the X display on which Emacs was started.
+
+For the X display name of individual frames, see the `display'
+frame parameter.")
(defun x-handle-display (switch)
+ "Handle -display DISPLAY option."
(setq x-display-name (car x-invocation-args)
x-invocation-args (cdr x-invocation-args))
;; Make subshell programs see the same DISPLAY value Emacs really uses.
(#x5f1 . ?\e,Gq\e(B)
(#x5f2 . ?\e,Gr\e(B)
;; Cyrillic
+ (#x680 . ?\e$,1)R\e(B)
+ (#x681 . ?\e$,1)V\e(B)
+ (#x682 . ?\e$,1)Z\e(B)
+ (#x683 . ?\e$,1)\\e(B)
+ (#x684 . ?\e$,1)b\e(B)
+ (#x685 . ?\e$,1)n\e(B)
+ (#x686 . ?\e$,1)p\e(B)
+ (#x687 . ?\e$,1)r\e(B)
+ (#x688 . ?\e$,1)v\e(B)
+ (#x689 . ?\e$,1)x\e(B)
+ (#x68a . ?\e$,1)z\e(B)
+ (#x68c . ?\e$,1*8\e(B)
+ (#x68d . ?\e$,1*B\e(B)
+ (#x68e . ?\e$,1*H\e(B)
+ (#x68f . ?\e$,1*N\e(B)
+ (#x690 . ?\e$,1)S\e(B)
+ (#x691 . ?\e$,1)W\e(B)
+ (#x692 . ?\e$,1)[\e(B)
+ (#x693 . ?\e$,1)]\e(B)
+ (#x694 . ?\e$,1)c\e(B)
+ (#x695 . ?\e$,1)o\e(B)
+ (#x696 . ?\e$,1)q\e(B)
+ (#x697 . ?\e$,1)s\e(B)
+ (#x698 . ?\e$,1)w\e(B)
+ (#x699 . ?\e$,1)y\e(B)
+ (#x69a . ?\e$,1){\e(B)
+ (#x69c . ?\e$,1*9\e(B)
+ (#x69d . ?\e$,1*C\e(B)
+ (#x69e . ?\e$,1*I\e(B)
+ (#x69f . ?\e$,1*O\e(B)
(#x6a1 . ?\e,Lr\e(B)
(#x6a2 . ?\e,Ls\e(B)
(#x6a3 . ?\e,Lq\e(B)
\f
;;;; Selections and cut buffers
-;;; We keep track of the last text selected here, so we can check the
-;;; current selection against it, and avoid passing back our own text
-;;; from x-cut-buffer-or-selection-value. We track all three
-;;; seperately in case another X application only sets one of them
-;;; (say the cut buffer) we aren't fooled by the PRIMARY or
-;;; CLIPBOARD selection staying the same.
+;; We keep track of the last text selected here, so we can check the
+;; current selection against it, and avoid passing back our own text
+;; from x-cut-buffer-or-selection-value. We track all three
+;; seperately in case another X application only sets one of them
+;; (say the cut buffer) we aren't fooled by the PRIMARY or
+;; CLIPBOARD selection staying the same.
(defvar x-last-selected-text-clipboard nil
"The value of the CLIPBOARD X selection last time we selected or
pasted text.")
(defvar x-last-selected-text-cut-encoded nil
"The value of the X cut buffer last time we selected or pasted text.
This is the actual text stored in the X cut buffer.")
+(defvar x-last-cut-buffer-coding 'iso-latin-1
+ "The coding we last used to encode/decode the text from the X cut buffer")
-;;; It is said that overlarge strings are slow to put into the cut buffer.
-;;; Note this value is overridden below.
-(defvar x-cut-buffer-max 20000
- "Max number of characters to put in the cut buffer.")
+(defvar x-cut-buffer-max 20000 ; Note this value is overridden below.
+ "Max number of characters to put in the cut buffer.
+It is said that overlarge strings are slow to put into the cut buffer.")
(defcustom x-select-enable-clipboard nil
"Non-nil means cutting and pasting uses the clipboard.
:type 'boolean
:group 'killing)
-;;; Make TEXT, a string, the primary X selection.
-;;; Also, set the value of X cut buffer 0, for backward compatibility
-;;; with older X applications.
-;;; gildea@stop.mail-abuse.org says it's not desirable to put kills
-;;; in the clipboard.
(defun x-select-text (text &optional push)
+ "Make TEXT, a string, the primary X selection.
+Also, set the value of X cut buffer 0, for backward compatibility
+with older X applications.
+gildea@stop.mail-abuse.org says it's not desirable to put kills
+in the clipboard."
;; Don't send the cut buffer too much text.
;; It becomes slow, and if really big it causes errors.
(cond ((>= (length text) x-cut-buffer-max)
x-last-selected-text-cut-encoded ""))
(t
(setq x-last-selected-text-cut text
+ x-last-cut-buffer-coding 'iso-latin-1
x-last-selected-text-cut-encoded
- (encode-coding-string text (or locale-coding-system
- 'iso-latin-1)))
+ ;; ICCCM says cut buffer always contain ISO-Latin-1
+ (encode-coding-string text 'iso-latin-1))
(x-set-cut-buffer x-last-selected-text-cut-encoded push)))
(x-set-selection 'PRIMARY text)
(setq x-last-selected-text-primary text)
;; (1) If their lengthes are different, select the longer one. This
;; is because an X client may just cut off unsupported characters.
;;
-;; (2) Otherwise, if the Nth character of CTEXT is an ASCII
-;; character that is different from the Nth character of UTF8,
-;; select UTF8. This is because an X client may replace unsupported
-;; characters with some ASCII character (typically ` ' or `?') in
-;; CTEXT.
+;; (2) Otherwise, if they are different at Nth character, and that
+;; of UTF8 is a Latin character and that of CTEXT belongs to a CJK
+;; character set, select UTF8. Also select UTF8 if the Nth
+;; character of UTF8 is non-ASCII where as that of CTEXT is ASCII.
+;; This is because an X client may replace unsupported characters
+;; with some ASCII character (typically ` ' or `?') in CTEXT.
;;
;; (3) Otherwise, select CTEXT. This is because legacy charsets are
;; better for the current Emacs, especially when the selection owner
(if (/= len-utf8 len-ctext)
(if (> len-utf8 len-ctext) utf8 ctext)
(let ((result (compare-strings utf8 0 len-utf8 ctext 0 len-ctext)))
- (if (or (eq result t)
- (>= (aref ctext (1- (abs result))) 128))
+ (if (eq result t)
ctext
- utf8)))))
+ (let ((utf8-char (aref utf8 (1- (abs result))))
+ (ctext-char (aref ctext (1- (abs result)))))
+ (if (or (and (aref (char-category-set utf8-char) ?l)
+ (aref (char-category-set ctext-char) ?C))
+ (and (>= utf8-char 128)
+ (< ctext-char 128)))
+ utf8
+ ctext)))))))
+
+;; Get a selection value of type TYPE by calling x-get-selection with
+;; an appropiate DATA-TYPE argument decidd by `x-select-request-type'.
+;; The return value is already decoded. If x-get-selection causes an
+;; error, this function return nil.
(defun x-selection-value (type)
(let (text)
(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.
-;;; If this function is called twice and finds the same text,
-;;; it returns nil the second time. This is so that a single
-;;; selection won't be added to the kill ring over and over.
+
+;; Return the value of the current X selection.
+;; Consult the selection, and the cut buffer. Treat empty strings
+;; as if they were unset.
+;; If this function is called twice and finds the same text,
+;; it returns nil the second time. This is so that a single
+;; selection won't be added to the kill ring over and over.
(defun x-cut-buffer-or-selection-value ()
(let (clip-text primary-text cut-text)
(when x-select-enable-clipboard
;; from what we remebered them to be last time we did a
;; cut/paste operation.
(setq cut-text
- (cond;; check cut buffer
- ((or (not cut-text) (string= cut-text ""))
- (setq x-last-selected-text-cut nil))
- ;; This short cut doesn't work because x-get-cut-buffer
- ;; always returns a newly created string.
- ;; ((eq cut-text x-last-selected-text-cut) nil)
- ((string= cut-text x-last-selected-text-cut-encoded)
- ;; See the comment above. No need of this recording.
- ;; Record the newer string,
- ;; so subsequent calls can use the `eq' test.
- ;; (setq x-last-selected-text-cut cut-text)
- nil)
- (t
- (setq x-last-selected-text-cut-encoded cut-text
+ (let ((next-coding (or next-selection-coding-system 'iso-latin-1)))
+ (cond;; check cut buffer
+ ((or (not cut-text) (string= cut-text ""))
+ (setq x-last-selected-text-cut nil))
+ ;; This short cut doesn't work because x-get-cut-buffer
+ ;; always returns a newly created string.
+ ;; ((eq cut-text x-last-selected-text-cut) nil)
+ ((and (string= cut-text x-last-selected-text-cut-encoded)
+ (eq x-last-cut-buffer-coding next-coding))
+ ;; See the comment above. No need of this recording.
+ ;; Record the newer string,
+ ;; so subsequent calls can use the `eq' test.
+ ;; (setq x-last-selected-text-cut cut-text)
+ nil)
+ (t
+ (setq x-last-selected-text-cut-encoded cut-text
+ x-last-cut-buffer-coding next-coding
x-last-selected-text-cut
- (decode-coding-string cut-text (or locale-coding-system
- 'iso-latin-1))))))
+ ;; ICCCM says cut buffer always contain ISO-Latin-1, but
+ ;; use next-selection-coding-system if not nil.
+ (decode-coding-string
+ cut-text next-coding))))))
;; As we have done one selection, clear this now.
(setq next-selection-coding-system nil)
))
\f
-;;; Do the actual X Windows setup here; the above code just defines
-;;; functions and variables that we use now.
+;; 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.
+;; Make sure we have a valid resource name.
(or (stringp x-resource-name)
(let (i)
(setq x-resource-name (invocation-name))
(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)
+ ;; The size parms apply to all frames. Don't set it if there are
+ ;; sizes there already (from command line).
+ (if (and (assq 'height parsed)
+ (not (assq 'height default-frame-alist)))
(setq default-frame-alist
(cons (cons 'height (cdr (assq 'height parsed)))
default-frame-alist)))
- (if (assq 'width parsed)
+ (if (and (assq 'width parsed)
+ (not (assq 'width default-frame-alist)))
(setq default-frame-alist
(cons (cons 'width (cdr (assq 'width parsed)))
default-frame-alist))))))
(if res-selection-timeout
(setq x-selection-timeout (string-to-number res-selection-timeout))))
+;; Set scroll bar mode to right if set by X resources. Default is left.
+(if (equal (x-get-resource "verticalScrollBars" "ScrollBars") "right")
+ (customize-set-variable 'scroll-bar-mode 'right))
+
(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.
+;; 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 off window-splitting optimization; X is usually fast enough
-;;; that this is only annoying.
+;; Turn off window-splitting optimization; X is usually fast enough
+;; that this is only annoying.
(setq split-window-keep-point t)
;; Don't show the frame name; that's redundant with X.
;; 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)))
+ (interactive "*")
+ (let ((clipboard-text (x-selection-value 'CLIPBOARD))
(x-select-enable-clipboard t))
(if (and clipboard-text (> (length clipboard-text) 0))
(kill-new clipboard-text))
(yank)))
(define-key menu-bar-edit-menu [paste]
- (cons "Paste" (cons "Paste text from clipboard or kill ring"
- 'x-clipboard-yank)))
+ '(menu-item "Paste" x-clipboard-yank
+ :enable (not buffer-read-only)
+ :help "Paste (yank) text most recently cut/copied"))
;; Initiate drag and drop
(add-hook 'after-make-frame-functions 'x-dnd-init-frame)
-(global-set-key [drag-n-drop] 'x-dnd-handle-drag-n-drop-event)
-
-;;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78
+(define-key special-event-map [drag-n-drop] 'x-dnd-handle-drag-n-drop-event)
+
+;; Let F10 do menu bar navigation.
+(defun x-menu-bar-open (&optional frame)
+ "Open the menu bar if `menu-bar-mode' is on. otherwise call `tmm-menubar'."
+ (interactive "i")
+ (if menu-bar-mode (menu-bar-open frame)
+ (tmm-menubar)))
+
+(and (fboundp 'menu-bar-open)
+ (global-set-key [f10] 'x-menu-bar-open))
+
+(defcustom x-gtk-stock-map
+ '(
+ ("etc/images/new" . "gtk-new")
+ ("etc/images/open" . "gtk-open")
+ ("etc/images/diropen" . "n:system-file-manager")
+ ("etc/images/close" . "gtk-close")
+ ("etc/images/save" . "gtk-save")
+ ("etc/images/saveas" . "gtk-save-as")
+ ("etc/images/undo" . "gtk-undo")
+ ("etc/images/cut" . "gtk-cut")
+ ("etc/images/copy" . "gtk-copy")
+ ("etc/images/paste" . "gtk-paste")
+ ("etc/images/search" . "gtk-find")
+ ("etc/images/print" . "gtk-print")
+ ("etc/images/preferences" . "gtk-preferences")
+ ("etc/images/help" . "gtk-help")
+ ("etc/images/left-arrow" . "gtk-go-back")
+ ("etc/images/right-arrow" . "gtk-go-forward")
+ ("etc/images/home" . "gtk-home")
+ ("etc/images/jump-to" . "gtk-jump-to")
+ ("etc/images/index" . "gtk-index")
+ ("etc/images/search" . "gtk-find")
+ ("etc/images/exit" . "gtk-quit"))
+ "How icons for tool bars are mapped to Gtk+ stock items.
+Emacs must be compiled with the Gtk+ toolkit for this to have any effect.
+A value that begins with n: denotes a named icon instead of a stock icon."
+ :version "22.2"
+ :type 'alist
+ :group 'x)
+
+(defvar icon-map-list nil
+ "*A list of alists that maps icon file names to stock/named icons.
+The alists are searched in the order they appear. The first match is used.
+The keys in the alists are file names without extension and with two directory
+components. For example, to map /usr/share/emacs/22.1.1/etc/images/open.xpm
+to stock item gtk-open, use:
+
+ (\"etc/images/open\" . \"gtk-open\")
+
+Themes also have named icons. To map to one of those, use n: before the name:
+
+ (\"etc/images/diropen\" . \"n:system-file-manager\")
+
+The list elements are either the symbol name for the alist or the alist itself.")
+
+(defun x-gtk-map-stock (file)
+ "Map icon with file name FILE to a Gtk+ stock name, using `x-gtk-stock-map'."
+ (if (stringp file)
+ (let* ((file-sans (file-name-sans-extension file))
+ (key (and (string-match "/\\([^/]+/[^/]+/[^/]+$\\)" file-sans)
+ (match-string 1 file-sans)))
+ (value))
+ (mapc (lambda (elem)
+ (let ((assoc (if (symbolp elem) (symbol-value elem) elem)))
+ (or value (setq value (assoc-string (or key file-sans)
+ assoc)))))
+ icon-map-list)
+ (and value (cdr value)))
+ nil))
+
+;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78
;;; x-win.el ends here