;;; mac-win.el --- parse switches controlling interface with Mac window system -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 1999, 2000, 2002, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
;; Author: Andrew Choi <akochoi@mac.com>
;; Keywords: terminals
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(require 'mouse)
(require 'scroll-bar)
(require 'faces)
-;;(require 'select)
+(require 'select)
(require 'menu-bar)
(require 'fontset)
(require 'dnd)
(let ((param (nth 3 aelt)))
(setq default-frame-alist
(cons (cons param
- (string-to-int (car x-invocation-args)))
+ (string-to-number (car x-invocation-args)))
default-frame-alist)
x-invocation-args
(cdr x-invocation-args))))))
(define-key special-event-map [language-change] 'mac-handle-language-change)
\f
-;;;; Selections and cut buffers
-
-;; Setup to use the Mac clipboard. The functions mac-cut-function and
-;; mac-paste-function are defined in mac.c.
-(set-selection-coding-system 'compound-text-mac)
-
-(setq interprogram-cut-function
- '(lambda (str push)
- (mac-cut-function
- (encode-coding-string str selection-coding-system t) push)))
-
-(setq interprogram-paste-function
- '(lambda ()
- (let ((clipboard (mac-paste-function)))
- (if clipboard
- (decode-coding-string clipboard selection-coding-system t)))))
-
+;;;; Selections and Services menu
+
+;; Setup to use the Mac clipboard.
+(set-selection-coding-system mac-system-coding-system)
+
+;;; We keep track of the last text selected here, so we can check the
+;;; current selection against it, and avoid passing back our own text
+;;; from x-get-selection-value.
+(defvar x-last-selected-text-clipboard nil
+ "The value of the CLIPBOARD selection last time we selected or
+pasted text.")
+(defvar x-last-selected-text-primary nil
+ "The value of the PRIMARY X selection last time we selected or
+pasted text.")
+
+(defcustom x-select-enable-clipboard t
+ "*Non-nil means cutting and pasting uses the clipboard.
+This is in addition to the primary selection."
+ :type 'boolean
+ :group 'killing)
+
+;;; Make TEXT, a string, the primary X selection.
+(defun x-select-text (text &optional push)
+ (x-set-selection 'PRIMARY text)
+ (setq x-last-selected-text-primary text)
+ (if (not x-select-enable-clipboard)
+ (setq x-last-selected-text-clipboard nil)
+ (x-set-selection 'CLIPBOARD text)
+ (setq x-last-selected-text-clipboard text))
+ )
+
+(defun x-get-selection (&optional type data-type)
+ "Return the value of a selection.
+The argument TYPE (default `PRIMARY') says which selection,
+and the argument DATA-TYPE (default `STRING') says
+how to convert the data.
+
+TYPE may be any symbol \(but nil stands for `PRIMARY'). However,
+only a few symbols are commonly used. They conventionally have
+all upper-case names. The most often used ones, in addition to
+`PRIMARY', are `SECONDARY' and `CLIPBOARD'.
+
+DATA-TYPE is usually `STRING', but can also be one of the symbols
+in `selection-converter-alist', which see."
+ (let ((data (x-get-selection-internal (or type 'PRIMARY)
+ (or data-type 'STRING)))
+ (coding (or next-selection-coding-system
+ selection-coding-system)))
+ (when (and (stringp data)
+ (setq data-type (get-text-property 0 'foreign-selection data)))
+ (cond ((eq data-type 'public.utf16-plain-text)
+ (let ((encoded (and (fboundp 'mac-code-convert-string)
+ (mac-code-convert-string data
+ 'utf-16 coding))))
+ (if encoded
+ (let ((coding-save last-coding-system-used))
+ (setq data (decode-coding-string encoded coding))
+ (setq last-coding-system-used coding-save))
+ (setq data
+ (decode-coding-string data 'utf-16)))))
+ ((eq data-type 'com.apple.traditional-mac-plain-text)
+ (setq data (decode-coding-string data coding)))
+ ((eq data-type 'public.file-url)
+ (setq data (decode-coding-string data 'utf-8))
+ ;; Remove a trailing nul character.
+ (let ((len (length data)))
+ (if (and (> len 0) (= (aref data (1- len)) ?\0))
+ (setq data (substring data 0 (1- len)))))))
+ (put-text-property 0 (length data) 'foreign-selection data-type data))
+ data))
+
+(defun x-selection-value (type)
+ (let ((data-types '(public.utf16-plain-text
+ com.apple.traditional-mac-plain-text
+ public.file-url))
+ text tiff-image)
+ (while (and (null text) data-types)
+ (setq text (condition-case nil
+ (x-get-selection type (car data-types))
+ (error nil)))
+ (setq data-types (cdr data-types)))
+ (if text
+ (remove-text-properties 0 (length text) '(foreign-selection nil) text))
+ (setq tiff-image (condition-case nil
+ (x-get-selection type 'public.tiff)
+ (error nil)))
+ (when tiff-image
+ (remove-text-properties 0 (length tiff-image)
+ '(foreign-selection nil) tiff-image)
+ (setq tiff-image (create-image tiff-image 'tiff t))
+ (or text (setq text " "))
+ (put-text-property 0 (length text) 'display tiff-image text))
+ text))
+
+;;; Return the value of the current selection.
+;;; Treat empty strings as if they were unset.
+;;; If this function is called twice and finds the same text,
+;;; it returns nil the second time. This is so that a single
+;;; selection won't be added to the kill ring over and over.
+(defun x-get-selection-value ()
+ (let (clip-text primary-text)
+ (if (not x-select-enable-clipboard)
+ (setq x-last-selected-text-clipboard nil)
+ (setq clip-text (x-selection-value 'CLIPBOARD))
+ (if (string= clip-text "") (setq clip-text nil))
+
+ ;; Check the CLIPBOARD selection for 'newness', is it different
+ ;; from what we remebered them to be last time we did a
+ ;; cut/paste operation.
+ (setq clip-text
+ (cond;; check clipboard
+ ((or (not clip-text) (string= clip-text ""))
+ (setq x-last-selected-text-clipboard nil))
+ ((eq clip-text x-last-selected-text-clipboard) nil)
+ ((string= clip-text x-last-selected-text-clipboard)
+ ;; Record the newer string,
+ ;; so subsequent calls can use the `eq' test.
+ (setq x-last-selected-text-clipboard clip-text)
+ nil)
+ (t
+ (setq x-last-selected-text-clipboard clip-text))))
+ )
+
+ (setq primary-text (x-selection-value 'PRIMARY))
+ ;; Check the PRIMARY selection for 'newness', is it different
+ ;; from what we remebered them to be last time we did a
+ ;; cut/paste operation.
+ (setq primary-text
+ (cond;; check primary selection
+ ((or (not primary-text) (string= primary-text ""))
+ (setq x-last-selected-text-primary nil))
+ ((eq primary-text x-last-selected-text-primary) nil)
+ ((string= primary-text x-last-selected-text-primary)
+ ;; Record the newer string,
+ ;; so subsequent calls can use the `eq' test.
+ (setq x-last-selected-text-primary primary-text)
+ nil)
+ (t
+ (setq x-last-selected-text-primary primary-text))))
+
+ ;; As we have done one selection, clear this now.
+ (setq next-selection-coding-system nil)
+
+ ;; At this point we have recorded the current values for the
+ ;; selection from clipboard (if we are supposed to) and primary,
+ ;; So return the first one that has changed (which is the first
+ ;; non-null one).
+ (or clip-text primary-text)
+ ))
+
+(put 'CLIPBOARD 'mac-scrap-name "com.apple.scrap.clipboard")
+(when (eq system-type 'darwin)
+ (put 'FIND 'mac-scrap-name "com.apple.scrap.find")
+ (put 'PRIMARY 'mac-scrap-name
+ (format "org.gnu.Emacs.%d.selection.PRIMARY" (emacs-pid))))
+(put 'com.apple.traditional-mac-plain-text 'mac-ostype "TEXT")
+(put 'public.utf16-plain-text 'mac-ostype "utxt")
+(put 'public.tiff 'mac-ostype "TIFF")
+(put 'public.file-url 'mac-ostype "furl")
+
+(defun mac-select-convert-to-string (selection type value)
+ (let ((str (cdr (xselect-convert-to-string selection nil value)))
+ coding)
+ (setq coding (or next-selection-coding-system selection-coding-system))
+ (if coding
+ (setq coding (coding-system-base coding))
+ (setq coding 'raw-text))
+ (when str
+ ;; If TYPE is nil, this is a local request, thus return STR as
+ ;; is. Otherwise, encode STR.
+ (if (not type)
+ str
+ (let ((inhibit-read-only t))
+ (remove-text-properties 0 (length str) '(composition nil) str)
+ (cond
+ ((eq type 'public.utf16-plain-text)
+ (let (s)
+ (when (and (fboundp 'mac-code-convert-string)
+ (memq coding (find-coding-systems-string str)))
+ (setq coding (coding-system-change-eol-conversion coding 'mac))
+ (setq s (mac-code-convert-string
+ (encode-coding-string str coding)
+ coding 'utf-16)))
+ (setq str (or s (encode-coding-string str 'utf-16-mac)))))
+ ((eq type 'com.apple.traditional-mac-plain-text)
+ (let ((encodables (find-coding-systems-string str))
+ (rest mac-script-code-coding-systems))
+ (unless (memq coding encodables)
+ (while (and rest (not (memq (cdar rest) encodables)))
+ (setq rest (cdr rest)))
+ (if rest
+ (setq coding (cdar rest)))))
+ (setq coding (coding-system-change-eol-conversion coding 'mac))
+ (setq str (encode-coding-string str coding)))
+ (t
+ (error "Unknown selection type: %S" type))
+ )))
+
+ (setq next-selection-coding-system nil)
+ (cons type str))))
+
+(defun mac-select-convert-to-file-url (selection type value)
+ (let ((filename (xselect-convert-to-filename selection type value))
+ (coding (or file-name-coding-system default-file-name-coding-system)))
+ (if (and filename coding)
+ (setq filename (encode-coding-string filename coding)))
+ (and filename
+ (concat "file://localhost"
+ (mapconcat 'url-hexify-string
+ (split-string filename "/") "/")))))
+
+(setq selection-converter-alist
+ (nconc
+ '((public.utf16-plain-text . mac-select-convert-to-string)
+ (com.apple.traditional-mac-plain-text . mac-select-convert-to-string)
+ ;; This is not enabled by default because the `Import Image'
+ ;; menu makes Emacs crash or hang for unknown reasons.
+ ;; (public.tiff . nil)
+ (public.file-url . mac-select-convert-to-file-url)
+ )
+ selection-converter-alist))
+
+(defun mac-services-open-file ()
+ (interactive)
+ (find-file-existing (x-selection-value mac-services-selection)))
+
+(defun mac-services-open-selection ()
+ (interactive)
+ (switch-to-buffer (generate-new-buffer "*untitled*"))
+ (insert (x-selection-value mac-services-selection))
+ (sit-for 0)
+ (save-buffer) ; It pops up the save dialog.
+ )
+
+(defun mac-services-mail-selection ()
+ (interactive)
+ (compose-mail)
+ (rfc822-goto-eoh)
+ (forward-line 1)
+ (insert (x-selection-value mac-services-selection) "\n"))
+
+(defun mac-services-mail-to ()
+ (interactive)
+ (compose-mail (x-selection-value mac-services-selection)))
+
+(defun mac-services-insert-text ()
+ (interactive)
+ (let ((text (x-selection-value mac-services-selection)))
+ (if (not buffer-read-only)
+ (insert text)
+ (kill-new text)
+ (message
+ (substitute-command-keys
+ "The text from the Services menu can be accessed with \\[yank]")))))
+
+(defvar mac-application-menu-map (make-sparse-keymap))
+(define-key mac-application-menu-map [quit] 'save-buffers-kill-emacs)
+(define-key mac-application-menu-map [services perform open-file]
+ 'mac-services-open-file)
+(define-key mac-application-menu-map [services perform open-selection]
+ 'mac-services-open-selection)
+(define-key mac-application-menu-map [services perform mail-selection]
+ 'mac-services-mail-selection)
+(define-key mac-application-menu-map [services perform mail-to]
+ 'mac-services-mail-to)
+(define-key mac-application-menu-map [services paste]
+ 'mac-services-insert-text)
+(define-key mac-application-menu-map [preferences] 'customize)
+(define-key mac-application-menu-map [about] 'display-splash-screen)
+(global-set-key [menu-bar application] mac-application-menu-map)
\f
;;; Do the actual Windows setup here; the above code just defines
;;; functions and variables that we use now.
(char-table-extra-slot translation-table 0)))
(let
- ((encoding-vector
+ ((encoding-vector
(vconcat
(make-vector 32 nil)
;; mac-dingbats (32..126) -> emacs-mule mapping
(if mac-encoded
(aset table c mac-encoded))))))))
+;; We assume none of official dim2 charsets (0x90..0x99) are encoded
+;; to these fonts.
+
(define-ccl-program ccl-encode-mac-roman-font
`(0
- (if (r0 != ,(charset-id 'ascii))
- (if (r0 <= ?\x8f)
- (translate-character mac-roman-encoder r0 r1)
- ((r1 <<= 7)
- (r1 |= r2)
- (translate-character mac-roman-encoder r0 r1)))))
+ (if (r0 <= ?\xef)
+ (translate-character mac-roman-encoder r0 r1)
+ ((r1 <<= 7)
+ (r1 |= r2)
+ (translate-character mac-roman-encoder r0 r1))))
"CCL program for Mac Roman font")
(define-ccl-program ccl-encode-mac-centraleurroman-font
`(0
- (if (r0 != ,(charset-id 'ascii))
- (if (r0 <= ?\x8f)
- (translate-character encode-mac-centraleurroman r0 r1)
- ((r1 <<= 7)
- (r1 |= r2)
- (translate-character encode-mac-centraleurroman r0 r1)))))
+ (if (r0 <= ?\xef)
+ (translate-character encode-mac-centraleurroman r0 r1)
+ ((r1 <<= 7)
+ (r1 |= r2)
+ (translate-character encode-mac-centraleurroman r0 r1))))
"CCL program for Mac Central European Roman font")
(define-ccl-program ccl-encode-mac-cyrillic-font
`(0
- (if (r0 != ,(charset-id 'ascii))
- (if (r0 <= ?\x8f)
- (translate-character encode-mac-cyrillic r0 r1)
- ((r1 <<= 7)
- (r1 |= r2)
- (translate-character encode-mac-cyrillic r0 r1)))))
+ (if (r0 <= ?\xef)
+ (translate-character encode-mac-cyrillic r0 r1)
+ ((r1 <<= 7)
+ (r1 |= r2)
+ (translate-character encode-mac-cyrillic r0 r1))))
"CCL program for Mac Cyrillic font")
(define-ccl-program ccl-encode-mac-symbol-font
`(0
- (if (r0 != ,(charset-id 'ascii))
- (if (r0 <= ?\x8f)
- (translate-character mac-symbol-encoder r0 r1)
- ((r1 <<= 7)
- (r1 |= r2)
- (translate-character mac-symbol-encoder r0 r1)))))
+ (if (r0 <= ?\xef)
+ (translate-character mac-symbol-encoder r0 r1)
+ ((r1 <<= 7)
+ (r1 |= r2)
+ (translate-character mac-symbol-encoder r0 r1))))
"CCL program for Mac Symbol font")
(define-ccl-program ccl-encode-mac-dingbats-font
`(0
- (if (r0 != ,(charset-id 'ascii))
- (if (r0 <= ?\x8f)
- (translate-character mac-dingbats-encoder r0 r1)
- ((r1 <<= 7)
- (r1 |= r2)
- (translate-character mac-dingbats-encoder r0 r1)))))
+ (if (r0 <= ?\xef)
+ (translate-character mac-dingbats-encoder r0 r1)
+ ((r1 <<= 7)
+ (r1 |= r2)
+ (translate-character mac-dingbats-encoder r0 r1))))
"CCL program for Mac Dingbats font")
mac-font-encoder-list)
font-ccl-encoder-alist))
+(defconst mac-char-fontspec-list
+ ;; Directly operate on a char-table instead of a fontset so that it
+ ;; may not create a dummy fontset.
+ (let ((template (make-char-table 'fontset)))
+ (dolist
+ (font-encoder
+ (nreverse
+ (mapcar (lambda (lst)
+ (cons (cons (nth 3 lst) (nth 0 lst)) (nth 1 lst)))
+ mac-font-encoder-list)))
+ (let ((font (car font-encoder))
+ (encoder (cdr font-encoder)))
+ (map-char-table
+ (lambda (key val)
+ (or (null val)
+ (generic-char-p key)
+ (memq (char-charset key)
+ '(ascii eight-bit-control eight-bit-graphic))
+ (aset template key font)))
+ (get encoder 'translation-table))))
+
+ ;; Like fontset-info, but extend a range only if its "to" part is
+ ;; the predecessor of the current char.
+ (let* ((last '((0 nil)))
+ (accumulator last)
+ last-char-or-range last-char last-elt)
+ (map-char-table
+ (lambda (char elt)
+ (when elt
+ (setq last-char-or-range (car (car last))
+ last-char (if (consp last-char-or-range)
+ (cdr last-char-or-range)
+ last-char-or-range)
+ last-elt (cdr (car last)))
+ (if (and (eq elt last-elt)
+ (= char (1+ last-char))
+ (eq (char-charset char) (char-charset last-char)))
+ (if (consp last-char-or-range)
+ (setcdr last-char-or-range char)
+ (setcar (car last) (cons last-char char)))
+ (setcdr last (list (cons char elt)))
+ (setq last (cdr last)))))
+ template)
+ (cdr accumulator))))
+
(defun fontset-add-mac-fonts (fontset &optional base-family)
+ "Add font-specs for Mac fonts to FONTSET.
+The added font-specs are determined by BASE-FAMILY and the value
+of `mac-char-fontspec-list', which is a list
+of (CHARACTER-OR-RANGE . (FAMILY-FORMAT . REGISTRY)). If
+BASE-FAMILY is nil, the font family in the added font-specs is
+also nil. If BASE-FAMILY is a string, `%s' in FAMILY-FORMAT is
+replaced with the string. Otherwise, `%s' in FAMILY-FORMAT is
+replaced with the ASCII font family name in FONTSET."
(if base-family
- (setq base-family (downcase base-family))
- (let ((ascii-font
- (downcase (x-resolve-font-name
- (fontset-font fontset (charset-id 'ascii))))))
- (setq base-family (aref (x-decompose-font-name ascii-font)
- xlfd-regexp-family-subnum))))
-;; (if (not (string-match "^fontset-" fontset))
-;; (setq fontset
-;; (concat "fontset-" (aref (x-decompose-font-name fontset)
-;; xlfd-regexp-encoding-subnum))))
- (dolist
- (font-encoder
- (nreverse
- (mapcar (lambda (lst)
- (cons (cons (format (nth 3 lst) base-family) (nth 0 lst))
- (nth 1 lst)))
- mac-font-encoder-list)))
- (let ((font (car font-encoder))
- (encoder (cdr font-encoder)))
- (map-char-table
- (lambda (key val)
- (or (null val)
- (generic-char-p key)
- (memq (char-charset key)
- '(ascii eight-bit-control eight-bit-graphic))
- (set-fontset-font fontset key font)))
- (get encoder 'translation-table)))))
-
+ (if (stringp base-family)
+ (setq base-family (downcase base-family))
+ (let ((ascii-font (fontset-font fontset (charset-id 'ascii))))
+ (if ascii-font
+ (setq base-family
+ (aref (x-decompose-font-name
+ (downcase (x-resolve-font-name ascii-font)))
+ xlfd-regexp-family-subnum))))))
+ (let (fontspec-cache fontspec)
+ (dolist (char-fontspec mac-char-fontspec-list)
+ (setq fontspec (cdr (assq (cdr char-fontspec) fontspec-cache)))
+ (when (null fontspec)
+ (setq fontspec
+ (cons (and base-family
+ (format (car (cdr char-fontspec)) base-family))
+ (cdr (cdr char-fontspec))))
+ (setq fontspec-cache (cons (cons (cdr char-fontspec) fontspec)
+ fontspec-cache)))
+ (set-fontset-font fontset (car char-fontspec) fontspec))))
+
(defun create-fontset-from-mac-roman-font (font &optional resolved-font
fontset-name)
"Create a fontset from a Mac roman font FONT.
It returns a name of the created fontset."
(let ((fontset
(create-fontset-from-ascii-font font resolved-font fontset-name)))
- (fontset-add-mac-fonts fontset)
+ (fontset-add-mac-fonts fontset t)
fontset))
;; Setup the default fontset.
(setup-default-fontset)
+;; Add Mac-encoding fonts unless ETL fonts are installed.
+(unless (x-list-fonts "*-iso8859-1")
+ (fontset-add-mac-fonts "fontset-default"))
;; Create a fontset that uses mac-roman font. With this fontset,
;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,
(create-fontset-from-fontset-spec
"-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
-(fontset-add-mac-fonts "fontset-mac")
+(fontset-add-mac-fonts "fontset-mac" t)
;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
(create-fontset-from-x-resource)
(error "Suspending an Emacs running under Mac makes no sense"))
(add-hook 'suspend-hook 'x-win-suspend-error)
+;;; Arrange for the kill and yank functions to set and check the clipboard.
+(setq interprogram-cut-function 'x-select-text)
+(setq interprogram-paste-function 'x-get-selection-value)
+
+(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value)
+
+;;; Turn off window-splitting optimization; Mac is usually fast enough
+;;; that this is only annoying.
+(setq split-window-keep-point t)
+
;; Don't show the frame name; that's redundant.
(setq-default mode-line-frame-identification " ")
;; Turn on support for mouse wheels.
(mouse-wheel-mode 1)
+
+;; Enable CLIPBOARD copy/paste through menu bar commands.
+(menu-bar-enable-clipboard)
+
(defun mac-drag-n-drop (event)
"Edit the files listed in the drag-n-drop EVENT.
Switch to a buffer editing the last file dropped."
'(lambda ()
(defvar mac-ready-for-drag-n-drop t)))
\f
-;;;; Scroll bars
+;;;; Non-toolkit Scroll bars
+
+(unless x-toolkit-scroll-bars
;; for debugging
;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
(mac-scroll-ignore-events)
(scroll-up 1)))
+)
\f
;;;; Others