aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorDan Nicolaescu2008-07-27 18:24:48 +0000
committerDan Nicolaescu2008-07-27 18:24:48 +0000
commit9e2a2647758db83b490e2993aa31cd4607305a82 (patch)
tree9c3d41b47bcd316c60d56bef8d7fd32789e59411 /lisp
parent7f19297073b2dd6c28987bf5663933591f59e91e (diff)
downloademacs-9e2a2647758db83b490e2993aa31cd4607305a82.tar.gz
emacs-9e2a2647758db83b490e2993aa31cd4607305a82.zip
Remove support for Mac Carbon.
* mactoolbox.c: * macterm.h: * macterm.c: * macselect.c: * macmenu.c: * macgui.h: * macfns.c: * mac.c: Remove file. * s/darwin.h: * m/intel386.h: * xfaces.c: * xdisp.c: * window.c: * tparam.c: * termhooks.h: * termcap.c: * term.c: * syssignal.h: * sysselect.h: * sysdep.c: * process.c: * lread.c: * lisp.h: * keyboard.c: * image.c: * fringe.c: * frame.h: * frame.c: * fontset.c: * font.h: * font.c: * fns.c: * fileio.c: * emacs.c: * dispnew.c: * dispextern.h: * config.in: * atimer.c: * Makefile.in: Remove code for Carbon * erc.el: Remove code for Carbon. Remove support for Mac Carbon. * term/mac-win.el: Remove file * international/mule-cmds.el: * version.el: * startup.el: * simple.el: * mwheel.el: * mouse.el: * loadup.el: * isearch.el: * info.el: * frame.el: * faces.el: * disp-table.el: * cus-start.el: * cus-face.el: * cus-edit.el: * Makefile.in: Remove code for Carbon. Remove support for Mac Carbon. * makefile.w32-in: * emacsclient.c: Remove code for Carbon. * PROBLEMS: * MACHINES: Remove mentions of Mac Carbon. * ns-emacs.texi: * faq.texi: Remove mentions of Mac Carbon. * os.texi: * frames.texi: * display.texi: Remove mentions of Mac Carbon. * xresources.texi: Remove mentions of Mac Carbon. * make-tarball.txt: * admin.el: * FOR-RELEASE: * CPP-DEFINES: Remove mentions of Mac Carbon. Remove support for Mac Carbon. * mac: Remove directory. * make-dist: * configure.in: * README: * Makefile.in: * INSTALL: Remove code for Carbon. * configure: Regenerate.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog21
-rw-r--r--lisp/Makefile.in1
-rw-r--r--lisp/cus-edit.el17
-rw-r--r--lisp/cus-face.el2
-rw-r--r--lisp/cus-start.el38
-rw-r--r--lisp/disp-table.el8
-rw-r--r--lisp/erc/ChangeLog4
-rw-r--r--lisp/erc/erc.el1
-rw-r--r--lisp/faces.el20
-rw-r--r--lisp/frame.el34
-rw-r--r--lisp/info.el2
-rw-r--r--lisp/international/mule-cmds.el18
-rw-r--r--lisp/isearch.el2
-rw-r--r--lisp/loadup.el3
-rw-r--r--lisp/mouse.el2
-rw-r--r--lisp/mwheel.el4
-rw-r--r--lisp/simple.el3
-rw-r--r--lisp/startup.el2
-rw-r--r--lisp/term/mac-win.el2002
-rw-r--r--lisp/version.el2
20 files changed, 68 insertions, 2118 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5442fbd6191..30680d79a62 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,24 @@
12008-07-27 Dan Nicolaescu <dann@ics.uci.edu>
2
3 Remove support for Mac Carbon.
4 * term/mac-win.el: Remove file
5 * international/mule-cmds.el:
6 * version.el:
7 * startup.el:
8 * simple.el:
9 * mwheel.el:
10 * mouse.el:
11 * loadup.el:
12 * isearch.el:
13 * info.el:
14 * frame.el:
15 * faces.el:
16 * disp-table.el:
17 * cus-start.el:
18 * cus-face.el:
19 * cus-edit.el:
20 * Makefile.in: Remove code for Carbon.
21
12008-07-26 Adrian Robert <Adrian.B.Robert@gmail.com> 222008-07-26 Adrian Robert <Adrian.B.Robert@gmail.com>
2 23
3 * term/ns-win.el (ns-extended-platform-support-mode): Get rid of 24 * term/ns-win.el (ns-extended-platform-support-mode): Get rid of
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 02fdb3d6d42..9a20439c48a 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -1111,7 +1111,6 @@ ELCFILES = \
1111 $(lisp)/tempo.elc \ 1111 $(lisp)/tempo.elc \
1112 $(lisp)/term.elc \ 1112 $(lisp)/term.elc \
1113 $(lisp)/term/common-win.elc \ 1113 $(lisp)/term/common-win.elc \
1114 $(lisp)/term/mac-win.elc \
1115 $(lisp)/term/ns-win.elc \ 1114 $(lisp)/term/ns-win.elc \
1116 $(lisp)/term/pc-win.elc \ 1115 $(lisp)/term/pc-win.elc \
1117 $(lisp)/term/rxvt.elc \ 1116 $(lisp)/term/rxvt.elc \
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index fe23aa76b7e..3669ef6d429 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -447,13 +447,6 @@
447 :link '(custom-manual "(emacs)Windows") 447 :link '(custom-manual "(emacs)Windows")
448 :group 'environment) 448 :group 'environment)
449 449
450(defgroup mac nil
451 "Mac specific features."
452 :link '(custom-manual "(emacs)Mac OS")
453 :group 'environment
454 :version "22.1"
455 :prefix "mac-")
456
457;;; Custom mode keymaps 450;;; Custom mode keymaps
458 451
459(defvar custom-mode-map 452(defvar custom-mode-map
@@ -2068,7 +2061,7 @@ and `face'."
2068;;; The `custom' Widget. 2061;;; The `custom' Widget.
2069 2062
2070(defface custom-button 2063(defface custom-button
2071 '((((type x w32 mac ns) (class color)) ; Like default modeline 2064 '((((type x w32 ns) (class color)) ; Like default modeline
2072 (:box (:line-width 2 :style released-button) 2065 (:box (:line-width 2 :style released-button)
2073 :background "lightgrey" :foreground "black")) 2066 :background "lightgrey" :foreground "black"))
2074 (t 2067 (t
@@ -2080,7 +2073,7 @@ and `face'."
2080(put 'custom-button-face 'face-alias 'custom-button) 2073(put 'custom-button-face 'face-alias 'custom-button)
2081 2074
2082(defface custom-button-mouse 2075(defface custom-button-mouse
2083 '((((type x w32 mac ns) (class color)) 2076 '((((type x w32 ns) (class color))
2084 (:box (:line-width 2 :style released-button) 2077 (:box (:line-width 2 :style released-button)
2085 :background "grey90" :foreground "black")) 2078 :background "grey90" :foreground "black"))
2086 (t 2079 (t
@@ -2102,7 +2095,7 @@ and `face'."
2102 (if custom-raised-buttons 'custom-button-mouse 'highlight)) 2095 (if custom-raised-buttons 'custom-button-mouse 'highlight))
2103 2096
2104(defface custom-button-pressed 2097(defface custom-button-pressed
2105 '((((type x w32 mac ns) (class color)) 2098 '((((type x w32 ns) (class color))
2106 (:box (:line-width 2 :style pressed-button) 2099 (:box (:line-width 2 :style pressed-button)
2107 :background "lightgrey" :foreground "black")) 2100 :background "lightgrey" :foreground "black"))
2108 (t 2101 (t
@@ -3161,10 +3154,6 @@ OS/2 Presentation Manager.")
3161 :sibling-args (:help-echo "\ 3154 :sibling-args (:help-echo "\
3162Windows NT/9X.") 3155Windows NT/9X.")
3163 w32) 3156 w32)
3164 (const :format "MAC "
3165 :sibling-args (:help-echo "\
3166Macintosh OS (Carbon interface).")
3167 mac)
3168 (const :format "NS " 3157 (const :format "NS "
3169 :sibling-args (:help-echo "\ 3158 :sibling-args (:help-echo "\
3170GNUstep or Macintosh OS Cocoa interface.") 3159GNUstep or Macintosh OS Cocoa interface.")
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 5581cff9588..e7baa3c9ed7 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -44,7 +44,7 @@
44 ;; Create frame-local faces 44 ;; Create frame-local faces
45 (dolist (frame (frame-list)) 45 (dolist (frame (frame-list))
46 (face-spec-set-2 face frame value) 46 (face-spec-set-2 face frame value)
47 (when (memq (window-system frame) '(x w32 mac ns)) 47 (when (memq (window-system frame) '(x w32 ns))
48 (setq have-window-system t))) 48 (setq have-window-system t)))
49 ;; When making a face after frames already exist 49 ;; When making a face after frames already exist
50 (if have-window-system 50 (if have-window-system
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 17828bcf581..428cdfd17b5 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -200,42 +200,6 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
200 (suggest-key-bindings keyboard (choice (const :tag "off" nil) 200 (suggest-key-bindings keyboard (choice (const :tag "off" nil)
201 (integer :tag "time" 2) 201 (integer :tag "time" 2)
202 (other :tag "on"))) 202 (other :tag "on")))
203 ;; macselect.c
204 (mac-dnd-known-types mac (repeat string) "22.1")
205 ;; macterm.c
206 (mac-control-modifier mac (choice (const :tag "No modifier" nil)
207 (const control) (const meta)
208 (const alt) (const hyper)
209 (const super)) "22.1")
210 (mac-command-modifier mac (choice (const :tag "No modifier" nil)
211 (const control) (const meta)
212 (const alt) (const hyper)
213 (const super)) "22.1")
214 (mac-option-modifier mac (choice (const :tag "No modifier (work as option)" nil)
215 (const control) (const meta)
216 (const alt) (const hyper)
217 (const super)) "22.1")
218 (mac-function-modifier mac
219 (choice (const :tag "No modifier (work as function)" nil)
220 (const control) (const meta)
221 (const alt) (const hyper)
222 (const super)) "22.1")
223 (mac-emulate-three-button-mouse mac
224 (choice (const :tag "No emulation" nil)
225 (const :tag "Option->2, Command->3" t)
226 (const :tag "Command->2, Option->3" reverse))
227 "22.1")
228 (mac-wheel-button-is-mouse-2 mac boolean "22.1")
229 (mac-pass-command-to-system mac boolean "22.1")
230 (mac-pass-control-to-system mac boolean "22.1")
231 (mac-allow-anti-aliasing mac boolean "22.1")
232 (mac-ts-script-language-on-focus mac
233 (choice (const :tag "System default behavior" nil)
234 (const :tag "Restore to script/language used in the last focus frame" t)
235 (cons :tag "Specify script/language"
236 (integer :tag "Script code")
237 (integer :tag "Language code")))
238 "22.1")
239 203
240;; This is not good news because it will use the wrong 204;; This is not good news because it will use the wrong
241;; version-specific directories when you upgrade. We need 205;; version-specific directories when you upgrade. We need
@@ -387,8 +351,6 @@ since it could result in memory overflow and make Emacs crash."
387 (eq system-type 'ms-dos)) 351 (eq system-type 'ms-dos))
388 ((string-match "\\`w32-" (symbol-name symbol)) 352 ((string-match "\\`w32-" (symbol-name symbol))
389 (eq system-type 'windows-nt)) 353 (eq system-type 'windows-nt))
390 ((string-match "\\`mac-" (symbol-name symbol))
391 (featurep 'mac-carbon))
392 ((string-match "\\`x-.*gtk" (symbol-name symbol)) 354 ((string-match "\\`x-.*gtk" (symbol-name symbol))
393 (featurep 'gtk)) 355 (featurep 'gtk))
394 ((string-match "\\`x-" (symbol-name symbol)) 356 ((string-match "\\`x-" (symbol-name symbol))
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index e7ade431181..700a9b0d0a5 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -142,7 +142,7 @@ Valid symbols are `truncation', `wrap', `escape', `control',
142 "Display character C as character SC in the g1 character set. 142 "Display character C as character SC in the g1 character set.
143This function assumes that your terminal uses the SO/SI characters; 143This function assumes that your terminal uses the SO/SI characters;
144it is meaningless for an X frame." 144it is meaningless for an X frame."
145 (if (memq window-system '(x w32 mac ns)) 145 (if (memq window-system '(x w32 ns))
146 (error "Cannot use string glyphs in a windowing system")) 146 (error "Cannot use string glyphs in a windowing system"))
147 (or standard-display-table 147 (or standard-display-table
148 (setq standard-display-table (make-display-table))) 148 (setq standard-display-table (make-display-table)))
@@ -154,7 +154,7 @@ it is meaningless for an X frame."
154 "Display character C as character GC in graphics character set. 154 "Display character C as character GC in graphics character set.
155This function assumes VT100-compatible escapes; it is meaningless for an 155This function assumes VT100-compatible escapes; it is meaningless for an
156X frame." 156X frame."
157 (if (memq window-system '(x w32 mac ns)) 157 (if (memq window-system '(x w32 ns))
158 (error "Cannot use string glyphs in a windowing system")) 158 (error "Cannot use string glyphs in a windowing system"))
159 (or standard-display-table 159 (or standard-display-table
160 (setq standard-display-table (make-display-table))) 160 (setq standard-display-table (make-display-table)))
@@ -243,7 +243,7 @@ for users who call this function in `.emacs'."
243 (equal (aref standard-display-table 161) [161]))) 243 (equal (aref standard-display-table 161) [161])))
244 (progn 244 (progn
245 (standard-display-default 160 255) 245 (standard-display-default 160 255)
246 (unless (or (memq window-system '(x w32 mac ns))) 246 (unless (or (memq window-system '(x w32 ns)))
247 (and (terminal-coding-system) 247 (and (terminal-coding-system)
248 (set-terminal-coding-system nil)))) 248 (set-terminal-coding-system nil))))
249 249
@@ -255,7 +255,7 @@ for users who call this function in `.emacs'."
255 ;; unless some other has been specified. 255 ;; unless some other has been specified.
256 (if (equal current-language-environment "English") 256 (if (equal current-language-environment "English")
257 (set-language-environment "latin-1")) 257 (set-language-environment "latin-1"))
258 (unless (or noninteractive (memq window-system '(x w32 mac ns))) 258 (unless (or noninteractive (memq window-system '(x w32 ns)))
259 ;; Send those codes literally to a character-based terminal. 259 ;; Send those codes literally to a character-based terminal.
260 ;; If we are using single-byte characters, 260 ;; If we are using single-byte characters,
261 ;; it doesn't matter which coding system we use. 261 ;; it doesn't matter which coding system we use.
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index f49748da008..5d93364dc4a 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,7 @@
12008-07-27 Dan Nicolaescu <dann@ics.uci.edu>
2
3 * erc.el: Remove code for Carbon.
4
12008-06-07 Glenn Morris <rgm@gnu.org> 52008-06-07 Glenn Morris <rgm@gnu.org>
2 6
3 * erc/erc-autoaway.el, erc/erc-ibuffer.el, erc/erc-menu.el: 7 * erc/erc-autoaway.el, erc/erc-ibuffer.el, erc/erc-menu.el:
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 866ea8e9f53..ccce93528db 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3384,7 +3384,6 @@ the message given by REASON."
3384 ((featurep 'gtk) 3384 ((featurep 'gtk)
3385 (concat ", GTK+ Version " 3385 (concat ", GTK+ Version "
3386 gtk-version-string)) 3386 gtk-version-string))
3387 ((featurep 'mac-carbon) ", Mac Carbon")
3388 ((featurep 'x-toolkit) ", X toolkit") 3387 ((featurep 'x-toolkit) ", X toolkit")
3389 (t "")) 3388 (t ""))
3390 (if (and (boundp 'x-toolkit-scroll-bars) 3389 (if (and (boundp 'x-toolkit-scroll-bars)
diff --git a/lisp/faces.el b/lisp/faces.el
index a12a87eef51..c42298f77d8 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -338,7 +338,7 @@ specifies an invalid attribute."
338 338
339(defun set-face-attributes-from-resources (face frame) 339(defun set-face-attributes-from-resources (face frame)
340 "Set attributes of FACE from X resources for FRAME." 340 "Set attributes of FACE from X resources for FRAME."
341 (when (memq (framep frame) '(x w32 mac ns)) 341 (when (memq (framep frame) '(x w32 ns))
342 (dolist (definition face-x-resources) 342 (dolist (definition face-x-resources)
343 (let ((attribute (car definition))) 343 (let ((attribute (car definition)))
344 (dolist (entry (cdr definition)) 344 (dolist (entry (cdr definition))
@@ -1010,7 +1010,7 @@ an integer value."
1010 ((:height) 1010 ((:height)
1011 'integerp) 1011 'integerp)
1012 (:stipple 1012 (:stipple
1013 (and (memq (window-system frame) '(x w32 mac ns)) 1013 (and (memq (window-system frame) '(x w32 ns))
1014 (mapcar #'list 1014 (mapcar #'list
1015 (apply #'nconc 1015 (apply #'nconc
1016 (mapcar (lambda (dir) 1016 (mapcar (lambda (dir)
@@ -1129,7 +1129,7 @@ of a global face. Value is the new attribute value."
1129 ;; explicitly in VALID, using color approximation code 1129 ;; explicitly in VALID, using color approximation code
1130 ;; in tty-colors.el. 1130 ;; in tty-colors.el.
1131 (when (and (memq attribute '(:foreground :background)) 1131 (when (and (memq attribute '(:foreground :background))
1132 (not (memq (window-system frame) '(x w32 mac ns))) 1132 (not (memq (window-system frame) '(x w32 ns)))
1133 (not (member new-value 1133 (not (member new-value
1134 '("unspecified" 1134 '("unspecified"
1135 "unspecified-fg" "unspecified-bg")))) 1135 "unspecified-fg" "unspecified-bg"))))
@@ -1624,7 +1624,7 @@ The argument FRAME specifies which frame to try.
1624The value may be different for frames on different display types. 1624The value may be different for frames on different display types.
1625If FRAME doesn't support colors, the value is nil. 1625If FRAME doesn't support colors, the value is nil.
1626If FRAME is nil, that stands for the selected frame." 1626If FRAME is nil, that stands for the selected frame."
1627 (if (memq (framep (or frame (selected-frame))) '(x w32 mac ns)) 1627 (if (memq (framep (or frame (selected-frame))) '(x w32 ns))
1628 (xw-defined-colors frame) 1628 (xw-defined-colors frame)
1629 (mapcar 'car (tty-color-alist frame)))) 1629 (mapcar 'car (tty-color-alist frame))))
1630(defalias 'x-defined-colors 'defined-colors) 1630(defalias 'x-defined-colors 'defined-colors)
@@ -1638,7 +1638,7 @@ If COLOR is the symbol `unspecified' or one of the strings
1638\"unspecified-fg\" or \"unspecified-bg\", the value is nil." 1638\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
1639 (if (member color '(unspecified "unspecified-bg" "unspecified-fg")) 1639 (if (member color '(unspecified "unspecified-bg" "unspecified-fg"))
1640 nil 1640 nil
1641 (if (member (framep (or frame (selected-frame))) '(x w32 mac ns)) 1641 (if (member (framep (or frame (selected-frame))) '(x w32 ns))
1642 (xw-color-defined-p color frame) 1642 (xw-color-defined-p color frame)
1643 (numberp (tty-color-translate color frame))))) 1643 (numberp (tty-color-translate color frame)))))
1644(defalias 'x-color-defined-p 'color-defined-p) 1644(defalias 'x-color-defined-p 'color-defined-p)
@@ -1656,7 +1656,7 @@ If COLOR is the symbol `unspecified' or one of the strings
1656\"unspecified-fg\" or \"unspecified-bg\", the value is nil." 1656\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
1657 (if (member color '(unspecified "unspecified-fg" "unspecified-bg")) 1657 (if (member color '(unspecified "unspecified-fg" "unspecified-bg"))
1658 nil 1658 nil
1659 (if (memq (framep (or frame (selected-frame))) '(x w32 mac ns)) 1659 (if (memq (framep (or frame (selected-frame))) '(x w32 ns))
1660 (xw-color-values color frame) 1660 (xw-color-values color frame)
1661 (tty-color-values color frame)))) 1661 (tty-color-values color frame))))
1662(defalias 'x-color-values 'color-values) 1662(defalias 'x-color-values 'color-values)
@@ -1668,7 +1668,7 @@ If COLOR is the symbol `unspecified' or one of the strings
1668The optional argument DISPLAY specifies which display to ask about. 1668The optional argument DISPLAY specifies which display to ask about.
1669DISPLAY should be either a frame or a display name (a string). 1669DISPLAY should be either a frame or a display name (a string).
1670If omitted or nil, that stands for the selected frame's display." 1670If omitted or nil, that stands for the selected frame's display."
1671 (if (memq (framep-on-display display) '(x w32 mac ns)) 1671 (if (memq (framep-on-display display) '(x w32 ns))
1672 (xw-display-color-p display) 1672 (xw-display-color-p display)
1673 (tty-display-color-p display))) 1673 (tty-display-color-p display)))
1674(defalias 'x-display-color-p 'display-color-p) 1674(defalias 'x-display-color-p 'display-color-p)
@@ -1679,7 +1679,7 @@ If omitted or nil, that stands for the selected frame's display."
1679 "Return non-nil if frames on DISPLAY can display shades of gray." 1679 "Return non-nil if frames on DISPLAY can display shades of gray."
1680 (let ((frame-type (framep-on-display display))) 1680 (let ((frame-type (framep-on-display display)))
1681 (cond 1681 (cond
1682 ((memq frame-type '(x w32 mac ns)) 1682 ((memq frame-type '(x w32 ns))
1683 (x-display-grayscale-p display)) 1683 (x-display-grayscale-p display))
1684 (t 1684 (t
1685 (> (tty-color-gray-shades display) 2))))) 1685 (> (tty-color-gray-shades display) 2)))))
@@ -2027,7 +2027,7 @@ frame parameters in PARAMETERS and `default-frame-alist'."
2027 ;; X resouces for the default face are applied during 2027 ;; X resouces for the default face are applied during
2028 ;; x-create-frame. 2028 ;; x-create-frame.
2029 (and (not (eq face 'default)) 2029 (and (not (eq face 'default))
2030 (memq (window-system frame) '(x w32 mac)) 2030 (memq (window-system frame) '(x w32))
2031 (make-face-x-resource-internal face frame)) 2031 (make-face-x-resource-internal face frame))
2032 ;; Apply attributes specified by face-new-frame-defaults 2032 ;; Apply attributes specified by face-new-frame-defaults
2033 (internal-merge-in-global-face face frame)) 2033 (internal-merge-in-global-face face frame))
@@ -2495,7 +2495,7 @@ Note: Other faces cannot inherit from the cursor face."
2495 '((default 2495 '((default
2496 :box (:line-width 1 :style released-button) 2496 :box (:line-width 1 :style released-button)
2497 :foreground "black") 2497 :foreground "black")
2498 (((type x w32 mac ns) (class color)) 2498 (((type x w32 ns) (class color))
2499 :background "grey75") 2499 :background "grey75")
2500 (((type x) (class mono)) 2500 (((type x) (class mono))
2501 :background "grey")) 2501 :background "grey"))
diff --git a/lisp/frame.el b/lisp/frame.el
index d959ce6571b..ff644c67b2a 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -843,7 +843,7 @@ the user during startup."
843 (select-frame frame) 843 (select-frame frame)
844 (raise-frame frame) 844 (raise-frame frame)
845 ;; Ensure, if possible, that frame gets input focus. 845 ;; Ensure, if possible, that frame gets input focus.
846 (when (memq (window-system frame) '(x mac w32 ns)) 846 (when (memq (window-system frame) '(x w32 ns))
847 (x-focus-frame frame)) 847 (x-focus-frame frame))
848 (when focus-follows-mouse 848 (when focus-follows-mouse
849 (set-mouse-position (selected-frame) (1- (frame-width)) 0))) 849 (set-mouse-position (selected-frame) (1- (frame-width)) 0)))
@@ -1165,8 +1165,8 @@ frame's display)."
1165 ((eq system-type 'windows-nt) 1165 ((eq system-type 'windows-nt)
1166 (with-no-warnings 1166 (with-no-warnings
1167 (> w32-num-mouse-buttons 0))) 1167 (> w32-num-mouse-buttons 0)))
1168 ((memq frame-type '(x mac ns)) 1168 ((memq frame-type '(x ns))
1169 t) ;; We assume X, Mac, NeXTstep *always* have a pointing device 1169 t) ;; We assume X and NeXTstep *always* have a pointing device
1170 (t 1170 (t
1171 (or (and (featurep 'xt-mouse) 1171 (or (and (featurep 'xt-mouse)
1172 xterm-mouse-mode) 1172 xterm-mouse-mode)
@@ -1181,7 +1181,7 @@ frame's display).
1181Support for popup menus requires that the mouse be available." 1181Support for popup menus requires that the mouse be available."
1182 (and 1182 (and
1183 (let ((frame-type (framep-on-display display))) 1183 (let ((frame-type (framep-on-display display)))
1184 (memq frame-type '(x w32 pc mac ns))) 1184 (memq frame-type '(x w32 pc ns)))
1185 (display-mouse-p display))) 1185 (display-mouse-p display)))
1186 1186
1187(defun display-graphic-p (&optional display) 1187(defun display-graphic-p (&optional display)
@@ -1191,7 +1191,7 @@ frames and several different fonts at once. This is true for displays
1191that use a window system such as X, and false for text-only terminals. 1191that use a window system such as X, and false for text-only terminals.
1192DISPLAY can be a display name, a frame, or nil (meaning the selected 1192DISPLAY can be a display name, a frame, or nil (meaning the selected
1193frame's display)." 1193frame's display)."
1194 (not (null (memq (framep-on-display display) '(x w32 mac ns))))) 1194 (not (null (memq (framep-on-display display) '(x w32 ns)))))
1195 1195
1196(defun display-images-p (&optional display) 1196(defun display-images-p (&optional display)
1197 "Return non-nil if DISPLAY can display images. 1197 "Return non-nil if DISPLAY can display images.
@@ -1219,7 +1219,7 @@ frame's display)."
1219 ;; the Windows' DOS Box. 1219 ;; the Windows' DOS Box.
1220 (with-no-warnings 1220 (with-no-warnings
1221 (not (null dos-windows-version)))) 1221 (not (null dos-windows-version))))
1222 ((memq frame-type '(x w32 mac ns)) 1222 ((memq frame-type '(x w32 ns))
1223 t) ;; FIXME? 1223 t) ;; FIXME?
1224 (t 1224 (t
1225 nil)))) 1225 nil))))
@@ -1230,7 +1230,7 @@ frame's display)."
1230 "Return the number of screens associated with DISPLAY." 1230 "Return the number of screens associated with DISPLAY."
1231 (let ((frame-type (framep-on-display display))) 1231 (let ((frame-type (framep-on-display display)))
1232 (cond 1232 (cond
1233 ((memq frame-type '(x w32 mac ns)) 1233 ((memq frame-type '(x w32 ns))
1234 (x-display-screens display)) 1234 (x-display-screens display))
1235 (t 1235 (t
1236 1)))) 1236 1))))
@@ -1242,7 +1242,7 @@ frame's display)."
1242For character terminals, each character counts as a single pixel." 1242For character terminals, each character counts as a single pixel."
1243 (let ((frame-type (framep-on-display display))) 1243 (let ((frame-type (framep-on-display display)))
1244 (cond 1244 (cond
1245 ((memq frame-type '(x w32 mac ns)) 1245 ((memq frame-type '(x w32 ns))
1246 (x-display-pixel-height display)) 1246 (x-display-pixel-height display))
1247 (t 1247 (t
1248 (frame-height (if (framep display) display (selected-frame))))))) 1248 (frame-height (if (framep display) display (selected-frame)))))))
@@ -1254,7 +1254,7 @@ For character terminals, each character counts as a single pixel."
1254For character terminals, each character counts as a single pixel." 1254For character terminals, each character counts as a single pixel."
1255 (let ((frame-type (framep-on-display display))) 1255 (let ((frame-type (framep-on-display display)))
1256 (cond 1256 (cond
1257 ((memq frame-type '(x w32 mac ns)) 1257 ((memq frame-type '(x w32 ns))
1258 (x-display-pixel-width display)) 1258 (x-display-pixel-width display))
1259 (t 1259 (t
1260 (frame-width (if (framep display) display (selected-frame))))))) 1260 (frame-width (if (framep display) display (selected-frame)))))))
@@ -1283,7 +1283,7 @@ displays not explicitely specified."
1283 "Return the height of DISPLAY's screen in millimeters. 1283 "Return the height of DISPLAY's screen in millimeters.
1284System values can be overridden by `display-mm-dimensions-alist'. 1284System values can be overridden by `display-mm-dimensions-alist'.
1285If the information is unavailable, value is nil." 1285If the information is unavailable, value is nil."
1286 (and (memq (framep-on-display display) '(x w32 mac ns)) 1286 (and (memq (framep-on-display display) '(x w32 ns))
1287 (or (cddr (assoc (or display (frame-parameter nil 'display)) 1287 (or (cddr (assoc (or display (frame-parameter nil 'display))
1288 display-mm-dimensions-alist)) 1288 display-mm-dimensions-alist))
1289 (cddr (assoc t display-mm-dimensions-alist)) 1289 (cddr (assoc t display-mm-dimensions-alist))
@@ -1295,7 +1295,7 @@ If the information is unavailable, value is nil."
1295 "Return the width of DISPLAY's screen in millimeters. 1295 "Return the width of DISPLAY's screen in millimeters.
1296System values can be overridden by `display-mm-dimensions-alist'. 1296System values can be overridden by `display-mm-dimensions-alist'.
1297If the information is unavailable, value is nil." 1297If the information is unavailable, value is nil."
1298 (and (memq (framep-on-display display) '(x w32 mac ns)) 1298 (and (memq (framep-on-display display) '(x w32 ns))
1299 (or (cadr (assoc (or display (frame-parameter nil 'display)) 1299 (or (cadr (assoc (or display (frame-parameter nil 'display))
1300 display-mm-dimensions-alist)) 1300 display-mm-dimensions-alist))
1301 (cadr (assoc t display-mm-dimensions-alist)) 1301 (cadr (assoc t display-mm-dimensions-alist))
@@ -1309,7 +1309,7 @@ The value may be `always', `when-mapped', `not-useful', or nil if
1309the question is inapplicable to a certain kind of display." 1309the question is inapplicable to a certain kind of display."
1310 (let ((frame-type (framep-on-display display))) 1310 (let ((frame-type (framep-on-display display)))
1311 (cond 1311 (cond
1312 ((memq frame-type '(x w32 mac ns)) 1312 ((memq frame-type '(x w32 ns))
1313 (x-display-backing-store display)) 1313 (x-display-backing-store display))
1314 (t 1314 (t
1315 'not-useful)))) 1315 'not-useful))))
@@ -1320,7 +1320,7 @@ the question is inapplicable to a certain kind of display."
1320 "Return non-nil if DISPLAY's screen supports the SaveUnder feature." 1320 "Return non-nil if DISPLAY's screen supports the SaveUnder feature."
1321 (let ((frame-type (framep-on-display display))) 1321 (let ((frame-type (framep-on-display display)))
1322 (cond 1322 (cond
1323 ((memq frame-type '(x w32 mac ns)) 1323 ((memq frame-type '(x w32 ns))
1324 (x-display-save-under display)) 1324 (x-display-save-under display))
1325 (t 1325 (t
1326 'not-useful)))) 1326 'not-useful))))
@@ -1331,7 +1331,7 @@ the question is inapplicable to a certain kind of display."
1331 "Return the number of planes supported by DISPLAY." 1331 "Return the number of planes supported by DISPLAY."
1332 (let ((frame-type (framep-on-display display))) 1332 (let ((frame-type (framep-on-display display)))
1333 (cond 1333 (cond
1334 ((memq frame-type '(x w32 mac ns)) 1334 ((memq frame-type '(x w32 ns))
1335 (x-display-planes display)) 1335 (x-display-planes display))
1336 ((eq frame-type 'pc) 1336 ((eq frame-type 'pc)
1337 4) 1337 4)
@@ -1344,7 +1344,7 @@ the question is inapplicable to a certain kind of display."
1344 "Return the number of color cells supported by DISPLAY." 1344 "Return the number of color cells supported by DISPLAY."
1345 (let ((frame-type (framep-on-display display))) 1345 (let ((frame-type (framep-on-display display)))
1346 (cond 1346 (cond
1347 ((memq frame-type '(x w32 mac ns)) 1347 ((memq frame-type '(x w32 ns))
1348 (x-display-color-cells display)) 1348 (x-display-color-cells display))
1349 ((eq frame-type 'pc) 1349 ((eq frame-type 'pc)
1350 16) 1350 16)
@@ -1359,7 +1359,7 @@ The value is one of the symbols `static-gray', `gray-scale',
1359`static-color', `pseudo-color', `true-color', or `direct-color'." 1359`static-color', `pseudo-color', `true-color', or `direct-color'."
1360 (let ((frame-type (framep-on-display display))) 1360 (let ((frame-type (framep-on-display display)))
1361 (cond 1361 (cond
1362 ((memq frame-type '(x w32 mac ns)) 1362 ((memq frame-type '(x w32 ns))
1363 (x-display-visual-class display)) 1363 (x-display-visual-class display))
1364 ((and (memq frame-type '(pc t)) 1364 ((and (memq frame-type '(pc t))
1365 (tty-display-color-p display)) 1365 (tty-display-color-p display))
@@ -1572,7 +1572,7 @@ cursor display. On a text-only terminal, this is not implemented."
1572 :init-value (not (or noninteractive 1572 :init-value (not (or noninteractive
1573 no-blinking-cursor 1573 no-blinking-cursor
1574 (eq system-type 'ms-dos) 1574 (eq system-type 'ms-dos)
1575 (not (memq window-system '(x w32 mac))))) 1575 (not (memq window-system '(x w32)))))
1576 :initialize 'custom-initialize-safe-default 1576 :initialize 'custom-initialize-safe-default
1577 :group 'cursor 1577 :group 'cursor
1578 :global t 1578 :global t
diff --git a/lisp/info.el b/lisp/info.el
index f07d0890933..0a735843231 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -3893,7 +3893,7 @@ the variable `Info-file-list-for-emacs'."
3893 ;; This is a serious problem for trying to handle multiple 3893 ;; This is a serious problem for trying to handle multiple
3894 ;; frame types at once. We want this text to be invisible 3894 ;; frame types at once. We want this text to be invisible
3895 ;; on frames that can display the font above. 3895 ;; on frames that can display the font above.
3896 (when (memq (framep (selected-frame)) '(x pc w32 mac ns)) 3896 (when (memq (framep (selected-frame)) '(x pc w32 ns))
3897 (add-text-properties (1- (match-beginning 2)) (match-end 2) 3897 (add-text-properties (1- (match-beginning 2)) (match-end 2)
3898 '(invisible t front-sticky nil rear-nonsticky t))))) 3898 '(invisible t front-sticky nil rear-nonsticky t)))))
3899 3899
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index e0220a87d6f..4b8ee720d7e 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -35,7 +35,6 @@
35(autoload 'widget-value "wid-edit") 35(autoload 'widget-value "wid-edit")
36 36
37(defvar mac-system-coding-system) 37(defvar mac-system-coding-system)
38(defvar mac-system-locale)
39 38
40;;; MULE related key bindings and menus. 39;;; MULE related key bindings and menus.
41 40
@@ -148,7 +147,7 @@
148 t) 147 t)
149(define-key-after set-coding-system-map [set-terminal-coding-system] 148(define-key-after set-coding-system-map [set-terminal-coding-system]
150 '(menu-item "For Terminal" set-terminal-coding-system 149 '(menu-item "For Terminal" set-terminal-coding-system
151 :enable (null (memq initial-window-system '(x w32 mac ns))) 150 :enable (null (memq initial-window-system '(x w32 ns)))
152 :help "How to encode terminal output") 151 :help "How to encode terminal output")
153 t) 152 t)
154(define-key-after set-coding-system-map [separator-3] 153(define-key-after set-coding-system-map [separator-3]
@@ -2502,18 +2501,6 @@ See also `locale-charset-language-names', `locale-language-names',
2502 (= 0 (length locale))) ; nil or empty string 2501 (= 0 (length locale))) ; nil or empty string
2503 (setq locale (getenv (pop vars) frame))))) 2502 (setq locale (getenv (pop vars) frame)))))
2504 2503
2505 (unless locale
2506 ;; The two tests are kept separate so the byte-compiler sees
2507 ;; that mac-get-preference is only called after checking its existence.
2508 (when (fboundp 'mac-get-preference)
2509 (setq locale (mac-get-preference "AppleLocale"))
2510 (unless locale
2511 (let ((languages (mac-get-preference "AppleLanguages")))
2512 (unless (= (length languages) 0) ; nil or empty vector
2513 (setq locale (aref languages 0)))))))
2514 (unless (or locale (not (boundp 'mac-system-locale)))
2515 (setq locale mac-system-locale))
2516
2517 (when locale 2504 (when locale
2518 (setq locale (locale-translate locale)) 2505 (setq locale (locale-translate locale))
2519 2506
@@ -2546,8 +2533,7 @@ See also `locale-charset-language-names', `locale-language-names',
2546 (when locale 2533 (when locale
2547 (if (string-match "\\.\\([^@]+\\)" locale) 2534 (if (string-match "\\.\\([^@]+\\)" locale)
2548 (locale-charset-to-coding-system 2535 (locale-charset-to-coding-system
2549 (match-string 1 locale)))) 2536 (match-string 1 locale)))))))
2550 (and (eq system-type 'macos) mac-system-coding-system))))
2551 2537
2552 (if (consp language-name) 2538 (if (consp language-name)
2553 ;; locale-language-names specify both lang-env and coding. 2539 ;; locale-language-names specify both lang-env and coding.
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 2deb90e2f56..13f0e1ba1d1 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1667,8 +1667,6 @@ Scroll-bar or mode-line events are processed appropriately."
1667;; Scroll-bar functions: 1667;; Scroll-bar functions:
1668(if (fboundp 'scroll-bar-toolkit-scroll) 1668(if (fboundp 'scroll-bar-toolkit-scroll)
1669 (put 'scroll-bar-toolkit-scroll 'isearch-scroll t)) 1669 (put 'scroll-bar-toolkit-scroll 'isearch-scroll t))
1670(if (fboundp 'mac-handle-scroll-bar-event)
1671 (put 'mac-handle-scroll-bar-event 'isearch-scroll t))
1672(if (fboundp 'w32-handle-scroll-bar-event) 1670(if (fboundp 'w32-handle-scroll-bar-event)
1673 (put 'w32-handle-scroll-bar-event 'isearch-scroll t)) 1671 (put 'w32-handle-scroll-bar-event 'isearch-scroll t))
1674 1672
diff --git a/lisp/loadup.el b/lisp/loadup.el
index e444fc5dcaa..c913be436ac 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -211,9 +211,6 @@
211(if (eq system-type 'macos) 211(if (eq system-type 'macos)
212 (progn 212 (progn
213 (load "ls-lisp"))) 213 (load "ls-lisp")))
214(if (featurep 'mac-carbon)
215 (progn
216 (load "term/mac-win")))
217(if (featurep 'ns) 214(if (featurep 'ns)
218 (progn 215 (progn
219 (load "emacs-lisp/easymenu") ;; for platform-related menu adjustments 216 (load "emacs-lisp/easymenu") ;; for platform-related menu adjustments
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 6a296e702a2..416336d7e49 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -673,7 +673,7 @@ This should be bound to a mouse drag event."
673 ;; If mark is highlighted, no need to bounce the cursor. 673 ;; If mark is highlighted, no need to bounce the cursor.
674 ;; On X, we highlight while dragging, thus once again no need to bounce. 674 ;; On X, we highlight while dragging, thus once again no need to bounce.
675 (or transient-mark-mode 675 (or transient-mark-mode
676 (memq (framep (selected-frame)) '(x pc w32 mac ns)) 676 (memq (framep (selected-frame)) '(x pc w32 ns))
677 (sit-for 1)) 677 (sit-for 1))
678 (push-mark) 678 (push-mark)
679 (set-mark (point)) 679 (set-mark (point))
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index e51b2d9dc78..2e81572f6cc 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -58,7 +58,7 @@
58 "22.1") 58 "22.1")
59(defcustom mouse-wheel-down-event 59(defcustom mouse-wheel-down-event
60 ;; In the latest versions of XEmacs, we could just use mouse-%s as well. 60 ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
61 (if (memq window-system '(w32 mac ns)) 61 (if (memq window-system '(w32 ns))
62 'wheel-up 62 'wheel-up
63 (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s") 63 (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
64 mouse-wheel-down-button))) 64 mouse-wheel-down-button)))
@@ -73,7 +73,7 @@
73 "22.1") 73 "22.1")
74(defcustom mouse-wheel-up-event 74(defcustom mouse-wheel-up-event
75 ;; In the latest versions of XEmacs, we could just use mouse-%s as well. 75 ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
76 (if (memq window-system '(w32 mac ns)) 76 (if (memq window-system '(w32 ns))
77 'wheel-down 77 'wheel-down
78 (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s") 78 (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
79 mouse-wheel-up-button))) 79 mouse-wheel-up-button)))
diff --git a/lisp/simple.el b/lisp/simple.el
index c242f46bb89..4dec38ccdbb 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -6103,7 +6103,6 @@ call `normal-erase-is-backspace-mode' (which see) instead."
6103 (if (if (eq normal-erase-is-backspace 'maybe) 6103 (if (if (eq normal-erase-is-backspace 'maybe)
6104 (and (not noninteractive) 6104 (and (not noninteractive)
6105 (or (memq system-type '(ms-dos windows-nt)) 6105 (or (memq system-type '(ms-dos windows-nt))
6106 (eq window-system 'mac)
6107 (and (memq window-system '(x)) 6106 (and (memq window-system '(x))
6108 (fboundp 'x-backspace-delete-keys-p) 6107 (fboundp 'x-backspace-delete-keys-p)
6109 (x-backspace-delete-keys-p)) 6108 (x-backspace-delete-keys-p))
@@ -6153,7 +6152,7 @@ See also `normal-erase-is-backspace'."
6153 (set-terminal-parameter nil 'normal-erase-is-backspace 6152 (set-terminal-parameter nil 'normal-erase-is-backspace
6154 (if enabled 1 0)) 6153 (if enabled 1 0))
6155 6154
6156 (cond ((or (memq window-system '(x w32 mac ns pc)) 6155 (cond ((or (memq window-system '(x w32 ns pc))
6157 (memq system-type '(ms-dos windows-nt))) 6156 (memq system-type '(ms-dos windows-nt)))
6158 (let* ((bindings 6157 (let* ((bindings
6159 `(([C-delete] [C-backspace]) 6158 `(([C-delete] [C-backspace])
diff --git a/lisp/startup.el b/lisp/startup.el
index 21ef966f185..3d2217f3eab 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -886,7 +886,7 @@ opening the first frame (e.g. open a connection to an X server).")
886 ;; only because all other settings of no-blinking-cursor are here. 886 ;; only because all other settings of no-blinking-cursor are here.
887 (unless (or noninteractive 887 (unless (or noninteractive
888 emacs-basic-display 888 emacs-basic-display
889 (and (memq window-system '(x w32 mac ns)) 889 (and (memq window-system '(x w32 ns))
890 (not (member (x-get-resource "cursorBlink" "CursorBlink") 890 (not (member (x-get-resource "cursorBlink" "CursorBlink")
891 '("off" "false"))))) 891 '("off" "false")))))
892 (setq no-blinking-cursor t)) 892 (setq no-blinking-cursor t))
diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el
deleted file mode 100644
index 829e0d2e640..00000000000
--- a/lisp/term/mac-win.el
+++ /dev/null
@@ -1,2002 +0,0 @@
1;;; mac-win.el --- parse switches controlling interface with Mac window system -*-coding: utf-8-*-
2
3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4;; 2008 Free Software Foundation, Inc.
5
6;; Author: Andrew Choi <akochoi@mac.com>
7;; Keywords: terminals
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; Mac-win.el: this file is loaded from ../lisp/startup.el when it recognizes
27;; that Mac windows are to be used. Command line switches are parsed and those
28;; pertaining to Mac are processed and removed from the command line. The
29;; Mac display is opened and hooks are set for popping up the initial window.
30
31;; startup.el will then examine startup files, and eventually call the hooks
32;; which create the first window(s).
33
34;;; Code:
35
36;; These are the standard X switches from the Xt Initialize.c file of
37;; Release 4.
38
39;; Command line Resource Manager string
40
41;; +rv *reverseVideo
42;; +synchronous *synchronous
43;; -background *background
44;; -bd *borderColor
45;; -bg *background
46;; -bordercolor *borderColor
47;; -borderwidth .borderWidth
48;; -bw .borderWidth
49;; -display .display
50;; -fg *foreground
51;; -fn *font
52;; -font *font
53;; -foreground *foreground
54;; -geometry .geometry
55;; -iconic .iconic
56;; -name .name
57;; -reverse *reverseVideo
58;; -rv *reverseVideo
59;; -selectionTimeout .selectionTimeout
60;; -synchronous *synchronous
61;; -xrm
62
63;; An alist of X options and the function which handles them. See
64;; ../startup.el.
65
66;; (if (not (eq window-system 'mac))
67;; (error "%s: Loading mac-win.el but not compiled for Mac" (invocation-name)))
68
69(require 'frame)
70(require 'mouse)
71(require 'scroll-bar)
72(require 'faces)
73(require 'select)
74(require 'menu-bar)
75(require 'fontset)
76(require 'dnd)
77
78(defvar mac-charset-info-alist)
79(defvar mac-service-selection)
80(defvar mac-system-script-code)
81(defvar mac-apple-event-map)
82(defvar mac-font-panel-mode)
83(defvar mac-ts-active-input-overlay)
84(defvar mac-ts-active-input-buf)
85(defvar x-invocation-args)
86(declare-function mac-code-convert-string "mac.c")
87(declare-function mac-coerce-ae-data "mac.c")
88(declare-function mac-resume-apple-event "macselect.c")
89;; Suppress warning when compiling on non-Mac.
90(declare-function mac-font-panel-mode "mac-win.el")
91(declare-function mac-atsu-font-face-attributes "macfns.c")
92(declare-function mac-ae-set-reply-parameter "macselect.c")
93(declare-function mac-clear-font-name-table "macfns.c")
94
95(defvar x-command-line-resources nil)
96
97;; Handler for switches of the form "-switch value" or "-switch".
98(defun x-handle-switch (switch)
99 (let ((aelt (assoc switch command-line-x-option-alist)))
100 (if aelt
101 (let ((param (nth 3 aelt))
102 (value (nth 4 aelt)))
103 (if value
104 (setq default-frame-alist
105 (cons (cons param value)
106 default-frame-alist))
107 (setq default-frame-alist
108 (cons (cons param
109 (car x-invocation-args))
110 default-frame-alist)
111 x-invocation-args (cdr x-invocation-args)))))))
112
113;; Handler for switches of the form "-switch n"
114(defun x-handle-numeric-switch (switch)
115 (let ((aelt (assoc switch command-line-x-option-alist)))
116 (if aelt
117 (let ((param (nth 3 aelt)))
118 (setq default-frame-alist
119 (cons (cons param
120 (string-to-number (car x-invocation-args)))
121 default-frame-alist)
122 x-invocation-args
123 (cdr x-invocation-args))))))
124
125;; Handle options that apply to initial frame only
126(defun x-handle-initial-switch (switch)
127 (let ((aelt (assoc switch command-line-x-option-alist)))
128 (if aelt
129 (let ((param (nth 3 aelt))
130 (value (nth 4 aelt)))
131 (if value
132 (setq initial-frame-alist
133 (cons (cons param value)
134 initial-frame-alist))
135 (setq initial-frame-alist
136 (cons (cons param
137 (car x-invocation-args))
138 initial-frame-alist)
139 x-invocation-args (cdr x-invocation-args)))))))
140
141;; Make -iconic apply only to the initial frame!
142(defun x-handle-iconic (switch)
143 (setq initial-frame-alist
144 (cons '(visibility . icon) initial-frame-alist)))
145
146;; Handle the -xrm option.
147(defun x-handle-xrm-switch (switch)
148 (unless (consp x-invocation-args)
149 (error "%s: missing argument to `%s' option" (invocation-name) switch))
150 (setq x-command-line-resources
151 (if (null x-command-line-resources)
152 (car x-invocation-args)
153 (concat x-command-line-resources "\n" (car x-invocation-args))))
154 (setq x-invocation-args (cdr x-invocation-args)))
155
156(declare-function x-parse-geometry "frame.c" (string))
157
158;; Handle the geometry option
159(defun x-handle-geometry (switch)
160 (let* ((geo (x-parse-geometry (car x-invocation-args)))
161 (left (assq 'left geo))
162 (top (assq 'top geo))
163 (height (assq 'height geo))
164 (width (assq 'width geo)))
165 (if (or height width)
166 (setq default-frame-alist
167 (append default-frame-alist
168 '((user-size . t))
169 (if height (list height))
170 (if width (list width)))
171 initial-frame-alist
172 (append initial-frame-alist
173 '((user-size . t))
174 (if height (list height))
175 (if width (list width)))))
176 (if (or left top)
177 (setq initial-frame-alist
178 (append initial-frame-alist
179 '((user-position . t))
180 (if left (list left))
181 (if top (list top)))))
182 (setq x-invocation-args (cdr x-invocation-args))))
183
184(defvar x-resource-name)
185
186;; Handle the -name option. Set the variable x-resource-name
187;; to the option's operand; set the name of
188;; the initial frame, too.
189(defun x-handle-name-switch (switch)
190 (or (consp x-invocation-args)
191 (error "%s: missing argument to `%s' option" (invocation-name) switch))
192 (setq x-resource-name (car x-invocation-args)
193 x-invocation-args (cdr x-invocation-args))
194 (setq initial-frame-alist (cons (cons 'name x-resource-name)
195 initial-frame-alist)))
196
197(defvar x-display-name nil
198 "The display name specifying server and frame.")
199
200(defun x-handle-display (switch)
201 (setq x-display-name (car x-invocation-args)
202 x-invocation-args (cdr x-invocation-args)))
203
204(defun x-handle-args (args)
205 "Process the X-related command line options in ARGS.
206This is done before the user's startup file is loaded. They are copied to
207`x-invocation-args', from which the X-related things are extracted, first
208the switch (e.g., \"-fg\") in the following code, and possible values
209\(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
210This function returns ARGS minus the arguments that have been processed."
211 ;; We use ARGS to accumulate the args that we don't handle here, to return.
212 (setq x-invocation-args args
213 args nil)
214 (while (and x-invocation-args
215 (not (equal (car x-invocation-args) "--")))
216 (let* ((this-switch (car x-invocation-args))
217 (orig-this-switch this-switch)
218 completion argval aelt handler)
219 (setq x-invocation-args (cdr x-invocation-args))
220 ;; Check for long options with attached arguments
221 ;; and separate out the attached option argument into argval.
222 (if (string-match "^--[^=]*=" this-switch)
223 (setq argval (substring this-switch (match-end 0))
224 this-switch (substring this-switch 0 (1- (match-end 0)))))
225 ;; Complete names of long options.
226 (if (string-match "^--" this-switch)
227 (progn
228 (setq completion (try-completion this-switch command-line-x-option-alist))
229 (if (eq completion t)
230 ;; Exact match for long option.
231 nil
232 (if (stringp completion)
233 (let ((elt (assoc completion command-line-x-option-alist)))
234 ;; Check for abbreviated long option.
235 (or elt
236 (error "Option `%s' is ambiguous" this-switch))
237 (setq this-switch completion))))))
238 (setq aelt (assoc this-switch command-line-x-option-alist))
239 (if aelt (setq handler (nth 2 aelt)))
240 (if handler
241 (if argval
242 (let ((x-invocation-args
243 (cons argval x-invocation-args)))
244 (funcall handler this-switch))
245 (funcall handler this-switch))
246 (setq args (cons orig-this-switch args)))))
247 (nconc (nreverse args) x-invocation-args))
248
249
250;;
251;; Standard Mac cursor shapes
252;;
253
254(defconst mac-pointer-arrow 0)
255(defconst mac-pointer-copy-arrow 1)
256(defconst mac-pointer-alias-arrow 2)
257(defconst mac-pointer-contextual-menu-arrow 3)
258(defconst mac-pointer-I-beam 4)
259(defconst mac-pointer-cross 5)
260(defconst mac-pointer-plus 6)
261(defconst mac-pointer-watch 7)
262(defconst mac-pointer-closed-hand 8)
263(defconst mac-pointer-open-hand 9)
264(defconst mac-pointer-pointing-hand 10)
265(defconst mac-pointer-counting-up-hand 11)
266(defconst mac-pointer-counting-down-hand 12)
267(defconst mac-pointer-counting-up-and-down-hand 13)
268(defconst mac-pointer-spinning 14)
269(defconst mac-pointer-resize-left 15)
270(defconst mac-pointer-resize-right 16)
271(defconst mac-pointer-resize-left-right 17)
272;; Mac OS X 10.2 and later
273(defconst mac-pointer-not-allowed 18)
274;; Mac OS X 10.3 and later
275(defconst mac-pointer-resize-up 19)
276(defconst mac-pointer-resize-down 20)
277(defconst mac-pointer-resize-up-down 21)
278(defconst mac-pointer-poof 22)
279
280;;
281;; Standard X cursor shapes that have Mac counterparts
282;;
283
284(defconst x-pointer-left-ptr mac-pointer-arrow)
285(defconst x-pointer-xterm mac-pointer-I-beam)
286(defconst x-pointer-crosshair mac-pointer-cross)
287(defconst x-pointer-plus mac-pointer-plus)
288(defconst x-pointer-watch mac-pointer-watch)
289(defconst x-pointer-hand2 mac-pointer-pointing-hand)
290(defconst x-pointer-left-side mac-pointer-resize-left)
291(defconst x-pointer-right-side mac-pointer-resize-right)
292(defconst x-pointer-sb-h-double-arrow mac-pointer-resize-left-right)
293(defconst x-pointer-top-side mac-pointer-resize-up)
294(defconst x-pointer-bottom-side mac-pointer-resize-down)
295(defconst x-pointer-sb-v-double-arrow mac-pointer-resize-up-down)
296
297
298;;
299;; Available colors
300;;
301;; The ordering of the colors is chosen for the user's convenience in
302;; `list-colors-display', which displays the reverse of this list.
303;; Roughly speaking, `list-colors-display' orders by (i) named shades
304;; of grey with hue 0.0, sorted by value (ii) named colors with
305;; saturation 1.0, sorted by hue, (iii) named non-white colors with
306;; saturation less than 1.0, sorted by hue, (iv) other named shades of
307;; white, (v) numbered colors sorted by hue, and (vi) numbered shades
308;; of grey.
309
310(defvar x-colors
311 '("gray100" "gray99" "gray98" "gray97" "gray96" "gray95" "gray94" "gray93" "gray92"
312 "gray91" "gray90" "gray89" "gray88" "gray87" "gray86" "gray85" "gray84" "gray83"
313 "gray82" "gray81" "gray80" "gray79" "gray78" "gray77" "gray76" "gray75" "gray74"
314 "gray73" "gray72" "gray71" "gray70" "gray69" "gray68" "gray67" "gray66" "gray65"
315 "gray64" "gray63" "gray62" "gray61" "gray60" "gray59" "gray58" "gray57" "gray56"
316 "gray55" "gray54" "gray53" "gray52" "gray51" "gray50" "gray49" "gray48" "gray47"
317 "gray46" "gray45" "gray44" "gray43" "gray42" "gray41" "gray40" "gray39" "gray38"
318 "gray37" "gray36" "gray35" "gray34" "gray33" "gray32" "gray31" "gray30" "gray29"
319 "gray28" "gray27" "gray26" "gray25" "gray24" "gray23" "gray22" "gray21" "gray20"
320 "gray19" "gray18" "gray17" "gray16" "gray15" "gray14" "gray13" "gray12" "gray11"
321 "gray10" "gray9" "gray8" "gray7" "gray6" "gray5" "gray4" "gray3" "gray2" "gray1"
322 "gray0" "LightPink1" "LightPink2" "LightPink3" "LightPink4" "pink1" "pink2" "pink3"
323 "pink4" "PaleVioletRed1" "PaleVioletRed2" "PaleVioletRed3" "PaleVioletRed4"
324 "LavenderBlush1" "LavenderBlush2" "LavenderBlush3" "LavenderBlush4" "VioletRed1"
325 "VioletRed2" "VioletRed3" "VioletRed4" "HotPink1" "HotPink2" "HotPink3" "HotPink4"
326 "DeepPink1" "DeepPink2" "DeepPink3" "DeepPink4" "maroon1" "maroon2" "maroon3"
327 "maroon4" "orchid1" "orchid2" "orchid3" "orchid4" "plum1" "plum2" "plum3" "plum4"
328 "thistle1" "thistle2" "thistle3" "thistle4" "MediumOrchid1" "MediumOrchid2"
329 "MediumOrchid3" "MediumOrchid4" "DarkOrchid1" "DarkOrchid2" "DarkOrchid3"
330 "DarkOrchid4" "purple1" "purple2" "purple3" "purple4" "MediumPurple1"
331 "MediumPurple2" "MediumPurple3" "MediumPurple4" "SlateBlue1" "SlateBlue2"
332 "SlateBlue3" "SlateBlue4" "RoyalBlue1" "RoyalBlue2" "RoyalBlue3" "RoyalBlue4"
333 "LightSteelBlue1" "LightSteelBlue2" "LightSteelBlue3" "LightSteelBlue4" "SlateGray1"
334 "SlateGray2" "SlateGray3" "SlateGray4" "DodgerBlue1" "DodgerBlue2" "DodgerBlue3"
335 "DodgerBlue4" "SteelBlue1" "SteelBlue2" "SteelBlue3" "SteelBlue4" "SkyBlue1"
336 "SkyBlue2" "SkyBlue3" "SkyBlue4" "LightSkyBlue1" "LightSkyBlue2" "LightSkyBlue3"
337 "LightSkyBlue4" "LightBlue1" "LightBlue2" "LightBlue3" "LightBlue4" "CadetBlue1"
338 "CadetBlue2" "CadetBlue3" "CadetBlue4" "azure1" "azure2" "azure3" "azure4"
339 "LightCyan1" "LightCyan2" "LightCyan3" "LightCyan4" "PaleTurquoise1"
340 "PaleTurquoise2" "PaleTurquoise3" "PaleTurquoise4" "DarkSlateGray1" "DarkSlateGray2"
341 "DarkSlateGray3" "DarkSlateGray4" "aquamarine1" "aquamarine2" "aquamarine3"
342 "aquamarine4" "SeaGreen1" "SeaGreen2" "SeaGreen3" "SeaGreen4" "honeydew1"
343 "honeydew2" "honeydew3" "honeydew4" "DarkSeaGreen1" "DarkSeaGreen2" "DarkSeaGreen3"
344 "DarkSeaGreen4" "PaleGreen1" "PaleGreen2" "PaleGreen3" "PaleGreen4"
345 "DarkOliveGreen1" "DarkOliveGreen2" "DarkOliveGreen3" "DarkOliveGreen4" "OliveDrab1"
346 "OliveDrab2" "OliveDrab3" "OliveDrab4" "ivory1" "ivory2" "ivory3" "ivory4"
347 "LightYellow1" "LightYellow2" "LightYellow3" "LightYellow4" "khaki1" "khaki2"
348 "khaki3" "khaki4" "LemonChiffon1" "LemonChiffon2" "LemonChiffon3" "LemonChiffon4"
349 "LightGoldenrod1" "LightGoldenrod2" "LightGoldenrod3" "LightGoldenrod4" "cornsilk1"
350 "cornsilk2" "cornsilk3" "cornsilk4" "goldenrod1" "goldenrod2" "goldenrod3"
351 "goldenrod4" "DarkGoldenrod1" "DarkGoldenrod2" "DarkGoldenrod3" "DarkGoldenrod4"
352 "wheat1" "wheat2" "wheat3" "wheat4" "NavajoWhite1" "NavajoWhite2" "NavajoWhite3"
353 "NavajoWhite4" "burlywood1" "burlywood2" "burlywood3" "burlywood4" "AntiqueWhite1"
354 "AntiqueWhite2" "AntiqueWhite3" "AntiqueWhite4" "bisque1" "bisque2" "bisque3"
355 "bisque4" "tan1" "tan2" "tan3" "tan4" "PeachPuff1" "PeachPuff2" "PeachPuff3"
356 "PeachPuff4" "seashell1" "seashell2" "seashell3" "seashell4" "chocolate1"
357 "chocolate2" "chocolate3" "chocolate4" "sienna1" "sienna2" "sienna3" "sienna4"
358 "LightSalmon1" "LightSalmon2" "LightSalmon3" "LightSalmon4" "salmon1" "salmon2"
359 "salmon3" "salmon4" "coral1" "coral2" "coral3" "coral4" "tomato1" "tomato2"
360 "tomato3" "tomato4" "MistyRose1" "MistyRose2" "MistyRose3" "MistyRose4" "snow1"
361 "snow2" "snow3" "snow4" "RosyBrown1" "RosyBrown2" "RosyBrown3" "RosyBrown4"
362 "IndianRed1" "IndianRed2" "IndianRed3" "IndianRed4" "firebrick1" "firebrick2"
363 "firebrick3" "firebrick4" "brown1" "brown2" "brown3" "brown4" "magenta1" "magenta2"
364 "magenta3" "magenta4" "blue1" "blue2" "blue3" "blue4" "DeepSkyBlue1" "DeepSkyBlue2"
365 "DeepSkyBlue3" "DeepSkyBlue4" "turquoise1" "turquoise2" "turquoise3" "turquoise4"
366 "cyan1" "cyan2" "cyan3" "cyan4" "SpringGreen1" "SpringGreen2" "SpringGreen3"
367 "SpringGreen4" "green1" "green2" "green3" "green4" "chartreuse1" "chartreuse2"
368 "chartreuse3" "chartreuse4" "yellow1" "yellow2" "yellow3" "yellow4" "gold1" "gold2"
369 "gold3" "gold4" "orange1" "orange2" "orange3" "orange4" "DarkOrange1" "DarkOrange2"
370 "DarkOrange3" "DarkOrange4" "OrangeRed1" "OrangeRed2" "OrangeRed3" "OrangeRed4"
371 "red1" "red2" "red3" "red4" "lavender blush" "ghost white" "lavender" "alice blue"
372 "azure" "light cyan" "mint cream" "honeydew" "ivory" "light goldenrod yellow"
373 "light yellow" "beige" "floral white" "old lace" "blanched almond" "moccasin"
374 "papaya whip" "bisque" "antique white" "linen" "peach puff" "seashell" "misty rose"
375 "snow" "light pink" "pink" "hot pink" "deep pink" "maroon" "pale violet red"
376 "violet red" "medium violet red" "violet" "plum" "thistle" "orchid" "medium orchid"
377 "dark orchid" "purple" "blue violet" "medium purple" "light slate blue"
378 "medium slate blue" "slate blue" "dark slate blue" "midnight blue" "navy"
379 "dark blue" "light steel blue" "cornflower blue" "dodger blue" "royal blue"
380 "light slate gray" "slate gray" "dark slate gray" "steel blue" "cadet blue"
381 "light sky blue" "sky blue" "light blue" "powder blue" "pale turquoise" "turquoise"
382 "medium turquoise" "dark cyan" "aquamarine" "medium aquamarine" "light sea green"
383 "medium sea green" "sea green" "dark sea green" "pale green" "lime green"
384 "forest green" "light green" "green yellow" "yellow green" "olive drab"
385 "dark olive green" "lemon chiffon" "khaki" "dark khaki" "cornsilk"
386 "pale goldenrod" "light goldenrod" "goldenrod" "dark goldenrod" "wheat"
387 "navajo white" "tan" "burlywood" "sandy brown" "peru" "chocolate" "saddle brown"
388 "sienna" "rosy brown" "dark salmon" "coral" "tomato" "light salmon" "salmon"
389 "light coral" "indian red" "firebrick" "brown" "dark red" "magenta"
390 "dark magenta" "dark violet" "medium blue" "blue" "deep sky blue"
391 "cyan" "medium spring green" "spring green" "green" "lawn green" "chartreuse"
392 "yellow" "gold" "orange" "dark orange" "orange red" "red" "white" "white smoke"
393 "gainsboro" "light grey" "gray" "dark grey" "dim gray" "black" )
394 "The list of X colors from the `rgb.txt' file.
395XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
396
397(defun xw-defined-colors (&optional frame)
398 "Internal function called by `defined-colors', which see."
399 (or frame (setq frame (selected-frame)))
400 (let ((all-colors x-colors)
401 (this-color nil)
402 (defined-colors nil))
403 (while all-colors
404 (setq this-color (car all-colors)
405 all-colors (cdr all-colors))
406 (and (color-supported-p this-color frame t)
407 (setq defined-colors (cons this-color defined-colors))))
408 defined-colors))
409
410;;;; Function keys
411
412(defun x-setup-function-keys (frame)
413 "Setup Function Keys for mac."
414 ;; Don't do this twice on the same display, or it would break
415 ;; normal-erase-is-backspace-mode.
416 (unless (terminal-parameter frame 'x-setup-function-keys)
417 (with-selected-frame frame
418 ;; Map certain keypad keys into ASCII characters
419 ;; that people usually expect.
420 (define-key local-function-key-map [backspace] [?\d])
421 (define-key local-function-key-map [delete] [?\d])
422 (define-key local-function-key-map [tab] [?\t])
423 (define-key local-function-key-map [linefeed] [?\n])
424 (define-key local-function-key-map [clear] [?\C-l])
425 (define-key local-function-key-map [return] [?\C-m])
426 (define-key local-function-key-map [escape] [?\e])
427 (define-key local-function-key-map [M-backspace] [?\M-\d])
428 (define-key local-function-key-map [M-delete] [?\M-\d])
429 (define-key local-function-key-map [M-tab] [?\M-\t])
430 (define-key local-function-key-map [M-linefeed] [?\M-\n])
431 (define-key local-function-key-map [M-clear] [?\M-\C-l])
432 (define-key local-function-key-map [M-return] [?\M-\C-m])
433 (define-key local-function-key-map [M-escape] [?\M-\e])
434 (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
435 local-function-key-map global-map))
436 (set-terminal-parameter frame 'x-setup-function-keys t)))
437
438;; These tell read-char how to convert
439;; these special chars to ASCII.
440(put 'backspace 'ascii-character ?\d)
441(put 'delete 'ascii-character ?\d)
442(put 'tab 'ascii-character ?\t)
443(put 'linefeed 'ascii-character ?\n)
444(put 'clear 'ascii-character ?\C-l)
445(put 'return 'ascii-character ?\C-m)
446(put 'escape 'ascii-character ?\e)
447
448;; Modifier name `ctrl' is an alias of `control'.
449(put 'ctrl 'modifier-value (get 'control 'modifier-value))
450
451
452;;;; Script codes and coding systems
453(defconst mac-script-code-coding-systems
454 '((0 . mac-roman) ; smRoman
455 (1 . japanese-shift-jis) ; smJapanese
456 (2 . chinese-big5) ; smTradChinese
457 (3 . korean-iso-8bit) ; smKorean
458 (7 . mac-cyrillic) ; smCyrillic
459 (25 . chinese-iso-8bit) ; smSimpChinese
460 (29 . mac-centraleurroman) ; smCentralEuroRoman
461 )
462 "Alist of Mac script codes vs Emacs coding systems.")
463
464(defun mac-add-charset-info (xlfd-charset mac-text-encoding)
465 "Add a character set to display with Mac fonts.
466Create an entry in `mac-charset-info-alist'.
467XLFD-CHARSET is a string which will appear in the XLFD font name
468to identify the character set. MAC-TEXT-ENCODING is the
469correspoinding TextEncodingBase value."
470 (add-to-list 'mac-charset-info-alist
471 (list xlfd-charset mac-text-encoding
472 (cdr (assq mac-text-encoding
473 mac-script-code-coding-systems)))))
474
475(setq mac-charset-info-alist nil)
476(mac-add-charset-info "mac-roman" 0)
477(mac-add-charset-info "jisx0208.1983-sjis" 1)
478(mac-add-charset-info "jisx0201.1976-0" 1)
479(mac-add-charset-info "big5-0" 2)
480(mac-add-charset-info "ksc5601.1989-0" 3)
481(mac-add-charset-info "mac-cyrillic" 7)
482(mac-add-charset-info "gb2312.1980-0" 25)
483(mac-add-charset-info "mac-centraleurroman" 29)
484(mac-add-charset-info "mac-symbol" 33)
485(mac-add-charset-info "adobe-fontspecific" 33) ; for X-Symbol
486(mac-add-charset-info "mac-dingbats" 34)
487(mac-add-charset-info "iso10646-1" 126) ; for ATSUI
488
489(define-charset 'mac-centraleurroman
490 "Mac Central European Roman"
491 :short-name "Mac CE"
492 :ascii-compatible-p t
493 :code-space [0 255]
494 :map
495 (let ((tbl
496 [?\Ä ?\Ā ?\ā ?\É ?\Ą ?\Ö ?\Ü ?\á ?\ą ?\Č ?\ä ?\č ?\Ć ?\ć ?\é ?\Ź
497 ?\ź ?\Ď ?\í ?\ď ?\Ē ?\ē ?\Ė ?\ó ?\ė ?\ô ?\ö ?\õ ?\ú ?\Ě ?\ě ?\ü
498 ?\† ?\° ?\Ę ?\£ ?\§ ?\• ?\¶ ?\ß ?\® ?\© ?\™ ?\ę ?\¨ ?\≠ ?\ģ ?\Į
499 ?\į ?\Ī ?\≤ ?\≥ ?\ī ?\Ķ ?\∂ ?\∑ ?\ł ?\Ļ ?\ļ ?\Ľ ?\ľ ?\Ĺ ?\ĺ ?\Ņ
500 ?\ņ ?\Ń ?\¬ ?\√ ?\ń ?\Ň ?\∆ ?\« ?\» ?\… ?\  ?\ň ?\Ő ?\Õ ?\ő ?\Ō
501 ?\– ?\— ?\“ ?\” ?\‘ ?\’ ?\÷ ?\◊ ?\ō ?\Ŕ ?\ŕ ?\Ř ?\‹ ?\› ?\ř ?\Ŗ
502 ?\ŗ ?\Š ?\‚ ?\„ ?\š ?\Ś ?\ś ?\Á ?\Ť ?\ť ?\Í ?\Ž ?\ž ?\Ū ?\Ó ?\Ô
503 ?\ū ?\Ů ?\Ú ?\ů ?\Ű ?\ű ?\Ų ?\ų ?\Ý ?\ý ?\ķ ?\Ż ?\Ł ?\ż ?\Ģ ?\ˇ])
504 (map (make-vector 512 nil)))
505 (or (= (length tbl) 128)
506 (error "Invalid vector length: %d" (length tbl)))
507 (dotimes (i 128)
508 (aset map (* i 2) i)
509 (aset map (1+ (* i 2)) i))
510 (dotimes (i 128)
511 (aset map (+ 256 (* i 2)) (+ 128 i))
512 (aset map (+ 256 (1+ (* i 2))) (aref tbl i)))
513 map))
514
515(define-coding-system 'mac-centraleurroman
516 "Mac Central European Roman Encoding (MIME:x-mac-centraleurroman)."
517 :coding-type 'charset
518 :mnemonic ?*
519 :charset-list '(mac-centraleurroman)
520 :mime-charset 'x-mac-centraleurroman)
521
522(define-charset 'mac-cyrillic
523 "Mac Cyrillic"
524 :short-name "Mac CYRILLIC"
525 :ascii-compatible-p t
526 :code-space [0 255]
527 :map
528 (let ((tbl
529 [?\А ?\Б ?\В ?\Г ?\Д ?\Е ?\Ж ?\З ?\И ?\Й ?\К ?\Л ?\М ?\Н ?\О ?\П
530 ?\Р ?\С ?\Т ?\У ?\Ф ?\Х ?\Ц ?\Ч ?\Ш ?\Щ ?\Ъ ?\Ы ?\Ь ?\Э ?\Ю ?\Я
531 ?\† ?\° ?\Ґ ?\£ ?\§ ?\• ?\¶ ?\І ?\® ?\© ?\™ ?\Ђ ?\ђ ?\≠ ?\Ѓ ?\ѓ
532 ?\∞ ?\± ?\≤ ?\≥ ?\і ?\µ ?\ґ ?\Ј ?\Є ?\є ?\Ї ?\ї ?\Љ ?\љ ?\Њ ?\њ
533 ?\ј ?\Ѕ ?\¬ ?\√ ?\ƒ ?\≈ ?\∆ ?\« ?\» ?\… ?\  ?\Ћ ?\ћ ?\Ќ ?\ќ ?\ѕ
534 ?\– ?\— ?\“ ?\” ?\‘ ?\’ ?\÷ ?\„ ?\Ў ?\ў ?\Џ ?\џ ?\№ ?\Ё ?\ё ?\я
535 ?\а ?\б ?\в ?\г ?\д ?\е ?\ж ?\з ?\и ?\й ?\к ?\л ?\м ?\н ?\о ?\п
536 ?\р ?\с ?\т ?\у ?\ф ?\х ?\ц ?\ч ?\ш ?\щ ?\ъ ?\ы ?\ь ?\э ?\ю ?\€])
537 (map (make-vector 512 nil)))
538 (or (= (length tbl) 128)
539 (error "Invalid vector length: %d" (length tbl)))
540 (dotimes (i 128)
541 (aset map (* i 2) i)
542 (aset map (1+ (* i 2)) i))
543 (dotimes (i 128)
544 (aset map (+ 256 (* i 2)) (+ 128 i))
545 (aset map (+ 256 (1+ (* i 2))) (aref tbl i)))
546 map))
547
548(define-coding-system 'mac-cyrillic
549 "Mac Cyrillic Encoding (MIME:x-mac-cyrillic)."
550 :coding-type 'charset
551 :mnemonic ?*
552 :charset-list '(mac-cyrillic)
553 :mime-charset 'x-mac-cyrillic)
554
555(define-charset 'mac-symbol
556 "Mac Symbol"
557 :short-name "Mac SYMBOL"
558 :code-space [32 254]
559 :map
560 (let ((tbl-32-126
561 [?\ ?\! ?\∀ ?\# ?\∃ ?\% ?\& ?\∍ ?\( ?\) ?\∗ ?\+ ?\, ?\− ?\. ?\/
562 ?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\8 ?\9 ?\: ?\; ?\< ?\= ?\> ?\?
563 ?\≅ ?\Α ?\Β ?\Χ ?\Δ ?\Ε ?\Φ ?\Γ ?\Η ?\Ι ?\ϑ ?\Κ ?\Λ ?\Μ ?\Ν ?\Ο
564 ?\Π ?\Θ ?\Ρ ?\Σ ?\Τ ?\Υ ?\ς ?\Ω ?\Ξ ?\Ψ ?\Ζ ?\[ ?\∴ ?\] ?\⊥ ?\_
565 ?\ ?\α ?\β ?\χ ?\δ ?\ε ?\φ ?\γ ?\η ?\ι ?\ϕ ?\κ ?\λ ?\μ ?\ν ?\ο
566 ?\π ?\θ ?\ρ ?\σ ?\τ ?\υ ?\ϖ ?\ω ?\ξ ?\ψ ?\ζ ?\{ ?\| ?\} ?\∼])
567 (map-32-126 (make-vector (* (1+ (- 126 32)) 2) nil))
568 (tbl-160-254
569 ;; Mapping of the following characters are changed from the
570 ;; original one:
571 ;; 0xE2 0x00AE+0xF87F->0x00AE # REGISTERED SIGN, alternate: sans serif
572 ;; 0xE3 0x00A9+0xF87F->0x00A9 # COPYRIGHT SIGN, alternate: sans serif
573 ;; 0xE4 0x2122+0xF87F->0x2122 # TRADE MARK SIGN, alternate: sans serif
574 [?\€ ?\ϒ ?\′ ?\≤ ?\⁄ ?\∞ ?\ƒ ?\♣ ?\♦ ?\♥ ?\♠ ?\↔ ?\← ?\↑ ?\→ ?\↓
575 ?\° ?\± ?\″ ?\≥ ?\× ?\∝ ?\∂ ?\• ?\÷ ?\≠ ?\≡ ?\≈ ?\… ?\⏐ ?\⎯ ?\↵
576 ?\ℵ ?\ℑ ?\ℜ ?\℘ ?\⊗ ?\⊕ ?\∅ ?\∩ ?\∪ ?\⊃ ?\⊇ ?\⊄ ?\⊂ ?\⊆ ?\∈ ?\∉
577 ?\∠ ?\∇ ?\® ?\© ?\™ ?\∏ ?\√ ?\⋅ ?\¬ ?\∧ ?\∨ ?\⇔ ?\⇐ ?\⇑ ?\⇒ ?\⇓
578 ?\◊ ?\〈 ?\® ?\© ?\™ ?\∑ ?\⎛ ?\⎜ ?\⎝ ?\⎡ ?\⎢ ?\⎣ ?\⎧ ?\⎨ ?\⎩ ?\⎪
579 ?\ ?\〉 ?\∫ ?\⌠ ?\⎮ ?\⌡ ?\⎞ ?\⎟ ?\⎠ ?\⎤ ?\⎥ ?\⎦ ?\⎫ ?\⎬ ?\⎭])
580 (map-160-254 (make-vector (* (1+ (- 254 160)) 2) nil)))
581 (dotimes (i (1+ (- 126 32)))
582 (aset map-32-126 (* i 2) (+ 32 i))
583 (aset map-32-126 (1+ (* i 2)) (aref tbl-32-126 i)))
584 (dotimes (i (1+ (- 254 160)))
585 (aset map-160-254 (* i 2) (+ 160 i))
586 (aset map-160-254 (1+ (* i 2)) (aref tbl-160-254 i)))
587 (vconcat map-32-126 map-160-254)))
588
589(define-charset 'mac-dingbats
590 "Mac Dingbats"
591 :short-name "Mac Dingbats"
592 :code-space [32 254]
593 :map
594 (let ((tbl-32-126
595 [?\ ?\✁ ?\✂ ?\✃ ?\✄ ?\☎ ?\✆ ?\✇ ?\✈ ?\✉ ?\☛ ?\☞ ?\✌ ?\✍ ?\✎ ?\✏
596 ?\✐ ?\✑ ?\✒ ?\✓ ?\✔ ?\✕ ?\✖ ?\✗ ?\✘ ?\✙ ?\✚ ?\✛ ?\✜ ?\✝ ?\✞ ?\✟
597 ?\✠ ?\✡ ?\✢ ?\✣ ?\✤ ?\✥ ?\✦ ?\✧ ?\★ ?\✩ ?\✪ ?\✫ ?\✬ ?\✭ ?\✮ ?\✯
598 ?\✰ ?\✱ ?\✲ ?\✳ ?\✴ ?\✵ ?\✶ ?\✷ ?\✸ ?\✹ ?\✺ ?\✻ ?\✼ ?\✽ ?\✾ ?\✿
599 ?\❀ ?\❁ ?\❂ ?\❃ ?\❄ ?\❅ ?\❆ ?\❇ ?\❈ ?\❉ ?\❊ ?\❋ ?\● ?\❍ ?\■ ?\❏
600 ?\❐ ?\❑ ?\❒ ?\▲ ?\▼ ?\◆ ?\❖ ?\◗ ?\❘ ?\❙ ?\❚ ?\❛ ?\❜ ?\❝ ?\❞])
601 (map-32-126 (make-vector (* (1+ (- 126 32)) 2) nil))
602 (tbl-128-141
603 [?\❨ ?\❩ ?\❪ ?\❫ ?\❬ ?\❭ ?\❮ ?\❯ ?\❰ ?\❱ ?\❲ ?\❳ ?\❴ ?\❵])
604 (map-128-141 (make-vector (* (1+ (- 141 128)) 2) nil))
605 (tbl-161-239
606 [?\❡ ?\❢ ?\❣ ?\❤ ?\❥ ?\❦ ?\❧ ?\♣ ?\♦ ?\♥ ?\♠ ?\① ?\② ?\③ ?\④
607 ?\⑤ ?\⑥ ?\⑦ ?\⑧ ?\⑨ ?\⑩ ?\❶ ?\❷ ?\❸ ?\❹ ?\❺ ?\❻ ?\❼ ?\❽ ?\❾ ?\❿
608 ?\➀ ?\➁ ?\➂ ?\➃ ?\➄ ?\➅ ?\➆ ?\➇ ?\➈ ?\➉ ?\➊ ?\➋ ?\➌ ?\➍ ?\➎ ?\➏
609 ?\➐ ?\➑ ?\➒ ?\➓ ?\➔ ?\→ ?\↔ ?\↕ ?\➘ ?\➙ ?\➚ ?\➛ ?\➜ ?\➝ ?\➞ ?\➟
610 ?\➠ ?\➡ ?\➢ ?\➣ ?\➤ ?\➥ ?\➦ ?\➧ ?\➨ ?\➩ ?\➪ ?\➫ ?\➬ ?\➭ ?\➮ ?\➯])
611 (map-161-239 (make-vector (* (1+ (- 239 161)) 2) nil))
612 (tbl-241-254
613 [?\➱ ?\➲ ?\➳ ?\➴ ?\➵ ?\➶ ?\➷ ?\➸ ?\➹ ?\➺ ?\➻ ?\➼ ?\➽ ?\➾])
614 (map-241-254 (make-vector (* (1+ (- 254 241)) 2) nil)))
615 (dotimes (i (1+ (- 126 32)))
616 (aset map-32-126 (* i 2) (+ 32 i))
617 (aset map-32-126 (1+ (* i 2)) (aref tbl-32-126 i)))
618 (dotimes (i (1+ (- 141 128)))
619 (aset map-128-141 (* i 2) (+ 128 i))
620 (aset map-128-141 (1+ (* i 2)) (aref tbl-128-141 i)))
621 (dotimes (i (1+ (- 239 161)))
622 (aset map-161-239 (* i 2) (+ 161 i))
623 (aset map-161-239 (1+ (* i 2)) (aref tbl-161-239 i)))
624 (dotimes (i (1+ (- 254 241)))
625 (aset map-241-254 (* i 2) (+ 241 i))
626 (aset map-241-254 (1+ (* i 2)) (aref tbl-241-254 i)))
627 (vconcat map-32-126 map-128-141 map-161-239 map-241-254)))
628
629(defconst mac-system-coding-system
630 (let ((base (or (cdr (assq mac-system-script-code
631 mac-script-code-coding-systems))
632 'mac-roman)))
633 (if (eq system-type 'darwin)
634 base
635 (coding-system-change-eol-conversion base 'mac)))
636 "Coding system derived from the system script code.")
637
638(set-selection-coding-system mac-system-coding-system)
639
640
641;;;; Keyboard layout/language change events
642(defun mac-handle-language-change (event)
643 "Set keyboard coding system to what is specified in EVENT."
644 (interactive "e")
645 (let ((coding-system
646 (cdr (assq (car (cadr event)) mac-script-code-coding-systems))))
647 (set-keyboard-coding-system (or coding-system 'mac-roman))
648 ;; MacJapanese maps reverse solidus to ?\x80.
649 (if (eq coding-system 'japanese-shift-jis)
650 (define-key key-translation-map [?\x80] "\\"))))
651
652(define-key special-event-map [language-change] 'mac-handle-language-change)
653
654
655;;;; Conversion between common flavors and Lisp string.
656
657(defconst mac-text-encoding-ascii #x600
658 "ASCII text encoding.")
659
660(defconst mac-text-encoding-mac-japanese-basic-variant #x20001
661 "MacJapanese text encoding without Apple double-byte extensions.")
662
663(defun mac-utxt-to-string (data &optional coding-system)
664 (or coding-system (setq coding-system mac-system-coding-system))
665 (let* ((encoding
666 (and (eq system-type 'darwin)
667 (eq (coding-system-base coding-system) 'japanese-shift-jis)
668 mac-text-encoding-mac-japanese-basic-variant))
669 (str (and (fboundp 'mac-code-convert-string)
670 (mac-code-convert-string data nil
671 (or encoding coding-system)))))
672 (when str
673 (setq str (decode-coding-string str coding-system))
674 (if (eq encoding mac-text-encoding-mac-japanese-basic-variant)
675 ;; Does it contain Apple one-byte extensions other than
676 ;; reverse solidus?
677 (if (string-match "[\xa0\xfd-\xff]" str)
678 (setq str nil)
679 ;; ASCII-only?
680 (unless (mac-code-convert-string data nil mac-text-encoding-ascii)
681 (subst-char-in-string ?\x5c ?\¥ str t)
682 (subst-char-in-string ?\x80 ?\\ str t)))))
683 (or str
684 (decode-coding-string data
685 (if (eq (byteorder) ?B) 'utf-16be 'utf-16le)))))
686
687(defun mac-string-to-utxt (string &optional coding-system)
688 (or coding-system (setq coding-system mac-system-coding-system))
689 (let (data encoding)
690 (when (and (fboundp 'mac-code-convert-string)
691 (memq (coding-system-base coding-system)
692 (find-coding-systems-string string)))
693 (setq coding-system
694 (coding-system-change-eol-conversion coding-system 'mac))
695 (let ((str string))
696 (when (and (eq system-type 'darwin)
697 (eq coding-system 'japanese-shift-jis-mac))
698 (setq encoding mac-text-encoding-mac-japanese-basic-variant)
699 (setq str (subst-char-in-string ?\\ ?\x80 str))
700 (subst-char-in-string ?\¥ ?\x5c str t)
701 ;; ASCII-only?
702 (if (string-match "\\`[\x00-\x7f]*\\'" str)
703 (setq str nil)))
704 (and str
705 (setq data (mac-code-convert-string
706 (encode-coding-string str coding-system)
707 (or encoding coding-system) nil)))))
708 (or data (encode-coding-string string (if (eq (byteorder) ?B)
709 'utf-16be-mac
710 'utf-16le-mac)))))
711
712(defun mac-TEXT-to-string (data &optional coding-system)
713 (or coding-system (setq coding-system mac-system-coding-system))
714 (prog1 (setq data (decode-coding-string data coding-system))
715 (when (eq (coding-system-base coding-system) 'japanese-shift-jis)
716 ;; (subst-char-in-string ?\x5c ?\¥ data t)
717 (subst-char-in-string ?\x80 ?\\ data t))))
718
719(defun mac-string-to-TEXT (string &optional coding-system)
720 (or coding-system (setq coding-system mac-system-coding-system))
721 (let ((encodables (find-coding-systems-string string))
722 (rest mac-script-code-coding-systems))
723 (unless (memq (coding-system-base coding-system) encodables)
724 (while (and rest (not (memq (cdar rest) encodables)))
725 (setq rest (cdr rest)))
726 (if rest
727 (setq coding-system (cdar rest)))))
728 (setq coding-system
729 (coding-system-change-eol-conversion coding-system 'mac))
730 (when (eq coding-system 'japanese-shift-jis-mac)
731 ;; (setq string (subst-char-in-string ?\\ ?\x80 string))
732 (setq string (subst-char-in-string ?\¥ ?\x5c string)))
733 (encode-coding-string string coding-system))
734
735(defun mac-furl-to-string (data)
736 ;; Remove a trailing nul character.
737 (let ((len (length data)))
738 (if (and (> len 0) (= (aref data (1- len)) ?\0))
739 (substring data 0 (1- len))
740 data)))
741
742(defun mac-TIFF-to-string (data &optional text)
743 (prog1 (or text (setq text (copy-sequence " ")))
744 (put-text-property 0 (length text) 'display (create-image data 'tiff t)
745 text)))
746
747;;;; Selections
748
749;;; We keep track of the last text selected here, so we can check the
750;;; current selection against it, and avoid passing back our own text
751;;; from x-get-selection-value.
752(defvar x-last-selected-text-clipboard nil
753 "The value of the CLIPBOARD selection last time we selected or
754pasted text.")
755(defvar x-last-selected-text-primary nil
756 "The value of the PRIMARY X selection last time we selected or
757pasted text.")
758
759(defcustom x-select-enable-clipboard t
760 "*Non-nil means cutting and pasting uses the clipboard.
761This is in addition to the primary selection."
762 :type 'boolean
763 :group 'killing)
764
765;;; Make TEXT, a string, the primary X selection.
766(defun x-select-text (text &optional push)
767 (x-set-selection 'PRIMARY text)
768 (setq x-last-selected-text-primary text)
769 (if (not x-select-enable-clipboard)
770 (setq x-last-selected-text-clipboard nil)
771 (x-set-selection 'CLIPBOARD text)
772 (setq x-last-selected-text-clipboard text))
773 )
774
775(declare-function x-get-selection-internal "xselect.c"
776 (selection-symbol target-type &optional time-stamp))
777
778(defun x-get-selection (&optional type data-type)
779 "Return the value of a selection.
780The argument TYPE (default `PRIMARY') says which selection,
781and the argument DATA-TYPE (default `STRING') says
782how to convert the data.
783
784TYPE may be any symbol \(but nil stands for `PRIMARY'). However,
785only a few symbols are commonly used. They conventionally have
786all upper-case names. The most often used ones, in addition to
787`PRIMARY', are `SECONDARY' and `CLIPBOARD'.
788
789DATA-TYPE is usually `STRING', but can also be one of the symbols
790in `selection-converter-alist', which see."
791 (let ((data (x-get-selection-internal (or type 'PRIMARY)
792 (or data-type 'STRING)))
793 (coding (or next-selection-coding-system
794 selection-coding-system)))
795 (when (and (stringp data)
796 (setq data-type (get-text-property 0 'foreign-selection data)))
797 (cond ((eq data-type 'public.utf16-plain-text)
798 (setq data (mac-utxt-to-string data coding)))
799 ((eq data-type 'com.apple.traditional-mac-plain-text)
800 (setq data (mac-TEXT-to-string data coding)))
801 ((eq data-type 'public.file-url)
802 (setq data (mac-furl-to-string data))))
803 (put-text-property 0 (length data) 'foreign-selection data-type data))
804 data))
805
806(defun x-selection-value (type)
807 (let ((data-types '(public.utf16-plain-text
808 com.apple.traditional-mac-plain-text
809 public.file-url))
810 text tiff-image)
811 (while (and (null text) data-types)
812 (setq text (condition-case nil
813 (x-get-selection type (car data-types))
814 (error nil)))
815 (setq data-types (cdr data-types)))
816 (if text
817 (remove-text-properties 0 (length text) '(foreign-selection nil) text))
818 (setq tiff-image (condition-case nil
819 (x-get-selection type 'public.tiff)
820 (error nil)))
821 (when tiff-image
822 (remove-text-properties 0 (length tiff-image)
823 '(foreign-selection nil) tiff-image)
824 (setq text (mac-TIFF-to-string tiff-image text)))
825 text))
826
827;;; Return the value of the current selection.
828;;; Treat empty strings as if they were unset.
829;;; If this function is called twice and finds the same text,
830;;; it returns nil the second time. This is so that a single
831;;; selection won't be added to the kill ring over and over.
832(defun x-get-selection-value ()
833 (let (clip-text primary-text)
834 (if (not x-select-enable-clipboard)
835 (setq x-last-selected-text-clipboard nil)
836 (setq clip-text (x-selection-value 'CLIPBOARD))
837 (if (string= clip-text "") (setq clip-text nil))
838
839 ;; Check the CLIPBOARD selection for 'newness', is it different
840 ;; from what we remebered them to be last time we did a
841 ;; cut/paste operation.
842 (setq clip-text
843 (cond;; check clipboard
844 ((or (not clip-text) (string= clip-text ""))
845 (setq x-last-selected-text-clipboard nil))
846 ((eq clip-text x-last-selected-text-clipboard) nil)
847 ((string= clip-text x-last-selected-text-clipboard)
848 ;; Record the newer string,
849 ;; so subsequent calls can use the `eq' test.
850 (setq x-last-selected-text-clipboard clip-text)
851 nil)
852 (t
853 (setq x-last-selected-text-clipboard clip-text))))
854 )
855
856 (setq primary-text (x-selection-value 'PRIMARY))
857 ;; Check the PRIMARY selection for 'newness', is it different
858 ;; from what we remebered them to be last time we did a
859 ;; cut/paste operation.
860 (setq primary-text
861 (cond;; check primary selection
862 ((or (not primary-text) (string= primary-text ""))
863 (setq x-last-selected-text-primary nil))
864 ((eq primary-text x-last-selected-text-primary) nil)
865 ((string= primary-text x-last-selected-text-primary)
866 ;; Record the newer string,
867 ;; so subsequent calls can use the `eq' test.
868 (setq x-last-selected-text-primary primary-text)
869 nil)
870 (t
871 (setq x-last-selected-text-primary primary-text))))
872
873 ;; As we have done one selection, clear this now.
874 (setq next-selection-coding-system nil)
875
876 ;; At this point we have recorded the current values for the
877 ;; selection from clipboard (if we are supposed to) and primary,
878 ;; So return the first one that has changed (which is the first
879 ;; non-null one).
880 (or clip-text primary-text)
881 ))
882
883(put 'CLIPBOARD 'mac-scrap-name "com.apple.scrap.clipboard")
884(when (eq system-type 'darwin)
885 (put 'FIND 'mac-scrap-name "com.apple.scrap.find")
886 (put 'PRIMARY 'mac-scrap-name
887 (format "org.gnu.Emacs.%d.selection.PRIMARY" (emacs-pid))))
888(put 'com.apple.traditional-mac-plain-text 'mac-ostype "TEXT")
889(put 'public.utf16-plain-text 'mac-ostype "utxt")
890(put 'public.tiff 'mac-ostype "TIFF")
891(put 'public.file-url 'mac-ostype "furl")
892
893(defun mac-select-convert-to-string (selection type value)
894 (let ((str (cdr (xselect-convert-to-string selection nil value)))
895 (coding (or next-selection-coding-system selection-coding-system)))
896 (when str
897 ;; If TYPE is nil, this is a local request, thus return STR as
898 ;; is. Otherwise, encode STR.
899 (if (not type)
900 str
901 (let ((inhibit-read-only t))
902 (remove-text-properties 0 (length str) '(composition nil) str)
903 (cond
904 ((eq type 'public.utf16-plain-text)
905 (setq str (mac-string-to-utxt str coding)))
906 ((eq type 'com.apple.traditional-mac-plain-text)
907 (setq str (mac-string-to-TEXT str coding)))
908 (t
909 (error "Unknown selection type: %S" type))
910 )))
911
912 (setq next-selection-coding-system nil)
913 (cons type str))))
914
915(defun mac-select-convert-to-file-url (selection type value)
916 (let ((filename (xselect-convert-to-filename selection type value))
917 (coding (or file-name-coding-system default-file-name-coding-system)))
918 (if (and filename coding)
919 (setq filename (encode-coding-string filename coding)))
920 (and filename
921 (concat "file://localhost"
922 (mapconcat 'url-hexify-string
923 (split-string filename "/") "/")))))
924
925(setq selection-converter-alist
926 (nconc
927 '((public.utf16-plain-text . mac-select-convert-to-string)
928 (com.apple.traditional-mac-plain-text . mac-select-convert-to-string)
929 ;; This is not enabled by default because the `Import Image'
930 ;; menu makes Emacs crash or hang for unknown reasons.
931 ;; (public.tiff . nil)
932 (public.file-url . mac-select-convert-to-file-url)
933 )
934 selection-converter-alist))
935
936;;;; Apple events, HICommand events, and Services menu
937
938;;; Event classes
939(put 'core-event 'mac-apple-event-class "aevt") ; kCoreEventClass
940(put 'internet-event 'mac-apple-event-class "GURL") ; kAEInternetEventClass
941
942;;; Event IDs
943;; kCoreEventClass
944(put 'open-application 'mac-apple-event-id "oapp") ; kAEOpenApplication
945(put 'reopen-application 'mac-apple-event-id "rapp") ; kAEReopenApplication
946(put 'open-documents 'mac-apple-event-id "odoc") ; kAEOpenDocuments
947(put 'print-documents 'mac-apple-event-id "pdoc") ; kAEPrintDocuments
948(put 'open-contents 'mac-apple-event-id "ocon") ; kAEOpenContents
949(put 'quit-application 'mac-apple-event-id "quit") ; kAEQuitApplication
950(put 'application-died 'mac-apple-event-id "obit") ; kAEApplicationDied
951(put 'show-preferences 'mac-apple-event-id "pref") ; kAEShowPreferences
952(put 'autosave-now 'mac-apple-event-id "asav") ; kAEAutosaveNow
953;; kAEInternetEventClass
954(put 'get-url 'mac-apple-event-id "GURL") ; kAEGetURL
955;; Converted HI command events
956(put 'about 'mac-apple-event-id "abou") ; kHICommandAbout
957(put 'show-hide-font-panel 'mac-apple-event-id "shfp") ; kHICommandShowHideFontPanel
958
959(defmacro mac-event-spec (event)
960 `(nth 1 ,event))
961
962(defmacro mac-event-ae (event)
963 `(nth 2 ,event))
964
965(defun mac-ae-parameter (ae &optional keyword type)
966 (or keyword (setq keyword "----")) ;; Direct object.
967 (if (not (and (consp ae) (equal (car ae) "aevt")))
968 (error "Not an Apple event: %S" ae)
969 (let ((type-data (cdr (assoc keyword (cdr ae))))
970 data)
971 (when (and type type-data (not (equal type (car type-data))))
972 (setq data (mac-coerce-ae-data (car type-data) (cdr type-data) type))
973 (setq type-data (if data (cons type data) nil)))
974 type-data)))
975
976(defun mac-ae-list (ae &optional keyword type)
977 (or keyword (setq keyword "----")) ;; Direct object.
978 (let ((desc (mac-ae-parameter ae keyword "list")))
979 (cond ((null desc)
980 nil)
981 ((not (equal (car desc) "list"))
982 (error "Parameter for \"%s\" is not a list" keyword))
983 (t
984 (if (null type)
985 (cdr desc)
986 (mapcar
987 (lambda (type-data)
988 (mac-coerce-ae-data (car type-data) (cdr type-data) type))
989 (cdr desc)))))))
990
991(defun mac-ae-number (ae keyword)
992 (let ((type-data (mac-ae-parameter ae keyword))
993 str)
994 (if (and type-data
995 (setq str (mac-coerce-ae-data (car type-data)
996 (cdr type-data) "TEXT")))
997 (let ((num (string-to-number str)))
998 ;; Mac OS Classic may return "0e+0" as the coerced value for
999 ;; the type "magn" and the data "\000\000\000\000".
1000 (if (= num 0.0) 0 num))
1001 nil)))
1002
1003(defun mac-bytes-to-integer (bytes &optional from to)
1004 (or from (setq from 0))
1005 (or to (setq to (length bytes)))
1006 (let* ((len (- to from))
1007 (extended-sign-len (- (1+ (ceiling (log most-positive-fixnum 2)))
1008 (* 8 len)))
1009 (result 0))
1010 (dotimes (i len)
1011 (setq result (logior (lsh result 8)
1012 (aref bytes (+ from (if (eq (byteorder) ?B) i
1013 (- len i 1)))))))
1014 (if (> extended-sign-len 0)
1015 (ash (lsh result extended-sign-len) (- extended-sign-len))
1016 result)))
1017
1018(defun mac-ae-selection-range (ae)
1019;; #pragma options align=mac68k
1020;; typedef struct SelectionRange {
1021;; short unused1; // 0 (not used)
1022;; short lineNum; // line to select (<0 to specify range)
1023;; long startRange; // start of selection range (if line < 0)
1024;; long endRange; // end of selection range (if line < 0)
1025;; long unused2; // 0 (not used)
1026;; long theDate; // modification date/time
1027;; } SelectionRange;
1028;; #pragma options align=reset
1029 (let ((range-bytes (cdr (mac-ae-parameter ae "kpos" "TEXT"))))
1030 (and range-bytes
1031 (list (mac-bytes-to-integer range-bytes 2 4)
1032 (mac-bytes-to-integer range-bytes 4 8)
1033 (mac-bytes-to-integer range-bytes 8 12)
1034 (mac-bytes-to-integer range-bytes 16 20)))))
1035
1036;; On Mac OS X 10.4 and later, the `open-document' event contains an
1037;; optional parameter keyAESearchText from the Spotlight search.
1038(defun mac-ae-text-for-search (ae)
1039 (let ((utf8-text (cdr (mac-ae-parameter ae "stxt" "utf8"))))
1040 (and utf8-text
1041 (decode-coding-string utf8-text 'utf-8))))
1042
1043(defun mac-ae-text (ae)
1044 (or (cdr (mac-ae-parameter ae nil "TEXT"))
1045 (error "No text in Apple event.")))
1046
1047(defun mac-ae-frame (ae &optional keyword type)
1048 (let ((bytes (cdr (mac-ae-parameter ae keyword type))))
1049 (if (or (null bytes) (/= (length bytes) 4))
1050 (error "No window reference in Apple event.")
1051 (let ((window-id (mac-coerce-ae-data "long" bytes "TEXT"))
1052 (rest (frame-list))
1053 frame)
1054 (while (and (null frame) rest)
1055 (if (string= (frame-parameter (car rest) 'window-id) window-id)
1056 (setq frame (car rest)))
1057 (setq rest (cdr rest)))
1058 frame))))
1059
1060(defun mac-ae-script-language (ae keyword)
1061;; struct WritingCode {
1062;; ScriptCode theScriptCode;
1063;; LangCode theLangCode;
1064;; };
1065 (let ((bytes (cdr (mac-ae-parameter ae keyword "intl"))))
1066 (and bytes
1067 (cons (mac-bytes-to-integer bytes 0 2)
1068 (mac-bytes-to-integer bytes 2 4)))))
1069
1070(defun mac-bytes-to-text-range (bytes &optional from to)
1071;; struct TextRange {
1072;; long fStart;
1073;; long fEnd;
1074;; short fHiliteStyle;
1075;; };
1076 (or from (setq from 0))
1077 (or to (setq to (length bytes)))
1078 (and (= (- to from) (+ 4 4 2))
1079 (list (mac-bytes-to-integer bytes from (+ from 4))
1080 (mac-bytes-to-integer bytes (+ from 4) (+ from 8))
1081 (mac-bytes-to-integer bytes (+ from 8) to))))
1082
1083(defun mac-ae-text-range-array (ae keyword)
1084;; struct TextRangeArray {
1085;; short fNumOfRanges;
1086;; TextRange fRange[1];
1087;; };
1088 (let* ((bytes (cdr (mac-ae-parameter ae keyword "tray")))
1089 (len (length bytes))
1090 nranges result)
1091 (when (and bytes (>= len 2)
1092 (progn
1093 (setq nranges (mac-bytes-to-integer bytes 0 2))
1094 (= len (+ 2 (* nranges 10)))))
1095 (setq result (make-vector nranges nil))
1096 (dotimes (i nranges)
1097 (aset result i
1098 (mac-bytes-to-text-range bytes (+ (* i 10) 2)
1099 (+ (* i 10) 12)))))
1100 result))
1101
1102(defconst mac-keyboard-modifier-mask-alist
1103 (mapcar
1104 (lambda (modifier-bit)
1105 (cons (car modifier-bit) (lsh 1 (cdr modifier-bit))))
1106 '((command . 8) ; cmdKeyBit
1107 (shift . 9) ; shiftKeyBit
1108 (option . 11) ; optionKeyBit
1109 (control . 12) ; controlKeyBit
1110 (function . 17))) ; kEventKeyModifierFnBit
1111 "Alist of Mac keyboard modifier symbols vs masks.")
1112
1113(defun mac-ae-keyboard-modifiers (ae)
1114 (let ((modifiers-value (mac-ae-number ae "kmod"))
1115 modifiers)
1116 (if modifiers-value
1117 (dolist (modifier-mask mac-keyboard-modifier-mask-alist)
1118 (if (/= (logand modifiers-value (cdr modifier-mask)) 0)
1119 (setq modifiers (cons (car modifier-mask) modifiers)))))
1120 modifiers))
1121
1122(defun mac-ae-reopen-application (event)
1123 "Show some frame in response to the Apple event EVENT.
1124The frame to be shown is chosen from visible or iconified frames
1125if possible. If there's no such frame, a new frame is created."
1126 (interactive "e")
1127 (unless (frame-visible-p (selected-frame))
1128 (let ((frame (or (car (visible-frame-list))
1129 (car (filtered-frame-list 'frame-visible-p)))))
1130 (if frame
1131 (select-frame frame)
1132 (switch-to-buffer-other-frame "*scratch*"))))
1133 (select-frame-set-input-focus (selected-frame)))
1134
1135(defun mac-ae-open-documents (event)
1136 "Open the documents specified by the Apple event EVENT."
1137 (interactive "e")
1138 (let ((ae (mac-event-ae event)))
1139 (dolist (file-name (mac-ae-list ae nil 'undecoded-file-name))
1140 (if file-name
1141 (dnd-open-local-file
1142 (concat "file://"
1143 (mapconcat 'url-hexify-string
1144 (split-string file-name "/") "/")) nil)))
1145 (let ((selection-range (mac-ae-selection-range ae))
1146 (search-text (mac-ae-text-for-search ae)))
1147 (cond (selection-range
1148 (let ((line (car selection-range))
1149 (start (cadr selection-range))
1150 (end (nth 2 selection-range)))
1151 (if (>= line 0)
1152 (goto-line (1+ line))
1153 (if (and (>= start 0) (>= end 0))
1154 (progn (set-mark (1+ start))
1155 (goto-char (1+ end)))))))
1156 ((stringp search-text)
1157 (re-search-forward
1158 (mapconcat 'regexp-quote (split-string search-text) "\\|")
1159 nil t)))))
1160 (select-frame-set-input-focus (selected-frame)))
1161
1162(defun mac-ae-quit-application (event)
1163 "Quit the application Emacs with the Apple event EVENT."
1164 (interactive "e")
1165 (let ((ae (mac-event-ae event)))
1166 (unwind-protect
1167 (save-buffers-kill-emacs)
1168 ;; Reaches here if the user has canceled the quit.
1169 (mac-resume-apple-event ae -128)))) ; userCanceledErr
1170
1171;; url-generic-parse-url is autoloaded from url-parse.
1172(declare-function url-type "url-parse" t t) ; defstruct
1173
1174(defun mac-ae-get-url (event)
1175 "Open the URL specified by the Apple event EVENT.
1176Currently the `mailto' scheme is supported."
1177 (interactive "e")
1178 (let* ((ae (mac-event-ae event))
1179 (parsed-url (url-generic-parse-url (mac-ae-text ae))))
1180 (if (string= (url-type parsed-url) "mailto")
1181 (progn
1182 (url-mailto parsed-url)
1183 (select-frame-set-input-focus (selected-frame)))
1184 (mac-resume-apple-event ae t))))
1185
1186(setq mac-apple-event-map (make-sparse-keymap))
1187
1188;; Received when Emacs is launched without associated documents.
1189;; Accept it as an Apple event, but no Emacs event is generated so as
1190;; not to erase the splash screen.
1191(define-key mac-apple-event-map [core-event open-application] 0)
1192
1193;; Received when a dock or application icon is clicked and Emacs is
1194;; already running.
1195(define-key mac-apple-event-map [core-event reopen-application]
1196 'mac-ae-reopen-application)
1197
1198(define-key mac-apple-event-map [core-event open-documents]
1199 'mac-ae-open-documents)
1200(define-key mac-apple-event-map [core-event show-preferences] 'customize)
1201(define-key mac-apple-event-map [core-event quit-application]
1202 'mac-ae-quit-application)
1203
1204(define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url)
1205
1206(define-key mac-apple-event-map [hi-command about] 'about-emacs)
1207
1208(declare-function tool-bar-mode "tool-bar" (&optional arg))
1209
1210;;; Converted Carbon Events
1211(defun mac-handle-toolbar-switch-mode (event)
1212 "Toggle visibility of tool-bars in response to EVENT.
1213With no keyboard modifiers, it toggles the visibility of the
1214frame where the tool-bar toggle button was pressed. With some
1215modifiers, it changes the global tool-bar visibility setting."
1216 (interactive "e")
1217 (let ((ae (mac-event-ae event)))
1218 (if (mac-ae-keyboard-modifiers ae)
1219 ;; Globally toggle tool-bar-mode if some modifier key is pressed.
1220 (tool-bar-mode 'toggle)
1221 (let ((frame (mac-ae-frame ae)))
1222 (set-frame-parameter frame 'tool-bar-lines
1223 (if (= (frame-parameter frame 'tool-bar-lines) 0)
1224 1 0))))))
1225
1226;; kEventClassWindow/kEventWindowToolbarSwitchMode
1227(define-key mac-apple-event-map [window toolbar-switch-mode]
1228 'mac-handle-toolbar-switch-mode)
1229
1230;;; Font panel
1231(when (fboundp 'mac-set-font-panel-visible-p)
1232
1233(define-minor-mode mac-font-panel-mode
1234 "Toggle use of the font panel.
1235With numeric ARG, display the font panel if and only if ARG is positive."
1236 :init-value nil
1237 :global t
1238 :group 'mac
1239 (mac-set-font-panel-visible-p mac-font-panel-mode))
1240
1241(defun mac-handle-font-panel-closed (event)
1242 "Update internal status in response to font panel closed EVENT."
1243 (interactive "e")
1244 ;; Synchronize with the minor mode variable.
1245 (mac-font-panel-mode 0))
1246
1247(defun mac-handle-font-selection (event)
1248 "Change default face attributes according to font selection EVENT."
1249 (interactive "e")
1250 (let* ((ae (mac-event-ae event))
1251 (fm-font-size (mac-ae-number ae "fmsz"))
1252 (atsu-font-id (mac-ae-number ae "auid"))
1253 (attribute-values (and atsu-font-id
1254 (mac-atsu-font-face-attributes atsu-font-id))))
1255 (if fm-font-size
1256 (setq attribute-values
1257 `(:height ,(* 10 fm-font-size) ,@attribute-values)))
1258 (apply 'set-face-attribute 'default (selected-frame) attribute-values)))
1259
1260;; kEventClassFont/kEventFontPanelClosed
1261(define-key mac-apple-event-map [font panel-closed]
1262 'mac-handle-font-panel-closed)
1263;; kEventClassFont/kEventFontSelection
1264(define-key mac-apple-event-map [font selection] 'mac-handle-font-selection)
1265(define-key mac-apple-event-map [hi-command show-hide-font-panel]
1266 'mac-font-panel-mode)
1267
1268(define-key-after menu-bar-showhide-menu [mac-font-panel-mode]
1269 (menu-bar-make-mm-toggle mac-font-panel-mode
1270 "Font Panel"
1271 "Show the font panel as a floating dialog")
1272 'showhide-speedbar)
1273
1274) ;; (fboundp 'mac-set-font-panel-visible-p)
1275
1276;;; Text Services
1277(defvar mac-ts-update-active-input-area-seqno 0
1278 "Number of processed update-active-input-area events.")
1279(setq mac-ts-active-input-overlay (make-overlay 0 0))
1280
1281(defface mac-ts-caret-position
1282 '((t :inverse-video t))
1283 "Face for caret position in Mac TSM active input area.
1284This is used when the active input area is displayed either in
1285the echo area or in a buffer where the cursor is not displayed."
1286 :group 'mac)
1287
1288(defface mac-ts-raw-text
1289 '((t :underline t))
1290 "Face for raw text in Mac TSM active input area."
1291 :group 'mac)
1292
1293(defface mac-ts-selected-raw-text
1294 '((t :underline t))
1295 "Face for selected raw text in Mac TSM active input area."
1296 :group 'mac)
1297
1298(defface mac-ts-converted-text
1299 '((((background dark)) :underline "gray20")
1300 (t :underline "gray80"))
1301 "Face for converted text in Mac TSM active input area."
1302 :group 'mac)
1303
1304(defface mac-ts-selected-converted-text
1305 '((t :underline t))
1306 "Face for selected converted text in Mac TSM active input area."
1307 :group 'mac)
1308
1309(defface mac-ts-block-fill-text
1310 '((t :underline t))
1311 "Face for block fill text in Mac TSM active input area."
1312 :group 'mac)
1313
1314(defface mac-ts-outline-text
1315 '((t :underline t))
1316 "Face for outline text in Mac TSM active input area."
1317 :group 'mac)
1318
1319(defface mac-ts-selected-text
1320 '((t :underline t))
1321 "Face for selected text in Mac TSM active input area."
1322 :group 'mac)
1323
1324(defface mac-ts-no-hilite
1325 '((t :inherit default))
1326 "Face for no hilite in Mac TSM active input area."
1327 :group 'mac)
1328
1329(defconst mac-ts-hilite-style-faces
1330 '((2 . mac-ts-raw-text) ; kTSMHiliteRawText
1331 (3 . mac-ts-selected-raw-text) ; kTSMHiliteSelectedRawText
1332 (4 . mac-ts-converted-text) ; kTSMHiliteConvertedText
1333 (5 . mac-ts-selected-converted-text) ; kTSMHiliteSelectedConvertedText
1334 (6 . mac-ts-block-fill-text) ; kTSMHiliteBlockFillText
1335 (7 . mac-ts-outline-text) ; kTSMHiliteOutlineText
1336 (8 . mac-ts-selected-text) ; kTSMHiliteSelectedText
1337 (9 . mac-ts-no-hilite)) ; kTSMHiliteNoHilite
1338 "Alist of Mac TSM hilite style vs Emacs face.")
1339
1340(defun mac-ts-update-active-input-buf (text fix-len hilite-rng update-rng)
1341 (let ((buf-len (length mac-ts-active-input-buf))
1342 confirmed)
1343 (if (or (null update-rng)
1344 (/= (% (length update-rng) 2) 0))
1345 ;; The parameter is missing (or in a bad format). The
1346 ;; existing inline input session is completely replaced with
1347 ;; the new text.
1348 (setq mac-ts-active-input-buf text)
1349 ;; Otherwise, the current subtext specified by the (2*j)-th
1350 ;; range is replaced with the new subtext specified by the
1351 ;; (2*j+1)-th range.
1352 (let ((tail buf-len)
1353 (i (length update-rng))
1354 segments rng)
1355 (while (> i 0)
1356 (setq i (- i 2))
1357 (setq rng (aref update-rng i))
1358 (if (and (<= 0 (cadr rng)) (< (cadr rng) tail)
1359 (<= tail buf-len))
1360 (setq segments
1361 (cons (substring mac-ts-active-input-buf (cadr rng) tail)
1362 segments)))
1363 (setq tail (car rng))
1364 (setq rng (aref update-rng (1+ i)))
1365 (if (and (<= 0 (car rng)) (< (car rng) (cadr rng))
1366 (<= (cadr rng) (length text)))
1367 (setq segments
1368 (cons (substring text (car rng) (cadr rng))
1369 segments))))
1370 (if (and (< 0 tail) (<= tail buf-len))
1371 (setq segments
1372 (cons (substring mac-ts-active-input-buf 0 tail)
1373 segments)))
1374 (setq mac-ts-active-input-buf (apply 'concat segments))))
1375 (setq buf-len (length mac-ts-active-input-buf))
1376 ;; Confirm (a part of) inline input session.
1377 (cond ((< fix-len 0)
1378 ;; Entire inline session is being confirmed.
1379 (setq confirmed mac-ts-active-input-buf)
1380 (setq mac-ts-active-input-buf ""))
1381 ((= fix-len 0)
1382 ;; None of the text is being confirmed (yet).
1383 (setq confirmed ""))
1384 (t
1385 (if (> fix-len buf-len)
1386 (setq fix-len buf-len))
1387 (setq confirmed (substring mac-ts-active-input-buf 0 fix-len))
1388 (setq mac-ts-active-input-buf
1389 (substring mac-ts-active-input-buf fix-len))))
1390 (setq buf-len (length mac-ts-active-input-buf))
1391 ;; Update highlighting and the caret position in the new inline
1392 ;; input session.
1393 (remove-text-properties 0 buf-len '(cursor nil) mac-ts-active-input-buf)
1394 (mapc (lambda (rng)
1395 (cond ((and (= (nth 2 rng) 1) ; kTSMHiliteCaretPosition
1396 (<= 0 (car rng)) (< (car rng) buf-len))
1397 (put-text-property (car rng) buf-len
1398 'cursor t mac-ts-active-input-buf))
1399 ((and (<= 0 (car rng)) (< (car rng) (cadr rng))
1400 (<= (cadr rng) buf-len))
1401 (put-text-property (car rng) (cadr rng) 'face
1402 (cdr (assq (nth 2 rng)
1403 mac-ts-hilite-style-faces))
1404 mac-ts-active-input-buf))))
1405 hilite-rng)
1406 confirmed))
1407
1408(defun mac-split-string-by-property-change (string)
1409 (let ((tail (length string))
1410 head result)
1411 (unless (= tail 0)
1412 (while (setq head (previous-property-change tail string)
1413 result (cons (substring string (or head 0) tail) result)
1414 tail head)))
1415 result))
1416
1417(defun mac-replace-untranslated-utf-8-chars (string &optional to-string)
1418 (or to-string (setq to-string "$,3u=(B"))
1419 (mapconcat
1420 (lambda (str)
1421 (if (get-text-property 0 'untranslated-utf-8 str) to-string str))
1422 (mac-split-string-by-property-change string)
1423 ""))
1424
1425(defun mac-keyboard-translate-char (ch)
1426 (if (and (characterp ch)
1427 (or (char-table-p keyboard-translate-table)
1428 (and (or (stringp keyboard-translate-table)
1429 (vectorp keyboard-translate-table))
1430 (> (length keyboard-translate-table) ch))))
1431 (or (aref keyboard-translate-table ch) ch)
1432 ch))
1433
1434(defun mac-unread-string (string)
1435 ;; Unread characters and insert them in a keyboard macro being
1436 ;; defined.
1437 (apply 'isearch-unread
1438 (mapcar 'mac-keyboard-translate-char
1439 (mac-replace-untranslated-utf-8-chars string))))
1440
1441(defun mac-ts-update-active-input-area (event)
1442 "Update Mac TSM active input area according to EVENT.
1443The confirmed text is converted to Emacs input events and pushed
1444into `unread-command-events'. The unconfirmed text is displayed
1445either in the current buffer or in the echo area."
1446 (interactive "e")
1447 (let* ((ae (mac-event-ae event))
1448 (type-text (mac-ae-parameter ae "tstx"))
1449 (text (or (cdr type-text) ""))
1450 (decode-fun (if (equal (car type-text) "TEXT")
1451 'mac-TEXT-to-string 'mac-utxt-to-string))
1452 (script-language (mac-ae-script-language ae "tssl"))
1453 (coding (or (cdr (assq (car script-language)
1454 mac-script-code-coding-systems))
1455 'mac-roman))
1456 (fix-len (mac-ae-number ae "tsfx"))
1457 ;; Optional parameters
1458 (hilite-rng (mac-ae-text-range-array ae "tshi"))
1459 (update-rng (mac-ae-text-range-array ae "tsup"))
1460 ;;(pin-rng (mac-bytes-to-text-range (cdr (mac-ae-parameter ae "tspn" "txrn"))))
1461 ;;(clause-offsets (cdr (mac-ae-parameter ae "tscl" "ofay")))
1462 (seqno (mac-ae-number ae "tsSn"))
1463 confirmed)
1464 (unless (= seqno mac-ts-update-active-input-area-seqno)
1465 ;; Reset internal states if sequence number is out of sync.
1466 (setq mac-ts-active-input-buf ""))
1467 (setq confirmed
1468 (mac-ts-update-active-input-buf text fix-len hilite-rng update-rng))
1469 (let ((use-echo-area
1470 (or isearch-mode
1471 (and cursor-in-echo-area (current-message))
1472 ;; Overlay strings are not shown in some cases.
1473 (get-char-property (point) 'invisible)
1474 (and (not (bobp))
1475 (or (and (get-char-property (point) 'display)
1476 (eq (get-char-property (1- (point)) 'display)
1477 (get-char-property (point) 'display)))
1478 (and (get-char-property (point) 'composition)
1479 (eq (get-char-property (1- (point)) 'composition)
1480 (get-char-property (point) 'composition)))))))
1481 active-input-string caret-seen)
1482 ;; Decode the active input area text with inheriting faces and
1483 ;; the caret position.
1484 (setq active-input-string
1485 (mapconcat
1486 (lambda (str)
1487 (let ((decoded (funcall decode-fun str coding)))
1488 (put-text-property 0 (length decoded) 'face
1489 (get-text-property 0 'face str) decoded)
1490 (when (and (not caret-seen)
1491 (get-text-property 0 'cursor str))
1492 (setq caret-seen t)
1493 (if (or use-echo-area (null cursor-type))
1494 (put-text-property 0 1 'face 'mac-ts-caret-position
1495 decoded)
1496 (put-text-property 0 1 'cursor t decoded)))
1497 decoded))
1498 (mac-split-string-by-property-change mac-ts-active-input-buf)
1499 ""))
1500 (put-text-property 0 (length active-input-string)
1501 'mac-ts-active-input-string t active-input-string)
1502 (if use-echo-area
1503 (let ((msg (current-message))
1504 message-log-max)
1505 (if (and msg
1506 ;; Don't get confused by previously displayed
1507 ;; `active-input-string'.
1508 (null (get-text-property 0 'mac-ts-active-input-string
1509 msg)))
1510 (setq msg (propertize msg 'display
1511 (concat msg active-input-string)))
1512 (setq msg active-input-string))
1513 (message "%s" msg)
1514 (overlay-put mac-ts-active-input-overlay 'before-string nil))
1515 (move-overlay mac-ts-active-input-overlay
1516 (point) (point) (current-buffer))
1517 (overlay-put mac-ts-active-input-overlay 'before-string
1518 active-input-string))
1519 (mac-unread-string (funcall decode-fun confirmed coding)))
1520 ;; The event is successfully processed. Sync the sequence number.
1521 (setq mac-ts-update-active-input-area-seqno (1+ seqno))))
1522
1523(defun mac-ts-unicode-for-key-event (event)
1524 "Convert Unicode key EVENT to Emacs key events and unread them."
1525 (interactive "e")
1526 (let* ((ae (mac-event-ae event))
1527 (text (cdr (mac-ae-parameter ae "tstx" "utxt")))
1528 (script-language (mac-ae-script-language ae "tssl"))
1529 (coding (or (cdr (assq (car script-language)
1530 mac-script-code-coding-systems))
1531 'mac-roman)))
1532 (if text
1533 (mac-unread-string (mac-utxt-to-string text coding)))))
1534
1535;; kEventClassTextInput/kEventTextInputUpdateActiveInputArea
1536(define-key mac-apple-event-map [text-input update-active-input-area]
1537 'mac-ts-update-active-input-area)
1538;; kEventClassTextInput/kEventTextInputUnicodeForKeyEvent
1539(define-key mac-apple-event-map [text-input unicode-for-key-event]
1540 'mac-ts-unicode-for-key-event)
1541
1542;;; Services
1543(defun mac-service-open-file ()
1544 "Open the file specified by the selection value for Services."
1545 (interactive)
1546 ;; The selection seems not to contain the file name as
1547 ;; public.utf16-plain-text data on Mac OS X 10.4.
1548 (dnd-open-file (x-get-selection mac-service-selection 'public.file-url) nil))
1549
1550(defun mac-service-open-selection ()
1551 "Create a new buffer containing the selection value for Services."
1552 (interactive)
1553 (switch-to-buffer (generate-new-buffer "*untitled*"))
1554 (insert (x-selection-value mac-service-selection))
1555 (sit-for 0)
1556 (save-buffer) ; It pops up the save dialog.
1557 )
1558
1559(defun mac-service-mail-selection ()
1560 "Prepare a mail buffer containing the selection value for Services."
1561 (interactive)
1562 (compose-mail)
1563 (rfc822-goto-eoh)
1564 (forward-line 1)
1565 (insert (x-selection-value mac-service-selection) "\n"))
1566
1567(defun mac-service-mail-to ()
1568 "Prepare a mail buffer to be sent to the selection value for Services."
1569 (interactive)
1570 (compose-mail (x-selection-value mac-service-selection)))
1571
1572(defun mac-service-insert-text ()
1573 "Insert the selection value for Services."
1574 (interactive)
1575 (let ((text (x-selection-value mac-service-selection)))
1576 (if (not buffer-read-only)
1577 (insert text)
1578 (kill-new text)
1579 (message "%s"
1580 (substitute-command-keys
1581 "The text from the Services menu can be accessed with \\[yank]")))))
1582
1583;; kEventClassService/kEventServicePaste
1584(define-key mac-apple-event-map [service paste] 'mac-service-insert-text)
1585;; kEventClassService/kEventServicePerform
1586(define-key mac-apple-event-map [service perform open-file]
1587 'mac-service-open-file)
1588(define-key mac-apple-event-map [service perform open-selection]
1589 'mac-service-open-selection)
1590(define-key mac-apple-event-map [service perform mail-selection]
1591 'mac-service-mail-selection)
1592(define-key mac-apple-event-map [service perform mail-to]
1593 'mac-service-mail-to)
1594
1595(defun mac-dispatch-apple-event (event)
1596 "Dispatch EVENT according to the keymap `mac-apple-event-map'."
1597 (interactive "e")
1598 (let* ((binding (lookup-key mac-apple-event-map (mac-event-spec event)))
1599 (ae (mac-event-ae event))
1600 (service-message (and (keymapp binding)
1601 (cdr (mac-ae-parameter ae "svmg")))))
1602 (when service-message
1603 (setq service-message
1604 (intern (decode-coding-string service-message 'utf-8)))
1605 (setq binding (lookup-key binding (vector service-message))))
1606 ;; Replace (cadr event) with a dummy position so that event-start
1607 ;; returns it.
1608 (setcar (cdr event) (list (selected-window) (point) '(0 . 0) 0))
1609 (if (null (mac-ae-parameter ae 'emacs-suspension-id))
1610 (command-execute binding nil (vector event) t)
1611 (condition-case err
1612 (progn
1613 (command-execute binding nil (vector event) t)
1614 (mac-resume-apple-event ae))
1615 (error
1616 (mac-ae-set-reply-parameter ae "errs"
1617 (cons "TEXT" (error-message-string err)))
1618 (mac-resume-apple-event ae -10000)))))) ; errAEEventFailed
1619
1620(define-key special-event-map [mac-apple-event] 'mac-dispatch-apple-event)
1621
1622;; Processing of Apple events are deferred at the startup time. For
1623;; example, files dropped onto the Emacs application icon can only be
1624;; processed when the initial frame has been created: this is where
1625;; the files should be opened.
1626(add-hook 'after-init-hook 'mac-process-deferred-apple-events)
1627
1628(run-with-idle-timer 5 t 'mac-cleanup-expired-apple-events)
1629
1630
1631;;;; Drag and drop
1632
1633(defcustom mac-dnd-types-alist
1634 '(("furl" . mac-dnd-handle-furl)
1635 ("hfs " . mac-dnd-handle-hfs)
1636 ("utxt" . mac-dnd-insert-utxt)
1637 ("TEXT" . mac-dnd-insert-TEXT)
1638 ("TIFF" . mac-dnd-insert-TIFF))
1639 "Which function to call to handle a drop of that type.
1640The function takes three arguments, WINDOW, ACTION and DATA.
1641WINDOW is where the drop occurred, ACTION is always `private' on
1642Mac. DATA is the drop data. Unlike the x-dnd counterpart, the
1643return value of the function is not significant.
1644
1645See also `mac-dnd-known-types'."
1646 :version "22.1"
1647 :type 'alist
1648 :group 'mac)
1649
1650(defun mac-dnd-handle-furl (window action data)
1651 (dnd-handle-one-url window action (mac-furl-to-string data)))
1652
1653(defun mac-dnd-handle-hfs (window action data)
1654;; struct HFSFlavor {
1655;; OSType fileType;
1656;; OSType fileCreator;
1657;; UInt16 fdFlags;
1658;; FSSpec fileSpec;
1659;; };
1660 (let* ((file-name (mac-coerce-ae-data "fss " (substring data 10)
1661 'undecoded-file-name))
1662 (url (concat "file://"
1663 (mapconcat 'url-hexify-string
1664 (split-string file-name "/") "/"))))
1665 (dnd-handle-one-url window action url)))
1666
1667(defun mac-dnd-insert-utxt (window action data)
1668 (dnd-insert-text window action (mac-utxt-to-string data)))
1669
1670(defun mac-dnd-insert-TEXT (window action data)
1671 (dnd-insert-text window action (mac-TEXT-to-string data)))
1672
1673(defun mac-dnd-insert-TIFF (window action data)
1674 (dnd-insert-text window action (mac-TIFF-to-string data)))
1675
1676(defun mac-dnd-drop-data (event frame window data type &optional action)
1677 (or action (setq action 'private))
1678 (let* ((type-info (assoc type mac-dnd-types-alist))
1679 (handler (cdr type-info))
1680 (w (posn-window (event-start event))))
1681 (when handler
1682 (if (and (window-live-p w)
1683 (not (window-minibuffer-p w))
1684 (not (window-dedicated-p w)))
1685 ;; If dropping in an ordinary window which we could use,
1686 ;; let dnd-open-file-other-window specify what to do.
1687 (progn
1688 (when (not mouse-yank-at-point)
1689 (goto-char (posn-point (event-start event))))
1690 (funcall handler window action data))
1691 ;; If we can't display the file here,
1692 ;; make a new window for it.
1693 (let ((dnd-open-file-other-window t))
1694 (select-frame frame)
1695 (funcall handler window action data))))))
1696
1697(defun mac-dnd-handle-drag-n-drop-event (event)
1698 "Receive drag and drop events."
1699 (interactive "e")
1700 (let ((window (posn-window (event-start event)))
1701 (ae (mac-event-ae event))
1702 action)
1703 (when (windowp window) (select-window window))
1704 (if (memq 'option (mac-ae-keyboard-modifiers ae))
1705 (setq action 'copy))
1706 (dolist (item (mac-ae-list ae))
1707 (if (not (equal (car item) "null"))
1708 (mac-dnd-drop-data event (selected-frame) window
1709 (cdr item) (car item) action)))))
1710
1711(setq font-encoding-alist
1712 (append
1713 '(("mac-roman" . mac-roman)
1714 ("mac-centraleurroman" . mac-centraleurroman)
1715 ("mac-cyrillic" . mac-cyrillic)
1716 ("mac-symbol" . mac-symbol)
1717 ("mac-dingbats" . mac-dingbats))
1718 font-encoding-alist))
1719
1720(declare-function set-fontset-font "fontset.c"
1721 (name target font-spec &optional frame add))
1722
1723(defun fontset-add-mac-fonts (fontset &optional base-family)
1724 (dolist (elt `((latin . (,(or base-family "Monaco") . "mac-roman"))
1725 (mac-roman . (,base-family . "mac-roman"))
1726 (mac-centraleurroman . (,base-family . "mac-centraleurroman"))
1727 (mac-cyrillic . (,base-family . "mac-cyrillic"))
1728 (mac-symbol . (,base-family . "mac-symbol"))
1729 (mac-dingbats . (,base-family . "mac-dingbats"))))
1730 (set-fontset-font fontset (car elt) (cdr elt))))
1731
1732(declare-function new-fontset "fontset.c" (name fontlist))
1733
1734(defun create-fontset-from-mac-roman-font (font &optional resolved-font
1735 fontset-name)
1736 "Create a fontset from a Mac roman font FONT.
1737
1738Optional 1st arg RESOLVED-FONT is a resolved name of FONT. If
1739omitted, `x-resolve-font-name' is called to get the resolved name. At
1740this time, if FONT is not available, error is signaled.
1741
1742Optional 2nd arg FONTSET-NAME is a string to be used in
1743`<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted,
1744an appropriate name is generated automatically.
1745
1746It returns a name of the created fontset."
1747 (or resolved-font
1748 (setq resolved-font (x-resolve-font-name font)))
1749 (let ((base-family (aref (x-decompose-font-name resolved-font)
1750 xlfd-regexp-family-subnum)))
1751 (if (string= base-family "*")
1752 (setq base-family nil))
1753 (new-fontset fontset-name (list (cons 'ascii resolved-font)))
1754 (fontset-add-mac-fonts fontset-name base-family)))
1755
1756(defun x-win-suspend-error ()
1757 (error "Suspending an Emacs running under Mac makes no sense"))
1758
1759(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value)
1760
1761(defvar mac-initialized nil
1762 "Non-nil if the w32 window system has been initialized.")
1763
1764(defun mac-initialize-window-system ()
1765 "Initialize Emacs for Mac GUI frames."
1766
1767;;; Do the actual Windows setup here; the above code just defines
1768;;; functions and variables that we use now.
1769
1770(setq command-line-args (x-handle-args command-line-args))
1771
1772;;; Make sure we have a valid resource name.
1773(or (stringp x-resource-name)
1774 (let (i)
1775 (setq x-resource-name (invocation-name))
1776
1777 ;; Change any . or * characters in x-resource-name to hyphens,
1778 ;; so as not to choke when we use it in X resource queries.
1779 (while (setq i (string-match "[.*]" x-resource-name))
1780 (aset x-resource-name i ?-))))
1781
1782(declare-function x-display-list "macfns.c" ())
1783(declare-function x-open-connection "macfns.c"
1784 (display &optional xrm-string must-succeed))
1785
1786(if (x-display-list)
1787 ;; On Mac OS 8/9, Most coding systems used in code conversion for
1788 ;; font names are not ready at the time when the terminal frame is
1789 ;; created. So we reconstruct font name table for the initial
1790 ;; frame.
1791 (mac-clear-font-name-table)
1792 (x-open-connection "Mac"
1793 x-command-line-resources
1794 ;; Exit Emacs with fatal error if this fails.
1795 t))
1796
1797(add-hook 'suspend-hook 'x-win-suspend-error)
1798
1799;;; Arrange for the kill and yank functions to set and check the clipboard.
1800(setq interprogram-cut-function 'x-select-text)
1801(setq interprogram-paste-function 'x-get-selection-value)
1802
1803
1804
1805
1806;;; Turn off window-splitting optimization; Mac is usually fast enough
1807;;; that this is only annoying.
1808(setq split-window-keep-point t)
1809
1810;; Don't show the frame name; that's redundant.
1811(setq-default mode-line-frame-identification " ")
1812
1813;; Turn on support for mouse wheels.
1814(mouse-wheel-mode 1)
1815
1816
1817;; Enable CLIPBOARD copy/paste through menu bar commands.
1818(menu-bar-enable-clipboard)
1819
1820
1821;; Initiate drag and drop
1822
1823(define-key special-event-map [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event)
1824
1825
1826;;;; Non-toolkit Scroll bars
1827
1828(unless (and (boundp 'x-toolkit-scroll-bars) x-toolkit-scroll-bars)
1829
1830;; for debugging
1831;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
1832
1833;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)
1834
1835(global-set-key
1836 [vertical-scroll-bar down-mouse-1]
1837 'mac-handle-scroll-bar-event)
1838
1839(global-unset-key [vertical-scroll-bar drag-mouse-1])
1840(global-unset-key [vertical-scroll-bar mouse-1])
1841
1842;; Adjust Courier font specifications in x-fixed-font-alist.
1843(let ((courier-fonts (assoc "Courier" x-fixed-font-alist)))
1844 (if courier-fonts
1845 (dolist (label-fonts (cdr courier-fonts))
1846 (setcdr label-fonts
1847 (mapcar
1848 (lambda (font)
1849 (if (string-match "\\`-adobe-courier-\\([^-]*\\)-\\(.\\)-\\(.*\\)-iso8859-1\\'" font)
1850 (replace-match
1851 (if (string= (match-string 2 font) "o")
1852 "-*-courier-\\1-i-\\3-*-*"
1853 "-*-courier-\\1-\\2-\\3-*-*")
1854 t nil font)
1855 font))
1856 (cdr label-fonts))))))
1857
1858;; Setup the default fontset.
1859(setup-default-fontset)
1860
1861;; Create a fontset that uses mac-roman font. With this fontset,
1862;; characters belonging to mac-roman charset (that contains ASCII and
1863;; more Latin characters) are displayed by a mac-roman font.
1864(create-fontset-from-mac-roman-font
1865 "-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman" nil
1866 "-apple-Monaco-normal-r-*-*-12-*-*-*-*-*-fontset-standard")
1867
1868;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
1869(create-fontset-from-x-resource)
1870
1871(declare-function x-get-resource "frame.c"
1872 (attribute class &optional component subclass))
1873
1874;; Apply a geometry resource to the initial frame. Put it at the end
1875;; of the alist, so that anything specified on the command line takes
1876;; precedence.
1877(let* ((res-geometry (x-get-resource "geometry" "Geometry"))
1878 parsed)
1879 (if res-geometry
1880 (progn
1881 (setq parsed (x-parse-geometry res-geometry))
1882 ;; If the resource specifies a position,
1883 ;; call the position and size "user-specified".
1884 (if (or (assq 'top parsed) (assq 'left parsed))
1885 (setq parsed (cons '(user-position . t)
1886 (cons '(user-size . t) parsed))))
1887 ;; All geometry parms apply to the initial frame.
1888 (setq initial-frame-alist (append initial-frame-alist parsed))
1889 ;; The size parms apply to all frames. Don't set it if there are
1890 ;; sizes there already (from command line).
1891 (if (and (assq 'height parsed)
1892 (not (assq 'height default-frame-alist)))
1893 (setq default-frame-alist
1894 (cons (cons 'height (cdr (assq 'height parsed)))
1895 default-frame-alist)))
1896 (if (and (assq 'width parsed)
1897 (not (assq 'width default-frame-alist)))
1898 (setq default-frame-alist
1899 (cons (cons 'width (cdr (assq 'width parsed)))
1900 default-frame-alist))))))
1901
1902;; Check the reverseVideo resource.
1903(let ((case-fold-search t))
1904 (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
1905 (if (and rv
1906 (string-match "^\\(true\\|yes\\|on\\)$" rv))
1907 (setq default-frame-alist
1908 (cons '(reverse . t) default-frame-alist)))))
1909
1910(setq mac-initialized t)))
1911
1912(defun mac-handle-scroll-bar-event (event)
1913 "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
1914 (interactive "e")
1915 (let* ((position (event-start event))
1916 (window (nth 0 position))
1917 (bar-part (nth 4 position)))
1918 (select-window window)
1919 (cond
1920 ((eq bar-part 'up)
1921 (goto-char (window-start window))
1922 (mac-scroll-down-line))
1923 ((eq bar-part 'above-handle)
1924 (mac-scroll-down))
1925 ((eq bar-part 'handle)
1926 (scroll-bar-drag event))
1927 ((eq bar-part 'below-handle)
1928 (mac-scroll-up))
1929 ((eq bar-part 'down)
1930 (goto-char (window-start window))
1931 (mac-scroll-up-line)))))
1932
1933(defun mac-scroll-ignore-events ()
1934 ;; Ignore confusing non-mouse events
1935 (while (not (memq (car-safe (read-event))
1936 '(mouse-1 double-mouse-1 triple-mouse-1))) nil))
1937
1938(defun mac-scroll-down ()
1939 (track-mouse
1940 (mac-scroll-ignore-events)
1941 (scroll-down)))
1942
1943(defun mac-scroll-down-line ()
1944 (track-mouse
1945 (mac-scroll-ignore-events)
1946 (scroll-down 1)))
1947
1948(defun mac-scroll-up ()
1949 (track-mouse
1950 (mac-scroll-ignore-events)
1951 (scroll-up)))
1952
1953(defun mac-scroll-up-line ()
1954 (track-mouse
1955 (mac-scroll-ignore-events)
1956 (scroll-up 1)))
1957
1958
1959
1960;;;; Others
1961
1962(unless (eq system-type 'darwin)
1963 ;; This variable specifies the Unix program to call (as a process) to
1964 ;; determine the amount of free space on a file system (defaults to
1965 ;; df). If it is not set to nil, ls-lisp will not work correctly
1966 ;; unless an external application df is implemented on the Mac.
1967 (setq directory-free-space-program nil)
1968
1969 ;; Set this so that Emacs calls subprocesses with "sh" as shell to
1970 ;; expand filenames Note no subprocess for the shell is actually
1971 ;; started (see run_mac_command in sysdep.c).
1972 (setq shell-file-name "sh")
1973
1974 ;; Some system variables are encoded with the system script code.
1975 (dolist (v '(system-name
1976 emacs-build-system ; Mac OS 9 version cannot dump
1977 user-login-name user-real-login-name user-full-name))
1978 (set v (decode-coding-string (symbol-value v) mac-system-coding-system))))
1979
1980;; Now the default directory is changed to the user's home directory
1981;; in emacs.c if invoked from the WindowServer (with -psn_* option).
1982;; (if (string= default-directory "/")
1983;; (cd "~"))
1984
1985;; Darwin 6- pty breakage is now controlled from the C code so that
1986;; it applies to all builds on darwin. See s/darwin.h PTY_ITERATION.
1987;; (setq process-connection-type t)
1988
1989;; Assume that fonts are always scalable on the Mac. This sometimes
1990;; results in characters with jagged edges. However, without it,
1991;; fonts with both truetype and bitmap representations but no italic
1992;; or bold bitmap versions will not display these variants correctly.
1993(setq scalable-fonts-allowed t)
1994
1995(add-to-list 'handle-args-function-alist '(mac . x-handle-args))
1996(add-to-list 'frame-creation-function-alist '(mac . x-create-frame-with-faces))
1997(add-to-list 'window-system-initialization-alist '(mac . mac-initialize-window-system))
1998
1999(provide 'mac-win)
2000
2001;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6
2002;;; mac-win.el ends here
diff --git a/lisp/version.el b/lisp/version.el
index 74dd878d7e3..e8f1ac5b964 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -67,8 +67,6 @@ to the system configuration; look at `system-configuration' instead."
67 ((featurep 'x-toolkit) ", X toolkit") 67 ((featurep 'x-toolkit) ", X toolkit")
68 ((featurep 'ns) 68 ((featurep 'ns)
69 (format ", *Step %s" ns-version-string)) 69 (format ", *Step %s" ns-version-string))
70 ((boundp 'mac-carbon-version-string)
71 (concat ", Carbon Version " mac-carbon-version-string))
72 (t "")) 70 (t ""))
73 (if (and (boundp 'x-toolkit-scroll-bars) 71 (if (and (boundp 'x-toolkit-scroll-bars)
74 (memq x-toolkit-scroll-bars '(xaw xaw3d))) 72 (memq x-toolkit-scroll-bars '(xaw xaw3d)))