Mercurial > emacs
changeset 83598:9ebefb43d02d
(x-setup-function-keys): New function.
(w32-initialize-window-system): Move non function key global setup
here.
| author | Jason Rumney <jasonr@gnu.org> |
|---|---|
| date | Wed, 16 May 2007 10:13:09 +0000 |
| parents | e1a74926d58b |
| children | 97b499195801 |
| files | lisp/term/w32-win.el |
| diffstat | 1 files changed, 100 insertions(+), 114 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/term/w32-win.el Wed May 16 10:09:11 2007 +0000 +++ b/lisp/term/w32-win.el Wed May 16 10:13:09 2007 +0000 @@ -89,9 +89,6 @@ ;; The following definition is used for debugging scroll bar events. ;(defun w32-handle-scroll-bar-event (event) (interactive "e") (princ event)) -;; Handle mouse-wheel events with mwheel. -(mouse-wheel-mode 1) - (defun w32-drag-n-drop-debug (event) "Print the drag-n-drop EVENT in a readable form." (interactive "e") @@ -1039,44 +1036,18 @@ ;;;; Function keys -;;; make f10 activate the real menubar rather than the mini-buffer menu -;;; navigation feature. -(global-set-key [f10] (lambda () - (interactive) (w32-send-sys-command ?\xf100))) - -(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame - global-map) - -(define-key function-key-map [S-tab] [backtab]) - - -;;; Do the actual Windows setup here; the above code just defines -;;; functions and variables that we use now. - -(setq command-line-args (x-handle-args command-line-args)) +(defun x-setup-function-keys (frame) + "Setup Function Keys for w32." + ;; make f10 activate the real menubar rather than the mini-buffer menu + ;; navigation feature. + (global-set-key [f10] (lambda () + (interactive) (w32-send-sys-command ?\xf100))) -;;; Make sure we have a valid resource name. -(or (stringp x-resource-name) - (setq x-resource-name - ;; Change any . or * characters in x-resource-name to hyphens, - ;; so as not to choke when we use it in X resource queries. - (replace-regexp-in-string "[.*]" "-" (invocation-name)))) + (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame + global-map) -;; For the benefit of older Emacses (19.27 and earlier) that are sharing -;; the same lisp directory, don't pass the third argument unless we seem -;; to have the multi-display support. -(if (fboundp 'x-close-connection) - (x-open-connection "" - x-command-line-resources - ;; Exit Emacs with fatal error if this fails. - t) - (x-open-connection "" - x-command-line-resources)) - -(setq frame-creation-function 'x-create-frame-with-faces) - -;; (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) -;; x-cut-buffer-max)) + (define-key function-key-map [S-tab] [backtab])) + ;; W32 expects the menu bar cut and paste commands to use the clipboard. ;; This has ,? to match both on Sunos and on Solaris. @@ -1093,83 +1064,9 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") -;; Conditional on new-fontset so bootstrapping works on non-GUI compiles -(if (fboundp 'new-fontset) - (progn - ;; Setup the default fontset. - (setup-default-fontset) - ;; Create the standard fontset. - (create-fontset-from-fontset-spec w32-standard-fontset-spec t) - ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...). - (create-fontset-from-x-resource) - ;; Try to create a fontset from a font specification which comes - ;; from initial-frame-alist, default-frame-alist, or X resource. - ;; A font specification in command line argument (i.e. -fn XXXX) - ;; should be already in default-frame-alist as a `font' - ;; parameter. However, any font specifications in site-start - ;; library, user's init file (.emacs), and default.el are not - ;; yet handled here. - - (let ((font (or (cdr (assq 'font initial-frame-alist)) - (cdr (assq 'font default-frame-alist)) - (x-get-resource "font" "Font"))) - xlfd-fields resolved-name) - (if (and font - (not (query-fontset font)) - (setq resolved-name (x-resolve-font-name font)) - (setq xlfd-fields (x-decompose-font-name font))) - (if (string= "fontset" - (aref xlfd-fields xlfd-regexp-registry-subnum)) - (new-fontset font - (x-complement-fontset-spec xlfd-fields nil)) - ;; Create a fontset from FONT. The fontset name is - ;; generated from FONT. - (create-fontset-from-ascii-font font - resolved-name "startup")))))) - -;; Apply a geometry resource to the initial frame. Put it at the end -;; of the alist, so that anything specified on the command line takes -;; precedence. -(let* ((res-geometry (x-get-resource "geometry" "Geometry")) - parsed) - (if res-geometry - (progn - (setq parsed (x-parse-geometry res-geometry)) - ;; If the resource specifies a position, - ;; call the position and size "user-specified". - (if (or (assq 'top parsed) (assq 'left parsed)) - (setq parsed (cons '(user-position . t) - (cons '(user-size . t) parsed)))) - ;; All geometry parms apply to the initial frame. - (setq initial-frame-alist (append initial-frame-alist parsed)) - ;; The size parms apply to all frames. - (if (assq 'height parsed) - (push (cons 'height (cdr (assq 'height parsed))) - default-frame-alist)) - (if (assq 'width parsed) - (push (cons 'width (cdr (assq 'width parsed))) - default-frame-alist))))) - -;; Check the reverseVideo resource. -(let ((case-fold-search t)) - (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) - (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv)) - (push '(reverse . t) default-frame-alist)))) - (defun x-win-suspend-error () "Report an error when a suspend is attempted." (error "Suspending an Emacs running under W32 makes no sense")) -(add-hook 'suspend-hook 'x-win-suspend-error) - -;;; Turn off window-splitting optimization; w32 is usually fast enough -;;; that this is only annoying. -(setq split-window-keep-point t) - -;; Don't show the frame name; that's redundant. -(setq-default mode-line-frame-identification " ") - -;;; Set to a system sound if you want a fancy bell. -(set-message-beep 'ok) ;; Remap some functions to call w32 common dialogs @@ -1249,7 +1146,96 @@ ;; multi-tty support (defun w32-initialize-window-system () "Initialize Emacs for W32 GUI frames." -) + ;; Handle mouse-wheel events with mwheel. + (mouse-wheel-mode 1) + + ;; Do the actual Windows setup here; the above code just defines + ;; functions and variables that we use now. + + (setq command-line-args (x-handle-args command-line-args)) + + ;; Make sure we have a valid resource name. + (or (stringp x-resource-name) + (setq x-resource-name + ;; Change any . or * characters in x-resource-name to hyphens, + ;; so as not to choke when we use it in X resource queries. + (replace-regexp-in-string "[.*]" "-" (invocation-name)))) + + (x-open-connection "" x-command-line-resources t) + + (setq frame-creation-function 'x-create-frame-with-faces) + + ;; Setup the default fontset. + (setup-default-fontset) + ;; Create the standard fontset. + (create-fontset-from-fontset-spec w32-standard-fontset-spec t) + ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...). + (create-fontset-from-x-resource) + ;; Try to create a fontset from a font specification which comes + ;; from initial-frame-alist, default-frame-alist, or X resource. + ;; A font specification in command line argument (i.e. -fn XXXX) + ;; should be already in default-frame-alist as a `font' + ;; parameter. However, any font specifications in site-start + ;; library, user's init file (.emacs), and default.el are not + ;; yet handled here. + + (let ((font (or (cdr (assq 'font initial-frame-alist)) + (cdr (assq 'font default-frame-alist)) + (x-get-resource "font" "Font"))) + xlfd-fields resolved-name) + (if (and font + (not (query-fontset font)) + (setq resolved-name (x-resolve-font-name font)) + (setq xlfd-fields (x-decompose-font-name font))) + (if (string= "fontset" + (aref xlfd-fields xlfd-regexp-registry-subnum)) + (new-fontset font + (x-complement-fontset-spec xlfd-fields nil)) + ;; Create a fontset from FONT. The fontset name is + ;; generated from FONT. + (create-fontset-from-ascii-font font + resolved-name "startup")))) + + ;; Apply a geometry resource to the initial frame. Put it at the end + ;; of the alist, so that anything specified on the command line takes + ;; precedence. + (let* ((res-geometry (x-get-resource "geometry" "Geometry")) + parsed) + (if res-geometry + (progn + (setq parsed (x-parse-geometry res-geometry)) + ;; If the resource specifies a position, + ;; call the position and size "user-specified". + (if (or (assq 'top parsed) (assq 'left parsed)) + (setq parsed (cons '(user-position . t) + (cons '(user-size . t) parsed)))) + ;; All geometry parms apply to the initial frame. + (setq initial-frame-alist (append initial-frame-alist parsed)) + ;; The size parms apply to all frames. + (if (assq 'height parsed) + (push (cons 'height (cdr (assq 'height parsed))) + default-frame-alist)) + (if (assq 'width parsed) + (push (cons 'width (cdr (assq 'width parsed))) + default-frame-alist))))) + + (add-hook 'suspend-hook 'x-win-suspend-error) + + ;; Turn off window-splitting optimization; w32 is usually fast enough + ;; that this is only annoying. + (setq split-window-keep-point t) + + ;; Don't show the frame name; that's redundant. + (setq-default mode-line-frame-identification " ") + + ;; Set to a system sound if you want a fancy bell. + (set-message-beep 'ok) + + ;; Check the reverseVideo resource. + (let ((case-fold-search t)) + (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) + (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv)) + (push '(reverse . t) default-frame-alist))))) (add-to-list 'handle-args-function-alist '(w32 . x-handle-args)) (add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces))