1 ;;; mac-win.el --- support for "Macintosh windows".
3 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
5 ;; Author: Andrew Choi <akochoi@i-cable.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.
26 ;; ---------------------------------------------------------------------------
27 ;; We want to delay setting frame parameters until the faces are setup
29 ;; Mac can't handle ~ prefix in file names
30 ;(setq auto-save-list-file-prefix ".saves-")
32 (setq frame-creation-function
'x-create-frame-with-faces
)
35 ;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
37 ;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)
40 [vertical-scroll-bar down-mouse-1
]
41 'mac-handle-scroll-bar-event
)
43 (global-unset-key [vertical-scroll-bar drag-mouse-1
])
44 (global-unset-key [vertical-scroll-bar mouse-1
])
46 (defun mac-handle-scroll-bar-event (event)
47 "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
49 (let* ((position (event-start event
))
50 (window (nth 0 position
))
51 (bar-part (nth 4 position
)))
52 (select-window window
)
55 (goto-char (window-start window
))
56 (mac-scroll-down-line))
57 ((eq bar-part
'above-handle
)
59 ((eq bar-part
'handle
)
60 (scroll-bar-drag event
))
61 ((eq bar-part
'below-handle
)
64 (goto-char (window-start window
))
65 (mac-scroll-up-line)))))
67 (defun mac-scroll-down ()
69 (while (not (eq (car-safe (read-event)) 'mouse-1
)) nil
)
72 (defun mac-scroll-down-line ()
74 (while (not (eq (car-safe (read-event)) 'mouse-1
)) nil
)
77 (defun mac-scroll-up ()
79 (while (not (eq (car-safe (read-event)) 'mouse-1
)) nil
)
82 (defun mac-scroll-up-line ()
84 (while (not (eq (car-safe (read-event)) 'mouse-1
)) nil
)
87 (defun xw-defined-colors (&optional frame
)
88 "Internal function called by `defined-colors', which see."
89 (or frame
(setq frame
(selected-frame)))
90 (let ((all-colors x-colors
)
94 (setq this-color
(car all-colors
)
95 all-colors
(cdr all-colors
))
96 (and (color-supported-p this-color frame t
)
97 (setq defined-colors
(cons this-color defined-colors
))))
100 ;; Don't have this yet.
101 (fset 'x-get-resource
'ignore
)
103 ;; This variable specifies the Unix program to call (as a process) to
104 ;; deteremine the amount of free space on a file system (defaults to
105 ;; df). If it is not set to nil, ls-lisp will not work correctly
106 ;; unless an external application df is implemented on the Mac.
109 (setq dired-free-space-program nil
)
111 ;; Set this so that Emacs calls subprocesses with "sh" as shell to
112 ;; expand filenames Note no subprocess for the shell is actually
113 ;; started (see run_mac_command in sysdep.c).
114 (setq shell-file-name
"sh")
116 ;; X Window emulation in macterm.c is not complete enough to start a
117 ;; frame without a minibuffer properly. Call this to tell ediff
118 ;; library to use a single frame.
119 (ediff-toggle-multiframe)
121 ;; Setup to use the Mac clipboard. The functions mac-cut-function and
122 ;; mac-paste-function are defined in mac.c.
123 (set-selection-coding-system 'compound-text-mac
)
125 (setq interprogram-cut-function
128 (encode-coding-string str selection-coding-system t
) push
)))
130 (setq interprogram-paste-function
132 (decode-coding-string
133 (mac-paste-function) selection-coding-system t
)))
135 (defun mac-drag-n-drop (event)
136 "Edit the files listed in the drag-n-drop event.\n\
137 Switch to a buffer editing the last file dropped."
140 ;; Make sure the drop target has positive co-ords
141 ;; before setting the selected frame - otherwise it
142 ;; won't work. <skx@tardis.ed.ac.uk>
143 (let* ((window (posn-window (event-start event
)))
144 (coords (posn-x-y (event-start event
)))
147 (if (and (> x
0) (> y
0))
148 (set-frame-selected-window nil window
))
149 (mapcar 'find-file
(car (cdr (cdr event
)))))
153 (global-set-key [drag-n-drop
] 'mac-drag-n-drop
)
155 ;; By checking whether the variable mac-ready-for-drag-n-drop has been
156 ;; defined, the event loop in macterm.c can be informed that it can
157 ;; now receive Finder drag and drop events. Files dropped onto the
158 ;; Emacs application icon can only be processed when the initial frame
159 ;; has been created: this is where the files should be opened.
160 (add-hook 'after-init-hook
162 (defvar mac-ready-for-drag-n-drop t
)))
164 ; Define constant values to be set to mac-keyboard-text-encoding
165 (defconst kTextEncodingMacRoman
0)
166 (defconst kTextEncodingISOLatin1
513 "0x201")
167 (defconst kTextEncodingISOLatin2
514 "0x202")
170 (define-ccl-program ccl-encode-mac-roman-font
172 (if (r0 != ,(charset-id 'ascii
))
173 (if (r0 == ,(charset-id 'latin-iso8859-1
))
174 (translate-character mac-roman-encoder r0 r1
)
177 (translate-character mac-roman-encoder r0 r1
)))))
178 "CCL program for Mac Roman font")
180 (setq font-ccl-encoder-alist
181 (cons '("mac-roman" . ccl-encode-mac-roman-font
)
182 font-ccl-encoder-alist
))
184 ;; Create a fontset that uses mac-roman font. With this fontset,
185 ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,
186 ;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font.
188 (if (fboundp 'new-fontset
)
190 (create-fontset-from-fontset-spec
191 "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
192 ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
193 (let ((monaco-font '("monaco" .
"mac-roman")))
197 (or (generic-char-p key
)
198 (memq (char-charset key
)
199 '(ascii eight-bit-control eight-bit-graphic
))
200 (set-fontset-font "fontset-mac" key monaco-font
))))
201 (get 'mac-roman-encoder
'translation-table
)))))
203 ;; To display filenames in Chinese or Japanese, replace mac-roman with
205 (setq file-name-coding-system
'mac-roman
)
207 ;; (prefer-coding-system 'mac-roman)
213 (defvar x-colors
'("LightGreen"
812 "LightGoldenrodYellow"
813 "light goldenrod yellow"
830 "medium spring green"
965 "The list of X colors from the `rgb.txt' file.
966 XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
968 ;;; mac-win.el ends here