X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/590bc75d2829f1fc05986979b2be35ca21be1cc0..cb5b9015b372175f1fc90cb7ba3f43298c621509:/lisp/term/mac-win.el diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el index ae2003fcee..e39e1fffeb 100644 --- a/lisp/term/mac-win.el +++ b/lisp/term/mac-win.el @@ -1,7 +1,7 @@ -;;; mac-win.el --- parse switches controlling interface with Mac window system +;;; mac-win.el --- parse switches controlling interface with Mac window system -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 1999, 2000, 2002, 2003, 2004, 2005 -;; Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Andrew Choi ;; Keywords: terminals @@ -10,7 +10,7 @@ ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -20,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -54,8 +54,6 @@ ;; -font *font ;; -foreground *foreground ;; -geometry .geometry -;; -i .iconType -;; -itype .iconType ;; -iconic .iconic ;; -name .name ;; -reverse *reverseVideo @@ -74,11 +72,18 @@ (require 'mouse) (require 'scroll-bar) (require 'faces) -;;(require 'select) +(require 'select) (require 'menu-bar) (require 'fontset) (require 'dnd) - +(eval-when-compile (require 'url)) + +(defvar mac-charset-info-alist) +(defvar mac-service-selection) +(defvar mac-system-script-code) +(defvar mac-apple-event-map) +(defvar mac-font-panel-mode) +(defvar mac-ts-active-input-overlay) (defvar x-invocation-args) (defvar x-command-line-resources nil) @@ -106,7 +111,7 @@ (let ((param (nth 3 aelt))) (setq default-frame-alist (cons (cons param - (string-to-int (car x-invocation-args))) + (string-to-number (car x-invocation-args))) default-frame-alist) x-invocation-args (cdr x-invocation-args)))))) @@ -1084,32 +1089,1210 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") (put 'return 'ascii-character ?\C-m) (put 'escape 'ascii-character ?\e) +;; Modifier name `ctrl' is an alias of `control'. +(put 'ctrl 'modifier-value (get 'control 'modifier-value)) + -;;;; Keysyms +;;;; Script codes and coding systems +(defconst mac-script-code-coding-systems + '((0 . mac-roman) ; smRoman + (1 . japanese-shift-jis) ; smJapanese + (2 . chinese-big5) ; smTradChinese + (3 . korean-iso-8bit) ; smKorean + (7 . mac-cyrillic) ; smCyrillic + (25 . chinese-iso-8bit) ; smSimpChinese + (29 . mac-centraleurroman) ; smCentralEuroRoman + ) + "Alist of Mac script codes vs Emacs coding systems.") + +(defun mac-add-charset-info (xlfd-charset mac-text-encoding) + "Add a character set to display with Mac fonts. +Create an entry in `mac-charset-info-alist'. +XLFD-CHARSET is a string which will appear in the XLFD font name +to identify the character set. MAC-TEXT-ENCODING is the +correspoinding TextEncodingBase value." + (add-to-list 'mac-charset-info-alist + (list xlfd-charset mac-text-encoding + (cdr (assq mac-text-encoding + mac-script-code-coding-systems))))) + +(setq mac-charset-info-alist nil) +(mac-add-charset-info "mac-roman" 0) +(mac-add-charset-info "jisx0208.1983-sjis" 1) +(mac-add-charset-info "jisx0201.1976-0" 1) +(mac-add-charset-info "big5-0" 2) +(mac-add-charset-info "ksc5601.1989-0" 3) +(mac-add-charset-info "mac-cyrillic" 7) +(mac-add-charset-info "gb2312.1980-0" 25) +(mac-add-charset-info "mac-centraleurroman" 29) +(mac-add-charset-info "mac-symbol" 33) +(mac-add-charset-info "adobe-fontspecific" 33) ; for X-Symbol +(mac-add-charset-info "mac-dingbats" 34) +(mac-add-charset-info "iso10646-1" 126) ; for ATSUI + +(cp-make-coding-system + mac-centraleurroman + [?\,AD(B ?\$,1 (B ?\$,1 !(B ?\,AI(B ?\$,1 $(B ?\,AV(B ?\,A\(B ?\,Aa(B ?\$,1 %(B ?\$,1 ,(B ?\,Ad(B ?\$,1 -(B ?\$,1 &(B ?\$,1 '(B ?\,Ai(B ?\$,1!9(B + ?\$,1!:(B ?\$,1 .(B ?\,Am(B ?\$,1 /(B ?\$,1 2(B ?\$,1 3(B ?\$,1 6(B ?\,As(B ?\$,1 7(B ?\,At(B ?\,Av(B ?\,Au(B ?\,Az(B ?\$,1 :(B ?\$,1 ;(B ?\,A|(B + ?\$,1s (B ?\,A0(B ?\$,1 8(B ?\,A#(B ?\,A'(B ?\$,1s"(B ?\,A6(B ?\,A_(B ?\,A.(B ?\,A)(B ?\$,1ub(B ?\$,1 9(B ?\,A((B ?\$,1y (B ?\$,1 C(B ?\$,1 N(B + ?\$,1 O(B ?\$,1 J(B ?\$,1y$(B ?\$,1y%(B ?\$,1 K(B ?\$,1 V(B ?\$,1x"(B ?\$,1x1(B ?\$,1 b(B ?\$,1 [(B ?\$,1 \(B ?\$,1 ](B ?\$,1 ^(B ?\$,1 Y(B ?\$,1 Z(B ?\$,1 e(B + ?\$,1 f(B ?\$,1 c(B ?\,A,(B ?\$,1x:(B ?\$,1 d(B ?\$,1 g(B ?\$,1x&(B ?\,A+(B ?\,A;(B ?\$,1s&(B ?\,A (B ?\$,1 h(B ?\$,1 p(B ?\,AU(B ?\$,1 q(B ?\$,1 l(B + ?\$,1rs(B ?\$,1rt(B ?\$,1r|(B ?\$,1r}(B ?\$,1rx(B ?\$,1ry(B ?\,Aw(B ?\$,2"*(B ?\$,1 m(B ?\$,1 t(B ?\$,1 u(B ?\$,1 x(B ?\$,1s9(B ?\$,1s:(B ?\$,1 y(B ?\$,1 v(B + ?\$,1 w(B ?\$,1! (B ?\$,1rz(B ?\$,1r~(B ?\$,1!!(B ?\$,1 z(B ?\$,1 {(B ?\,AA(B ?\$,1!$(B ?\$,1!%(B ?\,AM(B ?\$,1!=(B ?\$,1!>(B ?\$,1!*(B ?\,AS(B ?\,AT(B + ?\$,1!+(B ?\$,1!.(B ?\,AZ(B ?\$,1!/(B ?\$,1!0(B ?\$,1!1(B ?\$,1!2(B ?\$,1!3(B ?\,A](B ?\,A}(B ?\$,1 W(B ?\$,1!;(B ?\$,1 a(B ?\$,1!<(B ?\$,1 B(B ?\$,1$g(B] + "Mac Central European Roman Encoding (MIME:x-mac-centraleurroman).") +(coding-system-put 'mac-centraleurroman 'mime-charset 'x-mac-centraleurroman) + +(cp-make-coding-system + mac-cyrillic + [?\$,1(0(B ?\$,1(1(B ?\$,1(2(B ?\$,1(3(B ?\$,1(4(B ?\$,1(5(B ?\$,1(6(B ?\$,1(7(B ?\$,1(8(B ?\$,1(9(B ?\$,1(:(B ?\$,1(;(B ?\$,1(<(B ?\$,1(=(B ?\$,1(>(B ?\$,1(?(B + ?\$,1(@(B ?\$,1(A(B ?\$,1(B(B ?\$,1(C(B ?\$,1(D(B ?\$,1(E(B ?\$,1(F(B ?\$,1(G(B ?\$,1(H(B ?\$,1(I(B ?\$,1(J(B ?\$,1(K(B ?\$,1(L(B ?\$,1(M(B ?\$,1(N(B ?\$,1(O(B + ?\$,1s (B ?\,A0(B ?\$,1)P(B ?\,A#(B ?\,A'(B ?\$,1s"(B ?\,A6(B ?\$,1(&(B ?\,A.(B ?\,A)(B ?\$,1ub(B ?\$,1("(B ?\$,1(r(B ?\$,1y (B ?\$,1(#(B ?\$,1(s(B + ?\$,1x>(B ?\,A1(B ?\$,1y$(B ?\$,1y%(B ?\$,1(v(B ?\,A5(B ?\$,1)Q(B ?\$,1(((B ?\$,1($(B ?\$,1(t(B ?\$,1('(B ?\$,1(w(B ?\$,1()(B ?\$,1(y(B ?\$,1(*(B ?\$,1(z(B + ?\$,1(x(B ?\$,1(%(B ?\,A,(B ?\$,1x:(B ?\$,1!R(B ?\$,1xh(B ?\$,1x&(B ?\,A+(B ?\,A;(B ?\$,1s&(B ?\,A (B ?\$,1(+(B ?\$,1({(B ?\$,1(,(B ?\$,1(|(B ?\$,1(u(B + ?\$,1rs(B ?\$,1rt(B ?\$,1r|(B ?\$,1r}(B ?\$,1rx(B ?\$,1ry(B ?\,Aw(B ?\$,1r~(B ?\$,1(.(B ?\$,1(~(B ?\$,1(/(B ?\$,1((B ?\$,1uV(B ?\$,1(!(B ?\$,1(q(B ?\$,1(o(B + ?\$,1(P(B ?\$,1(Q(B ?\$,1(R(B ?\$,1(S(B ?\$,1(T(B ?\$,1(U(B ?\$,1(V(B ?\$,1(W(B ?\$,1(X(B ?\$,1(Y(B ?\$,1(Z(B ?\$,1([(B ?\$,1(\(B ?\$,1(](B ?\$,1(^(B ?\$,1(_(B + ?\$,1(`(B ?\$,1(a(B ?\$,1(b(B ?\$,1(c(B ?\$,1(d(B ?\$,1(e(B ?\$,1(f(B ?\$,1(g(B ?\$,1(h(B ?\$,1(i(B ?\$,1(j(B ?\$,1(k(B ?\$,1(l(B ?\$,1(m(B ?\$,1(n(B ?\$,1tL(B] + "Mac Cyrillic Encoding (MIME:x-mac-cyrillic).") +(coding-system-put 'mac-cyrillic 'mime-charset 'x-mac-cyrillic) + +(let + ((encoding-vector + (vconcat + (make-vector 32 nil) + ;; mac-symbol (32..126) -> emacs-mule mapping + [?\ ?\! ?\$,1x (B ?\# ?\$,1x#(B ?\% ?\& ?\$,1x-(B ?\( ?\) ?\$,1x7(B ?\+ ?\, ?\$,1x2(B ?\. ?\/ + ?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\8 ?\9 ?\: ?\; ?\< ?\= ?\> ?\? + ?\$,1xe(B ?\$,1&q(B ?\$,1&r(B ?\$,1''(B ?\$,1&t(B ?\$,1&u(B ?\$,1'&(B ?\$,1&s(B ?\$,1&w(B ?\$,1&y(B ?\$,1'Q(B ?\$,1&z(B ?\$,1&{(B ?\$,1&|(B ?\$,1&}(B ?\$,1&(B + ?\$,1' (B ?\$,1&x(B ?\$,1'!(B ?\$,1'#(B ?\$,1'$(B ?\$,1'%(B ?\$,1'B(B ?\$,1')(B ?\$,1&~(B ?\$,1'((B ?\$,1&v(B ?\[ ?\$,1xT(B ?\] ?\$,1ye(B ?\_ + ?\$,3bE(B ?\$,1'1(B ?\$,1'2(B ?\$,1'G(B ?\$,1'4(B ?\$,1'5(B ?\$,1'F(B ?\$,1'3(B ?\$,1'7(B ?\$,1'9(B ?\$,1'U(B ?\$,1':(B ?\$,1';(B ?\$,1'<(B ?\$,1'=(B ?\$,1'?(B + ?\$,1'@(B ?\$,1'8(B ?\$,1'A(B ?\$,1'C(B ?\$,1'D(B ?\$,1'E(B ?\$,1'V(B ?\$,1'I(B ?\$,1'>(B ?\$,1'H(B ?\$,1'6(B ?\{ ?\| ?\} ?\$,1x\(B] + (make-vector (- 160 127) nil) + ;; mac-symbol (160..254) -> emacs-mule mapping + ;; Mapping of the following characters are changed from the + ;; original one: + ;; 0xE2 0x00AE+0xF87F -> 0x00AE # REGISTERED SIGN, alternate: sans serif + ;; 0xE3 0x00A9+0xF87F -> 0x00A9 # COPYRIGHT SIGN, alternate: sans serif + ;; 0xE4 0x2122+0xF87F -> 0x2122 # TRADE MARK SIGN, alternate: sans serif + [?\$,1tL(B ?\$,1'R(B ?\$,1s2(B ?\$,1y$(B ?\$,1sD(B ?\$,1x>(B ?\$,1!R(B ?\$,2#c(B ?\$,2#f(B ?\$,2#e(B ?\$,2#`(B ?\$,1vt(B ?\$,1vp(B ?\$,1vq(B ?\$,1vr(B ?\$,1vs(B + ?\,A0(B ?\,A1(B ?\$,1s3(B ?\$,1y%(B ?\,AW(B ?\$,1x=(B ?\$,1x"(B ?\$,1s"(B ?\,Aw(B ?\$,1y (B ?\$,1y!(B ?\$,1xh(B ?\$,1s&(B ?\$,1|p(B ?\$,1|O(B ?\$,1w5(B + ?\$,1uu(B ?\$,1uQ(B ?\$,1u\(B ?\$,1uX(B ?\$,1yW(B ?\$,1yU(B ?\$,1x%(B ?\$,1xI(B ?\$,1xJ(B ?\$,1yC(B ?\$,1yG(B ?\$,1yD(B ?\$,1yB(B ?\$,1yF(B ?\$,1x((B ?\$,1x)(B + ?\$,1x@(B ?\$,1x'(B ?\,A.(B ?\,A)(B ?\$,1ub(B ?\$,1x/(B ?\$,1x:(B ?\$,1z%(B ?\,A,(B ?\$,1xG(B ?\$,1xH(B ?\$,1wT(B ?\$,1wP(B ?\$,1wQ(B ?\$,1wR(B ?\$,1wS(B + ?\$,2"*(B ?\$,2=H(B ?\,A.(B ?\,A)(B ?\$,1ub(B ?\$,1x1(B ?\$,1|;(B ?\$,1|<(B ?\$,1|=(B ?\$,1|A(B ?\$,1|B(B ?\$,1|C(B ?\$,1|G(B ?\$,1|H(B ?\$,1|I(B ?\$,1|J(B + ?\$,3b_(B ?\$,2=I(B ?\$,1xK(B ?\$,1{ (B ?\$,1|N(B ?\$,1{!(B ?\$,1|>(B ?\$,1|?(B ?\$,1|@(B ?\$,1|D(B ?\$,1|E(B ?\$,1|F(B ?\$,1|K(B ?\$,1|L(B ?\$,1|M(B + nil])) + translation-table) + (setq translation-table + (make-translation-table-from-vector encoding-vector)) +;; (define-translation-table 'mac-symbol-decoder translation-table) + (define-translation-table 'mac-symbol-encoder + (char-table-extra-slot translation-table 0))) + +(let + ((encoding-vector + (vconcat + (make-vector 32 nil) + ;; mac-dingbats (32..126) -> emacs-mule mapping + [?\ ?\$,2%A(B ?\$,2%B(B ?\$,2%C(B ?\$,2%D(B ?\$,2"n(B ?\$,2%F(B ?\$,2%G(B ?\$,2%H(B ?\$,2%I(B ?\$,2"{(B ?\$,2"~(B ?\$,2%L(B ?\$,2%M(B ?\$,2%N(B ?\$,2%O(B + ?\$,2%P(B ?\$,2%Q(B ?\$,2%R(B ?\$,2%S(B ?\$,2%T(B ?\$,2%U(B ?\$,2%V(B ?\$,2%W(B ?\$,2%X(B ?\$,2%Y(B ?\$,2%Z(B ?\$,2%[(B ?\$,2%\(B ?\$,2%](B ?\$,2%^(B ?\$,2%_(B + ?\$,2%`(B ?\$,2%a(B ?\$,2%b(B ?\$,2%c(B ?\$,2%d(B ?\$,2%e(B ?\$,2%f(B ?\$,2%g(B ?\$,2"e(B ?\$,2%i(B ?\$,2%j(B ?\$,2%k(B ?\$,2%l(B ?\$,2%m(B ?\$,2%n(B ?\$,2%o(B + ?\$,2%p(B ?\$,2%q(B ?\$,2%r(B ?\$,2%s(B ?\$,2%t(B ?\$,2%u(B ?\$,2%v(B ?\$,2%w(B ?\$,2%x(B ?\$,2%y(B ?\$,2%z(B ?\$,2%{(B ?\$,2%|(B ?\$,2%}(B ?\$,2%~(B ?\$,2%(B + ?\$,2& (B ?\$,2&!(B ?\$,2&"(B ?\$,2&#(B ?\$,2&$(B ?\$,2&%(B ?\$,2&&(B ?\$,2&'(B ?\$,2&((B ?\$,2&)(B ?\$,2&*(B ?\$,2&+(B ?\$,2"/(B ?\$,2&-(B ?\$,2!`(B ?\$,2&/(B + ?\$,2&0(B ?\$,2&1(B ?\$,2&2(B ?\$,2!r(B ?\$,2!|(B ?\$,2"&(B ?\$,2&6(B ?\$,2"7(B ?\$,2&8(B ?\$,2&9(B ?\$,2&:(B ?\$,2&;(B ?\$,2&<(B ?\$,2&=(B ?\$,2&>(B + nil + ;; mac-dingbats (128..141) -> emacs-mule mapping + ?\$,2&H(B ?\$,2&I(B ?\$,2&J(B ?\$,2&K(B ?\$,2&L(B ?\$,2&M(B ?\$,2&N(B ?\$,2&O(B ?\$,2&P(B ?\$,2&Q(B ?\$,2&R(B ?\$,2&S(B ?\$,2&T(B ?\$,2&U(B] + (make-vector (- 161 142) nil) + ;; mac-dingbats (161..239) -> emacs-mule mapping + [?\$,2&A(B ?\$,2&B(B ?\$,2&C(B ?\$,2&D(B ?\$,2&E(B ?\$,2&F(B ?\$,2&G(B ?\$,2#c(B ?\$,2#f(B ?\$,2#e(B ?\$,2#`(B ?\$,1~@(B ?\$,1~A(B ?\$,1~B(B ?\$,1~C(B + ?\$,1~D(B ?\$,1~E(B ?\$,1~F(B ?\$,1~G(B ?\$,1~H(B ?\$,1~I(B ?\$,2&V(B ?\$,2&W(B ?\$,2&X(B ?\$,2&Y(B ?\$,2&Z(B ?\$,2&[(B ?\$,2&\(B ?\$,2&](B ?\$,2&^(B ?\$,2&_(B + ?\$,2&`(B ?\$,2&a(B ?\$,2&b(B ?\$,2&c(B ?\$,2&d(B ?\$,2&e(B ?\$,2&f(B ?\$,2&g(B ?\$,2&h(B ?\$,2&i(B ?\$,2&j(B ?\$,2&k(B ?\$,2&l(B ?\$,2&m(B ?\$,2&n(B ?\$,2&o(B + ?\$,2&p(B ?\$,2&q(B ?\$,2&r(B ?\$,2&s(B ?\$,2&t(B ?\$,1vr(B ?\$,1vt(B ?\$,1vu(B ?\$,2&x(B ?\$,2&y(B ?\$,2&z(B ?\$,2&{(B ?\$,2&|(B ?\$,2&}(B ?\$,2&~(B ?\$,2&(B + ?\$,2' (B ?\$,2'!(B ?\$,2'"(B ?\$,2'#(B ?\$,2'$(B ?\$,2'%(B ?\$,2'&(B ?\$,2''(B ?\$,2'((B ?\$,2')(B ?\$,2'*(B ?\$,2'+(B ?\$,2',(B ?\$,2'-(B ?\$,2'.(B ?\$,2'/(B + nil + ;; mac-dingbats (241..254) -> emacs-mule mapping + ?\$,2'1(B ?\$,2'2(B ?\$,2'3(B ?\$,2'4(B ?\$,2'5(B ?\$,2'6(B ?\$,2'7(B ?\$,2'8(B ?\$,2'9(B ?\$,2':(B ?\$,2';(B ?\$,2'<(B ?\$,2'=(B ?\$,2'>(B + nil])) + translation-table) + (setq translation-table + (make-translation-table-from-vector encoding-vector)) +;; (define-translation-table 'mac-dingbats-decoder translation-table) + (define-translation-table 'mac-dingbats-encoder + (char-table-extra-slot translation-table 0))) + +(defconst mac-system-coding-system + (let ((base (or (cdr (assq mac-system-script-code + mac-script-code-coding-systems)) + 'mac-roman))) + (if (eq system-type 'darwin) + base + (coding-system-change-eol-conversion base 'mac))) + "Coding system derived from the system script code.") -;; Define constant values to be set to mac-keyboard-text-encoding -(defconst kTextEncodingMacRoman 0) -(defconst kTextEncodingISOLatin1 513 "0x201") -(defconst kTextEncodingISOLatin2 514 "0x202") +(set-selection-coding-system mac-system-coding-system) -;;;; Selections and cut buffers +;;;; Keyboard layout/language change events +(defun mac-handle-language-change (event) + "Set keyboard coding system to what is specified in EVENT." + (interactive "e") + (let ((coding-system + (cdr (assq (car (cadr event)) mac-script-code-coding-systems)))) + (set-keyboard-coding-system (or coding-system 'mac-roman)) + ;; MacJapanese maps reverse solidus to ?\x80. + (if (eq coding-system 'japanese-shift-jis) + (define-key key-translation-map [?\x80] "\\")))) -;; Setup to use the Mac clipboard. The functions mac-cut-function and -;; mac-paste-function are defined in mac.c. -(set-selection-coding-system 'compound-text-mac) +(define-key special-event-map [language-change] 'mac-handle-language-change) -(setq interprogram-cut-function - '(lambda (str push) - (mac-cut-function - (encode-coding-string str selection-coding-system t) push))) + +;;;; Conversion between common flavors and Lisp string. + +(defconst mac-text-encoding-ascii #x600 + "ASCII text encoding.") + +(defconst mac-text-encoding-mac-japanese-basic-variant #x20001 + "MacJapanese text encoding without Apple double-byte extensions.") + +(defun mac-utxt-to-string (data &optional coding-system) + (or coding-system (setq coding-system mac-system-coding-system)) + (let* ((encoding + (and (eq system-type 'darwin) + (eq (coding-system-base coding-system) 'japanese-shift-jis) + mac-text-encoding-mac-japanese-basic-variant)) + (str (and (fboundp 'mac-code-convert-string) + (mac-code-convert-string data nil + (or encoding coding-system))))) + (when str + (setq str (decode-coding-string str coding-system)) + (if (eq encoding mac-text-encoding-mac-japanese-basic-variant) + ;; Does it contain Apple one-byte extensions other than + ;; reverse solidus? + (if (string-match "[\xa0\xfd-\xff]" str) + (setq str nil) + ;; ASCII-only? + (unless (mac-code-convert-string data nil mac-text-encoding-ascii) + (subst-char-in-string ?\x5c ?\(J\(B str t) + (subst-char-in-string ?\x80 ?\\ str t))))) + (or str + (decode-coding-string data + (if (eq (byteorder) ?B) 'utf-16be 'utf-16le))))) + +(defun mac-string-to-utxt (string &optional coding-system) + (or coding-system (setq coding-system mac-system-coding-system)) + (let (data encoding) + (when (and (fboundp 'mac-code-convert-string) + (memq (coding-system-base coding-system) + (find-coding-systems-string string))) + (setq coding-system + (coding-system-change-eol-conversion coding-system 'mac)) + (let ((str string)) + (when (and (eq system-type 'darwin) + (eq coding-system 'japanese-shift-jis-mac)) + (setq encoding mac-text-encoding-mac-japanese-basic-variant) + (setq str (subst-char-in-string ?\\ ?\x80 str)) + (subst-char-in-string ?\(J\(B ?\x5c str t) + ;; ASCII-only? + (if (string-match "\\`[\x00-\x7f]*\\'" str) + (setq str nil))) + (and str + (setq data (mac-code-convert-string + (encode-coding-string str coding-system) + (or encoding coding-system) nil))))) + (or data (encode-coding-string string (if (eq (byteorder) ?B) + 'utf-16be-mac + 'utf-16le-mac))))) + +(defun mac-TEXT-to-string (data &optional coding-system) + (or coding-system (setq coding-system mac-system-coding-system)) + (prog1 (setq data (decode-coding-string data coding-system)) + (when (eq (coding-system-base coding-system) 'japanese-shift-jis) + ;; (subst-char-in-string ?\x5c ?\(J\(B data t) + (subst-char-in-string ?\x80 ?\\ data t)))) + +(defun mac-string-to-TEXT (string &optional coding-system) + (or coding-system (setq coding-system mac-system-coding-system)) + (let ((encodables (find-coding-systems-string string)) + (rest mac-script-code-coding-systems)) + (unless (memq (coding-system-base coding-system) encodables) + (while (and rest (not (memq (cdar rest) encodables))) + (setq rest (cdr rest))) + (if rest + (setq coding-system (cdar rest))))) + (setq coding-system + (coding-system-change-eol-conversion coding-system 'mac)) + (when (eq coding-system 'japanese-shift-jis-mac) + ;; (setq string (subst-char-in-string ?\\ ?\x80 string)) + (setq string (subst-char-in-string ?\(J\(B ?\x5c string))) + (encode-coding-string string coding-system)) + +(defun mac-furl-to-string (data) + ;; Remove a trailing nul character. + (let ((len (length data))) + (if (and (> len 0) (= (aref data (1- len)) ?\0)) + (substring data 0 (1- len)) + data))) + +(defun mac-TIFF-to-string (data &optional text) + (prog1 (or text (setq text (copy-sequence " "))) + (put-text-property 0 (length text) 'display (create-image data 'tiff t) + text))) + +;;;; Selections + +;;; We keep track of the last text selected here, so we can check the +;;; current selection against it, and avoid passing back our own text +;;; from x-get-selection-value. +(defvar x-last-selected-text-clipboard nil + "The value of the CLIPBOARD selection last time we selected or +pasted text.") +(defvar x-last-selected-text-primary nil + "The value of the PRIMARY X selection last time we selected or +pasted text.") + +(defcustom x-select-enable-clipboard t + "*Non-nil means cutting and pasting uses the clipboard. +This is in addition to the primary selection." + :type 'boolean + :group 'killing) + +;;; Make TEXT, a string, the primary X selection. +(defun x-select-text (text &optional push) + (x-set-selection 'PRIMARY text) + (setq x-last-selected-text-primary text) + (if (not x-select-enable-clipboard) + (setq x-last-selected-text-clipboard nil) + (x-set-selection 'CLIPBOARD text) + (setq x-last-selected-text-clipboard text)) + ) + +(defun x-get-selection (&optional type data-type) + "Return the value of a selection. +The argument TYPE (default `PRIMARY') says which selection, +and the argument DATA-TYPE (default `STRING') says +how to convert the data. + +TYPE may be any symbol \(but nil stands for `PRIMARY'). However, +only a few symbols are commonly used. They conventionally have +all upper-case names. The most often used ones, in addition to +`PRIMARY', are `SECONDARY' and `CLIPBOARD'. + +DATA-TYPE is usually `STRING', but can also be one of the symbols +in `selection-converter-alist', which see." + (let ((data (x-get-selection-internal (or type 'PRIMARY) + (or data-type 'STRING))) + (coding (or next-selection-coding-system + selection-coding-system))) + (when (and (stringp data) + (setq data-type (get-text-property 0 'foreign-selection data))) + (cond ((eq data-type 'public.utf16-plain-text) + (setq data (mac-utxt-to-string data coding))) + ((eq data-type 'com.apple.traditional-mac-plain-text) + (setq data (mac-TEXT-to-string data coding))) + ((eq data-type 'public.file-url) + (setq data (mac-furl-to-string data)))) + (put-text-property 0 (length data) 'foreign-selection data-type data)) + data)) + +(defun x-selection-value (type) + (let ((data-types '(public.utf16-plain-text + com.apple.traditional-mac-plain-text + public.file-url)) + text tiff-image) + (while (and (null text) data-types) + (setq text (condition-case nil + (x-get-selection type (car data-types)) + (error nil))) + (setq data-types (cdr data-types))) + (if text + (remove-text-properties 0 (length text) '(foreign-selection nil) text)) + (setq tiff-image (condition-case nil + (x-get-selection type 'public.tiff) + (error nil))) + (when tiff-image + (remove-text-properties 0 (length tiff-image) + '(foreign-selection nil) tiff-image) + (setq text (mac-TIFF-to-string tiff-image text))) + text)) + +;;; Return the value of the current selection. +;;; Treat empty strings as if they were unset. +;;; If this function is called twice and finds the same text, +;;; it returns nil the second time. This is so that a single +;;; selection won't be added to the kill ring over and over. +(defun x-get-selection-value () + (let (clip-text primary-text) + (if (not x-select-enable-clipboard) + (setq x-last-selected-text-clipboard nil) + (setq clip-text (x-selection-value 'CLIPBOARD)) + (if (string= clip-text "") (setq clip-text nil)) + + ;; Check the CLIPBOARD selection for 'newness', is it different + ;; from what we remebered them to be last time we did a + ;; cut/paste operation. + (setq clip-text + (cond;; check clipboard + ((or (not clip-text) (string= clip-text "")) + (setq x-last-selected-text-clipboard nil)) + ((eq clip-text x-last-selected-text-clipboard) nil) + ((string= clip-text x-last-selected-text-clipboard) + ;; Record the newer string, + ;; so subsequent calls can use the `eq' test. + (setq x-last-selected-text-clipboard clip-text) + nil) + (t + (setq x-last-selected-text-clipboard clip-text)))) + ) + + (setq primary-text (x-selection-value 'PRIMARY)) + ;; Check the PRIMARY selection for 'newness', is it different + ;; from what we remebered them to be last time we did a + ;; cut/paste operation. + (setq primary-text + (cond;; check primary selection + ((or (not primary-text) (string= primary-text "")) + (setq x-last-selected-text-primary nil)) + ((eq primary-text x-last-selected-text-primary) nil) + ((string= primary-text x-last-selected-text-primary) + ;; Record the newer string, + ;; so subsequent calls can use the `eq' test. + (setq x-last-selected-text-primary primary-text) + nil) + (t + (setq x-last-selected-text-primary primary-text)))) + + ;; As we have done one selection, clear this now. + (setq next-selection-coding-system nil) + + ;; At this point we have recorded the current values for the + ;; selection from clipboard (if we are supposed to) and primary, + ;; So return the first one that has changed (which is the first + ;; non-null one). + (or clip-text primary-text) + )) + +(put 'CLIPBOARD 'mac-scrap-name "com.apple.scrap.clipboard") +(when (eq system-type 'darwin) + (put 'FIND 'mac-scrap-name "com.apple.scrap.find") + (put 'PRIMARY 'mac-scrap-name + (format "org.gnu.Emacs.%d.selection.PRIMARY" (emacs-pid)))) +(put 'com.apple.traditional-mac-plain-text 'mac-ostype "TEXT") +(put 'public.utf16-plain-text 'mac-ostype "utxt") +(put 'public.tiff 'mac-ostype "TIFF") +(put 'public.file-url 'mac-ostype "furl") + +(defun mac-select-convert-to-string (selection type value) + (let ((str (cdr (xselect-convert-to-string selection nil value))) + (coding (or next-selection-coding-system selection-coding-system))) + (when str + ;; If TYPE is nil, this is a local request, thus return STR as + ;; is. Otherwise, encode STR. + (if (not type) + str + (let ((inhibit-read-only t)) + (remove-text-properties 0 (length str) '(composition nil) str) + (cond + ((eq type 'public.utf16-plain-text) + (setq str (mac-string-to-utxt str coding))) + ((eq type 'com.apple.traditional-mac-plain-text) + (setq str (mac-string-to-TEXT str coding))) + (t + (error "Unknown selection type: %S" type)) + ))) + + (setq next-selection-coding-system nil) + (cons type str)))) + +(defun mac-select-convert-to-file-url (selection type value) + (let ((filename (xselect-convert-to-filename selection type value)) + (coding (or file-name-coding-system default-file-name-coding-system))) + (if (and filename coding) + (setq filename (encode-coding-string filename coding))) + (and filename + (concat "file://localhost" + (mapconcat 'url-hexify-string + (split-string filename "/") "/"))))) + +(setq selection-converter-alist + (nconc + '((public.utf16-plain-text . mac-select-convert-to-string) + (com.apple.traditional-mac-plain-text . mac-select-convert-to-string) + ;; This is not enabled by default because the `Import Image' + ;; menu makes Emacs crash or hang for unknown reasons. + ;; (public.tiff . nil) + (public.file-url . mac-select-convert-to-file-url) + ) + selection-converter-alist)) + +;;;; Apple events, HICommand events, and Services menu + +;;; Event classes +(put 'core-event 'mac-apple-event-class "aevt") ; kCoreEventClass +(put 'internet-event 'mac-apple-event-class "GURL") ; kAEInternetEventClass + +;;; Event IDs +;; kCoreEventClass +(put 'open-application 'mac-apple-event-id "oapp") ; kAEOpenApplication +(put 'reopen-application 'mac-apple-event-id "rapp") ; kAEReopenApplication +(put 'open-documents 'mac-apple-event-id "odoc") ; kAEOpenDocuments +(put 'print-documents 'mac-apple-event-id "pdoc") ; kAEPrintDocuments +(put 'open-contents 'mac-apple-event-id "ocon") ; kAEOpenContents +(put 'quit-application 'mac-apple-event-id "quit") ; kAEQuitApplication +(put 'application-died 'mac-apple-event-id "obit") ; kAEApplicationDied +(put 'show-preferences 'mac-apple-event-id "pref") ; kAEShowPreferences +(put 'autosave-now 'mac-apple-event-id "asav") ; kAEAutosaveNow +;; kAEInternetEventClass +(put 'get-url 'mac-apple-event-id "GURL") ; kAEGetURL +;; Converted HI command events +(put 'about 'mac-apple-event-id "abou") ; kHICommandAbout +(put 'show-hide-font-panel 'mac-apple-event-id "shfp") ; kHICommandShowHideFontPanel + +(defmacro mac-event-spec (event) + `(nth 1 ,event)) + +(defmacro mac-event-ae (event) + `(nth 2 ,event)) + +(defun mac-ae-parameter (ae &optional keyword type) + (or keyword (setq keyword "----")) ;; Direct object. + (if (not (and (consp ae) (equal (car ae) "aevt"))) + (error "Not an Apple event: %S" ae) + (let ((type-data (cdr (assoc keyword (cdr ae)))) + data) + (when (and type type-data (not (equal type (car type-data)))) + (setq data (mac-coerce-ae-data (car type-data) (cdr type-data) type)) + (setq type-data (if data (cons type data) nil))) + type-data))) + +(defun mac-ae-list (ae &optional keyword type) + (or keyword (setq keyword "----")) ;; Direct object. + (let ((desc (mac-ae-parameter ae keyword "list"))) + (cond ((null desc) + nil) + ((not (equal (car desc) "list")) + (error "Parameter for \"%s\" is not a list" keyword)) + (t + (if (null type) + (cdr desc) + (mapcar + (lambda (type-data) + (mac-coerce-ae-data (car type-data) (cdr type-data) type)) + (cdr desc))))))) + +(defun mac-ae-number (ae keyword) + (let ((type-data (mac-ae-parameter ae keyword)) + str) + (if (and type-data + (setq str (mac-coerce-ae-data (car type-data) + (cdr type-data) "TEXT"))) + (let ((num (string-to-number str))) + ;; Mac OS Classic may return "0e+0" as the coerced value for + ;; the type "magn" and the data "\000\000\000\000". + (if (= num 0.0) 0 num)) + nil))) + +(defun mac-bytes-to-integer (bytes &optional from to) + (or from (setq from 0)) + (or to (setq to (length bytes))) + (let* ((len (- to from)) + (extended-sign-len (- (1+ (ceiling (log most-positive-fixnum 2))) + (* 8 len))) + (result 0)) + (dotimes (i len) + (setq result (logior (lsh result 8) + (aref bytes (+ from (if (eq (byteorder) ?B) i + (- len i 1))))))) + (if (> extended-sign-len 0) + (ash (lsh result extended-sign-len) (- extended-sign-len)) + result))) + +(defun mac-ae-selection-range (ae) +;; #pragma options align=mac68k +;; typedef struct SelectionRange { +;; short unused1; // 0 (not used) +;; short lineNum; // line to select (<0 to specify range) +;; long startRange; // start of selection range (if line < 0) +;; long endRange; // end of selection range (if line < 0) +;; long unused2; // 0 (not used) +;; long theDate; // modification date/time +;; } SelectionRange; +;; #pragma options align=reset + (let ((range-bytes (cdr (mac-ae-parameter ae "kpos" "TEXT")))) + (and range-bytes + (list (mac-bytes-to-integer range-bytes 2 4) + (mac-bytes-to-integer range-bytes 4 8) + (mac-bytes-to-integer range-bytes 8 12) + (mac-bytes-to-integer range-bytes 16 20))))) + +;; On Mac OS X 10.4 and later, the `open-document' event contains an +;; optional parameter keyAESearchText from the Spotlight search. +(defun mac-ae-text-for-search (ae) + (let ((utf8-text (cdr (mac-ae-parameter ae "stxt" "utf8")))) + (and utf8-text + (decode-coding-string utf8-text 'utf-8)))) + +(defun mac-ae-text (ae) + (or (cdr (mac-ae-parameter ae nil "TEXT")) + (error "No text in Apple event."))) + +(defun mac-ae-frame (ae &optional keyword type) + (let ((bytes (cdr (mac-ae-parameter ae keyword type)))) + (if (or (null bytes) (/= (length bytes) 4)) + (error "No window reference in Apple event.") + (let ((window-id (mac-coerce-ae-data "long" bytes "TEXT")) + (rest (frame-list)) + frame) + (while (and (null frame) rest) + (if (string= (frame-parameter (car rest) 'window-id) window-id) + (setq frame (car rest))) + (setq rest (cdr rest))) + frame)))) + +(defun mac-ae-script-language (ae keyword) +;; struct WritingCode { +;; ScriptCode theScriptCode; +;; LangCode theLangCode; +;; }; + (let ((bytes (cdr (mac-ae-parameter ae keyword "intl")))) + (and bytes + (cons (mac-bytes-to-integer bytes 0 2) + (mac-bytes-to-integer bytes 2 4))))) + +(defun mac-bytes-to-text-range (bytes &optional from to) +;; struct TextRange { +;; long fStart; +;; long fEnd; +;; short fHiliteStyle; +;; }; + (or from (setq from 0)) + (or to (setq to (length bytes))) + (and (= (- to from) (+ 4 4 2)) + (list (mac-bytes-to-integer bytes from (+ from 4)) + (mac-bytes-to-integer bytes (+ from 4) (+ from 8)) + (mac-bytes-to-integer bytes (+ from 8) to)))) + +(defun mac-ae-text-range-array (ae keyword) +;; struct TextRangeArray { +;; short fNumOfRanges; +;; TextRange fRange[1]; +;; }; + (let* ((bytes (cdr (mac-ae-parameter ae keyword "tray"))) + (len (length bytes)) + nranges result) + (when (and bytes (>= len 2) + (progn + (setq nranges (mac-bytes-to-integer bytes 0 2)) + (= len (+ 2 (* nranges 10))))) + (setq result (make-vector nranges nil)) + (dotimes (i nranges) + (aset result i + (mac-bytes-to-text-range bytes (+ (* i 10) 2) + (+ (* i 10) 12))))) + result)) + +(defconst mac-keyboard-modifier-mask-alist + (mapcar + (lambda (modifier-bit) + (cons (car modifier-bit) (lsh 1 (cdr modifier-bit)))) + '((command . 8) ; cmdKeyBit + (shift . 9) ; shiftKeyBit + (option . 11) ; optionKeyBit + (control . 12) ; controlKeyBit + (function . 17))) ; kEventKeyModifierFnBit + "Alist of Mac keyboard modifier symbols vs masks.") + +(defun mac-ae-keyboard-modifiers (ae) + (let ((modifiers-value (mac-ae-number ae "kmod")) + modifiers) + (if modifiers-value + (dolist (modifier-mask mac-keyboard-modifier-mask-alist) + (if (/= (logand modifiers-value (cdr modifier-mask)) 0) + (setq modifiers (cons (car modifier-mask) modifiers))))) + modifiers)) + +(defun mac-ae-reopen-application (event) + "Show some frame in response to the Apple event EVENT. +The frame to be shown is chosen from visible or iconified frames +if possible. If there's no such frame, a new frame is created." + (interactive "e") + (unless (frame-visible-p (selected-frame)) + (let ((frame (or (car (visible-frame-list)) + (car (filtered-frame-list 'frame-visible-p))))) + (if frame + (select-frame frame) + (switch-to-buffer-other-frame "*scratch*")))) + (select-frame-set-input-focus (selected-frame))) + +(defun mac-ae-open-documents (event) + "Open the documents specified by the Apple event EVENT." + (interactive "e") + (let ((ae (mac-event-ae event))) + (dolist (file-name (mac-ae-list ae nil 'undecoded-file-name)) + (if file-name + (dnd-open-local-file + (concat "file://" + (mapconcat 'url-hexify-string + (split-string file-name "/") "/")) nil))) + (let ((selection-range (mac-ae-selection-range ae)) + (search-text (mac-ae-text-for-search ae))) + (cond (selection-range + (let ((line (car selection-range)) + (start (cadr selection-range)) + (end (nth 2 selection-range))) + (if (> line 0) + (goto-line line) + (if (and (> start 0) (> end 0)) + (progn (set-mark start) + (goto-char end)))))) + ((stringp search-text) + (re-search-forward + (mapconcat 'regexp-quote (split-string search-text) "\\|") + nil t))))) + (select-frame-set-input-focus (selected-frame))) + +(defun mac-ae-quit-application (event) + "Quit the application Emacs with the Apple event EVENT." + (interactive "e") + (let ((ae (mac-event-ae event))) + (unwind-protect + (save-buffers-kill-emacs) + ;; Reaches here if the user has canceled the quit. + (mac-resume-apple-event ae -128)))) ; userCanceledErr + +(defun mac-ae-get-url (event) + "Open the URL specified by the Apple event EVENT. +Currently the `mailto' scheme is supported." + (interactive "e") + (let* ((ae (mac-event-ae event)) + (parsed-url (url-generic-parse-url (mac-ae-text ae)))) + (if (string= (url-type parsed-url) "mailto") + (progn + (url-mailto parsed-url) + (select-frame-set-input-focus (selected-frame))) + (mac-resume-apple-event ae t)))) + +(setq mac-apple-event-map (make-sparse-keymap)) + +;; Received when Emacs is launched without associated documents. +;; Accept it as an Apple event, but no Emacs event is generated so as +;; not to erase the splash screen. +(define-key mac-apple-event-map [core-event open-application] 0) + +;; Received when a dock or application icon is clicked and Emacs is +;; already running. +(define-key mac-apple-event-map [core-event reopen-application] + 'mac-ae-reopen-application) + +(define-key mac-apple-event-map [core-event open-documents] + 'mac-ae-open-documents) +(define-key mac-apple-event-map [core-event show-preferences] 'customize) +(define-key mac-apple-event-map [core-event quit-application] + 'mac-ae-quit-application) + +(define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url) + +(define-key mac-apple-event-map [hi-command about] 'about-emacs) + +;;; Converted Carbon Events +(defun mac-handle-toolbar-switch-mode (event) + "Toggle visibility of tool-bars in response to EVENT. +With no keyboard modifiers, it toggles the visibility of the +frame where the tool-bar toggle button was pressed. With some +modifiers, it changes the global tool-bar visibility setting." + (interactive "e") + (let ((ae (mac-event-ae event))) + (if (mac-ae-keyboard-modifiers ae) + ;; Globally toggle tool-bar-mode if some modifier key is pressed. + (tool-bar-mode 'toggle) + (let ((frame (mac-ae-frame ae))) + (set-frame-parameter frame 'tool-bar-lines + (if (= (frame-parameter frame 'tool-bar-lines) 0) + 1 0)))))) + +;; kEventClassWindow/kEventWindowToolbarSwitchMode +(define-key mac-apple-event-map [window toolbar-switch-mode] + 'mac-handle-toolbar-switch-mode) + +;;; Font panel +(when (fboundp 'mac-set-font-panel-visible-p) + +(define-minor-mode mac-font-panel-mode + "Toggle use of the font panel. +With numeric ARG, display the font panel if and only if ARG is positive." + :init-value nil + :global t + :group 'mac + (mac-set-font-panel-visible-p mac-font-panel-mode)) + +(defun mac-handle-font-panel-closed (event) + "Update internal status in response to font panel closed EVENT." + (interactive "e") + ;; Synchronize with the minor mode variable. + (mac-font-panel-mode 0)) -(setq interprogram-paste-function - '(lambda () - (let ((clipboard (mac-paste-function))) - (if clipboard - (decode-coding-string clipboard selection-coding-system t))))) +(defun mac-handle-font-selection (event) + "Change default face attributes according to font selection EVENT." + (interactive "e") + (let* ((ae (mac-event-ae event)) + (fm-font-size (mac-ae-number ae "fmsz")) + (atsu-font-id (mac-ae-number ae "auid")) + (attribute-values (and atsu-font-id + (mac-atsu-font-face-attributes atsu-font-id)))) + (if fm-font-size + (setq attribute-values + `(:height ,(* 10 fm-font-size) ,@attribute-values))) + (apply 'set-face-attribute 'default (selected-frame) attribute-values))) + +;; kEventClassFont/kEventFontPanelClosed +(define-key mac-apple-event-map [font panel-closed] + 'mac-handle-font-panel-closed) +;; kEventClassFont/kEventFontSelection +(define-key mac-apple-event-map [font selection] 'mac-handle-font-selection) +(define-key mac-apple-event-map [hi-command show-hide-font-panel] + 'mac-font-panel-mode) + +(define-key-after menu-bar-showhide-menu [mac-font-panel-mode] + (menu-bar-make-mm-toggle mac-font-panel-mode + "Font Panel" + "Show the font panel as a floating dialog") + 'showhide-speedbar) + +) ;; (fboundp 'mac-set-font-panel-visible-p) + +;;; Text Services +(defvar mac-ts-active-input-buf "" + "Byte sequence of the current Mac TSM active input area.") +(defvar mac-ts-update-active-input-area-seqno 0 + "Number of processed update-active-input-area events.") +(setq mac-ts-active-input-overlay (make-overlay 0 0)) + +(defface mac-ts-caret-position + '((t :inverse-video t)) + "Face for caret position in Mac TSM active input area. +This is used when the active input area is displayed either in +the echo area or in a buffer where the cursor is not displayed." + :group 'mac) + +(defface mac-ts-raw-text + '((t :underline t)) + "Face for raw text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-selected-raw-text + '((t :underline t)) + "Face for selected raw text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-converted-text + '((((background dark)) :underline "gray20") + (t :underline "gray80")) + "Face for converted text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-selected-converted-text + '((t :underline t)) + "Face for selected converted text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-block-fill-text + '((t :underline t)) + "Face for block fill text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-outline-text + '((t :underline t)) + "Face for outline text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-selected-text + '((t :underline t)) + "Face for selected text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-no-hilite + '((t :inherit default)) + "Face for no hilite in Mac TSM active input area." + :group 'mac) + +(defconst mac-ts-hilite-style-faces + '((2 . mac-ts-raw-text) ; kTSMHiliteRawText + (3 . mac-ts-selected-raw-text) ; kTSMHiliteSelectedRawText + (4 . mac-ts-converted-text) ; kTSMHiliteConvertedText + (5 . mac-ts-selected-converted-text) ; kTSMHiliteSelectedConvertedText + (6 . mac-ts-block-fill-text) ; kTSMHiliteBlockFillText + (7 . mac-ts-outline-text) ; kTSMHiliteOutlineText + (8 . mac-ts-selected-text) ; kTSMHiliteSelectedText + (9 . mac-ts-no-hilite)) ; kTSMHiliteNoHilite + "Alist of Mac TSM hilite style vs Emacs face.") + +(defun mac-ts-update-active-input-buf (text fix-len hilite-rng update-rng) + (let ((buf-len (length mac-ts-active-input-buf)) + confirmed) + (if (or (null update-rng) + (/= (% (length update-rng) 2) 0)) + ;; The parameter is missing (or in a bad format). The + ;; existing inline input session is completely replaced with + ;; the new text. + (setq mac-ts-active-input-buf text) + ;; Otherwise, the current subtext specified by the (2*j)-th + ;; range is replaced with the new subtext specified by the + ;; (2*j+1)-th range. + (let ((tail buf-len) + (i (length update-rng)) + segments rng) + (while (> i 0) + (setq i (- i 2)) + (setq rng (aref update-rng i)) + (if (and (<= 0 (cadr rng)) (< (cadr rng) tail) + (<= tail buf-len)) + (setq segments + (cons (substring mac-ts-active-input-buf (cadr rng) tail) + segments))) + (setq tail (car rng)) + (setq rng (aref update-rng (1+ i))) + (if (and (<= 0 (car rng)) (< (car rng) (cadr rng)) + (<= (cadr rng) (length text))) + (setq segments + (cons (substring text (car rng) (cadr rng)) + segments)))) + (if (and (< 0 tail) (<= tail buf-len)) + (setq segments + (cons (substring mac-ts-active-input-buf 0 tail) + segments))) + (setq mac-ts-active-input-buf (apply 'concat segments)))) + (setq buf-len (length mac-ts-active-input-buf)) + ;; Confirm (a part of) inline input session. + (cond ((< fix-len 0) + ;; Entire inline session is being confirmed. + (setq confirmed mac-ts-active-input-buf) + (setq mac-ts-active-input-buf "")) + ((= fix-len 0) + ;; None of the text is being confirmed (yet). + (setq confirmed "")) + (t + (if (> fix-len buf-len) + (setq fix-len buf-len)) + (setq confirmed (substring mac-ts-active-input-buf 0 fix-len)) + (setq mac-ts-active-input-buf + (substring mac-ts-active-input-buf fix-len)))) + (setq buf-len (length mac-ts-active-input-buf)) + ;; Update highlighting and the caret position in the new inline + ;; input session. + (remove-text-properties 0 buf-len '(cursor nil) mac-ts-active-input-buf) + (mapc (lambda (rng) + (cond ((and (= (nth 2 rng) 1) ; kTSMHiliteCaretPosition + (<= 0 (car rng)) (< (car rng) buf-len)) + (put-text-property (car rng) buf-len + 'cursor t mac-ts-active-input-buf)) + ((and (<= 0 (car rng)) (< (car rng) (cadr rng)) + (<= (cadr rng) buf-len)) + (put-text-property (car rng) (cadr rng) 'face + (cdr (assq (nth 2 rng) + mac-ts-hilite-style-faces)) + mac-ts-active-input-buf)))) + hilite-rng) + confirmed)) + +(defun mac-split-string-by-property-change (string) + (let ((tail (length string)) + head result) + (unless (= tail 0) + (while (setq head (previous-property-change tail string) + result (cons (substring string (or head 0) tail) result) + tail head))) + result)) + +(defun mac-replace-untranslated-utf-8-chars (string &optional to-string) + (or to-string (setq to-string "$,3u=(B")) + (mapconcat + (lambda (str) + (if (get-text-property 0 'untranslated-utf-8 str) to-string str)) + (mac-split-string-by-property-change string) + "")) + +(defun mac-keyboard-translate-char (ch) + (if (and (char-valid-p ch) + (or (char-table-p keyboard-translate-table) + (and (or (stringp keyboard-translate-table) + (vectorp keyboard-translate-table)) + (> (length keyboard-translate-table) ch)))) + (or (aref keyboard-translate-table ch) ch) + ch)) + +(defun mac-unread-string (string) + ;; Unread characters and insert them in a keyboard macro being + ;; defined. + (apply 'isearch-unread + (mapcar 'mac-keyboard-translate-char + (mac-replace-untranslated-utf-8-chars string)))) + +(defun mac-ts-update-active-input-area (event) + "Update Mac TSM active input area according to EVENT. +The confirmed text is converted to Emacs input events and pushed +into `unread-command-events'. The unconfirmed text is displayed +either in the current buffer or in the echo area." + (interactive "e") + (let* ((ae (mac-event-ae event)) + (type-text (mac-ae-parameter ae "tstx")) + (text (or (cdr type-text) "")) + (decode-fun (if (equal (car type-text) "TEXT") + 'mac-TEXT-to-string 'mac-utxt-to-string)) + (script-language (mac-ae-script-language ae "tssl")) + (coding (or (cdr (assq (car script-language) + mac-script-code-coding-systems)) + 'mac-roman)) + (fix-len (mac-ae-number ae "tsfx")) + ;; Optional parameters + (hilite-rng (mac-ae-text-range-array ae "tshi")) + (update-rng (mac-ae-text-range-array ae "tsup")) + ;;(pin-rng (mac-bytes-to-text-range (cdr (mac-ae-parameter ae "tspn" "txrn")))) + ;;(clause-offsets (cdr (mac-ae-parameter ae "tscl" "ofay"))) + (seqno (mac-ae-number ae "tsSn")) + confirmed) + (unless (= seqno mac-ts-update-active-input-area-seqno) + ;; Reset internal states if sequence number is out of sync. + (setq mac-ts-active-input-buf "")) + (setq confirmed + (mac-ts-update-active-input-buf text fix-len hilite-rng update-rng)) + (let ((use-echo-area + (or isearch-mode + (and cursor-in-echo-area (current-message)) + ;; Overlay strings are not shown in some cases. + (get-char-property (point) 'invisible) + (and (not (bobp)) + (or (and (get-char-property (point) 'display) + (eq (get-char-property (1- (point)) 'display) + (get-char-property (point) 'display))) + (and (get-char-property (point) 'composition) + (eq (get-char-property (1- (point)) 'composition) + (get-char-property (point) 'composition))))))) + active-input-string caret-seen) + ;; Decode the active input area text with inheriting faces and + ;; the caret position. + (setq active-input-string + (mapconcat + (lambda (str) + (let ((decoded (funcall decode-fun str coding))) + (put-text-property 0 (length decoded) 'face + (get-text-property 0 'face str) decoded) + (when (and (not caret-seen) + (get-text-property 0 'cursor str)) + (setq caret-seen t) + (if (or use-echo-area (null cursor-type)) + (put-text-property 0 1 'face 'mac-ts-caret-position + decoded) + (put-text-property 0 1 'cursor t decoded))) + decoded)) + (mac-split-string-by-property-change mac-ts-active-input-buf) + "")) + (put-text-property 0 (length active-input-string) + 'mac-ts-active-input-string t active-input-string) + (if use-echo-area + (let ((msg (current-message)) + message-log-max) + (if (and msg + ;; Don't get confused by previously displayed + ;; `active-input-string'. + (null (get-text-property 0 'mac-ts-active-input-string + msg))) + (setq msg (propertize msg 'display + (concat msg active-input-string))) + (setq msg active-input-string)) + (message "%s" msg) + (overlay-put mac-ts-active-input-overlay 'before-string nil)) + (move-overlay mac-ts-active-input-overlay + (point) (point) (current-buffer)) + (overlay-put mac-ts-active-input-overlay 'before-string + active-input-string)) + (mac-unread-string (funcall decode-fun confirmed coding))) + ;; The event is successfully processed. Sync the sequence number. + (setq mac-ts-update-active-input-area-seqno (1+ seqno)))) + +(defun mac-ts-unicode-for-key-event (event) + "Convert Unicode key EVENT to Emacs key events and unread them." + (interactive "e") + (let* ((ae (mac-event-ae event)) + (text (cdr (mac-ae-parameter ae "tstx" "utxt"))) + (script-language (mac-ae-script-language ae "tssl")) + (coding (or (cdr (assq (car script-language) + mac-script-code-coding-systems)) + 'mac-roman))) + (if text + (mac-unread-string (mac-utxt-to-string text coding))))) + +;; kEventClassTextInput/kEventTextInputUpdateActiveInputArea +(define-key mac-apple-event-map [text-input update-active-input-area] + 'mac-ts-update-active-input-area) +;; kEventClassTextInput/kEventTextInputUnicodeForKeyEvent +(define-key mac-apple-event-map [text-input unicode-for-key-event] + 'mac-ts-unicode-for-key-event) + +;;; Services +(defun mac-service-open-file () + "Open the file specified by the selection value for Services." + (interactive) + (find-file-existing (x-selection-value mac-service-selection))) + +(defun mac-service-open-selection () + "Create a new buffer containing the selection value for Services." + (interactive) + (switch-to-buffer (generate-new-buffer "*untitled*")) + (insert (x-selection-value mac-service-selection)) + (sit-for 0) + (save-buffer) ; It pops up the save dialog. + ) + +(defun mac-service-mail-selection () + "Prepare a mail buffer containing the selection value for Services." + (interactive) + (compose-mail) + (rfc822-goto-eoh) + (forward-line 1) + (insert (x-selection-value mac-service-selection) "\n")) + +(defun mac-service-mail-to () + "Prepare a mail buffer to be sent to the selection value for Services." + (interactive) + (compose-mail (x-selection-value mac-service-selection))) + +(defun mac-service-insert-text () + "Insert the selection value for Services." + (interactive) + (let ((text (x-selection-value mac-service-selection))) + (if (not buffer-read-only) + (insert text) + (kill-new text) + (message + (substitute-command-keys + "The text from the Services menu can be accessed with \\[yank]"))))) + +;; kEventClassService/kEventServicePaste +(define-key mac-apple-event-map [service paste] 'mac-service-insert-text) +;; kEventClassService/kEventServicePerform +(define-key mac-apple-event-map [service perform open-file] + 'mac-service-open-file) +(define-key mac-apple-event-map [service perform open-selection] + 'mac-service-open-selection) +(define-key mac-apple-event-map [service perform mail-selection] + 'mac-service-mail-selection) +(define-key mac-apple-event-map [service perform mail-to] + 'mac-service-mail-to) + +(defun mac-dispatch-apple-event (event) + "Dispatch EVENT according to the keymap `mac-apple-event-map'." + (interactive "e") + (let* ((binding (lookup-key mac-apple-event-map (mac-event-spec event))) + (ae (mac-event-ae event)) + (service-message (and (keymapp binding) + (cdr (mac-ae-parameter ae "svmg"))))) + (when service-message + (setq service-message + (intern (decode-coding-string service-message 'utf-8))) + (setq binding (lookup-key binding (vector service-message)))) + ;; Replace (cadr event) with a dummy position so that event-start + ;; returns it. + (setcar (cdr event) (list (selected-window) (point) '(0 . 0) 0)) + (if (null (mac-ae-parameter ae 'emacs-suspension-id)) + (command-execute binding nil (vector event) t) + (condition-case err + (progn + (command-execute binding nil (vector event) t) + (mac-resume-apple-event ae)) + (error + (mac-ae-set-reply-parameter ae "errs" + (cons "TEXT" (error-message-string err))) + (mac-resume-apple-event ae -10000)))))) ; errAEEventFailed + +(define-key special-event-map [mac-apple-event] 'mac-dispatch-apple-event) + +;; Processing of Apple events are deferred at the startup time. For +;; example, files dropped onto the Emacs application icon can only be +;; processed when the initial frame has been created: this is where +;; the files should be opened. +(add-hook 'after-init-hook 'mac-process-deferred-apple-events) + +(run-with-idle-timer 5 t 'mac-cleanup-expired-apple-events) + +;;;; Drag and drop + +(defcustom mac-dnd-types-alist + '(("furl" . mac-dnd-handle-furl) + ("hfs " . mac-dnd-handle-hfs) + ("utxt" . mac-dnd-insert-utxt) + ("TEXT" . mac-dnd-insert-TEXT) + ("TIFF" . mac-dnd-insert-TIFF)) + "Which function to call to handle a drop of that type. +The function takes three arguments, WINDOW, ACTION and DATA. +WINDOW is where the drop occurred, ACTION is always `private' on +Mac. DATA is the drop data. Unlike the x-dnd counterpart, the +return value of the function is not significant. + +See also `mac-dnd-known-types'." + :version "22.1" + :type 'alist + :group 'mac) + +(defun mac-dnd-handle-furl (window action data) + (dnd-handle-one-url window action (mac-furl-to-string data))) + +(defun mac-dnd-handle-hfs (window action data) +;; struct HFSFlavor { +;; OSType fileType; +;; OSType fileCreator; +;; UInt16 fdFlags; +;; FSSpec fileSpec; +;; }; + (let* ((file-name (mac-coerce-ae-data "fss " (substring data 10) + 'undecoded-file-name)) + (url (concat "file://" + (mapconcat 'url-hexify-string + (split-string file-name "/") "/")))) + (dnd-handle-one-url window action url))) + +(defun mac-dnd-insert-utxt (window action data) + (dnd-insert-text window action (mac-utxt-to-string data))) + +(defun mac-dnd-insert-TEXT (window action data) + (dnd-insert-text window action (mac-TEXT-to-string data))) + +(defun mac-dnd-insert-TIFF (window action data) + (dnd-insert-text window action (mac-TIFF-to-string data))) + +(defun mac-dnd-drop-data (event frame window data type &optional action) + (or action (setq action 'private)) + (let* ((type-info (assoc type mac-dnd-types-alist)) + (handler (cdr type-info)) + (w (posn-window (event-start event)))) + (when handler + (if (and (window-live-p w) + (not (window-minibuffer-p w)) + (not (window-dedicated-p w))) + ;; If dropping in an ordinary window which we could use, + ;; let dnd-open-file-other-window specify what to do. + (progn + (when (not mouse-yank-at-point) + (goto-char (posn-point (event-start event)))) + (funcall handler window action data)) + ;; If we can't display the file here, + ;; make a new window for it. + (let ((dnd-open-file-other-window t)) + (select-frame frame) + (funcall handler window action data)))))) + +(defun mac-dnd-handle-drag-n-drop-event (event) + "Receive drag and drop events." + (interactive "e") + (let ((window (posn-window (event-start event))) + (ae (mac-event-ae event)) + action) + (when (windowp window) (select-window window)) + (if (memq 'option (mac-ae-keyboard-modifiers ae)) + (setq action 'copy)) + (dolist (item (mac-ae-list ae)) + (if (not (equal (car item) "null")) + (mac-dnd-drop-data event (selected-frame) window + (cdr item) (car item) action))))) ;;; Do the actual Windows setup here; the above code just defines ;;; functions and variables that we use now. @@ -1139,317 +2322,17 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") (setq frame-creation-function 'x-create-frame-with-faces) -(define-ccl-program ccl-encode-mac-roman-font - `(0 - (if (r0 != ,(charset-id 'ascii)) - (if (r0 <= ?\x8f) - (translate-character mac-roman-encoder r0 r1) - ((r1 <<= 7) - (r1 |= r2) - (translate-character mac-roman-encoder r0 r1))))) - "CCL program for Mac Roman font") - -(let - ((encoding-vector (make-vector 256 nil)) - (i 0) - (vec ;; mac-centraleurroman (128..255) -> UCS mapping - [ #x00C4 ;; 128:LATIN CAPITAL LETTER A WITH DIAERESIS - #x0100 ;; 129:LATIN CAPITAL LETTER A WITH MACRON - #x0101 ;; 130:LATIN SMALL LETTER A WITH MACRON - #x00C9 ;; 131:LATIN CAPITAL LETTER E WITH ACUTE - #x0104 ;; 132:LATIN CAPITAL LETTER A WITH OGONEK - #x00D6 ;; 133:LATIN CAPITAL LETTER O WITH DIAERESIS - #x00DC ;; 134:LATIN CAPITAL LETTER U WITH DIAERESIS - #x00E1 ;; 135:LATIN SMALL LETTER A WITH ACUTE - #x0105 ;; 136:LATIN SMALL LETTER A WITH OGONEK - #x010C ;; 137:LATIN CAPITAL LETTER C WITH CARON - #x00E4 ;; 138:LATIN SMALL LETTER A WITH DIAERESIS - #x010D ;; 139:LATIN SMALL LETTER C WITH CARON - #x0106 ;; 140:LATIN CAPITAL LETTER C WITH ACUTE - #x0107 ;; 141:LATIN SMALL LETTER C WITH ACUTE - #x00E9 ;; 142:LATIN SMALL LETTER E WITH ACUTE - #x0179 ;; 143:LATIN CAPITAL LETTER Z WITH ACUTE - #x017A ;; 144:LATIN SMALL LETTER Z WITH ACUTE - #x010E ;; 145:LATIN CAPITAL LETTER D WITH CARON - #x00ED ;; 146:LATIN SMALL LETTER I WITH ACUTE - #x010F ;; 147:LATIN SMALL LETTER D WITH CARON - #x0112 ;; 148:LATIN CAPITAL LETTER E WITH MACRON - #x0113 ;; 149:LATIN SMALL LETTER E WITH MACRON - #x0116 ;; 150:LATIN CAPITAL LETTER E WITH DOT ABOVE - #x00F3 ;; 151:LATIN SMALL LETTER O WITH ACUTE - #x0117 ;; 152:LATIN SMALL LETTER E WITH DOT ABOVE - #x00F4 ;; 153:LATIN SMALL LETTER O WITH CIRCUMFLEX - #x00F6 ;; 154:LATIN SMALL LETTER O WITH DIAERESIS - #x00F5 ;; 155:LATIN SMALL LETTER O WITH TILDE - #x00FA ;; 156:LATIN SMALL LETTER U WITH ACUTE - #x011A ;; 157:LATIN CAPITAL LETTER E WITH CARON - #x011B ;; 158:LATIN SMALL LETTER E WITH CARON - #x00FC ;; 159:LATIN SMALL LETTER U WITH DIAERESIS - #x2020 ;; 160:DAGGER - #x00B0 ;; 161:DEGREE SIGN - #x0118 ;; 162:LATIN CAPITAL LETTER E WITH OGONEK - #x00A3 ;; 163:POUND SIGN - #x00A7 ;; 164:SECTION SIGN - #x2022 ;; 165:BULLET - #x00B6 ;; 166:PILCROW SIGN - #x00DF ;; 167:LATIN SMALL LETTER SHARP S - #x00AE ;; 168:REGISTERED SIGN - #x00A9 ;; 169:COPYRIGHT SIGN - #x2122 ;; 170:TRADE MARK SIGN - #x0119 ;; 171:LATIN SMALL LETTER E WITH OGONEK - #x00A8 ;; 172:DIAERESIS - #x2260 ;; 173:NOT EQUAL TO - #x0123 ;; 174:LATIN SMALL LETTER G WITH CEDILLA - #x012E ;; 175:LATIN CAPITAL LETTER I WITH OGONEK - #x012F ;; 176:LATIN SMALL LETTER I WITH OGONEK - #x012A ;; 177:LATIN CAPITAL LETTER I WITH MACRON - #x2264 ;; 178:LESS-THAN OR EQUAL TO - #x2265 ;; 179:GREATER-THAN OR EQUAL TO - #x012B ;; 180:LATIN SMALL LETTER I WITH MACRON - #x0136 ;; 181:LATIN CAPITAL LETTER K WITH CEDILLA - #x2202 ;; 182:PARTIAL DIFFERENTIAL - #x2211 ;; 183:N-ARY SUMMATION - #x0142 ;; 184:LATIN SMALL LETTER L WITH STROKE - #x013B ;; 185:LATIN CAPITAL LETTER L WITH CEDILLA - #x013C ;; 186:LATIN SMALL LETTER L WITH CEDILLA - #x013D ;; 187:LATIN CAPITAL LETTER L WITH CARON - #x013E ;; 188:LATIN SMALL LETTER L WITH CARON - #x0139 ;; 189:LATIN CAPITAL LETTER L WITH ACUTE - #x013A ;; 190:LATIN SMALL LETTER L WITH ACUTE - #x0145 ;; 191:LATIN CAPITAL LETTER N WITH CEDILLA - #x0146 ;; 192:LATIN SMALL LETTER N WITH CEDILLA - #x0143 ;; 193:LATIN CAPITAL LETTER N WITH ACUTE - #x00AC ;; 194:NOT SIGN - #x221A ;; 195:SQUARE ROOT - #x0144 ;; 196:LATIN SMALL LETTER N WITH ACUTE - #x0147 ;; 197:LATIN CAPITAL LETTER N WITH CARON - #x2206 ;; 198:INCREMENT - #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK - #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK - #x2026 ;; 201:HORIZONTAL ELLIPSIS - #x00A0 ;; 202:NO-BREAK SPACE - #x0148 ;; 203:LATIN SMALL LETTER N WITH CARON - #x0150 ;; 204:LATIN CAPITAL LETTER O WITH DOUBLE ACUTE - #x00D5 ;; 205:LATIN CAPITAL LETTER O WITH TILDE - #x0151 ;; 206:LATIN SMALL LETTER O WITH DOUBLE ACUTE - #x014C ;; 207:LATIN CAPITAL LETTER O WITH MACRON - #x2013 ;; 208:EN DASH - #x2014 ;; 209:EM DASH - #x201C ;; 210:LEFT DOUBLE QUOTATION MARK - #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK - #x2018 ;; 212:LEFT SINGLE QUOTATION MARK - #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK - #x00F7 ;; 214:DIVISION SIGN - #x25CA ;; 215:LOZENGE - #x014D ;; 216:LATIN SMALL LETTER O WITH MACRON - #x0154 ;; 217:LATIN CAPITAL LETTER R WITH ACUTE - #x0155 ;; 218:LATIN SMALL LETTER R WITH ACUTE - #x0158 ;; 219:LATIN CAPITAL LETTER R WITH CARON - #x2039 ;; 220:SINGLE LEFT-POINTING ANGLE QUOTATION MARK - #x203A ;; 221:SINGLE RIGHT-POINTING ANGLE QUOTATION MARK - #x0159 ;; 222:LATIN SMALL LETTER R WITH CARON - #x0156 ;; 223:LATIN CAPITAL LETTER R WITH CEDILLA - #x0157 ;; 224:LATIN SMALL LETTER R WITH CEDILLA - #x0160 ;; 225:LATIN CAPITAL LETTER S WITH CARON - #x201A ;; 226:SINGLE LOW-9 QUOTATION MARK - #x201E ;; 227:DOUBLE LOW-9 QUOTATION MARK - #x0161 ;; 228:LATIN SMALL LETTER S WITH CARON - #x015A ;; 229:LATIN CAPITAL LETTER S WITH ACUTE - #x015B ;; 230:LATIN SMALL LETTER S WITH ACUTE - #x00C1 ;; 231:LATIN CAPITAL LETTER A WITH ACUTE - #x0164 ;; 232:LATIN CAPITAL LETTER T WITH CARON - #x0165 ;; 233:LATIN SMALL LETTER T WITH CARON - #x00CD ;; 234:LATIN CAPITAL LETTER I WITH ACUTE - #x017D ;; 235:LATIN CAPITAL LETTER Z WITH CARON - #x017E ;; 236:LATIN SMALL LETTER Z WITH CARON - #x016A ;; 237:LATIN CAPITAL LETTER U WITH MACRON - #x00D3 ;; 238:LATIN CAPITAL LETTER O WITH ACUTE - #x00D4 ;; 239:LATIN CAPITAL LETTER O WITH CIRCUMFLEX - #x016B ;; 240:LATIN SMALL LETTER U WITH MACRON - #x016E ;; 241:LATIN CAPITAL LETTER U WITH RING ABOVE - #x00DA ;; 242:LATIN CAPITAL LETTER U WITH ACUTE - #x016F ;; 243:LATIN SMALL LETTER U WITH RING ABOVE - #x0170 ;; 244:LATIN CAPITAL LETTER U WITH DOUBLE ACUTE - #x0171 ;; 245:LATIN SMALL LETTER U WITH DOUBLE ACUTE - #x0172 ;; 246:LATIN CAPITAL LETTER U WITH OGONEK - #x0173 ;; 247:LATIN SMALL LETTER U WITH OGONEK - #x00DD ;; 248:LATIN CAPITAL LETTER Y WITH ACUTE - #x00FD ;; 249:LATIN SMALL LETTER Y WITH ACUTE - #x0137 ;; 250:LATIN SMALL LETTER K WITH CEDILLA - #x017B ;; 251:LATIN CAPITAL LETTER Z WITH DOT ABOVE - #x0141 ;; 252:LATIN CAPITAL LETTER L WITH STROKE - #x017C ;; 253:LATIN SMALL LETTER Z WITH DOT ABOVE - #x0122 ;; 254:LATIN CAPITAL LETTER G WITH CEDILLA - #x02C7 ;; 255:CARON - ]) - translation-table) - (while (< i 128) - (aset encoding-vector i i) - (setq i (1+ i))) - (while (< i 256) - (aset encoding-vector i - (decode-char 'ucs (aref vec (- i 128)))) - (setq i (1+ i))) - (setq translation-table - (make-translation-table-from-vector encoding-vector)) -;; (define-translation-table 'mac-centraleurroman-decoder translation-table) - (define-translation-table 'mac-centraleurroman-encoder - (char-table-extra-slot translation-table 0))) - -(let - ((encoding-vector (make-vector 256 nil)) - (i 0) - (vec ;; mac-cyrillic (128..255) -> UCS mapping - [ #x0410 ;; 128:CYRILLIC CAPITAL LETTER A - #x0411 ;; 129:CYRILLIC CAPITAL LETTER BE - #x0412 ;; 130:CYRILLIC CAPITAL LETTER VE - #x0413 ;; 131:CYRILLIC CAPITAL LETTER GHE - #x0414 ;; 132:CYRILLIC CAPITAL LETTER DE - #x0415 ;; 133:CYRILLIC CAPITAL LETTER IE - #x0416 ;; 134:CYRILLIC CAPITAL LETTER ZHE - #x0417 ;; 135:CYRILLIC CAPITAL LETTER ZE - #x0418 ;; 136:CYRILLIC CAPITAL LETTER I - #x0419 ;; 137:CYRILLIC CAPITAL LETTER SHORT I - #x041A ;; 138:CYRILLIC CAPITAL LETTER KA - #x041B ;; 139:CYRILLIC CAPITAL LETTER EL - #x041C ;; 140:CYRILLIC CAPITAL LETTER EM - #x041D ;; 141:CYRILLIC CAPITAL LETTER EN - #x041E ;; 142:CYRILLIC CAPITAL LETTER O - #x041F ;; 143:CYRILLIC CAPITAL LETTER PE - #x0420 ;; 144:CYRILLIC CAPITAL LETTER ER - #x0421 ;; 145:CYRILLIC CAPITAL LETTER ES - #x0422 ;; 146:CYRILLIC CAPITAL LETTER TE - #x0423 ;; 147:CYRILLIC CAPITAL LETTER U - #x0424 ;; 148:CYRILLIC CAPITAL LETTER EF - #x0425 ;; 149:CYRILLIC CAPITAL LETTER HA - #x0426 ;; 150:CYRILLIC CAPITAL LETTER TSE - #x0427 ;; 151:CYRILLIC CAPITAL LETTER CHE - #x0428 ;; 152:CYRILLIC CAPITAL LETTER SHA - #x0429 ;; 153:CYRILLIC CAPITAL LETTER SHCHA - #x042A ;; 154:CYRILLIC CAPITAL LETTER HARD SIGN - #x042B ;; 155:CYRILLIC CAPITAL LETTER YERU - #x042C ;; 156:CYRILLIC CAPITAL LETTER SOFT SIGN - #x042D ;; 157:CYRILLIC CAPITAL LETTER E - #x042E ;; 158:CYRILLIC CAPITAL LETTER YU - #x042F ;; 159:CYRILLIC CAPITAL LETTER YA - #x2020 ;; 160:DAGGER - #x00B0 ;; 161:DEGREE SIGN - #x0490 ;; 162:CYRILLIC CAPITAL LETTER GHE WITH UPTURN - #x00A3 ;; 163:POUND SIGN - #x00A7 ;; 164:SECTION SIGN - #x2022 ;; 165:BULLET - #x00B6 ;; 166:PILCROW SIGN - #x0406 ;; 167:CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I - #x00AE ;; 168:REGISTERED SIGN - #x00A9 ;; 169:COPYRIGHT SIGN - #x2122 ;; 170:TRADE MARK SIGN - #x0402 ;; 171:CYRILLIC CAPITAL LETTER DJE - #x0452 ;; 172:CYRILLIC SMALL LETTER DJE - #x2260 ;; 173:NOT EQUAL TO - #x0403 ;; 174:CYRILLIC CAPITAL LETTER GJE - #x0453 ;; 175:CYRILLIC SMALL LETTER GJE - #x221E ;; 176:INFINITY - #x00B1 ;; 177:PLUS-MINUS SIGN - #x2264 ;; 178:LESS-THAN OR EQUAL TO - #x2265 ;; 179:GREATER-THAN OR EQUAL TO - #x0456 ;; 180:CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I - #x00B5 ;; 181:MICRO SIGN - #x0491 ;; 182:CYRILLIC SMALL LETTER GHE WITH UPTURN - #x0408 ;; 183:CYRILLIC CAPITAL LETTER JE - #x0404 ;; 184:CYRILLIC CAPITAL LETTER UKRAINIAN IE - #x0454 ;; 185:CYRILLIC SMALL LETTER UKRAINIAN IE - #x0407 ;; 186:CYRILLIC CAPITAL LETTER YI - #x0457 ;; 187:CYRILLIC SMALL LETTER YI - #x0409 ;; 188:CYRILLIC CAPITAL LETTER LJE - #x0459 ;; 189:CYRILLIC SMALL LETTER LJE - #x040A ;; 190:CYRILLIC CAPITAL LETTER NJE - #x045A ;; 191:CYRILLIC SMALL LETTER NJE - #x0458 ;; 192:CYRILLIC SMALL LETTER JE - #x0405 ;; 193:CYRILLIC CAPITAL LETTER DZE - #x00AC ;; 194:NOT SIGN - #x221A ;; 195:SQUARE ROOT - #x0192 ;; 196:LATIN SMALL LETTER F WITH HOOK - #x2248 ;; 197:ALMOST EQUAL TO - #x2206 ;; 198:INCREMENT - #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK - #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK - #x2026 ;; 201:HORIZONTAL ELLIPSIS - #x00A0 ;; 202:NO-BREAK SPACE - #x040B ;; 203:CYRILLIC CAPITAL LETTER TSHE - #x045B ;; 204:CYRILLIC SMALL LETTER TSHE - #x040C ;; 205:CYRILLIC CAPITAL LETTER KJE - #x045C ;; 206:CYRILLIC SMALL LETTER KJE - #x0455 ;; 207:CYRILLIC SMALL LETTER DZE - #x2013 ;; 208:EN DASH - #x2014 ;; 209:EM DASH - #x201C ;; 210:LEFT DOUBLE QUOTATION MARK - #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK - #x2018 ;; 212:LEFT SINGLE QUOTATION MARK - #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK - #x00F7 ;; 214:DIVISION SIGN - #x201E ;; 215:DOUBLE LOW-9 QUOTATION MARK - #x040E ;; 216:CYRILLIC CAPITAL LETTER SHORT U - #x045E ;; 217:CYRILLIC SMALL LETTER SHORT U - #x040F ;; 218:CYRILLIC CAPITAL LETTER DZHE - #x045F ;; 219:CYRILLIC SMALL LETTER DZHE - #x2116 ;; 220:NUMERO SIGN - #x0401 ;; 221:CYRILLIC CAPITAL LETTER IO - #x0451 ;; 222:CYRILLIC SMALL LETTER IO - #x044F ;; 223:CYRILLIC SMALL LETTER YA - #x0430 ;; 224:CYRILLIC SMALL LETTER A - #x0431 ;; 225:CYRILLIC SMALL LETTER BE - #x0432 ;; 226:CYRILLIC SMALL LETTER VE - #x0433 ;; 227:CYRILLIC SMALL LETTER GHE - #x0434 ;; 228:CYRILLIC SMALL LETTER DE - #x0435 ;; 229:CYRILLIC SMALL LETTER IE - #x0436 ;; 230:CYRILLIC SMALL LETTER ZHE - #x0437 ;; 231:CYRILLIC SMALL LETTER ZE - #x0438 ;; 232:CYRILLIC SMALL LETTER I - #x0439 ;; 233:CYRILLIC SMALL LETTER SHORT I - #x043A ;; 234:CYRILLIC SMALL LETTER KA - #x043B ;; 235:CYRILLIC SMALL LETTER EL - #x043C ;; 236:CYRILLIC SMALL LETTER EM - #x043D ;; 237:CYRILLIC SMALL LETTER EN - #x043E ;; 238:CYRILLIC SMALL LETTER O - #x043F ;; 239:CYRILLIC SMALL LETTER PE - #x0440 ;; 240:CYRILLIC SMALL LETTER ER - #x0441 ;; 241:CYRILLIC SMALL LETTER ES - #x0442 ;; 242:CYRILLIC SMALL LETTER TE - #x0443 ;; 243:CYRILLIC SMALL LETTER U - #x0444 ;; 244:CYRILLIC SMALL LETTER EF - #x0445 ;; 245:CYRILLIC SMALL LETTER HA - #x0446 ;; 246:CYRILLIC SMALL LETTER TSE - #x0447 ;; 247:CYRILLIC SMALL LETTER CHE - #x0448 ;; 248:CYRILLIC SMALL LETTER SHA - #x0449 ;; 249:CYRILLIC SMALL LETTER SHCHA - #x044A ;; 250:CYRILLIC SMALL LETTER HARD SIGN - #x044B ;; 251:CYRILLIC SMALL LETTER YERU - #x044C ;; 252:CYRILLIC SMALL LETTER SOFT SIGN - #x044D ;; 253:CYRILLIC SMALL LETTER E - #x044E ;; 254:CYRILLIC SMALL LETTER YU - #x20AC ;; 255:EURO SIGN - ]) - translation-table) - (while (< i 128) - (aset encoding-vector i i) - (setq i (1+ i))) - (while (< i 256) - (aset encoding-vector i - (decode-char 'ucs (aref vec (- i 128)))) - (setq i (1+ i))) - (setq translation-table - (make-translation-table-from-vector encoding-vector)) -;; (define-translation-table 'mac-cyrillic-decoder translation-table) - (define-translation-table 'mac-cyrillic-encoder - (char-table-extra-slot translation-table 0))) - (defvar mac-font-encoder-list '(("mac-roman" mac-roman-encoder ccl-encode-mac-roman-font "%s") - ("mac-centraleurroman" mac-centraleurroman-encoder + ("mac-centraleurroman" encode-mac-centraleurroman ccl-encode-mac-centraleurroman-font "%s ce") - ("mac-cyrillic" mac-cyrillic-encoder - ccl-encode-mac-cyrillic-font "%s cy"))) + ("mac-cyrillic" encode-mac-cyrillic + ccl-encode-mac-cyrillic-font "%s cy") + ("mac-symbol" mac-symbol-encoder + ccl-encode-mac-symbol-font "symbol") + ("mac-dingbats" mac-dingbats-encoder + ccl-encode-mac-dingbats-font "zapf dingbats"))) (let ((encoder-list (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list)) @@ -1468,26 +2351,54 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") (if mac-encoded (aset table c mac-encoded)))))))) +;; We assume none of official dim2 charsets (0x90..0x99) are encoded +;; to these fonts. + +(define-ccl-program ccl-encode-mac-roman-font + `(0 + (if (r0 <= ?\xef) + (translate-character mac-roman-encoder r0 r1) + ((r1 <<= 7) + (r1 |= r2) + (translate-character mac-roman-encoder r0 r1)))) + "CCL program for Mac Roman font") + (define-ccl-program ccl-encode-mac-centraleurroman-font `(0 - (if (r0 != ,(charset-id 'ascii)) - (if (r0 <= ?\x8f) - (translate-character mac-centraleurroman-encoder r0 r1) - ((r1 <<= 7) - (r1 |= r2) - (translate-character mac-centraleurroman-encoder r0 r1))))) + (if (r0 <= ?\xef) + (translate-character encode-mac-centraleurroman r0 r1) + ((r1 <<= 7) + (r1 |= r2) + (translate-character encode-mac-centraleurroman r0 r1)))) "CCL program for Mac Central European Roman font") (define-ccl-program ccl-encode-mac-cyrillic-font `(0 - (if (r0 != ,(charset-id 'ascii)) - (if (r0 <= ?\x8f) - (translate-character mac-cyrillic-encoder r0 r1) - ((r1 <<= 7) - (r1 |= r2) - (translate-character mac-cyrillic-encoder r0 r1))))) + (if (r0 <= ?\xef) + (translate-character encode-mac-cyrillic r0 r1) + ((r1 <<= 7) + (r1 |= r2) + (translate-character encode-mac-cyrillic r0 r1)))) "CCL program for Mac Cyrillic font") +(define-ccl-program ccl-encode-mac-symbol-font + `(0 + (if (r0 <= ?\xef) + (translate-character mac-symbol-encoder r0 r1) + ((r1 <<= 7) + (r1 |= r2) + (translate-character mac-symbol-encoder r0 r1)))) + "CCL program for Mac Symbol font") + +(define-ccl-program ccl-encode-mac-dingbats-font + `(0 + (if (r0 <= ?\xef) + (translate-character mac-dingbats-encoder r0 r1) + ((r1 <<= 7) + (r1 |= r2) + (translate-character mac-dingbats-encoder r0 r1)))) + "CCL program for Mac Dingbats font") + (setq font-ccl-encoder-alist (nconc @@ -1495,36 +2406,81 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") mac-font-encoder-list) font-ccl-encoder-alist)) +(defconst mac-char-fontspec-list + ;; Directly operate on a char-table instead of a fontset so that it + ;; may not create a dummy fontset. + (let ((template (make-char-table 'fontset))) + (dolist + (font-encoder + (nreverse + (mapcar (lambda (lst) + (cons (cons (nth 3 lst) (nth 0 lst)) (nth 1 lst))) + mac-font-encoder-list))) + (let ((font (car font-encoder)) + (encoder (cdr font-encoder))) + (map-char-table + (lambda (key val) + (or (null val) + (generic-char-p key) + (memq (char-charset key) + '(ascii eight-bit-control eight-bit-graphic)) + (aset template key font))) + (get encoder 'translation-table)))) + + ;; Like fontset-info, but extend a range only if its "to" part is + ;; the predecessor of the current char. + (let* ((last '((0 nil))) + (accumulator last) + last-char-or-range last-char last-elt) + (map-char-table + (lambda (char elt) + (when elt + (setq last-char-or-range (car (car last)) + last-char (if (consp last-char-or-range) + (cdr last-char-or-range) + last-char-or-range) + last-elt (cdr (car last))) + (if (and (eq elt last-elt) + (= char (1+ last-char)) + (eq (char-charset char) (char-charset last-char))) + (if (consp last-char-or-range) + (setcdr last-char-or-range char) + (setcar (car last) (cons last-char char))) + (setcdr last (list (cons char elt))) + (setq last (cdr last))))) + template) + (cdr accumulator)))) + (defun fontset-add-mac-fonts (fontset &optional base-family) + "Add font-specs for Mac fonts to FONTSET. +The added font-specs are determined by BASE-FAMILY and the value +of `mac-char-fontspec-list', which is a list +of (CHARACTER-OR-RANGE . (FAMILY-FORMAT . REGISTRY)). If +BASE-FAMILY is nil, the font family in the added font-specs is +also nil. If BASE-FAMILY is a string, `%s' in FAMILY-FORMAT is +replaced with the string. Otherwise, `%s' in FAMILY-FORMAT is +replaced with the ASCII font family name in FONTSET." (if base-family - (setq base-family (downcase base-family)) - (let ((ascii-font - (downcase (x-resolve-font-name - (fontset-font fontset (charset-id 'ascii)))))) - (setq base-family (aref (x-decompose-font-name ascii-font) - xlfd-regexp-family-subnum)))) -;; (if (not (string-match "^fontset-" fontset)) -;; (setq fontset -;; (concat "fontset-" (aref (x-decompose-font-name fontset) -;; xlfd-regexp-encoding-subnum)))) - (dolist - (font-encoder - (nreverse - (mapcar (lambda (lst) - (cons (cons (format (nth 3 lst) base-family) (nth 0 lst)) - (nth 1 lst))) - mac-font-encoder-list))) - (let ((font (car font-encoder)) - (encoder (cdr font-encoder))) - (map-char-table - (lambda (key val) - (or (null val) - (generic-char-p key) - (memq (char-charset key) - '(ascii eight-bit-control eight-bit-graphic)) - (set-fontset-font fontset key font))) - (get encoder 'translation-table))))) - + (if (stringp base-family) + (setq base-family (downcase base-family)) + (let ((ascii-font (fontset-font fontset (charset-id 'ascii)))) + (if ascii-font + (setq base-family + (aref (x-decompose-font-name + (downcase (x-resolve-font-name ascii-font))) + xlfd-regexp-family-subnum)))))) + (let (fontspec-cache fontspec) + (dolist (char-fontspec mac-char-fontspec-list) + (setq fontspec (cdr (assq (cdr char-fontspec) fontspec-cache))) + (when (null fontspec) + (setq fontspec + (cons (and base-family + (format (car (cdr char-fontspec)) base-family)) + (cdr (cdr char-fontspec)))) + (setq fontspec-cache (cons (cons (cdr char-fontspec) fontspec) + fontspec-cache))) + (set-fontset-font fontset (car char-fontspec) fontspec)))) + (defun create-fontset-from-mac-roman-font (font &optional resolved-font fontset-name) "Create a fontset from a Mac roman font FONT. @@ -1540,19 +2496,50 @@ an appropriate name is generated automatically. It returns a name of the created fontset." (let ((fontset (create-fontset-from-ascii-font font resolved-font fontset-name))) - (fontset-add-mac-fonts fontset) + (fontset-add-mac-fonts fontset t) fontset)) +;; Adjust Courier font specifications in x-fixed-font-alist. +(let ((courier-fonts (assoc "Courier" x-fixed-font-alist))) + (if courier-fonts + (dolist (label-fonts (cdr courier-fonts)) + (setcdr label-fonts + (mapcar + (lambda (font) + (if (string-match "\\`-adobe-courier-\\([^-]*\\)-\\(.\\)-\\(.*\\)-iso8859-1\\'" font) + (replace-match + (if (string= (match-string 2 font) "o") + "-*-courier-\\1-i-\\3-*-*" + "-*-courier-\\1-\\2-\\3-*-*") + t nil font) + font)) + (cdr label-fonts)))))) + ;; Setup the default fontset. (setup-default-fontset) +(cond ((x-list-fonts "*-iso10646-1" nil nil 1) + ;; Use ATSUI (if available) for the following charsets. + (dolist + (charset '(latin-iso8859-1 + latin-iso8859-2 latin-iso8859-3 latin-iso8859-4 + thai-tis620 greek-iso8859-7 arabic-iso8859-6 + hebrew-iso8859-8 cyrillic-iso8859-5 + latin-iso8859-9 latin-iso8859-15 latin-iso8859-14 + japanese-jisx0212 chinese-sisheng ipa + vietnamese-viscii-lower vietnamese-viscii-upper + lao ethiopic tibetan)) + (set-fontset-font nil charset '(nil . "iso10646-1")))) + ((null (x-list-fonts "*-iso8859-1" nil nil 1)) + ;; Add Mac-encoding fonts unless ETL fonts are installed. + (fontset-add-mac-fonts "fontset-default"))) ;; Create a fontset that uses mac-roman font. With this fontset, ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1, ;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font. (create-fontset-from-fontset-spec - "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac, + "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-standard, ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") -(fontset-add-mac-fonts "fontset-mac") +(fontset-add-mac-fonts "fontset-standard" t) ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...). (create-fontset-from-x-resource) @@ -1597,12 +2584,15 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") (cons '(user-size . t) parsed)))) ;; All geometry parms apply to the initial frame. (setq initial-frame-alist (append initial-frame-alist parsed)) - ;; The size parms apply to all frames. - (if (assq 'height parsed) + ;; The size parms apply to all frames. Don't set it if there are + ;; sizes there already (from command line). + (if (and (assq 'height parsed) + (not (assq 'height default-frame-alist))) (setq default-frame-alist (cons (cons 'height (cdr (assq 'height parsed))) default-frame-alist))) - (if (assq 'width parsed) + (if (and (assq 'width parsed) + (not (assq 'width default-frame-alist))) (setq default-frame-alist (cons (cons 'width (cdr (assq 'width parsed))) default-frame-alist)))))) @@ -1619,52 +2609,34 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") (error "Suspending an Emacs running under Mac makes no sense")) (add-hook 'suspend-hook 'x-win-suspend-error) +;;; Arrange for the kill and yank functions to set and check the clipboard. +(setq interprogram-cut-function 'x-select-text) +(setq interprogram-paste-function 'x-get-selection-value) + +(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value) + +;;; Turn off window-splitting optimization; Mac is usually fast enough +;;; that this is only annoying. +(setq split-window-keep-point t) + ;; Don't show the frame name; that's redundant. (setq-default mode-line-frame-identification " ") ;; Turn on support for mouse wheels. (mouse-wheel-mode 1) -(defun mac-drag-n-drop (event) - "Edit the files listed in the drag-n-drop EVENT. -Switch to a buffer editing the last file dropped." - (interactive "e") - ;; Make sure the drop target has positive co-ords - ;; before setting the selected frame - otherwise it - ;; won't work. - (let* ((window (posn-window (event-start event))) - (coords (posn-x-y (event-start event))) - (x (car coords)) - (y (cdr coords))) - (if (and (> x 0) (> y 0)) - (set-frame-selected-window nil window)) - (mapcar (lambda (file-name) - (if (listp file-name) - (let ((line (car file-name)) - (start (car (cdr file-name))) - (end (car (cdr (cdr file-name))))) - (if (> line 0) - (goto-line line) - (if (and (> start 0) (> end 0)) - (progn (set-mark start) - (goto-char end))))) - (dnd-handle-one-url window 'private - (concat "file:" file-name)))) - (car (cdr (cdr event))))) - (raise-frame)) - -(global-set-key [drag-n-drop] 'mac-drag-n-drop) - -;; By checking whether the variable mac-ready-for-drag-n-drop has been -;; defined, the event loop in macterm.c can be informed that it can -;; now receive Finder drag and drop events. Files dropped onto the -;; Emacs application icon can only be processed when the initial frame -;; has been created: this is where the files should be opened. -(add-hook 'after-init-hook - '(lambda () - (defvar mac-ready-for-drag-n-drop t))) + +;; Enable CLIPBOARD copy/paste through menu bar commands. +(menu-bar-enable-clipboard) + +;; Initiate drag and drop + +(define-key special-event-map [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event) + -;;;; Scroll bars +;;;; Non-toolkit Scroll bars + +(unless x-toolkit-scroll-bars ;; for debugging ;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event)) @@ -1724,6 +2696,8 @@ Switch to a buffer editing the last file dropped." (mac-scroll-ignore-events) (scroll-up 1))) +) + ;;;; Others @@ -1739,19 +2713,16 @@ Switch to a buffer editing the last file dropped." ;; started (see run_mac_command in sysdep.c). (setq shell-file-name "sh") - ;; To display filenames in Chinese or Japanese, replace mac-roman with - ;; big5 or sjis - (setq file-name-coding-system 'mac-roman)) + ;; Some system variables are encoded with the system script code. + (dolist (v '(system-name + emacs-build-system ; Mac OS 9 version cannot dump + user-login-name user-real-login-name user-full-name)) + (set v (decode-coding-string (symbol-value v) mac-system-coding-system)))) -;; X Window emulation in macterm.c is not complete enough to start a -;; frame without a minibuffer properly. Call this to tell ediff -;; library to use a single frame. -; (ediff-toggle-multiframe) - -;; If Emacs is started from the Finder, change the default directory -;; to the user's home directory. -(if (string= default-directory "/") - (cd "~")) +;; Now the default directory is changed to the user's home directory +;; in emacs.c if invoked from the WindowServer (with -psn_* option). +;; (if (string= default-directory "/") +;; (cd "~")) ;; Darwin 6- pty breakage is now controlled from the C code so that ;; it applies to all builds on darwin. See s/darwin.h PTY_ITERATION. @@ -1763,7 +2734,5 @@ Switch to a buffer editing the last file dropped." ;; or bold bitmap versions will not display these variants correctly. (setq scalable-fonts-allowed t) -;; (prefer-coding-system 'mac-roman) - ;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6 ;;; mac-win.el ends here