diff options
| author | Dan Nicolaescu | 2008-07-27 18:24:48 +0000 |
|---|---|---|
| committer | Dan Nicolaescu | 2008-07-27 18:24:48 +0000 |
| commit | 9e2a2647758db83b490e2993aa31cd4607305a82 (patch) | |
| tree | 9c3d41b47bcd316c60d56bef8d7fd32789e59411 /lisp | |
| parent | 7f19297073b2dd6c28987bf5663933591f59e91e (diff) | |
| download | emacs-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/ChangeLog | 21 | ||||
| -rw-r--r-- | lisp/Makefile.in | 1 | ||||
| -rw-r--r-- | lisp/cus-edit.el | 17 | ||||
| -rw-r--r-- | lisp/cus-face.el | 2 | ||||
| -rw-r--r-- | lisp/cus-start.el | 38 | ||||
| -rw-r--r-- | lisp/disp-table.el | 8 | ||||
| -rw-r--r-- | lisp/erc/ChangeLog | 4 | ||||
| -rw-r--r-- | lisp/erc/erc.el | 1 | ||||
| -rw-r--r-- | lisp/faces.el | 20 | ||||
| -rw-r--r-- | lisp/frame.el | 34 | ||||
| -rw-r--r-- | lisp/info.el | 2 | ||||
| -rw-r--r-- | lisp/international/mule-cmds.el | 18 | ||||
| -rw-r--r-- | lisp/isearch.el | 2 | ||||
| -rw-r--r-- | lisp/loadup.el | 3 | ||||
| -rw-r--r-- | lisp/mouse.el | 2 | ||||
| -rw-r--r-- | lisp/mwheel.el | 4 | ||||
| -rw-r--r-- | lisp/simple.el | 3 | ||||
| -rw-r--r-- | lisp/startup.el | 2 | ||||
| -rw-r--r-- | lisp/term/mac-win.el | 2002 | ||||
| -rw-r--r-- | lisp/version.el | 2 |
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 @@ | |||
| 1 | 2008-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 | |||
| 1 | 2008-07-26 Adrian Robert <Adrian.B.Robert@gmail.com> | 22 | 2008-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 "\ |
| 3162 | Windows NT/9X.") | 3155 | Windows NT/9X.") |
| 3163 | w32) | 3156 | w32) |
| 3164 | (const :format "MAC " | ||
| 3165 | :sibling-args (:help-echo "\ | ||
| 3166 | Macintosh OS (Carbon interface).") | ||
| 3167 | mac) | ||
| 3168 | (const :format "NS " | 3157 | (const :format "NS " |
| 3169 | :sibling-args (:help-echo "\ | 3158 | :sibling-args (:help-echo "\ |
| 3170 | GNUstep or Macintosh OS Cocoa interface.") | 3159 | GNUstep 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. |
| 143 | This function assumes that your terminal uses the SO/SI characters; | 143 | This function assumes that your terminal uses the SO/SI characters; |
| 144 | it is meaningless for an X frame." | 144 | it 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. |
| 155 | This function assumes VT100-compatible escapes; it is meaningless for an | 155 | This function assumes VT100-compatible escapes; it is meaningless for an |
| 156 | X frame." | 156 | X 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 @@ | |||
| 1 | 2008-07-27 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 2 | |||
| 3 | * erc.el: Remove code for Carbon. | ||
| 4 | |||
| 1 | 2008-06-07 Glenn Morris <rgm@gnu.org> | 5 | 2008-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. | |||
| 1624 | The value may be different for frames on different display types. | 1624 | The value may be different for frames on different display types. |
| 1625 | If FRAME doesn't support colors, the value is nil. | 1625 | If FRAME doesn't support colors, the value is nil. |
| 1626 | If FRAME is nil, that stands for the selected frame." | 1626 | If 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 | |||
| 1668 | The optional argument DISPLAY specifies which display to ask about. | 1668 | The optional argument DISPLAY specifies which display to ask about. |
| 1669 | DISPLAY should be either a frame or a display name (a string). | 1669 | DISPLAY should be either a frame or a display name (a string). |
| 1670 | If omitted or nil, that stands for the selected frame's display." | 1670 | If 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). | |||
| 1181 | Support for popup menus requires that the mouse be available." | 1181 | Support 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 | |||
| 1191 | that use a window system such as X, and false for text-only terminals. | 1191 | that use a window system such as X, and false for text-only terminals. |
| 1192 | DISPLAY can be a display name, a frame, or nil (meaning the selected | 1192 | DISPLAY can be a display name, a frame, or nil (meaning the selected |
| 1193 | frame's display)." | 1193 | frame'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)." | |||
| 1242 | For character terminals, each character counts as a single pixel." | 1242 | For 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." | |||
| 1254 | For character terminals, each character counts as a single pixel." | 1254 | For 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. |
| 1284 | System values can be overridden by `display-mm-dimensions-alist'. | 1284 | System values can be overridden by `display-mm-dimensions-alist'. |
| 1285 | If the information is unavailable, value is nil." | 1285 | If 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. |
| 1296 | System values can be overridden by `display-mm-dimensions-alist'. | 1296 | System values can be overridden by `display-mm-dimensions-alist'. |
| 1297 | If the information is unavailable, value is nil." | 1297 | If 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 | |||
| 1309 | the question is inapplicable to a certain kind of display." | 1309 | the 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. | ||
| 206 | This 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 | ||
| 208 | the 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). | ||
| 210 | This 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. | ||
| 395 | XConsortium: 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. | ||
| 466 | Create an entry in `mac-charset-info-alist'. | ||
| 467 | XLFD-CHARSET is a string which will appear in the XLFD font name | ||
| 468 | to identify the character set. MAC-TEXT-ENCODING is the | ||
| 469 | correspoinding 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 | ||
| 754 | pasted text.") | ||
| 755 | (defvar x-last-selected-text-primary nil | ||
| 756 | "The value of the PRIMARY X selection last time we selected or | ||
| 757 | pasted text.") | ||
| 758 | |||
| 759 | (defcustom x-select-enable-clipboard t | ||
| 760 | "*Non-nil means cutting and pasting uses the clipboard. | ||
| 761 | This 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. | ||
| 780 | The argument TYPE (default `PRIMARY') says which selection, | ||
| 781 | and the argument DATA-TYPE (default `STRING') says | ||
| 782 | how to convert the data. | ||
| 783 | |||
| 784 | TYPE may be any symbol \(but nil stands for `PRIMARY'). However, | ||
| 785 | only a few symbols are commonly used. They conventionally have | ||
| 786 | all upper-case names. The most often used ones, in addition to | ||
| 787 | `PRIMARY', are `SECONDARY' and `CLIPBOARD'. | ||
| 788 | |||
| 789 | DATA-TYPE is usually `STRING', but can also be one of the symbols | ||
| 790 | in `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. | ||
| 1124 | The frame to be shown is chosen from visible or iconified frames | ||
| 1125 | if 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. | ||
| 1176 | Currently 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. | ||
| 1213 | With no keyboard modifiers, it toggles the visibility of the | ||
| 1214 | frame where the tool-bar toggle button was pressed. With some | ||
| 1215 | modifiers, 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. | ||
| 1235 | With 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. | ||
| 1284 | This is used when the active input area is displayed either in | ||
| 1285 | the 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. | ||
| 1443 | The confirmed text is converted to Emacs input events and pushed | ||
| 1444 | into `unread-command-events'. The unconfirmed text is displayed | ||
| 1445 | either 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. | ||
| 1640 | The function takes three arguments, WINDOW, ACTION and DATA. | ||
| 1641 | WINDOW is where the drop occurred, ACTION is always `private' on | ||
| 1642 | Mac. DATA is the drop data. Unlike the x-dnd counterpart, the | ||
| 1643 | return value of the function is not significant. | ||
| 1644 | |||
| 1645 | See 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 | |||
| 1738 | Optional 1st arg RESOLVED-FONT is a resolved name of FONT. If | ||
| 1739 | omitted, `x-resolve-font-name' is called to get the resolved name. At | ||
| 1740 | this time, if FONT is not available, error is signaled. | ||
| 1741 | |||
| 1742 | Optional 2nd arg FONTSET-NAME is a string to be used in | ||
| 1743 | `<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted, | ||
| 1744 | an appropriate name is generated automatically. | ||
| 1745 | |||
| 1746 | It 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))) |