;;; 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, 2007,
-;; 2008 Free Software Foundation, Inc.
+;; 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals, i18n
;; 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
+;; Beginning in Emacs 23, 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
down, this function is called. It calls the functions in the hook
`emacs-save-session-functions'. Functions are called with the current
buffer set to a temporary buffer. Functions should use `insert' to insert
-lisp code to save the session state. The buffer is saved
-in a file in the home directory of the user running Emacs. The file
-is evaluated when Emacs is restarted by the session manager.
+lisp code to save the session state. The buffer is saved in a file in the
+home directory of the user running Emacs. The file is evaluated when
+Emacs is restarted by the session manager.
If any of the functions returns non-nil, no more functions are called
and this function returns non-nil. This will inform the session manager
(defvar x-colors)
(defun xw-defined-colors (&optional frame)
- "Internal function called by `defined-colors', which see."
+ "Internal function called by `defined-colors'."
(or frame (setq frame (selected-frame)))
(let ((all-colors x-colors)
(this-color nil)
(defvar x-alternatives-map
(let ((map (make-sparse-keymap)))
;; Map certain keypad keys into ASCII characters that people usually expect.
- (define-key map [backspace] [127])
- (define-key map [delete] [127])
- (define-key map [tab] [?\t])
- (define-key map [linefeed] [?\n])
- (define-key map [clear] [?\C-l])
- (define-key map [return] [?\C-m])
- (define-key map [escape] [?\e])
(define-key map [M-backspace] [?\M-\d])
(define-key map [M-delete] [?\M-\d])
(define-key map [M-tab] [?\M-\t])
"Keymap of possible alternative meanings for some keys.")
(defun x-setup-function-keys (frame)
- "Set up `function-key-map' on FRAME for the X window system."
+ "Set up `function-key-map' on the graphical frame FRAME."
;; Don't do this twice on the same display, or it would break
;; normal-erase-is-backspace-mode.
(unless (terminal-parameter frame 'x-setup-function-keys)
(set-keymap-parent map (keymap-parent local-function-key-map))
(set-keymap-parent local-function-key-map map)))
(set-terminal-parameter frame 'x-setup-function-keys t)))
-
-;; These tell read-char how to convert
-;; these special chars to ASCII.
-(put 'backspace 'ascii-character 127)
-(put 'delete 'ascii-character 127)
-(put 'tab 'ascii-character ?\t)
-(put 'linefeed 'ascii-character ?\n)
-(put 'clear 'ascii-character 12)
-(put 'return 'ascii-character 13)
-(put 'escape 'ascii-character ?\e)
-
\f
;;;; Keysyms
;; 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
+;; separately 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
(defcustom x-select-enable-clipboard nil
"Non-nil means cutting and pasting uses the clipboard.
-This is in addition to, but in preference to, the primary selection."
+This is in addition to, but in preference to, the primary selection.
+
+On MS-Windows, this is non-nil by default, since Windows does not
+support other types of selections. \(The primary selection that is
+set by Emacs is not accessible to other programs on Windows.\)"
:type 'boolean
:group 'killing)
:group 'killing)
(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."
+ "Select TEXT, a string, according to the window system.
+
+On X, put TEXT in the primary X selection. For backward
+compatibility with older X applications, set the value of X cut
+buffer 0 as well, and if the optional argument PUSH is non-nil,
+rotate the cut buffers. If `x-select-enable-clipboard' is
+non-nil, copy the text to the X clipboard as well.
+
+On Windows, make TEXT the current selection. If
+`x-select-enable-clipboard' is non-nil, copy the text to the
+clipboard as well. The argument PUSH is ignored.
+
+On Nextstep, put TEXT in the pasteboard; PUSH is ignored."
;; With multi-tty, this function may be called from a tty frame.
(when (eq (framep (selected-frame)) 'x)
;; Don't send the cut buffer too much text.
")
;; Get a selection value of type TYPE by calling x-get-selection with
-;; an appropiate DATA-TYPE argument decided by `x-select-request-type'.
+;; an appropriate DATA-TYPE argument decided by `x-select-request-type'.
;; The return value is already decoded. If x-get-selection causes an
;; error, this function return nil.
(declare-function accelerate-menu "xmenu.c" (&optional frame) t)
(defun x-menu-bar-open (&optional frame)
- "Open the menu bar if `menu-bar-mode' is on. otherwise call `tmm-menubar'."
+ "Open the menu bar if `menu-bar-mode' is on, otherwise call `tmm-menubar'."
(interactive "i")
- (if menu-bar-mode (accelerate-menu frame)
+ (if (and menu-bar-mode
+ (fboundp 'accelerate-menu))
+ (accelerate-menu frame)
(tmm-menubar)))
\f
;;; Window system initialization.
(defun x-win-suspend-error ()
- (error "Suspending an Emacs running under X makes no sense"))
+ ;; Don't allow suspending if any of the frames are X frames.
+ (if (memq 'x (mapcar 'window-system (frame-list)))
+ (error "Cannot suspend Emacs while running under X")))
(defvar x-initialized nil
"Non-nil if the X window system has been initialized.")
(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 default fontset.
+ (create-default-fontset)
;; Create the standard fontset.
- (create-fontset-from-fontset-spec standard-fontset-spec t)
+ (condition-case err
+ (create-fontset-from-fontset-spec standard-fontset-spec t)
+ (error (display-warning
+ 'initialization
+ (format "Creation of the standard fontset failed: %s" err)
+ :error)))
;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
(create-fontset-from-x-resource)
;; Don't let Emacs suspend under X.
(add-hook 'suspend-hook 'x-win-suspend-error)
+ ;; During initialization, we defer sending size hints to the window
+ ;; manager, because that can induce a race condition:
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2008-10/msg00033.html
+ ;; Send the size hints once initialization is done.
+ (add-hook 'after-init-hook 'x-wm-set-size-hint)
+
;; Turn off window-splitting optimization; X is usually fast enough
;; that this is only annoying.
(setq split-window-keep-point t)
;; (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)
(define-key special-event-map [drag-n-drop] 'x-dnd-handle-drag-n-drop-event)
(defcustom x-gtk-stock-map
+ (mapcar (lambda (arg)
+ (cons (purecopy (car arg)) (purecopy (cdr arg))))
'(
("etc/images/new" . "gtk-new")
("etc/images/open" . "gtk-open")
("images/mail/save-draft" . "gtk-mail-handling")
("images/mail/send" . "gtk-mail-send")
("images/mail/spam" . "gtk-spam")
+ ;; Used for GDB Graphical Interface
+ ("images/gud/break" . "gtk-no")
+ ("images/gud/recstart" . "gtk-media-record")
+ ("images/gud/recstop" . "gtk-media-stop")
;; No themed versions available:
;; mail/preview (combining stock_mail and stock_zoom)
;; mail/save (combining stock_mail, stock_save and stock_convert)
- )
+ ))
"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."
:group 'x)
(defcustom icon-map-list '(x-gtk-stock-map)
- "A list of alists that maps icon file names to stock/named icons.
+ "A list of alists that map 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
(string :tag "Stock/named")))))
:group 'x)
+(defconst x-gtk-stock-cache (make-hash-table :weakness t :test 'equal))
+
(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))
+ "Map icon with file name FILE to a Gtk+ stock name.
+This uses `icon-map-list' to map icon file names to stock icon names."
+ (when (stringp file)
+ (or (gethash file x-gtk-stock-cache)
+ (puthash
+ file
+ (save-match-data
+ (let* ((file-sans (file-name-sans-extension file))
+ (key (and (string-match "/\\([^/]+/[^/]+/[^/]+$\\)"
+ file-sans)
+ (match-string 1 file-sans)))
+ (icon-map icon-map-list)
+ elem value)
+ (while (and (null value) icon-map)
+ (setq elem (car icon-map)
+ value (assoc-string (or key file-sans)
+ (if (symbolp elem)
+ (symbol-value elem)
+ elem))
+ icon-map (cdr icon-map)))
+ (and value (cdr value))))
+ x-gtk-stock-cache))))
(provide 'x-win)
HCoop / bpt / emacs.git / blobdiff