;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit;-*-
;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
-;; 2005, 2006 Free Software Foundation, Inc.
+;; 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,
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.
(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")
(defvar x-cut-buffer-max 20000 ; Note this value is overridden below.
"Max number of characters to put in the cut buffer.
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'.
;; 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)
(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)
;; Override Paste so it looks at CLIPBOARD first.
(defun x-clipboard-yank ()
"Insert the clipboard contents, or the last stretch of killed text."
- (interactive)
+ (interactive "*")
(let ((clipboard-text (x-selection-value 'CLIPBOARD))
(x-select-enable-clipboard t))
(if (and clipboard-text (> (length clipboard-text) 0))
(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)
+(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