Mercurial > hg > xemacs-beta
annotate lisp/x-init.el @ 5569:d19b6e3bdf91
#'cl-defsubst-expand; avoid mutually-recursive symbol macros.
lisp/ChangeLog addition:
2011-09-10 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-defsubst-expand):
Change set 2a6a8da4dd7c of
http://mid.gmane.org/19966.17522.332164.615228@parhasard.net
wasn't sufficiently comprehensive, symbol macros can be mutually
rather than simply recursive, and they can equally hang. Thanks
for the bug report, Michael Sperber, and for the test case,
Stephen Turnbull.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 10 Sep 2011 13:17:29 +0100 |
| parents | 3d1f8f0e690f |
| children | 1d1f385c9149 |
| rev | line source |
|---|---|
| 428 | 1 ;;; x-init.el --- initialization code for X windows |
| 2 | |
| 3 ;; Copyright (C) 1990, 1993, 1994, 1997 Free Software Foundation, Inc. | |
| 4 ;; Copyright (C) 1995 Board of Trustees, University of Illinois. | |
| 5 ;; Copyright (C) 1995, 1996 Ben Wing. | |
| 6 | |
| 7 ;; Maintainer: XEmacs Development Team | |
| 8 ;; Keywords: terminals, dumped | |
| 9 | |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5260
diff
changeset
|
12 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5260
diff
changeset
|
13 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5260
diff
changeset
|
14 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5260
diff
changeset
|
15 ;; option) any later version. |
| 428 | 16 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5260
diff
changeset
|
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5260
diff
changeset
|
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5260
diff
changeset
|
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5260
diff
changeset
|
20 ;; for more details. |
| 428 | 21 |
| 22 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5260
diff
changeset
|
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 24 |
| 25 ;;; Synched up with: Not synched. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ;; This file is dumped with XEmacs (when X support is compiled in). | |
| 30 | |
| 31 ;;; Code: | |
| 32 | |
| 502 | 33 (globally-declare-fboundp |
| 34 '(x-keysym-on-keyboard-p | |
| 35 x-server-vendor x-init-specifier-from-resources init-mule-x-win)) | |
| 36 | |
| 37 (globally-declare-boundp | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
38 '(x-initial-argv-list x-app-defaults-directory)) |
| 502 | 39 |
| 428 | 40 ;; If you want to change this variable, this is the place you must do it. |
| 41 ;; Do not set it to a string containing periods. X doesn't like that. | |
| 42 ;(setq x-emacs-application-class "Emacs") | |
| 43 | |
| 44 (defgroup x nil | |
| 45 "The X Window system." | |
| 46 :group 'environment) | |
| 47 | |
| 48 ;; OpenWindows-like "find" processing. These functions are really Sunisms, | |
| 49 ;; but we put them here instead of in x-win-sun.el in case someone wants | |
| 50 ;; to use them when not running on a Sun console (presumably after binding | |
| 51 ;; them to different keys, or putting them on menus.) | |
| 52 | |
| 53 (defvar ow-find-last-string nil) | |
| 54 (defvar ow-find-last-clipboard nil) | |
| 55 | |
| 56 (defun ow-find (&optional backward-p) | |
| 57 "Search forward the next occurrence of the text of the selection." | |
| 58 (interactive) | |
| 442 | 59 (let ((sel (ignore-errors (get-selection))) |
| 60 (clip (ignore-errors (get-clipboard))) | |
| 428 | 61 text) |
| 62 (setq text (cond | |
| 63 (sel) | |
| 64 ((not (equal clip ow-find-last-clipboard)) | |
| 65 (setq ow-find-last-clipboard clip)) | |
| 66 (ow-find-last-string) | |
| 67 (t (error "No selection available")))) | |
| 68 (setq ow-find-last-string text) | |
| 69 (cond (backward-p | |
| 70 (search-backward text) | |
| 71 (set-mark (+ (point) (length text)))) | |
| 72 (t | |
| 73 (search-forward text) | |
| 74 (set-mark (- (point) (length text))))) | |
| 75 (zmacs-activate-region))) | |
| 76 | |
| 77 (defun ow-find-backward () | |
| 78 "Search backward for the previous occurrence of the text of the selection." | |
| 79 (interactive) | |
| 80 (ow-find t)) | |
| 81 | |
| 82 (eval-when-compile | |
| 83 (load "x-win-sun" nil t) | |
| 84 (load "x-win-xfree86" nil t)) | |
| 85 | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
86 (defun x-initialize-keyboard (device) |
| 428 | 87 "Perform X-Server-specific initializations. Don't call this." |
| 88 ;; This is some heuristic junk that tries to guess whether this is | |
| 89 ;; a Sun keyboard. | |
| 90 ;; | |
| 91 ;; One way of implementing this (which would require C support) would | |
| 92 ;; be to examine the X keymap itself and see if the layout looks even | |
| 93 ;; remotely like a Sun - check for the Find key on a particular | |
| 94 ;; keycode, for example. It'd be nice to have a table of this to | |
| 95 ;; recognize various keyboards; see also xkeycaps. | |
| 96 ;; | |
| 97 ;; Note that we cannot use most vendor-provided proprietary keyboard | |
| 98 ;; APIs to identify the keyboard - those only work on the console. | |
| 99 ;; xkeycaps has the same problem when running `remotely'. | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
100 (let ((vendor (x-server-vendor device))) |
| 428 | 101 (cond ((or (string-match "Sun Microsystems" vendor) |
| 102 ;; MIT losingly fails to tell us what hardware the X server | |
| 103 ;; is managing, so assume all MIT displays are Suns... HA HA! | |
| 104 (string-equal "MIT X Consortium" vendor) | |
| 105 (string-equal "X Consortium" vendor)) | |
| 106 ;; Ok, we think this could be a Sun keyboard. Run the Sun code. | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
107 (x-win-init-sun device)) |
| 4062 | 108 ((string-match #r"XFree86\|Cygwin/X\|The X\.Org Foundation" vendor) |
| 428 | 109 ;; Those XFree86 people do some weird keysym stuff, too. |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
110 (x-win-init-xfree86 device))))) |
| 428 | 111 |
| 3360 | 112 ;; Moved from x-toolbar.el, since InfoDock doesn't dump x-toolbar.el. |
| 428 | 113 (defun x-init-toolbar-from-resources (locale) |
| 114 (loop for (specifier . resname) in | |
| 115 `(( ,top-toolbar-height . "topToolBarHeight") | |
| 116 (,bottom-toolbar-height . "bottomToolBarHeight") | |
| 117 ( ,left-toolbar-width . "leftToolBarWidth") | |
| 118 ( ,right-toolbar-width . "rightToolBarWidth") | |
| 119 | |
| 120 ( ,top-toolbar-border-width . "topToolBarBorderWidth") | |
| 121 (,bottom-toolbar-border-width . "bottomToolBarBorderWidth") | |
| 122 ( ,left-toolbar-border-width . "leftToolBarBorderWidth") | |
| 123 ( ,right-toolbar-border-width . "rightToolBarBorderWidth")) | |
| 124 do | |
| 125 (x-init-specifier-from-resources | |
| 126 specifier 'natnum locale (cons resname (upcase-initials resname))))) | |
| 127 | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
128 (defvar make-device-early-x-entry-point-called-p nil |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
129 "Whether `make-device-early-x-entry-point' has been called, at least once. |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
130 |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
131 Much of the X11-specific Lisp init code should only be called the first time |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
132 an X11 device is created; this variable allows for that.") |
| 428 | 133 |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
134 (defvar make-device-late-x-entry-point-called-p nil |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
135 "Whether `make-device-late-x-entry-point' has been called, at least once. |
| 428 | 136 |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
137 Much of the X11-specific Lisp init code should only be called the first time |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
138 an X11 device is created; this variable allows for that.") |
| 428 | 139 |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
140 (defun make-device-early-x-entry-point () |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
141 "Entry point to set up the Lisp environment for X device creation." |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
142 (unless make-device-early-x-entry-point-called-p |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
143 (setq initial-frame-plist |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
144 (and initial-frame-unmapped-p '(initially-unmapped t)) |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
145 ;; Save the argv value. |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
146 x-initial-argv-list |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
147 (cons (car command-line-args) command-line-args-left) |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
148 ;; Locate the app-defaults directory |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
149 x-app-defaults-directory |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
150 (or x-app-defaults-directory (locate-data-directory "app-defaults")) |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
151 make-device-early-x-entry-point-called-p t))) |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
152 |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
153 (defun make-device-late-x-entry-point (device) |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
154 "Entry point to do any Lisp-level X device-specific initialization." |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
155 ;; General code, called on every X device created: |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
156 (x-initialize-keyboard device) |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
157 ;; And the following code is to be called once, the first time an X11 |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
158 ;; device is created: |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
159 (unless make-device-late-x-entry-point-called-p |
| 428 | 160 (setq command-line-args-left (cdr x-initial-argv-list)) |
| 161 ;; Motif-ish bindings | |
| 162 (define-key global-map '(shift insert) 'yank-clipboard-selection) | |
| 163 (define-key global-map '(control insert) 'copy-primary-selection) | |
| 164 ;; These are Sun-isms. | |
| 165 (define-key global-map 'copy 'copy-primary-selection) | |
| 166 (define-key global-map 'paste 'yank-clipboard-selection) | |
| 167 (define-key global-map 'cut 'kill-primary-selection) | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4451
diff
changeset
|
168 (setq make-device-late-x-entry-point-called-p t))) |
| 428 | 169 |
| 170 (defun make-frame-on-display (display &optional props) | |
| 171 "Create a frame on the X display named DISPLAY. | |
| 172 DISPLAY should be a standard display string such as \"unix:0\", | |
| 173 or nil for the display specified on the command line or in the | |
| 174 DISPLAY environment variable. | |
| 175 | |
| 176 PROPS should be a plist of properties, as in the call to `make-frame'. | |
| 177 | |
| 178 This function opens a connection to the display or reuses an existing | |
| 179 connection. | |
| 180 | |
| 181 This function is a trivial wrapper around `make-frame-on-device'." | |
| 182 (interactive "sMake frame on display: ") | |
| 183 (if (equal display "") (setq display nil)) | |
| 184 (make-frame-on-device 'x display props)) | |
| 185 | |
| 186 ;;; x-init.el ends here |