diff options
| author | Jason Rumney | 2007-05-16 10:13:09 +0000 |
|---|---|---|
| committer | Jason Rumney | 2007-05-16 10:13:09 +0000 |
| commit | 00954c67012d2ca927ef7ee6520636e35d682ce5 (patch) | |
| tree | 17c14e205ed339f65876ca3406785add98793a80 | |
| parent | 91dc6f73095240242270c511afa081c48fa7d161 (diff) | |
| download | emacs-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.el | 212 |
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 | ||
| 1094 | See the documentation of `create-fontset-from-fontset-spec' for the format.") | 1065 | See 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)) |