;;; mac-win.el --- parse switches controlling interface with Mac window system -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
-;; 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Andrew Choi <akochoi@mac.com>
;; Keywords: terminals
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; An alist of X options and the function which handles them. See
;; ../startup.el.
-(if (not (eq window-system 'mac))
- (error "%s: Loading mac-win.el but not compiled for Mac" (invocation-name)))
+;; (if (not (eq window-system 'mac))
+;; (error "%s: Loading mac-win.el but not compiled for Mac" (invocation-name)))
(require 'frame)
(require 'mouse)
(defvar mac-service-selection)
(defvar mac-system-script-code)
(defvar mac-apple-event-map)
-(defvar mac-atsu-font-table)
(defvar mac-font-panel-mode)
(defvar mac-ts-active-input-overlay)
(defvar x-invocation-args)
(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
global-map)
+(defun x-setup-function-keys (frame)
+ "Setup Function Keys for mac."
;; Map certain keypad keys into ASCII characters
;; that people usually expect.
(define-key local-function-key-map [backspace] [?\d])
(define-key local-function-key-map [M-clear] [?\M-\C-l])
(define-key local-function-key-map [M-return] [?\M-\C-m])
(define-key local-function-key-map [M-escape] [?\M-\e])
+)
;; These tell read-char how to convert
;; these special chars to ASCII.
(if (and type-data
(setq str (mac-coerce-ae-data (car type-data)
(cdr type-data) "TEXT")))
- (string-to-number str)
+ (let ((num (string-to-number str)))
+ ;; Mac OS Classic may return "0e+0" as the coerced value for
+ ;; the type "magn" and the data "\000\000\000\000".
+ (if (= num 0.0) 0 num))
nil)))
(defun mac-bytes-to-integer (bytes &optional from to)
(+ (* i 10) 12)))))
result))
+(defconst mac-keyboard-modifier-mask-alist
+ (mapcar
+ (lambda (modifier-bit)
+ (cons (car modifier-bit) (lsh 1 (cdr modifier-bit))))
+ '((command . 8) ; cmdKeyBit
+ (shift . 9) ; shiftKeyBit
+ (option . 11) ; optionKeyBit
+ (control . 12) ; controlKeyBit
+ (function . 17))) ; kEventKeyModifierFnBit
+ "Alist of Mac keyboard modifier symbols vs masks.")
+
+(defun mac-ae-keyboard-modifiers (ae)
+ (let ((modifiers-value (mac-ae-number ae "kmod"))
+ modifiers)
+ (if modifiers-value
+ (dolist (modifier-mask mac-keyboard-modifier-mask-alist)
+ (if (/= (logand modifiers-value (cdr modifier-mask)) 0)
+ (setq modifiers (cons (car modifier-mask) modifiers)))))
+ modifiers))
+
(defun mac-ae-open-documents (event)
"Open the documents specified by the Apple event EVENT."
(interactive "e")
nil t)))))
(select-frame-set-input-focus (selected-frame)))
+(defun mac-ae-quit-application (event)
+ "Quit the application Emacs with the Apple event EVENT."
+ (interactive "e")
+ (let ((ae (mac-event-ae event)))
+ (unwind-protect
+ (save-buffers-kill-emacs)
+ ;; Reaches here if the user has canceled the quit.
+ (mac-resume-apple-event ae -128)))) ; userCanceledErr
+
(defun mac-ae-get-url (event)
"Open the URL specified by the Apple event EVENT.
Currently the `mailto' scheme is supported."
(let* ((ae (mac-event-ae event))
(parsed-url (url-generic-parse-url (mac-ae-text ae))))
(if (string= (url-type parsed-url) "mailto")
- (url-mailto parsed-url)
+ (progn
+ (url-mailto parsed-url)
+ (select-frame-set-input-focus (selected-frame)))
(mac-resume-apple-event ae t))))
(setq mac-apple-event-map (make-sparse-keymap))
'mac-ae-open-documents)
(define-key mac-apple-event-map [core-event show-preferences] 'customize)
(define-key mac-apple-event-map [core-event quit-application]
- 'save-buffers-kill-emacs)
+ 'mac-ae-quit-application)
(define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url)
frame where the tool-bar toggle button was pressed. With some
modifiers, it changes global tool-bar visibility setting."
(interactive "e")
- (let* ((ae (mac-event-ae event))
- (modifiers (cdr (mac-ae-parameter ae "kmod"))))
- (if (and modifiers (not (string= modifiers "\000\000\000\000")))
+ (let ((ae (mac-event-ae event)))
+ (if (mac-ae-keyboard-modifiers ae)
;; Globally toggle tool-bar-mode if some modifier key is pressed.
(tool-bar-mode)
(let ((frame (mac-ae-frame ae)))
'mac-handle-toolbar-switch-mode)
;;; Font panel
-(when (fboundp 'mac-set-font-panel-visibility)
+(when (fboundp 'mac-set-font-panel-visible-p)
(define-minor-mode mac-font-panel-mode
"Toggle use of the font panel.
:init-value nil
:global t
:group 'mac
- (mac-set-font-panel-visibility mac-font-panel-mode))
+ (mac-set-font-panel-visible-p mac-font-panel-mode))
(defun mac-handle-font-panel-closed (event)
"Update internal status in response to font panel closed EVENT."
(let* ((ae (mac-event-ae event))
(fm-font-size (mac-ae-number ae "fmsz"))
(atsu-font-id (mac-ae-number ae "auid"))
- (attribute-values (gethash atsu-font-id mac-atsu-font-table)))
+ (attribute-values (and atsu-font-id
+ (mac-atsu-font-face-attributes atsu-font-id))))
(if fm-font-size
(setq attribute-values
`(:height ,(* 10 fm-font-size) ,@attribute-values)))
"Show the font panel as a floating dialog")
'showhide-speedbar)
-) ;; (fboundp 'mac-set-font-panel-visibility)
+) ;; (fboundp 'mac-set-font-panel-visible-p)
;;; Text Services
(defvar mac-ts-active-input-buf ""
(mac-split-string-by-property-change string)
""))
+(defun mac-keyboard-translate-char (ch)
+ (if (and (char-valid-p ch)
+ (or (char-table-p keyboard-translate-table)
+ (and (or (stringp keyboard-translate-table)
+ (vectorp keyboard-translate-table))
+ (> (length keyboard-translate-table) ch))))
+ (or (aref keyboard-translate-table ch) ch)
+ ch))
+
+(defun mac-unread-string (string)
+ ;; Unread characters and insert them in a keyboard macro being
+ ;; defined.
+ (apply 'isearch-unread
+ (mapcar 'mac-keyboard-translate-char
+ (mac-replace-untranslated-utf-8-chars string))))
+
(defun mac-ts-update-active-input-area (event)
"Update Mac TSM active input area according to EVENT.
The confirmed text is converted to Emacs input events and pushed
(point) (point) (current-buffer))
(overlay-put mac-ts-active-input-overlay 'before-string
active-input-string))
- ;; Unread confirmed characters and insert them in a keyboard
- ;; macro being defined.
- (apply 'isearch-unread
- (append (mac-replace-untranslated-utf-8-chars
- (funcall decode-fun confirmed coding)) '())))
+ (mac-unread-string (funcall decode-fun confirmed coding)))
;; The event is successfully processed. Sync the sequence number.
(setq mac-ts-update-active-input-area-seqno (1+ seqno))))
(coding (or (cdr (assq (car script-language)
mac-script-code-coding-systems))
'mac-roman)))
- ;; Unread characters and insert them in a keyboard macro being
- ;; defined.
- (apply 'isearch-unread
- (append (mac-replace-untranslated-utf-8-chars
- (mac-utxt-to-string text coding)) '()))))
+ (if text
+ (mac-unread-string (mac-utxt-to-string text coding)))))
;; kEventClassTextInput/kEventTextInputUpdateActiveInputArea
(define-key mac-apple-event-map [text-input update-active-input-area]
("TIFF" . mac-dnd-insert-TIFF))
"Which function to call to handle a drop of that type.
The function takes three arguments, WINDOW, ACTION and DATA.
-WINDOW is where the drop occured, ACTION is always `private' on
+WINDOW is where the drop occurred, ACTION is always `private' on
Mac. DATA is the drop data. Unlike the x-dnd counterpart, the
return value of the function is not significant.
(defun mac-dnd-insert-TIFF (window action data)
(dnd-insert-text window action (mac-TIFF-to-string data)))
-(defun mac-dnd-drop-data (event frame window data type)
+(defun mac-dnd-drop-data (event frame window data type &optional action)
+ (or action (setq action 'private))
(let* ((type-info (assoc type mac-dnd-types-alist))
(handler (cdr type-info))
- (action 'private)
(w (posn-window (event-start event))))
(when handler
- (if (and (windowp w) (window-live-p w)
+ (if (and (window-live-p w)
(not (window-minibuffer-p w))
(not (window-dedicated-p w)))
;; If dropping in an ordinary window which we could use,
(defun mac-dnd-handle-drag-n-drop-event (event)
"Receive drag and drop events."
(interactive "e")
- (let ((window (posn-window (event-start event))))
+ (let ((window (posn-window (event-start event)))
+ (ae (mac-event-ae event))
+ action)
(when (windowp window) (select-window window))
- (dolist (item (mac-ae-list (mac-event-ae event)))
+ (if (memq 'option (mac-ae-keyboard-modifiers ae))
+ (setq action 'copy))
+ (dolist (item (mac-ae-list ae))
(if (not (equal (car item) "null"))
(mac-dnd-drop-data event (selected-frame) window
- (cdr item) (car item)))))
- (select-frame-set-input-focus (selected-frame)))
+ (cdr item) (car item) action)))))
\f
-;;; 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)
- (let (i)
- (setq x-resource-name (invocation-name))
-
- ;; Change any . or * characters in x-resource-name to hyphens,
- ;; so as not to choke when we use it in X resource queries.
- (while (setq i (string-match "[.*]" x-resource-name))
- (aset x-resource-name i ?-))))
-
-(if (x-display-list)
- ;; On Mac OS 8/9, Most coding systems used in code conversion for
- ;; font names are not ready at the time when the terminal frame is
- ;; created. So we reconstruct font name table for the initial
- ;; frame.
- (mac-clear-font-name-table)
- (x-open-connection "Mac"
- x-command-line-resources
- ;; Exit Emacs with fatal error if this fails.
- t))
-
-(setq frame-creation-function 'x-create-frame-with-faces)
-
(defvar mac-font-encoder-list
'(("mac-roman" mac-roman-encoder
ccl-encode-mac-roman-font "%s")
(fontset-add-mac-fonts fontset t)
fontset))
+(defun x-win-suspend-error ()
+ (error "Suspending an Emacs running under Mac makes no sense"))
+
+(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value)
+
+(defvar mac-initialized nil
+ "Non-nil if the w32 window system has been initialized.")
+
+(defun mac-initialize-window-system ()
+ "Initialize Emacs for Mac GUI frames."
+
+;;; 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)
+ (let (i)
+ (setq x-resource-name (invocation-name))
+
+ ;; Change any . or * characters in x-resource-name to hyphens,
+ ;; so as not to choke when we use it in X resource queries.
+ (while (setq i (string-match "[.*]" x-resource-name))
+ (aset x-resource-name i ?-))))
+
+(if (x-display-list)
+ ;; On Mac OS 8/9, Most coding systems used in code conversion for
+ ;; font names are not ready at the time when the terminal frame is
+ ;; created. So we reconstruct font name table for the initial
+ ;; frame.
+ (mac-clear-font-name-table)
+ (x-open-connection "Mac"
+ x-command-line-resources
+ ;; Exit Emacs with fatal error if this fails.
+ t))
+
+(add-hook 'suspend-hook 'x-win-suspend-error)
+
+;;; Arrange for the kill and yank functions to set and check the clipboard.
+(setq interprogram-cut-function 'x-select-text)
+(setq interprogram-paste-function 'x-get-selection-value)
+
+
+
+
+;;; Turn off window-splitting optimization; Mac 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 " ")
+
+;; Turn on support for mouse wheels.
+(mouse-wheel-mode 1)
+
+
+;; Enable CLIPBOARD copy/paste through menu bar commands.
+(menu-bar-enable-clipboard)
+
+
+;; Initiate drag and drop
+
+(define-key special-event-map [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event)
+
+\f
+;;;; Non-toolkit Scroll bars
+
+(unless x-toolkit-scroll-bars
+
+;; for debugging
+;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
+
+;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)
+
+(global-set-key
+ [vertical-scroll-bar down-mouse-1]
+ 'mac-handle-scroll-bar-event)
+
+(global-unset-key [vertical-scroll-bar drag-mouse-1])
+(global-unset-key [vertical-scroll-bar mouse-1])
+
;; Adjust Courier font specifications in x-fixed-font-alist.
(let ((courier-fonts (assoc "Courier" x-fixed-font-alist)))
(if courier-fonts
;; Setup the default fontset.
(setup-default-fontset)
-(cond ((x-list-fonts "*-iso10646-1")
+(cond ((x-list-fonts "*-iso10646-1" nil nil 1)
;; Use ATSUI (if available) for the following charsets.
(dolist
(charset '(latin-iso8859-1
vietnamese-viscii-lower vietnamese-viscii-upper
lao ethiopic tibetan))
(set-fontset-font nil charset '(nil . "iso10646-1"))))
- ((null (x-list-fonts "*-iso8859-1"))
+ ((null (x-list-fonts "*-iso8859-1" nil nil 1))
;; Add Mac-encoding fonts unless ETL fonts are installed.
(fontset-add-mac-fonts "fontset-default")))
(setq default-frame-alist
(cons '(reverse . t) default-frame-alist)))))
-(defun x-win-suspend-error ()
- (error "Suspending an Emacs running under Mac makes no sense"))
-(add-hook 'suspend-hook 'x-win-suspend-error)
-
-;;; Arrange for the kill and yank functions to set and check the clipboard.
-(setq interprogram-cut-function 'x-select-text)
-(setq interprogram-paste-function 'x-get-selection-value)
-
-(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value)
-
-;;; Turn off window-splitting optimization; Mac 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 " ")
-
-;; Turn on support for mouse wheels.
-(mouse-wheel-mode 1)
-
-
-;; Enable CLIPBOARD copy/paste through menu bar commands.
-(menu-bar-enable-clipboard)
-
-;; Initiate drag and drop
-
-(define-key special-event-map [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event)
-(define-key special-event-map [M-drag-n-drop] 'mac-dnd-handle-drag-n-drop-event)
-
-\f
-;;;; Non-toolkit Scroll bars
-
-(unless x-toolkit-scroll-bars
-
-;; for debugging
-;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
-
-;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)
-
-(global-set-key
- [vertical-scroll-bar down-mouse-1]
- 'mac-handle-scroll-bar-event)
-
-(global-unset-key [vertical-scroll-bar drag-mouse-1])
-(global-unset-key [vertical-scroll-bar mouse-1])
+(setq mac-initialized t)))
(defun mac-handle-scroll-bar-event (event)
"Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
(mac-scroll-ignore-events)
(scroll-up 1)))
-)
\f
;;;; Others
;; or bold bitmap versions will not display these variants correctly.
(setq scalable-fonts-allowed t)
+(add-to-list 'handle-args-function-alist '(mac . x-handle-args))
+(add-to-list 'frame-creation-function-alist '(mac . x-create-frame-with-faces))
+(add-to-list 'window-system-initialization-alist '(mac . mac-initialize-window-system))
+
+(provide 'mac-win)
+
;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6
;;; mac-win.el ends here