Mercurial > hg > xemacs-beta

comparison lisp/x11/x-init.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children b82b59fe008d
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
47 (if (marker-buffer (mark-marker t)) 47 (if (marker-buffer (mark-marker t))
48 (x-own-selection (cons (point-marker t) (mark-marker t))))) 48 (x-own-selection (cons (point-marker t) (mark-marker t)))))
49 49
50 ;;; OpenWindows-like "find" processing. These functions are really Sunisms, 50 ;;; OpenWindows-like "find" processing. These functions are really Sunisms,
51 ;;; but we put them here instead of in x-win-sun.el in case someone wants 51 ;;; but we put them here instead of in x-win-sun.el in case someone wants
52 ;;; to use them when not running on a Sun console (presumably after adding 52 ;;; to use them when not running on a Sun console (presumably after binding
53 ;;; the to different keys, or putting them on menus.) 53 ;;; them to different keys, or putting them on menus.)
54 54
55 (defvar ow-find-last-string nil) 55 (defvar ow-find-last-string nil)
56 (defvar ow-find-last-clipboard nil) 56 (defvar ow-find-last-clipboard nil)
57 57
58 (defun ow-find (&optional backward-p) 58 (defun ow-find (&optional backward-p)
75 (search-forward text) 75 (search-forward text)
76 (set-mark (- (point) (length text))))) 76 (set-mark (- (point) (length text)))))
77 (zmacs-activate-region))) 77 (zmacs-activate-region)))
78 78
79 (defun ow-find-backward () 79 (defun ow-find-backward ()
80 "Search backward the previous occurence of the text of the selection." 80 "Search backward the previous occurrence of the text of the selection."
81 (interactive) 81 (interactive)
82 (ow-find t)) 82 (ow-find t))
83 83
84 ;;; Load X-server specific code. 84 ;;; Load X-server specific code.
85 ;;; Specifically, load some code to repair the grievous damage that MIT and 85 ;;; Specifically, load some code to repair the grievous damage that MIT and
86 ;;; Sun have done to the default keymap for the Sun keyboards. 86 ;;; Sun have done to the default keymap for the Sun keyboards.
87 87
88 (defun x-initialize-keyboard () 88 (defun x-initialize-keyboard ()
89 "Don't call this." 89 "Perform X-Server-specific initializations. Don't call this."
90 (cond (;; This is some heuristic junk that tries to guess whether this is 90 ;; This is some heuristic junk that tries to guess whether this is
91 ;; a Sun keyboard. 91 ;; a Sun keyboard.
92 ;; 92 ;;
93 ;; One way of implementing this (which would require C support) would 93 ;; One way of implementing this (which would require C support) would
94 ;; be to examine the X keymap itself and see if the layout looks even 94 ;; be to examine the X keymap itself and see if the layout looks even
95 ;; remotely like a Sun - check for the Find key on a particular 95 ;; remotely like a Sun - check for the Find key on a particular
96 ;; keycode, for example. It'd be nice to have a table of this to 96 ;; keycode, for example. It'd be nice to have a table of this to
97 ;; recognize various keyboards; see also xkeycaps. 97 ;; recognize various keyboards; see also xkeycaps.
98 ;; 98 (let ((vendor (x-server-vendor)))
99 (let ((vendor (x-server-vendor))) 99 (cond ((or (string-match "Sun Microsystems" vendor)
100 (or (string-match "Sun Microsystems" vendor)
101 ;; MIT losingly fails to tell us what hardware the X server 100 ;; MIT losingly fails to tell us what hardware the X server
102 ;; is managing, so assume all MIT displays are Suns... HA HA! 101 ;; is managing, so assume all MIT displays are Suns... HA HA!
103 (string-equal "MIT X Consortium" vendor) 102 (string-equal "MIT X Consortium" vendor)
104 (string-equal "X Consortium" vendor))) 103 (string-equal "X Consortium" vendor))
105 ;; 104 ;; Ok, we think this could be a Sun keyboard. Load the Sun code.
106 ;; Ok, we think this could be a Sun keyboard. Load the Sun code. 105 (or (load "x-win-sun" t t)
107 ;; 106 (warn "Unable to load term file x-win-sun")))
108 (or (load "x-win-sun" t t) 107 ((string-match "XFree86" vendor)
109 (warn "Unable to load term file x-win-sun")) 108 ;; Those XFree86 people do some weird keysym stuff, too.
110 ) 109 (or (load "x-win-xfree86" t t)
111 ((string-match "XFree86" (x-server-vendor)) 110 (warn "Unable to load term file x-win-xfree86")))
112 ;; Those XFree86 people do some weird keysym stuff, too. 111 )))
113 (or (load "x-win-xfree86" t t)
114 (warn "Unable to load term file x-win-xfree86")))
115 ))
116 112
117 113
118 (defvar pre-x-win-initted nil) 114 (defvar pre-x-win-initted nil)
119 115
120 (defun init-pre-x-win () 116 (defun init-pre-x-win ()
121 "Initialize X Windows at startup (pre). Don't call this." 117 "Initialize X Windows at startup (pre). Don't call this."
122 (if (not pre-x-win-initted) 118 (when (not pre-x-win-initted)
123 (progn 119 (require 'x-iso8859-1)
124 (require 'x-iso8859-1) 120 (setq character-set-property 'x-iso8859/1) ; see x-iso8859-1.el
125 (setq character-set-property 'x-iso8859/1) ; see x-iso8859-1.el
126 121
127 (setq initial-frame-plist (if initial-frame-unmapped-p 122 (setq initial-frame-plist (if initial-frame-unmapped-p
128 '(initially-unmapped t) 123 '(initially-unmapped t)
129 nil)) 124 nil))
130 (setq pre-x-win-initted t)))) 125 (setq pre-x-win-initted t)))
131 126
132 (defvar x-win-initted nil) 127 (defvar x-win-initted nil)
133 128
134 (defun init-x-win () 129 (defun init-x-win ()
135 "Initialize X Windows at startup. Don't call this." 130 "Initialize X Windows at startup. Don't call this."
136 (if (not x-win-initted) 131 (when (not x-win-initted)
137 (progn 132 (init-pre-x-win)
138 (init-pre-x-win)
139 133
140 ;; Open the X display when this file is loaded 134 ;; Open the X display when this file is loaded
141 ;; (Note that the first frame is created later.) 135 ;; (Note that the first frame is created later.)
142 (setq x-initial-argv-list (cons (car command-line-args) 136 (setq x-initial-argv-list (cons (car command-line-args)
143 command-line-args-left)) 137 command-line-args-left))
144 (make-x-device nil) 138 (make-x-device nil)
145 (setq command-line-args-left (cdr x-initial-argv-list)) 139 (setq command-line-args-left (cdr x-initial-argv-list))
146 (setq x-win-initted t)))) 140 (setq x-win-initted t)))
147 141
148 (defvar post-x-win-initted nil) 142 (defvar post-x-win-initted nil)
149 143
150 (defun init-post-x-win () 144 (defun init-post-x-win ()
151 "Initialize X Windows at startup (post). Don't call this." 145 "Initialize X Windows at startup (post). Don't call this."
152 (if (not post-x-win-initted) 146 (when (not post-x-win-initted)
153 (progn 147 ;; We can't load this until after the initial X device is created
154 ;; We can't load this until after the initial X device is created 148 ;; because the icon initialization needs to access the display to get
155 ;; because the icon initialization needs to access the display to get 149 ;; any toolbar-related color resources.
156 ;; any toolbar-related color resources. 150 (if (featurep 'toolbar)
157 (if (featurep 'toolbar) 151 (init-x-toolbar))
158 (init-x-toolbar)) 152 ;; these are only ever called if zmacs-regions is true.
159 ;; these are only ever called if zmacs-regions is true. 153 (add-hook 'zmacs-deactivate-region-hook 'x-disown-selection)
160 (add-hook 'zmacs-deactivate-region-hook 'x-disown-selection) 154 (add-hook 'zmacs-activate-region-hook 'x-activate-region-as-selection)
161 (add-hook 'zmacs-activate-region-hook 'x-activate-region-as-selection) 155 (add-hook 'zmacs-update-region-hook 'x-activate-region-as-selection)
162 (add-hook 'zmacs-update-region-hook 'x-activate-region-as-selection)
163 156
164 ;; Motif-ish bindings 157 ;; Motif-ish bindings
165 ;; The following two were generally unliked. 158 ;; The following two were generally unliked.
166 ;;(define-key global-map '(shift delete) 159 ;;(define-key global-map '(shift delete) 'x-kill-primary-selection)
167 ;; 'x-kill-primary-selection) 160 ;;(define-key global-map '(control delete) 'x-delete-primary-selection)
168 ;;(define-key global-map '(control delete) 161 (define-key global-map '(shift insert) 'x-yank-clipboard-selection)
169 ;; 'x-delete-primary-selection) 162 (define-key global-map '(control insert) 'x-copy-primary-selection)
170 (define-key global-map '(shift insert) 'x-yank-clipboard-selection) 163 ;; These are Sun-isms.
171 (define-key global-map '(control insert) 'x-copy-primary-selection) 164 (define-key global-map 'copy 'x-copy-primary-selection)
172 ;; (Are these Sunisms?) 165 (define-key global-map 'paste 'x-yank-clipboard-selection)
173 (define-key global-map 'copy 'x-copy-primary-selection) 166 (define-key global-map 'cut 'x-kill-primary-selection)
174 (define-key global-map 'paste 'x-yank-clipboard-selection)
175 (define-key global-map 'cut 'x-kill-primary-selection)
176 167
177 (define-key global-map 'menu 'popup-mode-menu) 168 (define-key global-map 'menu 'popup-mode-menu)
178 ;;(define-key global-map '(shift menu) 'x-goto-menubar) ;NYI 169 ;;(define-key global-map '(shift menu) 'x-goto-menubar) ;NYI
179 170
180 ;; This runs after the first frame has been created (we can't 171 ;; This runs after the first frame has been created (we can't
181 ;; talk to the X server before that) but before the 172 ;; talk to the X server before that) but before the
182 ;; site-start-file or .emacs file, so sites and users have a 173 ;; site-start-file or .emacs file, so sites and users have a
183 ;; chance to override it. 174 ;; chance to override it.
184 (add-hook 'before-init-hook 'x-initialize-keyboard) 175 (add-hook 'before-init-hook 'x-initialize-keyboard)
185 176
186 (setq post-x-win-initted t)))) 177 (setq post-x-win-initted t)))
187 178
188 (defun make-frame-on-display (display &optional parms) 179 (defun make-frame-on-display (display &optional parms)
189 "Create a frame on the X display named DISPLAY. 180 "Create a frame on the X display named DISPLAY.
190 DISPLAY should be a standard display string such as \"unix:0\", 181 DISPLAY should be a standard display string such as \"unix:0\",
191 or nil for the display specified on the command line or in the 182 or nil for the display specified on the command line or in the