aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJason Rumney2007-05-16 10:13:09 +0000
committerJason Rumney2007-05-16 10:13:09 +0000
commit00954c67012d2ca927ef7ee6520636e35d682ce5 (patch)
tree17c14e205ed339f65876ca3406785add98793a80
parent91dc6f73095240242270c511afa081c48fa7d161 (diff)
downloademacs-00954c67012d2ca927ef7ee6520636e35d682ce5.tar.gz
emacs-00954c67012d2ca927ef7ee6520636e35d682ce5.zip
(x-setup-function-keys): New function.
(w32-initialize-window-system): Move non function key global setup here.
-rw-r--r--lisp/term/w32-win.el212
1 files changed, 99 insertions, 113 deletions
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 682de57d8a3..5bcc1aac822 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -89,9 +89,6 @@
89;; The following definition is used for debugging scroll bar events. 89;; The following definition is used for debugging scroll bar events.
90;(defun w32-handle-scroll-bar-event (event) (interactive "e") (princ event)) 90;(defun w32-handle-scroll-bar-event (event) (interactive "e") (princ event))
91 91
92;; Handle mouse-wheel events with mwheel.
93(mouse-wheel-mode 1)
94
95(defun w32-drag-n-drop-debug (event) 92(defun w32-drag-n-drop-debug (event)
96 "Print the drag-n-drop EVENT in a readable form." 93 "Print the drag-n-drop EVENT in a readable form."
97 (interactive "e") 94 (interactive "e")
@@ -1039,44 +1036,18 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
1039 1036
1040;;;; Function keys 1037;;;; Function keys
1041 1038
1042;;; make f10 activate the real menubar rather than the mini-buffer menu 1039(defun x-setup-function-keys (frame)
1043;;; navigation feature. 1040 "Setup Function Keys for w32."
1044(global-set-key [f10] (lambda () 1041 ;; make f10 activate the real menubar rather than the mini-buffer menu
1045 (interactive) (w32-send-sys-command ?\xf100))) 1042 ;; navigation feature.
1046 1043 (global-set-key [f10] (lambda ()
1047(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame 1044 (interactive) (w32-send-sys-command ?\xf100)))
1048 global-map)
1049 1045
1050(define-key function-key-map [S-tab] [backtab]) 1046 (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
1047 global-map)
1051 1048
1049 (define-key function-key-map [S-tab] [backtab]))
1052 1050
1053;;; Do the actual Windows setup here; the above code just defines
1054;;; functions and variables that we use now.
1055
1056(setq command-line-args (x-handle-args command-line-args))
1057
1058;;; Make sure we have a valid resource name.
1059(or (stringp x-resource-name)
1060 (setq x-resource-name
1061 ;; Change any . or * characters in x-resource-name to hyphens,
1062 ;; so as not to choke when we use it in X resource queries.
1063 (replace-regexp-in-string "[.*]" "-" (invocation-name))))
1064
1065;; For the benefit of older Emacses (19.27 and earlier) that are sharing
1066;; the same lisp directory, don't pass the third argument unless we seem
1067;; to have the multi-display support.
1068(if (fboundp 'x-close-connection)
1069 (x-open-connection ""
1070 x-command-line-resources
1071 ;; Exit Emacs with fatal error if this fails.
1072 t)
1073 (x-open-connection ""
1074 x-command-line-resources))
1075
1076(setq frame-creation-function 'x-create-frame-with-faces)
1077
1078;; (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100)
1079;; x-cut-buffer-max))
1080 1051
1081;; W32 expects the menu bar cut and paste commands to use the clipboard. 1052;; W32 expects the menu bar cut and paste commands to use the clipboard.
1082;; This has ,? to match both on Sunos and on Solaris. 1053;; This has ,? to match both on Sunos and on Solaris.
@@ -1093,83 +1064,9 @@ European languages which are distributed with Windows as
1093 1064
1094See the documentation of `create-fontset-from-fontset-spec' for the format.") 1065See the documentation of `create-fontset-from-fontset-spec' for the format.")
1095 1066
1096;; Conditional on new-fontset so bootstrapping works on non-GUI compiles
1097(if (fboundp 'new-fontset)
1098 (progn
1099 ;; Setup the default fontset.
1100 (setup-default-fontset)
1101 ;; Create the standard fontset.
1102 (create-fontset-from-fontset-spec w32-standard-fontset-spec t)
1103 ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...).
1104 (create-fontset-from-x-resource)
1105 ;; Try to create a fontset from a font specification which comes
1106 ;; from initial-frame-alist, default-frame-alist, or X resource.
1107 ;; A font specification in command line argument (i.e. -fn XXXX)
1108 ;; should be already in default-frame-alist as a `font'
1109 ;; parameter. However, any font specifications in site-start
1110 ;; library, user's init file (.emacs), and default.el are not
1111 ;; yet handled here.
1112
1113 (let ((font (or (cdr (assq 'font initial-frame-alist))
1114 (cdr (assq 'font default-frame-alist))
1115 (x-get-resource "font" "Font")))
1116 xlfd-fields resolved-name)
1117 (if (and font
1118 (not (query-fontset font))
1119 (setq resolved-name (x-resolve-font-name font))
1120 (setq xlfd-fields (x-decompose-font-name font)))
1121 (if (string= "fontset"
1122 (aref xlfd-fields xlfd-regexp-registry-subnum))
1123 (new-fontset font
1124 (x-complement-fontset-spec xlfd-fields nil))
1125 ;; Create a fontset from FONT. The fontset name is
1126 ;; generated from FONT.
1127 (create-fontset-from-ascii-font font
1128 resolved-name "startup"))))))
1129
1130;; Apply a geometry resource to the initial frame. Put it at the end
1131;; of the alist, so that anything specified on the command line takes
1132;; precedence.
1133(let* ((res-geometry (x-get-resource "geometry" "Geometry"))
1134 parsed)
1135 (if res-geometry
1136 (progn
1137 (setq parsed (x-parse-geometry res-geometry))
1138 ;; If the resource specifies a position,
1139 ;; call the position and size "user-specified".
1140 (if (or (assq 'top parsed) (assq 'left parsed))
1141 (setq parsed (cons '(user-position . t)
1142 (cons '(user-size . t) parsed))))
1143 ;; All geometry parms apply to the initial frame.
1144 (setq initial-frame-alist (append initial-frame-alist parsed))
1145 ;; The size parms apply to all frames.
1146 (if (assq 'height parsed)
1147 (push (cons 'height (cdr (assq 'height parsed)))
1148 default-frame-alist))
1149 (if (assq 'width parsed)
1150 (push (cons 'width (cdr (assq 'width parsed)))
1151 default-frame-alist)))))
1152
1153;; Check the reverseVideo resource.
1154(let ((case-fold-search t))
1155 (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
1156 (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv))
1157 (push '(reverse . t) default-frame-alist))))
1158
1159(defun x-win-suspend-error () 1067(defun x-win-suspend-error ()
1160 "Report an error when a suspend is attempted." 1068 "Report an error when a suspend is attempted."
1161 (error "Suspending an Emacs running under W32 makes no sense")) 1069 (error "Suspending an Emacs running under W32 makes no sense"))
1162(add-hook 'suspend-hook 'x-win-suspend-error)
1163
1164;;; Turn off window-splitting optimization; w32 is usually fast enough
1165;;; that this is only annoying.
1166(setq split-window-keep-point t)
1167
1168;; Don't show the frame name; that's redundant.
1169(setq-default mode-line-frame-identification " ")
1170
1171;;; Set to a system sound if you want a fancy bell.
1172(set-message-beep 'ok)
1173 1070
1174;; Remap some functions to call w32 common dialogs 1071;; Remap some functions to call w32 common dialogs
1175 1072
@@ -1249,7 +1146,96 @@ pop-up menu are unaffected by `w32-list-proportional-fonts')."
1249;; multi-tty support 1146;; multi-tty support
1250(defun w32-initialize-window-system () 1147(defun w32-initialize-window-system ()
1251 "Initialize Emacs for W32 GUI frames." 1148 "Initialize Emacs for W32 GUI frames."
1252) 1149 ;; Handle mouse-wheel events with mwheel.
1150 (mouse-wheel-mode 1)
1151
1152 ;; Do the actual Windows setup here; the above code just defines
1153 ;; functions and variables that we use now.
1154
1155 (setq command-line-args (x-handle-args command-line-args))
1156
1157 ;; Make sure we have a valid resource name.
1158 (or (stringp x-resource-name)
1159 (setq x-resource-name
1160 ;; Change any . or * characters in x-resource-name to hyphens,
1161 ;; so as not to choke when we use it in X resource queries.
1162 (replace-regexp-in-string "[.*]" "-" (invocation-name))))
1163
1164 (x-open-connection "" x-command-line-resources t)
1165
1166 (setq frame-creation-function 'x-create-frame-with-faces)
1167
1168 ;; Setup the default fontset.
1169 (setup-default-fontset)
1170 ;; Create the standard fontset.
1171 (create-fontset-from-fontset-spec w32-standard-fontset-spec t)
1172 ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...).
1173 (create-fontset-from-x-resource)
1174 ;; Try to create a fontset from a font specification which comes
1175 ;; from initial-frame-alist, default-frame-alist, or X resource.
1176 ;; A font specification in command line argument (i.e. -fn XXXX)
1177 ;; should be already in default-frame-alist as a `font'
1178 ;; parameter. However, any font specifications in site-start
1179 ;; library, user's init file (.emacs), and default.el are not
1180 ;; yet handled here.
1181
1182 (let ((font (or (cdr (assq 'font initial-frame-alist))
1183 (cdr (assq 'font default-frame-alist))
1184 (x-get-resource "font" "Font")))
1185 xlfd-fields resolved-name)
1186 (if (and font
1187 (not (query-fontset font))
1188 (setq resolved-name (x-resolve-font-name font))
1189 (setq xlfd-fields (x-decompose-font-name font)))
1190 (if (string= "fontset"
1191 (aref xlfd-fields xlfd-regexp-registry-subnum))
1192 (new-fontset font
1193 (x-complement-fontset-spec xlfd-fields nil))
1194 ;; Create a fontset from FONT. The fontset name is
1195 ;; generated from FONT.
1196 (create-fontset-from-ascii-font font
1197 resolved-name "startup"))))
1198
1199 ;; Apply a geometry resource to the initial frame. Put it at the end
1200 ;; of the alist, so that anything specified on the command line takes
1201 ;; precedence.
1202 (let* ((res-geometry (x-get-resource "geometry" "Geometry"))
1203 parsed)
1204 (if res-geometry
1205 (progn
1206 (setq parsed (x-parse-geometry res-geometry))
1207 ;; If the resource specifies a position,
1208 ;; call the position and size "user-specified".
1209 (if (or (assq 'top parsed) (assq 'left parsed))
1210 (setq parsed (cons '(user-position . t)
1211 (cons '(user-size . t) parsed))))
1212 ;; All geometry parms apply to the initial frame.
1213 (setq initial-frame-alist (append initial-frame-alist parsed))
1214 ;; The size parms apply to all frames.
1215 (if (assq 'height parsed)
1216 (push (cons 'height (cdr (assq 'height parsed)))
1217 default-frame-alist))
1218 (if (assq 'width parsed)
1219 (push (cons 'width (cdr (assq 'width parsed)))
1220 default-frame-alist)))))
1221
1222 (add-hook 'suspend-hook 'x-win-suspend-error)
1223
1224 ;; Turn off window-splitting optimization; w32 is usually fast enough
1225 ;; that this is only annoying.
1226 (setq split-window-keep-point t)
1227
1228 ;; Don't show the frame name; that's redundant.
1229 (setq-default mode-line-frame-identification " ")
1230
1231 ;; Set to a system sound if you want a fancy bell.
1232 (set-message-beep 'ok)
1233
1234 ;; Check the reverseVideo resource.
1235 (let ((case-fold-search t))
1236 (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
1237 (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv))
1238 (push '(reverse . t) default-frame-alist)))))
1253 1239
1254(add-to-list 'handle-args-function-alist '(w32 . x-handle-args)) 1240(add-to-list 'handle-args-function-alist '(w32 . x-handle-args))
1255(add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces)) 1241(add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces))