1 ;;; mac-win.el --- support for "Macintosh windows"
3 ;; Copyright (C) 1999, 2000, 2002 Free Software Foundation, Inc.
5 ;; Author: Andrew Choi <akochoi@mac.com>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
28 ;; ---------------------------------------------------------------------------
29 ;; We want to delay setting frame parameters until the faces are setup
31 ;; Mac can't handle ~ prefix in file names
32 ;(setq auto-save-list-file-prefix ".saves-")
34 (setq frame-creation-function 'x-create-frame-with-faces)
37 ;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
39 ;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)
42 [vertical-scroll-bar down-mouse-1]
43 'mac-handle-scroll-bar-event)
45 (global-unset-key [vertical-scroll-bar drag-mouse-1])
46 (global-unset-key [vertical-scroll-bar mouse-1])
50 (defun mac-handle-scroll-bar-event (event)
51 "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
53 (let* ((position (event-start event))
54 (window (nth 0 position))
55 (bar-part (nth 4 position)))
56 (select-window window)
59 (goto-char (window-start window))
60 (mac-scroll-down-line))
61 ((eq bar-part 'above-handle)
63 ((eq bar-part 'handle)
64 (scroll-bar-drag event))
65 ((eq bar-part 'below-handle)
68 (goto-char (window-start window))
69 (mac-scroll-up-line)))))
71 (defun mac-scroll-down ()
73 (while (not (eq (car-safe (read-event)) 'mouse-1)) nil)
76 (defun mac-scroll-down-line ()
78 (while (not (eq (car-safe (read-event)) 'mouse-1)) nil)
81 (defun mac-scroll-up ()
83 (while (not (eq (car-safe (read-event)) 'mouse-1)) nil)
86 (defun mac-scroll-up-line ()
88 (while (not (eq (car-safe (read-event)) 'mouse-1)) nil)
91 (defun xw-defined-colors (&optional frame)
92 "Internal function called by `defined-colors', which see."
93 (or frame (setq frame (selected-frame)))
94 (let ((all-colors x-colors)
98 (setq this-color (car all-colors)
99 all-colors (cdr all-colors))
100 (and (color-supported-p this-color frame t)
101 (setq defined-colors (cons this-color defined-colors))))
104 ;; Don't have this yet.
105 (fset 'x-get-resource 'ignore)
107 (unless (eq system-type 'darwin)
108 ;; This variable specifies the Unix program to call (as a process) to
109 ;; deteremine the amount of free space on a file system (defaults to
110 ;; df). If it is not set to nil, ls-lisp will not work correctly
111 ;; unless an external application df is implemented on the Mac.
112 (setq directory-free-space-program nil)
114 ;; Set this so that Emacs calls subprocesses with "sh" as shell to
115 ;; expand filenames Note no subprocess for the shell is actually
116 ;; started (see run_mac_command in sysdep.c).
117 (setq shell-file-name "sh"))
119 ;; X Window emulation in macterm.c is not complete enough to start a
120 ;; frame without a minibuffer properly. Call this to tell ediff
121 ;; library to use a single frame.
122 ; (ediff-toggle-multiframe)
124 ;; Setup to use the Mac clipboard. The functions mac-cut-function and
125 ;; mac-paste-function are defined in mac.c.
126 (set-selection-coding-system 'compound-text-mac)
128 (setq interprogram-cut-function
131 (encode-coding-string str selection-coding-system t) push)))
133 (setq interprogram-paste-function
135 (let ((clipboard (mac-paste-function)))
137 (decode-coding-string clipboard selection-coding-system t)))))
139 (defun mac-drag-n-drop (event)
140 "Edit the files listed in the drag-n-drop event.\n\
141 Switch to a buffer editing the last file dropped."
144 ;; Make sure the drop target has positive co-ords
145 ;; before setting the selected frame - otherwise it
146 ;; won't work. <skx@tardis.ed.ac.uk>
147 (let* ((window (posn-window (event-start event)))
148 (coords (posn-x-y (event-start event)))
151 (if (and (> x 0) (> y 0))
152 (set-frame-selected-window nil window))
156 (decode-coding-string
158 (or file-name-coding-system
159 default-file-name-coding-system))))
160 (car (cdr (cdr event)))))
164 (global-set-key [drag-n-drop] 'mac-drag-n-drop)
166 ;; By checking whether the variable mac-ready-for-drag-n-drop has been
167 ;; defined, the event loop in macterm.c can be informed that it can
168 ;; now receive Finder drag and drop events. Files dropped onto the
169 ;; Emacs application icon can only be processed when the initial frame
170 ;; has been created: this is where the files should be opened.
171 (add-hook 'after-init-hook
173 (defvar mac-ready-for-drag-n-drop t)))
175 (defun iconify-or-deiconify-frame ()
176 "Iconify the selected frame, or deiconify if it's currently an icon."
178 (if (eq (cdr (assq 'visibility (frame-parameters))) t)
180 (make-frame-visible)))
182 ; Define constant values to be set to mac-keyboard-text-encoding
183 (defconst kTextEncodingMacRoman 0)
184 (defconst kTextEncodingISOLatin1 513 "0x201")
185 (defconst kTextEncodingISOLatin2 514 "0x202")
188 (define-ccl-program ccl-encode-mac-roman-font
190 (if (r0 != ,(charset-id 'ascii))
191 (if (r0 == ,(charset-id 'latin-iso8859-1))
192 (translate-character mac-roman-encoder r0 r1)
195 (translate-character mac-roman-encoder r0 r1)))))
196 "CCL program for Mac Roman font")
198 (setq font-ccl-encoder-alist
199 (cons '("mac-roman" . ccl-encode-mac-roman-font)
200 font-ccl-encoder-alist))
202 ;; Create a fontset that uses mac-roman font. With this fontset,
203 ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,
204 ;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font.
206 (if (fboundp 'new-fontset)
209 (setup-default-fontset)
210 (create-fontset-from-fontset-spec
211 "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
212 ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
213 (let ((monaco-font '("monaco" . "mac-roman")))
217 (or (generic-char-p key)
218 (memq (char-charset val)
219 '(ascii eight-bit-control eight-bit-graphic))
220 (set-fontset-font "fontset-mac" val monaco-font))))
221 (get 'mac-roman-decoder 'translation-table)))))
223 (if (eq system-type 'darwin)
224 ;; On Darwin filenames are encoded in UTF-8
225 (setq file-name-coding-system 'utf-8)
226 ;; To display filenames in Chinese or Japanese, replace mac-roman with
228 (setq file-name-coding-system 'mac-roman))
230 ;; If Emacs is started from the Finder, change the default directory
231 ;; to the user's home directory.
232 (if (string= default-directory "/")
235 (unless (eq system-type 'darwin)
236 ;; Tell Emacs to use pipes instead of pty's for processes because the
237 ;; latter sometimes lose characters. Pty support is compiled in since
238 ;; ange-ftp will not work without it.
239 (setq process-connection-type nil))
241 ;; Assume that fonts are always scalable on the Mac. This sometimes
242 ;; results in characters with jagged edges. However, without it,
243 ;; fonts with both truetype and bitmap representations but no italic
244 ;; or bold bitmap versions will not display these variants correctly.
245 (setq scalable-fonts-allowed t)
247 ;; Make suspend-emacs [C-z] collapse the current frame
248 (substitute-key-definition 'suspend-emacs 'iconify-frame
251 ;; Support mouse-wheel scrolling
252 (autoload 'mwheel-scroll "mwheel")
253 (global-set-key [mouse-wheel] 'mwheel-scroll)
254 (global-set-key [C-mouse-wheel] 'mwheel-scroll)
255 (global-set-key [S-mouse-wheel] 'mwheel-scroll)
257 ;; (prefer-coding-system 'mac-roman)
259 ;; Map certain keypad keys into ASCII characters that people usually expect
260 (define-key function-key-map [return] [?\C-m])
261 (define-key function-key-map [M-return] [?\M-\C-m])
262 (define-key function-key-map [tab] [?\t])
263 (define-key function-key-map [M-tab] [?\M-\t])
264 (define-key function-key-map [backspace] [127])
265 (define-key function-key-map [M-backspace] [?\M-\d])
266 (define-key function-key-map [escape] [?\e])
267 (define-key function-key-map [M-escape] [?\M-\e])
269 ;; Tell read-char how to convert special chars to ASCII
270 (put 'return 'ascii-character 13)
276 (defvar x-colors '("LightGreen"
875 "LightGoldenrodYellow"
876 "light goldenrod yellow"
893 "medium spring green"
1028 "The list of X colors from the `rgb.txt' file.
1029 XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
1031 ;;; mac-win.el ends here