Mercurial > emacs
view lisp/term/mac-win.el @ 32961:5357dbf00515
2000-10-26 Simon Josefsson <sj@extundo.com>
* mail-source.el (mail-sources): IMAP predicate is a string.
(mail-sources): Add default values for IMAP mailbox, predicate and
fetchflag.
author | Dave Love <fx@gnu.org> |
---|---|
date | Fri, 27 Oct 2000 16:31:57 +0000 |
parents | 3d21222bc794 |
children | a72416fbef44 |
line wrap: on
line source
;;; mac-win.el --- support for "Macintosh windows". ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Andrew Choi <akochoi@i-cable.com> ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; 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. ;;; Code: ;; --------------------------------------------------------------------------- ;; We want to delay setting frame parameters until the faces are setup ;; Mac can't handle ~ prefix in file names ;(setq auto-save-list-file-prefix ".saves-") (setq frame-creation-function 'x-create-frame-with-faces) ;; for debugging ;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event)) ;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event) (global-set-key [vertical-scroll-bar down-mouse-1] 'mac-handle-scroll-bar-event) (global-unset-key [vertical-scroll-bar drag-mouse-1]) (global-unset-key [vertical-scroll-bar mouse-1]) (defun mac-handle-scroll-bar-event (event) "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling." (interactive "e") (let* ((position (event-start event)) (window (nth 0 position)) (bar-part (nth 4 position))) (select-window window) (cond ((eq bar-part 'up) (goto-char (window-start window)) (mac-scroll-down-line)) ((eq bar-part 'above-handle) (mac-scroll-down)) ((eq bar-part 'handle) (scroll-bar-drag event)) ((eq bar-part 'below-handle) (mac-scroll-up)) ((eq bar-part 'down) (goto-char (window-start window)) (mac-scroll-up-line))))) (defun mac-scroll-down () (track-mouse (while (not (eq (car-safe (read-event)) 'mouse-1)) nil) (scroll-down))) (defun mac-scroll-down-line () (track-mouse (while (not (eq (car-safe (read-event)) 'mouse-1)) nil) (scroll-down 1))) (defun mac-scroll-up () (track-mouse (while (not (eq (car-safe (read-event)) 'mouse-1)) nil) (scroll-up))) (defun mac-scroll-up-line () (track-mouse (while (not (eq (car-safe (read-event)) 'mouse-1)) nil) (scroll-up 1))) (defun xw-defined-colors (&optional frame) "Internal function called by `defined-colors', which see." (or frame (setq frame (selected-frame))) (let ((all-colors x-colors) (this-color nil) (defined-colors nil)) (while all-colors (setq this-color (car all-colors) all-colors (cdr all-colors)) (and (color-supported-p this-color frame t) (setq defined-colors (cons this-color defined-colors)))) defined-colors)) ;; Don't have this yet. (fset 'x-get-resource 'ignore) ;; Use Lisp verison of ls instead of calling subprocess on ls (faster, ;; don't need to write ls). (load "ls-lisp") (require 'dired) ;; This variable specifies the Unix program to call (as a process) to ;; deteremine the amount of free space on a file system (defaults to ;; df). If it is not set to nil, ls-lisp will not work correctly ;; unless an external application df is implemented on the Mac. (setq dired-free-space-program nil) ;; Set this so that Emacs calls subprocesses with "sh" as shell to ;; expand filenames Note no subprocess for the shell is actually ;; started (see run_mac_command in sysdep.c). (setq shell-file-name "sh") ;; X Window emulation in macterm.c is not complete enough to start a ;; frame without a minibuffer properly. Call this to tell ediff ;; library to use a single frame. (ediff-toggle-multiframe) ;; 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 () (decode-coding-string (mac-paste-function) selection-coding-system t))) (defun mac-drag-n-drop (event) "Edit the files listed in the drag-n-drop event.\n\ Switch to a buffer editing the last file dropped." (interactive "e") (save-excursion ;; Make sure the drop target has positive co-ords ;; before setting the selected frame - otherwise it ;; won't work. <skx@tardis.ed.ac.uk> (let* ((window (posn-window (event-start event))) (coords (posn-x-y (event-start event))) (x (car coords)) (y (cdr coords))) (if (and (> x 0) (> y 0)) (set-frame-selected-window nil window)) (mapcar 'find-file (car (cdr (cdr event))))) (raise-frame) (recenter))) (global-set-key [drag-n-drop] 'mac-drag-n-drop) ;; By checking whether the variable mac-ready-for-drag-n-drop has been ;; defined, the event loop in macterm.c can be informed that it can ;; now receive Finder drag and drop events. Files dropped onto the ;; Emacs application icon can only be processed when the initial frame ;; has been created: this is where the files should be opened. (add-hook 'after-init-hook '(lambda () (defvar mac-ready-for-drag-n-drop t))) ; Define constant values to be set to mac-keyboard-text-encoding (defconst kTextEncodingMacRoman 0) (defconst kTextEncodingISOLatin1 513 "0x201") (defconst kTextEncodingISOLatin2 514 "0x202") ;; Definitions for the Mac Roman character sets and coding system. ;; The Mac Roman encoding uses all 128 code points in the range 128 to ;; 255 for actual characters. Since Emacs cannot handle this many ;; code points as one character set, we divide it into two: ;; mac-roman-lower for code points 128 to 159 and mac-roman-upper for ;; code points 160 to 255. ;; Since Mac Roman does not follow the ISO 2022 standard and uses code ;; points in the range 128-159, it is necessary to define it as a ;; type-4 charset, with CCL programs and all. (define-ccl-program decode-mac-roman `(2 ((loop (read r0) (if (r0 < 128) ;; ASCII (if (r0 == ?\r) ;; assume such a file uses Mac EOL's (write-repeat ?\n) (write-repeat r0)) (if (r0 < 160) ;; lower ((r0 += 32) (r1 = ,(charset-id 'mac-roman-lower)) (write-multibyte-character r1 r0) (repeat)) ((r1 = ,(charset-id 'mac-roman-upper)) ;; upper (write-multibyte-character r1 r0) (repeat))))))) "CCL program to decode Mac Roman") (define-ccl-program encode-mac-roman `(1 ((loop (read-multibyte-character r0 r1) (if (r0 == ,(charset-id 'ascii)) (if (r1 == ?\n) (write-repeat ?\r) (write-repeat r1)) (if (r0 == ,(charset-id 'mac-roman-lower)) ((r1 += 96) (write-repeat r1)) (if (r0 == ,(charset-id 'mac-roman-upper)) ((r1 += 128) (write-repeat r1)))))))) "CCL program to encode Mac Roman") (make-coding-system 'mac-roman 4 ?M "Mac Roman Encoding" '(decode-mac-roman . encode-mac-roman) '((safe-charsets ascii mac-roman-lower mac-roman-upper) (valid codes (0 . 255)))) ;; This doesn't seem to do anything for type-4 charsets: ;; (put 'mac-roman 'eol-type (make-subsidiary-coding-system 'mac-roman)) (define-ccl-program ccl-encode-mac-roman-font `(0 (if (r0 == ,(charset-id 'mac-roman-lower)) (r1 += 96) (r1 += 128)))) (setq font-ccl-encoder-alist (cons '("mac-roman" . ccl-encode-mac-roman-font) font-ccl-encoder-alist)) (if (fboundp 'new-fontset) (progn (create-fontset-from-fontset-spec "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac, mac-roman-lower:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman, mac-roman-upper:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman" t))) ;; To display filenames in Chinese or Japanese, replace mac-roman with ;; big5 or sjis (setq file-name-coding-system 'mac-roman) ;; (prefer-coding-system 'mac-roman) (defun mac-roman-kbd-insert () "Insert a character in Mac Roman encoding at point.\n\ Called by keymap of Mac-kbd minor mode." (interactive "*") (let ((ch last-command-char)) (if (< ch 160) (insert (make-char 'mac-roman-lower (- last-command-char 96))) (insert (make-char 'mac-roman-upper (- last-command-char 128)))))) (defvar mac-roman-kbd-mode nil "Non-nil if in Mac-kbd minor mode.") (put 'mac-roman-kbd-mode 'permanent-local t) (or (assq 'mac-roman-kbd-mode minor-mode-alist) (setq minor-mode-alist (cons '(mac-roman-kbd-mode " Mac-kbd") minor-mode-alist))) (defvar mac-roman-kbd-mode-map (let ((map (make-keymap)) (i 128)) (while (< i 256) (define-key map (vector i) 'mac-roman-kbd-insert) (setq i (1+ i))) map) "Keymap for Mac-kbd minor mode.") (or (assq 'mac-roman-kbd-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'mac-roman-kbd-mode mac-roman-kbd-mode-map) minor-mode-map-alist))) (defun mac-roman-kbd-mode (&optional arg) "Toggle Mac Roman Keyboard (Mac-kbd) minor mode.\n\ In this minor mode, characters in the range 128 to 255 generated by\n\ the Mac keyboard are inserted as mac-roman-lower or mac-roman-upper\n\ characters, in the mac-roman encoding.\n\ \n\ With an argument, a positive argument enables Mac Roman Keyboard mode,\n\ and a negative argument disables it." (interactive "P") (if (if arg ;; Negative arg means switch it off. (<= (prefix-numeric-value arg) 0) ;; No arg means toggle. mac-roman-kbd-mode) (setq mac-roman-kbd-mode nil) ;; Enable mode. (setq mac-roman-kbd-mode t))) ;; ;; Available colors ;; (defvar x-colors '("LightGreen" "light green" "DarkRed" "dark red" "DarkMagenta" "dark magenta" "DarkCyan" "dark cyan" "DarkBlue" "dark blue" "DarkGray" "dark gray" "DarkGrey" "dark grey" "grey100" "gray100" "grey99" "gray99" "grey98" "gray98" "grey97" "gray97" "grey96" "gray96" "grey95" "gray95" "grey94" "gray94" "grey93" "gray93" "grey92" "gray92" "grey91" "gray91" "grey90" "gray90" "grey89" "gray89" "grey88" "gray88" "grey87" "gray87" "grey86" "gray86" "grey85" "gray85" "grey84" "gray84" "grey83" "gray83" "grey82" "gray82" "grey81" "gray81" "grey80" "gray80" "grey79" "gray79" "grey78" "gray78" "grey77" "gray77" "grey76" "gray76" "grey75" "gray75" "grey74" "gray74" "grey73" "gray73" "grey72" "gray72" "grey71" "gray71" "grey70" "gray70" "grey69" "gray69" "grey68" "gray68" "grey67" "gray67" "grey66" "gray66" "grey65" "gray65" "grey64" "gray64" "grey63" "gray63" "grey62" "gray62" "grey61" "gray61" "grey60" "gray60" "grey59" "gray59" "grey58" "gray58" "grey57" "gray57" "grey56" "gray56" "grey55" "gray55" "grey54" "gray54" "grey53" "gray53" "grey52" "gray52" "grey51" "gray51" "grey50" "gray50" "grey49" "gray49" "grey48" "gray48" "grey47" "gray47" "grey46" "gray46" "grey45" "gray45" "grey44" "gray44" "grey43" "gray43" "grey42" "gray42" "grey41" "gray41" "grey40" "gray40" "grey39" "gray39" "grey38" "gray38" "grey37" "gray37" "grey36" "gray36" "grey35" "gray35" "grey34" "gray34" "grey33" "gray33" "grey32" "gray32" "grey31" "gray31" "grey30" "gray30" "grey29" "gray29" "grey28" "gray28" "grey27" "gray27" "grey26" "gray26" "grey25" "gray25" "grey24" "gray24" "grey23" "gray23" "grey22" "gray22" "grey21" "gray21" "grey20" "gray20" "grey19" "gray19" "grey18" "gray18" "grey17" "gray17" "grey16" "gray16" "grey15" "gray15" "grey14" "gray14" "grey13" "gray13" "grey12" "gray12" "grey11" "gray11" "grey10" "gray10" "grey9" "gray9" "grey8" "gray8" "grey7" "gray7" "grey6" "gray6" "grey5" "gray5" "grey4" "gray4" "grey3" "gray3" "grey2" "gray2" "grey1" "gray1" "grey0" "gray0" "thistle4" "thistle3" "thistle2" "thistle1" "MediumPurple4" "MediumPurple3" "MediumPurple2" "MediumPurple1" "purple4" "purple3" "purple2" "purple1" "DarkOrchid4" "DarkOrchid3" "DarkOrchid2" "DarkOrchid1" "MediumOrchid4" "MediumOrchid3" "MediumOrchid2" "MediumOrchid1" "plum4" "plum3" "plum2" "plum1" "orchid4" "orchid3" "orchid2" "orchid1" "magenta4" "magenta3" "magenta2" "magenta1" "VioletRed4" "VioletRed3" "VioletRed2" "VioletRed1" "maroon4" "maroon3" "maroon2" "maroon1" "PaleVioletRed4" "PaleVioletRed3" "PaleVioletRed2" "PaleVioletRed1" "LightPink4" "LightPink3" "LightPink2" "LightPink1" "pink4" "pink3" "pink2" "pink1" "HotPink4" "HotPink3" "HotPink2" "HotPink1" "DeepPink4" "DeepPink3" "DeepPink2" "DeepPink1" "red4" "red3" "red2" "red1" "OrangeRed4" "OrangeRed3" "OrangeRed2" "OrangeRed1" "tomato4" "tomato3" "tomato2" "tomato1" "coral4" "coral3" "coral2" "coral1" "DarkOrange4" "DarkOrange3" "DarkOrange2" "DarkOrange1" "orange4" "orange3" "orange2" "orange1" "LightSalmon4" "LightSalmon3" "LightSalmon2" "LightSalmon1" "salmon4" "salmon3" "salmon2" "salmon1" "brown4" "brown3" "brown2" "brown1" "firebrick4" "firebrick3" "firebrick2" "firebrick1" "chocolate4" "chocolate3" "chocolate2" "chocolate1" "tan4" "tan3" "tan2" "tan1" "wheat4" "wheat3" "wheat2" "wheat1" "burlywood4" "burlywood3" "burlywood2" "burlywood1" "sienna4" "sienna3" "sienna2" "sienna1" "IndianRed4" "IndianRed3" "IndianRed2" "IndianRed1" "RosyBrown4" "RosyBrown3" "RosyBrown2" "RosyBrown1" "DarkGoldenrod4" "DarkGoldenrod3" "DarkGoldenrod2" "DarkGoldenrod1" "goldenrod4" "goldenrod3" "goldenrod2" "goldenrod1" "gold4" "gold3" "gold2" "gold1" "yellow4" "yellow3" "yellow2" "yellow1" "LightYellow4" "LightYellow3" "LightYellow2" "LightYellow1" "LightGoldenrod4" "LightGoldenrod3" "LightGoldenrod2" "LightGoldenrod1" "khaki4" "khaki3" "khaki2" "khaki1" "DarkOliveGreen4" "DarkOliveGreen3" "DarkOliveGreen2" "DarkOliveGreen1" "OliveDrab4" "OliveDrab3" "OliveDrab2" "OliveDrab1" "chartreuse4" "chartreuse3" "chartreuse2" "chartreuse1" "green4" "green3" "green2" "green1" "SpringGreen4" "SpringGreen3" "SpringGreen2" "SpringGreen1" "PaleGreen4" "PaleGreen3" "PaleGreen2" "PaleGreen1" "SeaGreen4" "SeaGreen3" "SeaGreen2" "SeaGreen1" "DarkSeaGreen4" "DarkSeaGreen3" "DarkSeaGreen2" "DarkSeaGreen1" "aquamarine4" "aquamarine3" "aquamarine2" "aquamarine1" "DarkSlateGray4" "DarkSlateGray3" "DarkSlateGray2" "DarkSlateGray1" "cyan4" "cyan3" "cyan2" "cyan1" "turquoise4" "turquoise3" "turquoise2" "turquoise1" "CadetBlue4" "CadetBlue3" "CadetBlue2" "CadetBlue1" "PaleTurquoise4" "PaleTurquoise3" "PaleTurquoise2" "PaleTurquoise1" "LightCyan4" "LightCyan3" "LightCyan2" "LightCyan1" "LightBlue4" "LightBlue3" "LightBlue2" "LightBlue1" "LightSteelBlue4" "LightSteelBlue3" "LightSteelBlue2" "LightSteelBlue1" "SlateGray4" "SlateGray3" "SlateGray2" "SlateGray1" "LightSkyBlue4" "LightSkyBlue3" "LightSkyBlue2" "LightSkyBlue1" "SkyBlue4" "SkyBlue3" "SkyBlue2" "SkyBlue1" "DeepSkyBlue4" "DeepSkyBlue3" "DeepSkyBlue2" "DeepSkyBlue1" "SteelBlue4" "SteelBlue3" "SteelBlue2" "SteelBlue1" "DodgerBlue4" "DodgerBlue3" "DodgerBlue2" "DodgerBlue1" "blue4" "blue3" "blue2" "blue1" "RoyalBlue4" "RoyalBlue3" "RoyalBlue2" "RoyalBlue1" "SlateBlue4" "SlateBlue3" "SlateBlue2" "SlateBlue1" "azure4" "azure3" "azure2" "azure1" "MistyRose4" "MistyRose3" "MistyRose2" "MistyRose1" "LavenderBlush4" "LavenderBlush3" "LavenderBlush2" "LavenderBlush1" "honeydew4" "honeydew3" "honeydew2" "honeydew1" "ivory4" "ivory3" "ivory2" "ivory1" "cornsilk4" "cornsilk3" "cornsilk2" "cornsilk1" "LemonChiffon4" "LemonChiffon3" "LemonChiffon2" "LemonChiffon1" "NavajoWhite4" "NavajoWhite3" "NavajoWhite2" "NavajoWhite1" "PeachPuff4" "PeachPuff3" "PeachPuff2" "PeachPuff1" "bisque4" "bisque3" "bisque2" "bisque1" "AntiqueWhite4" "AntiqueWhite3" "AntiqueWhite2" "AntiqueWhite1" "seashell4" "seashell3" "seashell2" "seashell1" "snow4" "snow3" "snow2" "snow1" "thistle" "MediumPurple" "medium purple" "purple" "BlueViolet" "blue violet" "DarkViolet" "dark violet" "DarkOrchid" "dark orchid" "MediumOrchid" "medium orchid" "orchid" "plum" "violet" "magenta" "VioletRed" "violet red" "MediumVioletRed" "medium violet red" "maroon" "PaleVioletRed" "pale violet red" "LightPink" "light pink" "pink" "DeepPink" "deep pink" "HotPink" "hot pink" "red" "OrangeRed" "orange red" "tomato" "LightCoral" "light coral" "coral" "DarkOrange" "dark orange" "orange" "LightSalmon" "light salmon" "salmon" "DarkSalmon" "dark salmon" "brown" "firebrick" "chocolate" "tan" "SandyBrown" "sandy brown" "wheat" "beige" "burlywood" "peru" "sienna" "SaddleBrown" "saddle brown" "IndianRed" "indian red" "RosyBrown" "rosy brown" "DarkGoldenrod" "dark goldenrod" "goldenrod" "LightGoldenrod" "light goldenrod" "gold" "yellow" "LightYellow" "light yellow" "LightGoldenrodYellow" "light goldenrod yellow" "PaleGoldenrod" "pale goldenrod" "khaki" "DarkKhaki" "dark khaki" "OliveDrab" "olive drab" "ForestGreen" "forest green" "YellowGreen" "yellow green" "LimeGreen" "lime green" "GreenYellow" "green yellow" "MediumSpringGreen" "medium spring green" "chartreuse" "green" "LawnGreen" "lawn green" "SpringGreen" "spring green" "PaleGreen" "pale green" "LightSeaGreen" "light sea green" "MediumSeaGreen" "medium sea green" "SeaGreen" "sea green" "DarkSeaGreen" "dark sea green" "DarkOliveGreen" "dark olive green" "DarkGreen" "dark green" "aquamarine" "MediumAquamarine" "medium aquamarine" "CadetBlue" "cadet blue" "LightCyan" "light cyan" "cyan" "turquoise" "MediumTurquoise" "medium turquoise" "DarkTurquoise" "dark turquoise" "PaleTurquoise" "pale turquoise" "PowderBlue" "powder blue" "LightBlue" "light blue" "LightSteelBlue" "light steel blue" "SteelBlue" "steel blue" "LightSkyBlue" "light sky blue" "SkyBlue" "sky blue" "DeepSkyBlue" "deep sky blue" "DodgerBlue" "dodger blue" "blue" "RoyalBlue" "royal blue" "MediumBlue" "medium blue" "LightSlateBlue" "light slate blue" "MediumSlateBlue" "medium slate blue" "SlateBlue" "slate blue" "DarkSlateBlue" "dark slate blue" "CornflowerBlue" "cornflower blue" "NavyBlue" "navy blue" "navy" "MidnightBlue" "midnight blue" "LightGray" "light gray" "LightGrey" "light grey" "grey" "gray" "LightSlateGrey" "light slate grey" "LightSlateGray" "light slate gray" "SlateGrey" "slate grey" "SlateGray" "slate gray" "DimGrey" "dim grey" "DimGray" "dim gray" "DarkSlateGrey" "dark slate grey" "DarkSlateGray" "dark slate gray" "black" "white" "MistyRose" "misty rose" "LavenderBlush" "lavender blush" "lavender" "AliceBlue" "alice blue" "azure" "MintCream" "mint cream" "honeydew" "seashell" "LemonChiffon" "lemon chiffon" "ivory" "cornsilk" "moccasin" "NavajoWhite" "navajo white" "PeachPuff" "peach puff" "bisque" "BlanchedAlmond" "blanched almond" "PapayaWhip" "papaya whip" "AntiqueWhite" "antique white" "linen" "OldLace" "old lace" "FloralWhite" "floral white" "gainsboro" "WhiteSmoke" "white smoke" "GhostWhite" "ghost white" "snow") "The list of X colors from the `rgb.txt' file. XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") ;;; mac-win.el ends here