diff options
Diffstat (limited to 'lisp/term')
| -rw-r--r-- | lisp/term/common-win.el | 461 | ||||
| -rw-r--r-- | lisp/term/ns-win.el | 479 | ||||
| -rw-r--r-- | lisp/term/pc-win.el | 47 | ||||
| -rw-r--r-- | lisp/term/tty-colors.el | 6 | ||||
| -rw-r--r-- | lisp/term/tvi970.el | 13 | ||||
| -rw-r--r-- | lisp/term/vt100.el | 14 | ||||
| -rw-r--r-- | lisp/term/w32-win.el | 17 | ||||
| -rw-r--r-- | lisp/term/w32console.el | 4 | ||||
| -rw-r--r-- | lisp/term/x-win.el | 201 |
9 files changed, 460 insertions, 782 deletions
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el index c185e36346c..1759d601d54 100644 --- a/lisp/term/common-win.el +++ b/lisp/term/common-win.el @@ -25,54 +25,139 @@ ;;; Code: +(defcustom x-select-enable-clipboard t + "Non-nil means cutting and pasting uses the clipboard. +This is in addition to, but in preference to, the primary selection. + +Note that MS-Windows does not support selection types other than the +clipboard. (The primary selection that is set by Emacs is not +accessible to other programs on MS-Windows.) + +This variable is not used by the Nextstep port." + :type 'boolean + :group 'killing + ;; The GNU/Linux version changed in 24.1, the MS-Windows version did not. + :version "24.1") + +(defvar x-last-selected-text) ; w32-fns.el +(declare-function w32-set-clipboard-data "w32select.c" + (string &optional ignored)) +(defvar ns-last-selected-text) ; ns-win.el +(declare-function ns-set-pasteboard "ns-win" (string)) + +(defun x-select-text (text) + "Select TEXT, a string, according to the window system. + +On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the +clipboard. If `x-select-enable-primary' is non-nil, put TEXT in +the primary selection. + +On MS-Windows, make TEXT the current selection. If +`x-select-enable-clipboard' is non-nil, copy the text to the +clipboard as well. + +On Nextstep, put TEXT in the pasteboard (`x-select-enable-clipboard' +is not used)." + (cond ((eq system-type 'windows-nt) + (if x-select-enable-clipboard + (w32-set-clipboard-data text)) + (setq x-last-selected-text text)) + ((featurep 'ns) + ;; Don't send the pasteboard too much text. + ;; It becomes slow, and if really big it causes errors. + (ns-set-pasteboard text) + (setq ns-last-selected-text text)) + (t + ;; With multi-tty, this function may be called from a tty frame. + (when (eq (framep (selected-frame)) 'x) + (when x-select-enable-primary + (x-set-selection 'PRIMARY text) + (setq x-last-selected-text-primary text)) + (when x-select-enable-clipboard + (x-set-selection 'CLIPBOARD text) + (setq x-last-selected-text-clipboard text)))))) + +;;;; Function keys + +(defvar x-alternatives-map + (let ((map (make-sparse-keymap))) + ;; Map certain keypad keys into ASCII characters that people usually expect. + (define-key map [M-backspace] [?\M-\d]) + (define-key map [M-delete] [?\M-\d]) + (define-key map [M-tab] [?\M-\t]) + (define-key map [M-linefeed] [?\M-\n]) + (define-key map [M-clear] [?\M-\C-l]) + (define-key map [M-return] [?\M-\C-m]) + (define-key map [M-escape] [?\M-\e]) + (unless (featurep 'ns) + (define-key map [iso-lefttab] [backtab]) + (define-key map [S-iso-lefttab] [backtab])) + (and (or (eq system-type 'windows-nt) + (featurep 'ns)) + (define-key map [S-tab] [backtab])) + map) + "Keymap of possible alternative meanings for some keys.") + +(defun x-setup-function-keys (frame) + "Set up `function-key-map' on the graphical frame FRAME." + ;; Don't do this twice on the same display, or it would break + ;; normal-erase-is-backspace-mode. + (unless (terminal-parameter frame 'x-setup-function-keys) + ;; Map certain keypad keys into ASCII characters that people usually expect. + (with-selected-frame frame + (let ((map (copy-keymap x-alternatives-map))) + (set-keymap-parent map (keymap-parent local-function-key-map)) + (set-keymap-parent local-function-key-map map)) + (when (featurep 'ns) + (setq interprogram-cut-function 'x-select-text + interprogram-paste-function 'x-selection-value + system-key-alist + (list + ;; These are special "keys" used to pass events from C to lisp. + (cons (logior (lsh 0 16) 1) 'ns-power-off) + (cons (logior (lsh 0 16) 2) 'ns-open-file) + (cons (logior (lsh 0 16) 3) 'ns-open-temp-file) + (cons (logior (lsh 0 16) 4) 'ns-drag-file) + (cons (logior (lsh 0 16) 5) 'ns-drag-color) + (cons (logior (lsh 0 16) 6) 'ns-drag-text) + (cons (logior (lsh 0 16) 7) 'ns-change-font) + (cons (logior (lsh 0 16) 8) 'ns-open-file-line) +;;; (cons (logior (lsh 0 16) 9) 'ns-insert-working-text) +;;; (cons (logior (lsh 0 16) 10) 'ns-delete-working-text) + (cons (logior (lsh 0 16) 11) 'ns-spi-service-call) + (cons (logior (lsh 0 16) 12) 'ns-new-frame) + (cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar) + (cons (logior (lsh 0 16) 14) 'ns-show-prefs) + )))) + (set-terminal-parameter frame 'x-setup-function-keys t))) (defvar x-invocation-args) (defvar x-command-line-resources nil) ;; Handler for switches of the form "-switch value" or "-switch". -(defun x-handle-switch (switch) +(defun x-handle-switch (switch &optional numeric) (let ((aelt (assoc switch command-line-x-option-alist))) (if aelt - (let ((param (nth 3 aelt)) - (value (nth 4 aelt))) - (if value - (setq default-frame-alist - (cons (cons param value) - default-frame-alist)) - (setq default-frame-alist - (cons (cons param - (car x-invocation-args)) - default-frame-alist) - x-invocation-args (cdr x-invocation-args))))))) + (setq default-frame-alist + (cons (cons (nth 3 aelt) + (if numeric + (string-to-number (pop x-invocation-args)) + (or (nth 4 aelt) (pop x-invocation-args)))) + default-frame-alist))))) ;; Handler for switches of the form "-switch n" (defun x-handle-numeric-switch (switch) - (let ((aelt (assoc switch command-line-x-option-alist))) - (if aelt - (let ((param (nth 3 aelt))) - (setq default-frame-alist - (cons (cons param - (string-to-number (car x-invocation-args))) - default-frame-alist) - x-invocation-args - (cdr x-invocation-args)))))) + (x-handle-switch switch t)) ;; Handle options that apply to initial frame only (defun x-handle-initial-switch (switch) (let ((aelt (assoc switch command-line-x-option-alist))) (if aelt - (let ((param (nth 3 aelt)) - (value (nth 4 aelt))) - (if value - (setq initial-frame-alist - (cons (cons param value) - initial-frame-alist)) - (setq initial-frame-alist - (cons (cons param - (car x-invocation-args)) - initial-frame-alist) - x-invocation-args (cdr x-invocation-args))))))) + (setq initial-frame-alist + (cons (cons (nth 3 aelt) + (or (nth 4 aelt) (pop x-invocation-args))) + initial-frame-alist))))) ;; Make -iconic apply only to the initial frame! (defun x-handle-iconic (switch) @@ -85,15 +170,14 @@ (error "%s: missing argument to `%s' option" (invocation-name) switch)) (setq x-command-line-resources (if (null x-command-line-resources) - (car x-invocation-args) - (concat x-command-line-resources "\n" (car x-invocation-args)))) - (setq x-invocation-args (cdr x-invocation-args))) + (pop x-invocation-args) + (concat x-command-line-resources "\n" (pop x-invocation-args))))) (declare-function x-parse-geometry "frame.c" (string)) ;; Handle the geometry option (defun x-handle-geometry (switch) - (let* ((geo (x-parse-geometry (car x-invocation-args))) + (let* ((geo (x-parse-geometry (pop x-invocation-args))) (left (assq 'left geo)) (top (assq 'top geo)) (height (assq 'height geo)) @@ -114,8 +198,7 @@ (append initial-frame-alist '((user-position . t)) (if left (list left)) - (if top (list top))))) - (setq x-invocation-args (cdr x-invocation-args)))) + (if top (list top))))))) (defvar x-resource-name) @@ -125,9 +208,8 @@ (defun x-handle-name-switch (switch) (or (consp x-invocation-args) (error "%s: missing argument to `%s' option" (invocation-name) switch)) - (setq x-resource-name (car x-invocation-args) - x-invocation-args (cdr x-invocation-args)) - (setq initial-frame-alist (cons (cons 'name x-resource-name) + (setq x-resource-name (pop x-invocation-args) + initial-frame-alist (cons (cons 'name x-resource-name) initial-frame-alist))) (defvar x-display-name nil @@ -137,8 +219,7 @@ On X, the display name of individual X frames is recorded in the (defun x-handle-display (switch) "Handle -display DISPLAY option." - (setq x-display-name (car x-invocation-args) - x-invocation-args (cdr x-invocation-args)) + (setq x-display-name (pop x-invocation-args)) ;; Make subshell programs see the same DISPLAY value Emacs really uses. ;; Note that this isn't completely correct, since Emacs can use ;; multiple displays. However, there is no way to tell an already @@ -146,21 +227,25 @@ On X, the display name of individual X frames is recorded in the (setenv "DISPLAY" x-display-name)) (defun x-handle-args (args) - "Process the X-related command line options in ARGS. -This is done before the user's startup file is loaded. They are copied to -`x-invocation-args', from which the X-related things are extracted, first -the switch (e.g., \"-fg\") in the following code, and possible values -\(e.g., \"black\") in the option handler code (e.g., x-handle-switch). -This function returns ARGS minus the arguments that have been processed." + "Process the X (or Nextstep) related command line options in ARGS. +This is done before the user's startup file is loaded. +Copies the options in ARGS to `x-invocation-args'. It then extracts +the X (or Nextstep) options according to the handlers defined in +`command-line-x-option-alist' (or `command-line-ns-option-alist'). +For example, `x-handle-switch' handles a switch like \"-fg\" and its +value \"black\". This function returns ARGS minus the arguments that +have been processed." ;; We use ARGS to accumulate the args that we don't handle here, to return. - (setq x-invocation-args args + (setq x-invocation-args args ; FIXME let-bind? args nil) (while (and x-invocation-args (not (equal (car x-invocation-args) "--"))) - (let* ((this-switch (car x-invocation-args)) + (let* ((this-switch (pop x-invocation-args)) (orig-this-switch this-switch) + (option-alist (if (featurep 'ns) + command-line-ns-option-alist + command-line-x-option-alist)) completion argval aelt handler) - (setq x-invocation-args (cdr x-invocation-args)) ;; Check for long options with attached arguments ;; and separate out the attached option argument into argval. (if (string-match "^--[^=]*=" this-switch) @@ -169,17 +254,17 @@ This function returns ARGS minus the arguments that have been processed." ;; Complete names of long options. (if (string-match "^--" this-switch) (progn - (setq completion (try-completion this-switch command-line-x-option-alist)) + (setq completion (try-completion this-switch option-alist)) (if (eq completion t) ;; Exact match for long option. nil (if (stringp completion) - (let ((elt (assoc completion command-line-x-option-alist))) + (let ((elt (assoc completion option-alist))) ;; Check for abbreviated long option. (or elt (error "Option `%s' is ambiguous" this-switch)) (setq this-switch completion)))))) - (setq aelt (assoc this-switch command-line-x-option-alist)) + (setq aelt (assoc this-switch option-alist)) (if aelt (setq handler (nth 2 aelt))) (if handler (if argval @@ -203,96 +288,190 @@ This function returns ARGS minus the arguments that have been processed." ;; white, (v) numbered colors sorted by hue, and (vi) numbered shades ;; of grey. +(declare-function ns-list-colors "nsfns.m" (&optional frame)) + (defvar x-colors - (purecopy - '("gray100" "gray99" "gray98" "gray97" "gray96" "gray95" "gray94" "gray93" "gray92" - "gray91" "gray90" "gray89" "gray88" "gray87" "gray86" "gray85" "gray84" "gray83" - "gray82" "gray81" "gray80" "gray79" "gray78" "gray77" "gray76" "gray75" "gray74" - "gray73" "gray72" "gray71" "gray70" "gray69" "gray68" "gray67" "gray66" "gray65" - "gray64" "gray63" "gray62" "gray61" "gray60" "gray59" "gray58" "gray57" "gray56" - "gray55" "gray54" "gray53" "gray52" "gray51" "gray50" "gray49" "gray48" "gray47" - "gray46" "gray45" "gray44" "gray43" "gray42" "gray41" "gray40" "gray39" "gray38" - "gray37" "gray36" "gray35" "gray34" "gray33" "gray32" "gray31" "gray30" "gray29" - "gray28" "gray27" "gray26" "gray25" "gray24" "gray23" "gray22" "gray21" "gray20" - "gray19" "gray18" "gray17" "gray16" "gray15" "gray14" "gray13" "gray12" "gray11" - "gray10" "gray9" "gray8" "gray7" "gray6" "gray5" "gray4" "gray3" "gray2" "gray1" - "gray0" "LightPink1" "LightPink2" "LightPink3" "LightPink4" "pink1" "pink2" "pink3" - "pink4" "PaleVioletRed1" "PaleVioletRed2" "PaleVioletRed3" "PaleVioletRed4" - "LavenderBlush1" "LavenderBlush2" "LavenderBlush3" "LavenderBlush4" "VioletRed1" - "VioletRed2" "VioletRed3" "VioletRed4" "HotPink1" "HotPink2" "HotPink3" "HotPink4" - "DeepPink1" "DeepPink2" "DeepPink3" "DeepPink4" "maroon1" "maroon2" "maroon3" - "maroon4" "orchid1" "orchid2" "orchid3" "orchid4" "plum1" "plum2" "plum3" "plum4" - "thistle1" "thistle2" "thistle3" "thistle4" "MediumOrchid1" "MediumOrchid2" - "MediumOrchid3" "MediumOrchid4" "DarkOrchid1" "DarkOrchid2" "DarkOrchid3" - "DarkOrchid4" "purple1" "purple2" "purple3" "purple4" "MediumPurple1" - "MediumPurple2" "MediumPurple3" "MediumPurple4" "SlateBlue1" "SlateBlue2" - "SlateBlue3" "SlateBlue4" "RoyalBlue1" "RoyalBlue2" "RoyalBlue3" "RoyalBlue4" - "LightSteelBlue1" "LightSteelBlue2" "LightSteelBlue3" "LightSteelBlue4" "SlateGray1" - "SlateGray2" "SlateGray3" "SlateGray4" "DodgerBlue1" "DodgerBlue2" "DodgerBlue3" - "DodgerBlue4" "SteelBlue1" "SteelBlue2" "SteelBlue3" "SteelBlue4" "SkyBlue1" - "SkyBlue2" "SkyBlue3" "SkyBlue4" "LightSkyBlue1" "LightSkyBlue2" "LightSkyBlue3" - "LightSkyBlue4" "LightBlue1" "LightBlue2" "LightBlue3" "LightBlue4" "CadetBlue1" - "CadetBlue2" "CadetBlue3" "CadetBlue4" "azure1" "azure2" "azure3" "azure4" - "LightCyan1" "LightCyan2" "LightCyan3" "LightCyan4" "PaleTurquoise1" - "PaleTurquoise2" "PaleTurquoise3" "PaleTurquoise4" "DarkSlateGray1" "DarkSlateGray2" - "DarkSlateGray3" "DarkSlateGray4" "aquamarine1" "aquamarine2" "aquamarine3" - "aquamarine4" "SeaGreen1" "SeaGreen2" "SeaGreen3" "SeaGreen4" "honeydew1" - "honeydew2" "honeydew3" "honeydew4" "DarkSeaGreen1" "DarkSeaGreen2" "DarkSeaGreen3" - "DarkSeaGreen4" "PaleGreen1" "PaleGreen2" "PaleGreen3" "PaleGreen4" - "DarkOliveGreen1" "DarkOliveGreen2" "DarkOliveGreen3" "DarkOliveGreen4" "OliveDrab1" - "OliveDrab2" "OliveDrab3" "OliveDrab4" "ivory1" "ivory2" "ivory3" "ivory4" - "LightYellow1" "LightYellow2" "LightYellow3" "LightYellow4" "khaki1" "khaki2" - "khaki3" "khaki4" "LemonChiffon1" "LemonChiffon2" "LemonChiffon3" "LemonChiffon4" - "LightGoldenrod1" "LightGoldenrod2" "LightGoldenrod3" "LightGoldenrod4" "cornsilk1" - "cornsilk2" "cornsilk3" "cornsilk4" "goldenrod1" "goldenrod2" "goldenrod3" - "goldenrod4" "DarkGoldenrod1" "DarkGoldenrod2" "DarkGoldenrod3" "DarkGoldenrod4" - "wheat1" "wheat2" "wheat3" "wheat4" "NavajoWhite1" "NavajoWhite2" "NavajoWhite3" - "NavajoWhite4" "burlywood1" "burlywood2" "burlywood3" "burlywood4" "AntiqueWhite1" - "AntiqueWhite2" "AntiqueWhite3" "AntiqueWhite4" "bisque1" "bisque2" "bisque3" - "bisque4" "tan1" "tan2" "tan3" "tan4" "PeachPuff1" "PeachPuff2" "PeachPuff3" - "PeachPuff4" "seashell1" "seashell2" "seashell3" "seashell4" "chocolate1" - "chocolate2" "chocolate3" "chocolate4" "sienna1" "sienna2" "sienna3" "sienna4" - "LightSalmon1" "LightSalmon2" "LightSalmon3" "LightSalmon4" "salmon1" "salmon2" - "salmon3" "salmon4" "coral1" "coral2" "coral3" "coral4" "tomato1" "tomato2" - "tomato3" "tomato4" "MistyRose1" "MistyRose2" "MistyRose3" "MistyRose4" "snow1" - "snow2" "snow3" "snow4" "RosyBrown1" "RosyBrown2" "RosyBrown3" "RosyBrown4" - "IndianRed1" "IndianRed2" "IndianRed3" "IndianRed4" "firebrick1" "firebrick2" - "firebrick3" "firebrick4" "brown1" "brown2" "brown3" "brown4" "magenta1" "magenta2" - "magenta3" "magenta4" "blue1" "blue2" "blue3" "blue4" "DeepSkyBlue1" "DeepSkyBlue2" - "DeepSkyBlue3" "DeepSkyBlue4" "turquoise1" "turquoise2" "turquoise3" "turquoise4" - "cyan1" "cyan2" "cyan3" "cyan4" "SpringGreen1" "SpringGreen2" "SpringGreen3" - "SpringGreen4" "green1" "green2" "green3" "green4" "chartreuse1" "chartreuse2" - "chartreuse3" "chartreuse4" "yellow1" "yellow2" "yellow3" "yellow4" "gold1" "gold2" - "gold3" "gold4" "orange1" "orange2" "orange3" "orange4" "DarkOrange1" "DarkOrange2" - "DarkOrange3" "DarkOrange4" "OrangeRed1" "OrangeRed2" "OrangeRed3" "OrangeRed4" - "red1" "red2" "red3" "red4" "lavender blush" "ghost white" "lavender" "alice blue" - "azure" "light cyan" "mint cream" "honeydew" "ivory" "light goldenrod yellow" - "light yellow" "beige" "floral white" "old lace" "blanched almond" "moccasin" - "papaya whip" "bisque" "antique white" "linen" "peach puff" "seashell" "misty rose" - "snow" "light pink" "pink" "hot pink" "deep pink" "maroon" "pale violet red" - "violet red" "medium violet red" "violet" "plum" "thistle" "orchid" "medium orchid" - "dark orchid" "purple" "blue violet" "medium purple" "light slate blue" - "medium slate blue" "slate blue" "dark slate blue" "midnight blue" "navy" - "dark blue" "light steel blue" "cornflower blue" "dodger blue" "royal blue" - "light slate gray" "slate gray" "dark slate gray" "steel blue" "cadet blue" - "light sky blue" "sky blue" "light blue" "powder blue" "pale turquoise" - "turquoise" "medium turquoise" "dark turquoise" "dark cyan" "aquamarine" - "medium aquamarine" "light sea green" - "medium sea green" "sea green" "dark sea green" "pale green" "lime green" - "dark green" "forest green" "light green" "green yellow" "yellow green" "olive drab" - "dark olive green" "lemon chiffon" "khaki" "dark khaki" "cornsilk" - "pale goldenrod" "light goldenrod" "goldenrod" "dark goldenrod" "wheat" - "navajo white" "tan" "burlywood" "sandy brown" "peru" "chocolate" "saddle brown" - "sienna" "rosy brown" "dark salmon" "coral" "tomato" "light salmon" "salmon" - "light coral" "indian red" "firebrick" "brown" "dark red" "magenta" - "dark magenta" "dark violet" "medium blue" "blue" "deep sky blue" - "cyan" "medium spring green" "spring green" "green" "lawn green" "chartreuse" - "yellow" "gold" "orange" "dark orange" "orange red" "red" "white" "white smoke" - "gainsboro" "light gray" "gray" "dark gray" "dim gray" "black" )) + (if (featurep 'ns) (ns-list-colors) + (purecopy + '("gray100" "grey100" "gray99" "grey99" "gray98" "grey98" "gray97" + "grey97" "gray96" "grey96" "gray95" "grey95" "gray94" "grey94" + "gray93" "grey93" "gray92" "grey92" "gray91" "grey91" "gray90" + "grey90" "gray89" "grey89" "gray88" "grey88" "gray87" "grey87" + "gray86" "grey86" "gray85" "grey85" "gray84" "grey84" "gray83" + "grey83" "gray82" "grey82" "gray81" "grey81" "gray80" "grey80" + "gray79" "grey79" "gray78" "grey78" "gray77" "grey77" "gray76" + "grey76" "gray75" "grey75" "gray74" "grey74" "gray73" "grey73" + "gray72" "grey72" "gray71" "grey71" "gray70" "grey70" "gray69" + "grey69" "gray68" "grey68" "gray67" "grey67" "gray66" "grey66" + "gray65" "grey65" "gray64" "grey64" "gray63" "grey63" "gray62" + "grey62" "gray61" "grey61" "gray60" "grey60" "gray59" "grey59" + "gray58" "grey58" "gray57" "grey57" "gray56" "grey56" "gray55" + "grey55" "gray54" "grey54" "gray53" "grey53" "gray52" "grey52" + "gray51" "grey51" "gray50" "grey50" "gray49" "grey49" "gray48" + "grey48" "gray47" "grey47" "gray46" "grey46" "gray45" "grey45" + "gray44" "grey44" "gray43" "grey43" "gray42" "grey42" "gray41" + "grey41" "gray40" "grey40" "gray39" "grey39" "gray38" "grey38" + "gray37" "grey37" "gray36" "grey36" "gray35" "grey35" "gray34" + "grey34" "gray33" "grey33" "gray32" "grey32" "gray31" "grey31" + "gray30" "grey30" "gray29" "grey29" "gray28" "grey28" "gray27" + "grey27" "gray26" "grey26" "gray25" "grey25" "gray24" "grey24" + "gray23" "grey23" "gray22" "grey22" "gray21" "grey21" "gray20" + "grey20" "gray19" "grey19" "gray18" "grey18" "gray17" "grey17" + "gray16" "grey16" "gray15" "grey15" "gray14" "grey14" "gray13" + "grey13" "gray12" "grey12" "gray11" "grey11" "gray10" "grey10" + "gray9" "grey9" "gray8" "grey8" "gray7" "grey7" "gray6" "grey6" + "gray5" "grey5" "gray4" "grey4" "gray3" "grey3" "gray2" "grey2" + "gray1" "grey1" "gray0" "grey0" + "LightPink1" "LightPink2" "LightPink3" "LightPink4" + "pink1" "pink2" "pink3" "pink4" + "PaleVioletRed1" "PaleVioletRed2" "PaleVioletRed3" "PaleVioletRed4" + "LavenderBlush1" "LavenderBlush2" "LavenderBlush3" "LavenderBlush4" + "VioletRed1" "VioletRed2" "VioletRed3" "VioletRed4" + "HotPink1" "HotPink2" "HotPink3" "HotPink4" + "DeepPink1" "DeepPink2" "DeepPink3" "DeepPink4" + "maroon1" "maroon2" "maroon3" "maroon4" + "orchid1" "orchid2" "orchid3" "orchid4" + "plum1" "plum2" "plum3" "plum4" + "thistle1" "thistle2" "thistle3" "thistle4" + "MediumOrchid1" "MediumOrchid2" "MediumOrchid3" "MediumOrchid4" + "DarkOrchid1" "DarkOrchid2" "DarkOrchid3" "DarkOrchid4" + "purple1" "purple2" "purple3" "purple4" + "MediumPurple1" "MediumPurple2" "MediumPurple3" "MediumPurple4" + "SlateBlue1" "SlateBlue2" "SlateBlue3" "SlateBlue4" + "RoyalBlue1" "RoyalBlue2" "RoyalBlue3" "RoyalBlue4" + "LightSteelBlue1" "LightSteelBlue2" "LightSteelBlue3" "LightSteelBlue4" + "SlateGray1" "SlateGray2" "SlateGray3" "SlateGray4" + "DodgerBlue1" "DodgerBlue2" "DodgerBlue3" "DodgerBlue4" + "SteelBlue1" "SteelBlue2" "SteelBlue3" "SteelBlue4" + "SkyBlue1" "SkyBlue2" "SkyBlue3" "SkyBlue4" + "LightSkyBlue1" "LightSkyBlue2" "LightSkyBlue3" "LightSkyBlue4" + "LightBlue1" "LightBlue2" "LightBlue3" "LightBlue4" + "CadetBlue1" "CadetBlue2" "CadetBlue3" "CadetBlue4" + "azure1" "azure2" "azure3" "azure4" + "LightCyan1" "LightCyan2" "LightCyan3" "LightCyan4" + "PaleTurquoise1" "PaleTurquoise2" "PaleTurquoise3" "PaleTurquoise4" + "DarkSlateGray1" "DarkSlateGray2" "DarkSlateGray3" "DarkSlateGray4" + "aquamarine1" "aquamarine2" "aquamarine3" "aquamarine4" + "SeaGreen1" "SeaGreen2" "SeaGreen3" "SeaGreen4" + "honeydew1" "honeydew2" "honeydew3" "honeydew4" + "DarkSeaGreen1" "DarkSeaGreen2" "DarkSeaGreen3" "DarkSeaGreen4" + "PaleGreen1" "PaleGreen2" "PaleGreen3" "PaleGreen4" + "DarkOliveGreen1" "DarkOliveGreen2" "DarkOliveGreen3" "DarkOliveGreen4" + "OliveDrab1" "OliveDrab2" "OliveDrab3" "OliveDrab4" + "ivory1" "ivory2" "ivory3" "ivory4" + "LightYellow1" "LightYellow2" "LightYellow3" "LightYellow4" + "khaki1" "khaki2" "khaki3" "khaki4" + "LemonChiffon1" "LemonChiffon2" "LemonChiffon3" "LemonChiffon4" + "LightGoldenrod1" "LightGoldenrod2" "LightGoldenrod3" "LightGoldenrod4" + "cornsilk1" "cornsilk2" "cornsilk3" "cornsilk4" + "goldenrod1" "goldenrod2" "goldenrod3" "goldenrod4" + "DarkGoldenrod1" "DarkGoldenrod2" "DarkGoldenrod3" "DarkGoldenrod4" + "wheat1" "wheat2" "wheat3" "wheat4" + "NavajoWhite1" "NavajoWhite2" "NavajoWhite3" "NavajoWhite4" + "burlywood1" "burlywood2" "burlywood3" "burlywood4" + "AntiqueWhite1" "AntiqueWhite2" "AntiqueWhite3" "AntiqueWhite4" + "bisque1" "bisque2" "bisque3" "bisque4" + "tan1" "tan2" "tan3" "tan4" + "PeachPuff1" "PeachPuff2" "PeachPuff3" "PeachPuff4" + "seashell1" "seashell2" "seashell3" "seashell4" + "chocolate1" "chocolate2" "chocolate3" "chocolate4" + "sienna1" "sienna2" "sienna3" "sienna4" + "LightSalmon1" "LightSalmon2" "LightSalmon3" "LightSalmon4" + "salmon1" "salmon2" "salmon3" "salmon4" + "coral1" "coral2" "coral3" "coral4" + "tomato1" "tomato2" "tomato3" "tomato4" + "MistyRose1" "MistyRose2" "MistyRose3" "MistyRose4" + "snow1" "snow2" "snow3" "snow4" + "RosyBrown1" "RosyBrown2" "RosyBrown3" "RosyBrown4" + "IndianRed1" "IndianRed2" "IndianRed3" "IndianRed4" + "firebrick1" "firebrick2" "firebrick3" "firebrick4" + "brown1" "brown2" "brown3" "brown4" + "magenta1" "magenta2" "magenta3" "magenta4" + "blue1" "blue2" "blue3" "blue4" + "DeepSkyBlue1" "DeepSkyBlue2" "DeepSkyBlue3" "DeepSkyBlue4" + "turquoise1" "turquoise2" "turquoise3" "turquoise4" + "cyan1" "cyan2" "cyan3" "cyan4" + "SpringGreen1" "SpringGreen2" "SpringGreen3" "SpringGreen4" + "green1" "green2" "green3" "green4" + "chartreuse1" "chartreuse2" "chartreuse3" "chartreuse4" + "yellow1" "yellow2" "yellow3" "yellow4" + "gold1" "gold2" "gold3" "gold4" + "orange1" "orange2" "orange3" "orange4" + "DarkOrange1" "DarkOrange2" "DarkOrange3" "DarkOrange4" + "OrangeRed1" "OrangeRed2" "OrangeRed3" "OrangeRed4" + "red1" "red2" "red3" "red4" + "lavender blush" "LavenderBlush" "ghost white" "GhostWhite" + "lavender" "alice blue" "AliceBlue" "azure" "light cyan" + "LightCyan" "mint cream" "MintCream" "honeydew" "ivory" + "light goldenrod yellow" "LightGoldenrodYellow" "light yellow" + "LightYellow" "beige" "floral white" "FloralWhite" "old lace" + "OldLace" "blanched almond" "BlanchedAlmond" "moccasin" + "papaya whip" "PapayaWhip" "bisque" "antique white" + "AntiqueWhite" "linen" "peach puff" "PeachPuff" "seashell" + "misty rose" "MistyRose" "snow" "light pink" "LightPink" "pink" + "hot pink" "HotPink" "deep pink" "DeepPink" "maroon" + "pale violet red" "PaleVioletRed" "violet red" "VioletRed" + "medium violet red" "MediumVioletRed" "violet" "plum" "thistle" + "orchid" "medium orchid" "MediumOrchid" "dark orchid" + "DarkOrchid" "purple" "blue violet" "BlueViolet" "medium purple" + "MediumPurple" "light slate blue" "LightSlateBlue" + "medium slate blue" "MediumSlateBlue" "slate blue" "SlateBlue" + "dark slate blue" "DarkSlateBlue" "midnight blue" "MidnightBlue" + "navy" "navy blue" "NavyBlue" "dark blue" "DarkBlue" + "light steel blue" "LightSteelBlue" "cornflower blue" + "CornflowerBlue" "dodger blue" "DodgerBlue" "royal blue" + "RoyalBlue" "light slate gray" "light slate grey" + "LightSlateGray" "LightSlateGrey" "slate gray" "slate grey" + "SlateGray" "SlateGrey" "dark slate gray" "dark slate grey" + "DarkSlateGray" "DarkSlateGrey" "steel blue" "SteelBlue" + "cadet blue" "CadetBlue" "light sky blue" "LightSkyBlue" + "sky blue" "SkyBlue" "light blue" "LightBlue" "powder blue" + "PowderBlue" "pale turquoise" "PaleTurquoise" "turquoise" + "medium turquoise" "MediumTurquoise" "dark turquoise" + "DarkTurquoise" "dark cyan" "DarkCyan" "aquamarine" + "medium aquamarine" "MediumAquamarine" "light sea green" + "LightSeaGreen" "medium sea green" "MediumSeaGreen" "sea green" + "SeaGreen" "dark sea green" "DarkSeaGreen" "pale green" + "PaleGreen" "lime green" "LimeGreen" "dark green" "DarkGreen" + "forest green" "ForestGreen" "light green" "LightGreen" + "green yellow" "GreenYellow" "yellow green" "YellowGreen" + "olive drab" "OliveDrab" "dark olive green" "DarkOliveGreen" + "lemon chiffon" "LemonChiffon" "khaki" "dark khaki" "DarkKhaki" + "cornsilk" "pale goldenrod" "PaleGoldenrod" "light goldenrod" + "LightGoldenrod" "goldenrod" "dark goldenrod" "DarkGoldenrod" + "wheat" "navajo white" "NavajoWhite" "tan" "burlywood" + "sandy brown" "SandyBrown" "peru" "chocolate" "saddle brown" + "SaddleBrown" "sienna" "rosy brown" "RosyBrown" "dark salmon" + "DarkSalmon" "coral" "tomato" "light salmon" "LightSalmon" + "salmon" "light coral" "LightCoral" "indian red" "IndianRed" + "firebrick" "brown" "dark red" "DarkRed" "magenta" + "dark magenta" "DarkMagenta" "dark violet" "DarkViolet" + "medium blue" "MediumBlue" "blue" "deep sky blue" "DeepSkyBlue" + "cyan" "medium spring green" "MediumSpringGreen" "spring green" + "SpringGreen" "green" "lawn green" "LawnGreen" "chartreuse" + "yellow" "gold" "orange" "dark orange" "DarkOrange" "orange red" + "OrangeRed" "red" "white" "white smoke" "WhiteSmoke" "gainsboro" + "light gray" "light grey" "LightGray" "LightGrey" "gray" "grey" + "dark gray" "dark grey" "DarkGray" "DarkGrey" "dim gray" + "dim grey" "DimGray" "DimGrey" "black"))) "List of basic colors available on color displays. For X, the list comes from the `rgb.txt' file,v 10.41 94/02/20. For Nextstep, this is a list of non-PANTONE colors returned by the operating system.") -;; arch-tag: 2a128601-99cc-401e-9dff-0ee6a36102ef +(defvar w32-color-map) + +(defun xw-defined-colors (&optional frame) + "Internal function called by `defined-colors', which see." + (if (featurep 'ns) + x-colors + (or frame (setq frame (selected-frame))) + (let (defined-colors) + (dolist (this-color (if (eq system-type 'windows-nt) + (or (mapcar 'car w32-color-map) x-colors) + x-colors)) + (and (color-supported-p this-color frame t) + (setq defined-colors (cons this-color defined-colors)))) + defined-colors))) + ;;; common-win.el ends here diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 0a4b4b15bfe..4617b07d0b9 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -41,131 +41,42 @@ ;;; Code: - -(if (not (featurep 'ns)) +(or (featurep 'ns) (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS" - (invocation-name))) + (invocation-name))) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl)) ; lexical-let -;; Documentation-purposes only: actually loaded in loadup.el +;; Documentation-purposes only: actually loaded in loadup.el. (require 'frame) (require 'mouse) (require 'faces) -(require 'easymenu) (require 'menu-bar) (require 'fontset) -;; Not needed? -;;(require 'ispell) - (defgroup ns nil "GNUstep/Mac OS X specific features." :group 'environment) -;; nsterm.m -(defvar ns-version-string) -(defvar ns-alternate-modifier) -(defvar ns-right-alternate-modifier) - ;;;; Command line argument handling. -(defvar ns-invocation-args nil) -(defvar ns-command-line-resources nil) - -;; Handler for switches of the form "-switch value" or "-switch". -(defun ns-handle-switch (switch &optional numeric) - (let ((aelt (assoc switch command-line-ns-option-alist))) - (if aelt - (setq default-frame-alist - (cons (cons (nth 3 aelt) - (if numeric - (string-to-number (pop ns-invocation-args)) - (or (nth 4 aelt) (pop ns-invocation-args)))) - default-frame-alist))))) - -;; Handler for switches of the form "-switch n" -(defun ns-handle-numeric-switch (switch) - (ns-handle-switch switch t)) - -;; Make -iconic apply only to the initial frame! -(defun ns-handle-iconic (switch) - (setq initial-frame-alist - (cons '(visibility . icon) initial-frame-alist))) - -;; Handle the -name option, set the name of the initial frame. -(defun ns-handle-name-switch (switch) - (or (consp ns-invocation-args) - (error "%s: missing argument to `%s' option" (invocation-name) switch)) - (setq initial-frame-alist (cons (cons 'name (pop ns-invocation-args)) - initial-frame-alist))) - -;; Set (but not used?) in frame.el. -(defvar x-display-name nil - "The name of the window display on which Emacs was started. -On X, the display name of individual X frames is recorded in the -`display' frame parameter.") +(defvar x-invocation-args) +(defvar ns-command-line-resources nil) ; FIXME unused? ;; nsterm.m. (defvar ns-input-file) -(defun ns-handle-nxopen (switch) - (setq unread-command-events (append unread-command-events '(ns-open-file)) - ns-input-file (append ns-input-file (list (pop ns-invocation-args))))) +(defun ns-handle-nxopen (switch &optional temp) + (setq unread-command-events (append unread-command-events + (if temp '(ns-open-temp-file) + '(ns-open-file))) + ns-input-file (append ns-input-file (list (pop x-invocation-args))))) (defun ns-handle-nxopentemp (switch) - (setq unread-command-events (append unread-command-events - '(ns-open-temp-file)) - ns-input-file (append ns-input-file (list (pop ns-invocation-args))))) + (ns-handle-nxopen switch t)) (defun ns-ignore-1-arg (switch) - (setq ns-invocation-args (cdr ns-invocation-args))) -(defun ns-ignore-2-arg (switch) - (setq ns-invocation-args (cddr ns-invocation-args))) - -(defun ns-handle-args (args) - "Process Nextstep-related command line options. -This is run before the user's startup file is loaded. -The options in ARGS are copied to `ns-invocation-args'. -The Nextstep-related settings are then applied using the handlers -defined in `command-line-ns-option-alist'. -The return value is ARGS minus the number of arguments processed." - ;; We use ARGS to accumulate the args that we don't handle here, to return. - (setq ns-invocation-args args - args nil) - (while ns-invocation-args - (let* ((this-switch (pop ns-invocation-args)) - (orig-this-switch this-switch) - completion argval aelt handler) - ;; Check for long options with attached arguments - ;; and separate out the attached option argument into argval. - (if (string-match "^--[^=]*=" this-switch) - (setq argval (substring this-switch (match-end 0)) - this-switch (substring this-switch 0 (1- (match-end 0))))) - ;; Complete names of long options. - (if (string-match "^--" this-switch) - (progn - (setq completion (try-completion this-switch - command-line-ns-option-alist)) - (if (eq completion t) - ;; Exact match for long option. - nil - (if (stringp completion) - (let ((elt (assoc completion command-line-ns-option-alist))) - ;; Check for abbreviated long option. - (or elt - (error "Option `%s' is ambiguous" this-switch)) - (setq this-switch completion)))))) - (setq aelt (assoc this-switch command-line-ns-option-alist)) - (if aelt (setq handler (nth 2 aelt))) - (if handler - (if argval - (let ((ns-invocation-args - (cons argval ns-invocation-args))) - (funcall handler this-switch)) - (funcall handler this-switch)) - (setq args (cons orig-this-switch args))))) - (nreverse args)) + (setq x-invocation-args (cdr x-invocation-args))) (defun ns-parse-geometry (geom) "Parse a Nextstep-style geometry string GEOM. @@ -187,28 +98,13 @@ The properties returned may include `top', `left', `height', and `width'." ;;;; Keyboard mapping. -;; These tell read-char how to convert these special chars to ASCII. -(put 'S-tab 'ascii-character (logior 16 ?\t)) - -(defvar ns-alternatives-map - (let ((map (make-sparse-keymap))) - ;; Map certain keypad keys into ASCII characters - ;; that people usually expect. - (define-key map [S-tab] [25]) - (define-key map [M-backspace] [?\M-\d]) - (define-key map [M-delete] [?\M-\d]) - (define-key map [M-tab] [?\M-\t]) - (define-key map [M-linefeed] [?\M-\n]) - (define-key map [M-clear] [?\M-\C-l]) - (define-key map [M-return] [?\M-\C-m]) - (define-key map [M-escape] [?\M-\e]) - map) - "Keymap of alternative meanings for some keys under Nextstep.") +(define-obsolete-variable-alias 'ns-alternatives-map 'x-alternatives-map "24.1") ;; Here are some Nextstep-like bindings for command key sequences. (define-key global-map [?\s-,] 'customize) (define-key global-map [?\s-'] 'next-multiframe-window) (define-key global-map [?\s-`] 'other-frame) +(define-key global-map [?\s-~] 'ns-prev-frame) (define-key global-map [?\s--] 'center-line) (define-key global-map [?\s-:] 'ispell) (define-key global-map [?\s-\;] 'ispell-next) @@ -258,13 +154,13 @@ The properties returned may include `top', `left', `height', and `width'." (define-key global-map [kp-prior] 'scroll-down) (define-key global-map [kp-next] 'scroll-up) -;;; Allow shift-clicks to work similarly to under Nextstep +;; Allow shift-clicks to work similarly to under Nextstep. (define-key global-map [S-mouse-1] 'mouse-save-then-kill) (global-unset-key [S-down-mouse-1]) - ;; Special Nextstep-generated events are converted to function keys. Here -;; are the bindings for them. +;; are the bindings for them. Note, these keys are actually declared in +;; x-setup-function-keys in common-win. (define-key global-map [ns-power-off] 'save-buffers-kill-emacs) (define-key global-map [ns-open-file] 'ns-find-file) (define-key global-map [ns-open-temp-file] [ns-open-file]) @@ -285,196 +181,15 @@ The properties returned may include `top', `left', `height', and `width'." (defvaralias 'mac-allow-anti-aliasing 'ns-antialias-text) (defvaralias 'mac-command-modifier 'ns-command-modifier) +(defvaralias 'mac-right-command-modifier 'ns-right-command-modifier) (defvaralias 'mac-control-modifier 'ns-control-modifier) +(defvaralias 'mac-right-control-modifier 'ns-right-control-modifier) (defvaralias 'mac-option-modifier 'ns-option-modifier) (defvaralias 'mac-right-option-modifier 'ns-right-option-modifier) (defvaralias 'mac-function-modifier 'ns-function-modifier) (declare-function ns-do-applescript "nsfns.m" (script)) (defalias 'do-applescript 'ns-do-applescript) -(defun x-setup-function-keys (frame) - "Set up `function-key-map' on the graphical frame FRAME." - (unless (terminal-parameter frame 'x-setup-function-keys) - (with-selected-frame frame - (setq interprogram-cut-function 'x-select-text - interprogram-paste-function 'x-cut-buffer-or-selection-value) - (let ((map (copy-keymap ns-alternatives-map))) - (set-keymap-parent map (keymap-parent local-function-key-map)) - (set-keymap-parent local-function-key-map map)) - (setq system-key-alist - (list - (cons (logior (lsh 0 16) 1) 'ns-power-off) - (cons (logior (lsh 0 16) 2) 'ns-open-file) - (cons (logior (lsh 0 16) 3) 'ns-open-temp-file) - (cons (logior (lsh 0 16) 4) 'ns-drag-file) - (cons (logior (lsh 0 16) 5) 'ns-drag-color) - (cons (logior (lsh 0 16) 6) 'ns-drag-text) - (cons (logior (lsh 0 16) 7) 'ns-change-font) - (cons (logior (lsh 0 16) 8) 'ns-open-file-line) -; (cons (logior (lsh 0 16) 9) 'ns-insert-working-text) -; (cons (logior (lsh 0 16) 10) 'ns-delete-working-text) - (cons (logior (lsh 0 16) 11) 'ns-spi-service-call) - (cons (logior (lsh 0 16) 12) 'ns-new-frame) - (cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar) - (cons (logior (lsh 0 16) 14) 'ns-show-prefs) - (cons (logior (lsh 1 16) 32) 'f1) - (cons (logior (lsh 1 16) 33) 'f2) - (cons (logior (lsh 1 16) 34) 'f3) - (cons (logior (lsh 1 16) 35) 'f4) - (cons (logior (lsh 1 16) 36) 'f5) - (cons (logior (lsh 1 16) 37) 'f6) - (cons (logior (lsh 1 16) 38) 'f7) - (cons (logior (lsh 1 16) 39) 'f8) - (cons (logior (lsh 1 16) 40) 'f9) - (cons (logior (lsh 1 16) 41) 'f10) - (cons (logior (lsh 1 16) 42) 'f11) - (cons (logior (lsh 1 16) 43) 'f12) - (cons (logior (lsh 1 16) 44) 'kp-insert) - (cons (logior (lsh 1 16) 45) 'kp-delete) - (cons (logior (lsh 1 16) 46) 'kp-home) - (cons (logior (lsh 1 16) 47) 'kp-end) - (cons (logior (lsh 1 16) 48) 'kp-prior) - (cons (logior (lsh 1 16) 49) 'kp-next) - (cons (logior (lsh 1 16) 50) 'print-screen) - (cons (logior (lsh 1 16) 51) 'scroll-lock) - (cons (logior (lsh 1 16) 52) 'pause) - (cons (logior (lsh 1 16) 53) 'system) - (cons (logior (lsh 1 16) 54) 'break) - (cons (logior (lsh 1 16) 56) 'please-tell-carl-what-this-key-is-called-56) - (cons (logior (lsh 1 16) 61) 'please-tell-carl-what-this-key-is-called-61) - (cons (logior (lsh 1 16) 62) 'please-tell-carl-what-this-key-is-called-62) - (cons (logior (lsh 1 16) 63) 'please-tell-carl-what-this-key-is-called-63) - (cons (logior (lsh 1 16) 64) 'please-tell-carl-what-this-key-is-called-64) - (cons (logior (lsh 1 16) 69) 'please-tell-carl-what-this-key-is-called-69) - (cons (logior (lsh 1 16) 70) 'please-tell-carl-what-this-key-is-called-70) - (cons (logior (lsh 1 16) 71) 'please-tell-carl-what-this-key-is-called-71) - (cons (logior (lsh 1 16) 72) 'please-tell-carl-what-this-key-is-called-72) - (cons (logior (lsh 1 16) 73) 'please-tell-carl-what-this-key-is-called-73) - (cons (logior (lsh 2 16) 3) 'kp-enter) - (cons (logior (lsh 2 16) 9) 'kp-tab) - (cons (logior (lsh 2 16) 28) 'kp-quit) - (cons (logior (lsh 2 16) 35) 'kp-hash) - (cons (logior (lsh 2 16) 42) 'kp-multiply) - (cons (logior (lsh 2 16) 43) 'kp-add) - (cons (logior (lsh 2 16) 44) 'kp-separator) - (cons (logior (lsh 2 16) 45) 'kp-subtract) - (cons (logior (lsh 2 16) 46) 'kp-decimal) - (cons (logior (lsh 2 16) 47) 'kp-divide) - (cons (logior (lsh 2 16) 48) 'kp-0) - (cons (logior (lsh 2 16) 49) 'kp-1) - (cons (logior (lsh 2 16) 50) 'kp-2) - (cons (logior (lsh 2 16) 51) 'kp-3) - (cons (logior (lsh 2 16) 52) 'kp-4) - (cons (logior (lsh 2 16) 53) 'kp-5) - (cons (logior (lsh 2 16) 54) 'kp-6) - (cons (logior (lsh 2 16) 55) 'kp-7) - (cons (logior (lsh 2 16) 56) 'kp-8) - (cons (logior (lsh 2 16) 57) 'kp-9) - (cons (logior (lsh 2 16) 60) 'kp-less) - (cons (logior (lsh 2 16) 61) 'kp-equal) - (cons (logior (lsh 2 16) 62) 'kp-more) - (cons (logior (lsh 2 16) 64) 'kp-at) - (cons (logior (lsh 2 16) 92) 'kp-backslash) - (cons (logior (lsh 2 16) 96) 'kp-backtick) - (cons (logior (lsh 2 16) 124) 'kp-bar) - (cons (logior (lsh 2 16) 126) 'kp-tilde) - (cons (logior (lsh 2 16) 157) 'kp-mu) - (cons (logior (lsh 2 16) 165) 'kp-yen) - (cons (logior (lsh 2 16) 167) 'kp-paragraph) - (cons (logior (lsh 2 16) 172) 'left) - (cons (logior (lsh 2 16) 173) 'up) - (cons (logior (lsh 2 16) 174) 'right) - (cons (logior (lsh 2 16) 175) 'down) - (cons (logior (lsh 2 16) 176) 'kp-ring) - (cons (logior (lsh 2 16) 201) 'kp-square) - (cons (logior (lsh 2 16) 204) 'kp-cube) - (cons (logior (lsh 3 16) 8) 'backspace) - (cons (logior (lsh 3 16) 9) 'tab) - (cons (logior (lsh 3 16) 10) 'linefeed) - (cons (logior (lsh 3 16) 11) 'clear) - (cons (logior (lsh 3 16) 13) 'return) - (cons (logior (lsh 3 16) 18) 'pause) - (cons (logior (lsh 3 16) 25) 'S-tab) - (cons (logior (lsh 3 16) 27) 'escape) - (cons (logior (lsh 3 16) 127) 'delete) - ))) - (set-terminal-parameter frame 'x-setup-function-keys t))) - - -;; Add a couple of menus and rearrange some others; easiest just to redo toplvl -;; Note keymap defns must be given last-to-first -(define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")) - -(setq menu-bar-final-items - (cond ((eq system-type 'darwin) - '(buffer windows services help-menu)) - ;; Otherwise, GNUstep. - (t - '(buffer windows services hide-app quit)))) - -;; Add standard top-level items to GNUstep menu. -(unless (eq system-type 'darwin) - (define-key global-map [menu-bar quit] '("Quit" . save-buffers-kill-emacs)) - (define-key global-map [menu-bar hide-app] '("Hide" . ns-do-hide-emacs))) - -(define-key global-map [menu-bar services] - (cons "Services" (make-sparse-keymap "Services"))) -(define-key global-map [menu-bar buffer] - (cons "Buffers" global-buffers-menu-map)) -;; (cons "Buffers" (make-sparse-keymap "Buffers"))) -(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu)) -(define-key global-map [menu-bar options] (cons "Options" menu-bar-options-menu)) -(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu)) -(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu)) - -;; If running under GNUstep, rename "Help" to "Info" -(cond ((eq system-type 'darwin) - (define-key global-map [menu-bar help-menu] - (cons "Help" menu-bar-help-menu))) - (t - (let ((contents (reverse (cdr menu-bar-help-menu)))) - (setq menu-bar-help-menu - (append (list 'keymap) (cdr contents) (list "Info")))) - (define-key global-map [menu-bar help-menu] - (cons "Info" menu-bar-help-menu)))) - -(if (not (eq system-type 'darwin)) - ;; in OS X it's in the app menu already - (define-key menu-bar-help-menu [info-panel] - '("About Emacs..." . ns-do-emacs-info-panel))) - -;;;; Edit menu: Modify slightly - -;; Substitute a Copy function that works better under X (for GNUstep). -(easy-menu-remove-item global-map '("menu-bar" "edit") 'copy) -(define-key-after menu-bar-edit-menu [copy] - '(menu-item "Copy" ns-copy-including-secondary - :enable mark-active - :help "Copy text in region between mark and current position") - 'cut) - -;; Change to same precondition as select-and-paste, as we don't have -;; `x-selection-exists-p'. -(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste) -(define-key-after menu-bar-edit-menu [paste] - '(menu-item "Paste" yank - :enable (and (cdr yank-menu) (not buffer-read-only)) - :help "Paste (yank) text most recently cut/copied") - 'copy) - -;; Change text to be more consistent with surrounding menu items `paste', etc. -(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste-from-menu) -(define-key-after menu-bar-edit-menu [select-paste] - '(menu-item "Select and Paste" yank-menu - :enable (and (cdr yank-menu) (not buffer-read-only)) - :help "Choose a string from the kill ring and paste it") - 'paste) - -;; Separate undo from cut/paste section, add spell for platform consistency. -(define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo) -(define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill) - - ;;;; Services (declare-function ns-perform-service "nsfns.m" (service send)) @@ -538,10 +253,6 @@ The properties returned may include `top', `left', `height', and `width'." (t (error (concat "Service " ns-input-spi-name " not recognized"))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - - ;; Composed key sequence handling for Nextstep system input methods. ;; (On Nextstep systems, input methods are provided for CJK ;; characters, etc. which require multiple keystrokes, and during @@ -638,29 +349,24 @@ See `ns-insert-working-text'." ;;;; OS X file system Unicode UTF-8 NFD (decomposed form) support ;; Lisp code based on utf-8m.el, by Seiji Zenitani, Eiji Honjoh, and ;; Carsten Bormann. -(if (eq system-type 'darwin) - (progn - - (defun ns-utf8-nfd-post-read-conversion (length) - "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences." - (save-excursion - (save-restriction - (narrow-to-region (point) (+ (point) length)) - (let ((str (buffer-string))) - (delete-region (point-min) (point-max)) - (insert (ns-convert-utf8-nfd-to-nfc str)) - (- (point-max) (point-min)) - )))) - - (define-coding-system 'utf-8-nfd - "UTF-8 NFD (decomposed) encoding." - :coding-type 'utf-8 - :mnemonic ?U - :charset-list '(unicode) - :post-read-conversion 'ns-utf8-nfd-post-read-conversion) - (set-file-name-coding-system 'utf-8-nfd))) - - +(when (eq system-type 'darwin) + (defun ns-utf8-nfd-post-read-conversion (length) + "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences." + (save-excursion + (save-restriction + (narrow-to-region (point) (+ (point) length)) + (let ((str (buffer-string))) + (delete-region (point-min) (point-max)) + (insert (ns-convert-utf8-nfd-to-nfc str)) + (- (point-max) (point-min)))))) + + (define-coding-system 'utf-8-nfd + "UTF-8 NFD (decomposed) encoding." + :coding-type 'utf-8 + :mnemonic ?U + :charset-list '(unicode) + :post-read-conversion 'ns-utf8-nfd-post-read-conversion) + (set-file-name-coding-system 'utf-8-nfd)) ;;;; Inter-app communications support. @@ -676,12 +382,10 @@ See `ns-insert-working-text'." "Insert contents of file `ns-input-file' like insert-file but with less prompting. If file is a directory perform a `find-file' on it." (interactive) - (let ((f)) - (setq f (car ns-input-file)) - (setq ns-input-file (cdr ns-input-file)) + (let ((f (pop ns-input-file))) (if (file-directory-p f) (find-file f) - (push-mark (+ (point) (car (cdr (insert-file-contents f)))))))) + (push-mark (+ (point) (cadr (insert-file-contents f))))))) (defvar ns-select-overlay nil "Overlay used to highlight areas in files requested by Nextstep apps.") @@ -734,8 +438,6 @@ Lines are highlighted according to `ns-input-line'." (add-hook 'first-change-hook 'ns-unselect-line) - - ;;;; Preferences handling. (declare-function ns-get-resource "nsfns.m" (owner name)) @@ -786,12 +488,10 @@ unless the current buffer is a scratch buffer." (defun ns-find-file () "Do a `find-file' with the `ns-input-file' as argument." (interactive) - (let ((f) (file) (bufwin1) (bufwin2)) - (setq f (file-truename (car ns-input-file))) - (setq ns-input-file (cdr ns-input-file)) - (setq file (find-file-noselect f)) - (setq bufwin1 (get-buffer-window file 'visible)) - (setq bufwin2 (get-buffer-window "*scratch*" 'visibile)) + (let* ((f (file-truename (pop ns-input-file))) + (file (find-file-noselect f)) + (bufwin1 (get-buffer-window file 'visible)) + (bufwin2 (get-buffer-window "*scratch*" 'visibile))) (cond (bufwin1 (select-frame (window-frame bufwin1)) @@ -810,13 +510,17 @@ unless the current buffer is a scratch buffer." (ns-hide-emacs 'activate) (find-file f))))) - - ;;;; Frame-related functions. ;; Don't show the frame name; that's redundant with Nextstep. (setq-default mode-line-frame-identification '(" ")) +;; nsterm.m +(defvar ns-alternate-modifier) +(defvar ns-right-alternate-modifier) +(defvar ns-right-command-modifier) +(defvar ns-right-control-modifier) + ;; You say tomAYto, I say tomAHto.. (defvaralias 'ns-option-modifier 'ns-alternate-modifier) (defvaralias 'ns-right-option-modifier 'ns-right-alternate-modifier) @@ -883,10 +587,8 @@ unless the current buffer is a scratch buffer." (if (not tool-bar-mode) (tool-bar-mode t))) - ;;;; Dialog-related functions. - ;; Ask user for confirm before printing. Due to Kevin Rodgers. (defun ns-print-buffer () "Interactive front-end to `print-buffer': asks for user confirmation first." @@ -904,7 +606,6 @@ unless the current buffer is a scratch buffer." (error "Cancelled"))) (print-buffer))) - ;;;; Font support. ;; Needed for font listing functions under both backend and normal @@ -949,17 +650,16 @@ come with OS X. See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles. -(if (fboundp 'new-fontset) - (progn - ;; Setup the default fontset. - (create-default-fontset) - ;; Create the standard fontset. - (condition-case err - (create-fontset-from-fontset-spec ns-standard-fontset-spec t) - (error (display-warning - 'initialization - (format "Creation of the standard fontset failed: %s" err) - :error))))) +(when (fboundp 'new-fontset) + ;; Setup the default fontset. + (create-default-fontset) + ;; Create the standard fontset. + (condition-case err + (create-fontset-from-fontset-spec ns-standard-fontset-spec t) + (error (display-warning + 'initialization + (format "Creation of the standard fontset failed: %s" err) + :error)))) (defvar ns-reg-to-script) ; nsfont.m @@ -1008,7 +708,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (defun ns-get-pasteboard () "Returns the value of the pasteboard." - (ns-get-cut-buffer-internal 'PRIMARY)) + (ns-get-cut-buffer-internal 'CLIPBOARD)) (declare-function ns-store-cut-buffer-internal "nsselect.m" (buffer string)) @@ -1016,43 +716,21 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") "Store STRING into the pasteboard of the Nextstep display server." ;; Check the data type of STRING. (if (not (stringp string)) (error "Nonstring given to pasteboard")) - (ns-store-cut-buffer-internal 'PRIMARY string)) + (ns-store-cut-buffer-internal 'CLIPBOARD string)) ;; 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-cut-buffer-or-selection-value. +;; from x-selection-value. (defvar ns-last-selected-text nil) -(defun x-select-text (text &optional push) - "Select TEXT, a string, according to the window system. - -On X, put TEXT in the primary X selection. For backward -compatibility with older X applications, set the value of X cut -buffer 0 as well, and if the optional argument PUSH is non-nil, -rotate the cut buffers. If `x-select-enable-clipboard' is -non-nil, copy the text to the X clipboard as well. - -On Windows, make TEXT the current selection. If -`x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. The argument PUSH is ignored. - -On Nextstep, put TEXT in the pasteboard; PUSH is ignored." - ;; Don't send the pasteboard too much text. - ;; It becomes slow, and if really big it causes errors. - (ns-set-pasteboard text) - (setq ns-last-selected-text text)) - ;; Return the value of the current Nextstep selection. For ;; compatibility with older Nextstep applications, this checks cut ;; buffer 0 before retrieving the value of the primary selection. -(defun x-cut-buffer-or-selection-value () +(defun x-selection-value () (let (text) - - ;; Consult the selection, then the cut buffer. Treat empty strings - ;; as if they were unset. + ;; Consult the selection. Treat empty strings as if they were unset. (or text (setq text (ns-get-pasteboard))) (if (string= text "") (setq text nil)) - (cond ((not text) nil) ((eq text ns-last-selected-text) nil) @@ -1073,7 +751,6 @@ On Nextstep, put TEXT in the pasteboard; PUSH is ignored." (insert (ns-get-cut-buffer-internal 'SECONDARY))) - ;;;; Scrollbar handling. (global-set-key [vertical-scroll-bar down-mouse-1] 'ns-handle-scroll-bar-event) @@ -1134,27 +811,6 @@ On Nextstep, put TEXT in the pasteboard; PUSH is ignored." ;;;; Color support. -(declare-function ns-list-colors "nsfns.m" (&optional frame)) - -(defvar x-colors (ns-list-colors) - "List of basic colors available on color displays. -For X, the list comes from the `rgb.txt' file,v 10.41 94/02/20. -For Nextstep, this is a list of non-PANTONE colors returned by -the operating system.") - -(defun xw-defined-colors (&optional frame) - "Internal function called by `defined-colors'." - (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 (face-color-supported-p frame this-color t) - (setq defined-colors (cons this-color defined-colors))) ;;) - defined-colors)) - ;; Functions for color panel + drag (defun ns-face-at-pos (pos) (let* ((frame (car pos)) @@ -1242,7 +898,7 @@ the operating system.") "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing." ;; PENDING: not needed? - (setq command-line-args (ns-handle-args command-line-args)) + (setq command-line-args (x-handle-args command-line-args)) (x-open-connection (system-name) nil t) @@ -1261,12 +917,11 @@ the operating system.") (setq ns-initialized t)) -(add-to-list 'handle-args-function-alist '(ns . ns-handle-args)) +(add-to-list 'handle-args-function-alist '(ns . x-handle-args)) (add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces)) (add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system)) (provide 'ns-win) -;; arch-tag: eb138a45-4e2e-4d68-b1c9-a39665731644 ;;; ns-win.el ends here diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index d1efd0f1644..e4041bdef28 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -192,44 +192,43 @@ the operating system.") ;; From lisp/term/w32-win.el ; -;;;; Selections and cut buffers +;;;; Selections ; ;;; We keep track of the last text selected here, so we can check the ;;; current selection against it, and avoid passing back our own text -;;; from x-cut-buffer-or-selection-value. +;;; from x-selection-value. (defvar x-last-selected-text nil) (defcustom x-select-enable-clipboard t "Non-nil means cutting and pasting uses the clipboard. This is in addition to, but in preference to, the primary selection. -On MS-Windows, this is non-nil by default, since Windows does not -support other types of selections. \(The primary selection that is -set by Emacs is not accessible to other programs on Windows.\)" +Note that MS-Windows does not support selection types other than the +clipboard. (The primary selection that is set by Emacs is not +accessible to other programs on MS-Windows.) + +This variable is not used by the Nextstep port." :type 'boolean :group 'killing) -(defun x-select-text (text &optional push) +(defun x-select-text (text) "Select TEXT, a string, according to the window system. -On X, put TEXT in the primary X selection. For backward -compatibility with older X applications, set the value of X cut -buffer 0 as well, and if the optional argument PUSH is non-nil, -rotate the cut buffers. If `x-select-enable-clipboard' is -non-nil, copy the text to the X clipboard as well. +On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the +clipboard. If `x-select-enable-primary' is non-nil, put TEXT in +the primary selection. On Windows, make TEXT the current selection. If `x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. The argument PUSH is ignored. +clipboard as well. -On Nextstep, put TEXT in the pasteboard; PUSH is ignored." +On Nextstep, put TEXT in the pasteboard." (if x-select-enable-clipboard (w16-set-clipboard-data text)) (setq x-last-selected-text text)) ;;; Return the value of the current selection. -;;; Consult the selection, then the cut buffer. Treat empty strings -;;; as if they were unset. +;;; Consult the selection. Treat empty strings as if they were unset. (defun x-get-selection-value () (if x-select-enable-clipboard (let (text) @@ -289,14 +288,15 @@ Disowning it means there is no such selection." (if (x-selection-owner-p selection) t)) -;; From lisp/faces.el: we only have one font, so always return -;; it, no matter which variety they've asked for. -(defun x-frob-font-slant (font which) - font) -(make-obsolete 'x-frob-font-slant 'make-face-... "21.1") -(defun x-frob-font-weight (font which) - font) -(make-obsolete 'x-frob-font-weight 'make-face-... "21.1") +;; x-get-selection-internal is used in select.el +(defun x-get-selection-internal (selection type &optional time_stamp) + "Return text selected from some X window. +SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. +\(Those are literal upper-case symbol names, since that's what X expects.) +TYPE is the type of data desired, typically `STRING'. +TIME_STAMP is the time to use in the XConvertSelection call for foreign +selections. If omitted, defaults to the time for the last event." + (x-get-selection-value)) ;; From src/fontset.c: (fset 'query-fontset 'ignore) @@ -420,5 +420,4 @@ Errors out because it is not supposed to be called, ever." (provide 'pc-win) -;; arch-tag: 5cbdb455-b495-427b-95d0-e417d77d00b4 ;;; pc-win.el ends here diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el index d0e688da5f7..8705d9d8cba 100644 --- a/lisp/term/tty-colors.el +++ b/lisp/term/tty-colors.el @@ -768,11 +768,6 @@ (yes . 8)) "An alist of supported standard tty color modes and their aliases.") -(defvar tty-defined-color-alist nil - "An alist of defined terminal colors and their RGB values. - -See the docstring of `tty-color-alist' for the details.") - (defun tty-color-alist (&optional frame) "Return an alist of colors supported by FRAME's terminal. FRAME defaults to the selected frame. @@ -1039,5 +1034,4 @@ A color is considered gray if the 3 components of its RGB value are equal." (setq colors (cdr colors))) count)) -;; arch-tag: 84d5c3ef-ae22-4754-99ac-e6350c0967ae ;;; tty-colors.el ends here diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index ecc22d94d59..48e2464ebf6 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -28,6 +28,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (defvar tvi970-terminal-map (let ((map (make-sparse-keymap))) @@ -102,7 +104,7 @@ ;; Should keypad numbers send ordinary digits or distinct escape sequences? -(defun tvi970-set-keypad-mode (&optional arg) +(define-minor-mode tvi970-set-keypad-mode "Set the current mode of the TVI 970 numeric keypad. In ``numeric keypad mode'', the number keys on the keypad act as ordinary digits. In ``alternate keypad mode'', the keys send distinct @@ -111,12 +113,9 @@ independent of the normal number keys. With no argument, toggle between the two possible modes. With a positive argument, select alternate keypad mode. With a negative argument, select numeric keypad mode." - (interactive "P") - (let ((newval (if (null arg) - (not (terminal-parameter nil 'tvi970-keypad-numeric)) - (> (prefix-numeric-value arg) 0)))) - (set-terminal-parameter nil 'tvi970-keypad-numeric newval) - (send-string-to-terminal (if newval "\e=" "\e>")))) + :variable (terminal-parameter nil 'tvi970-keypad-numeric) + (send-string-to-terminal + (if (terminal-parameter nil 'tvi970-keypad-numeric) "\e=" "\e>"))) ;; arch-tag: c1334cf0-1462-41c3-a963-c077d175f8f0 ;;; tvi970.el ends here diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el index 58dfaeae934..cc861e63865 100644 --- a/lisp/term/vt100.el +++ b/lisp/term/vt100.el @@ -41,19 +41,13 @@ (tty-run-terminal-initialization (selected-frame) "lk201")) ;;; Controlling the screen width. -(defvar vt100-wide-mode (= (frame-width) 132) - "t if vt100 is in 132-column mode.") - -(defun vt100-wide-mode (&optional arg) +(define-minor-mode vt100-wide-mode "Toggle 132/80 column mode for vt100s. With positive argument, switch to 132-column mode. With negative argument, switch to 80-column mode." - (interactive "P") - (setq vt100-wide-mode - (if (null arg) (not vt100-wide-mode) - (> (prefix-numeric-value arg) 0))) - (send-string-to-terminal (if vt100-wide-mode "\e[?3h" "\e[?3l")) - (set-frame-width terminal-frame (if vt100-wide-mode 132 80))) + :global t :init-value (= (frame-width) 132) + (send-string-to-terminal (if vt100-wide-mode "\e[?3h" "\e[?3l")) + (set-frame-width terminal-frame (if vt100-wide-mode 132 80))) ;; arch-tag: 9ff41f24-a7c9-4dee-9cf2-fbaa951eb840 ;;; vt100.el ends here diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index b6d0330b7a4..e160e0278d4 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -148,18 +148,8 @@ the last file dropped is selected." (global-set-key [language-change] 'ignore) (defvar x-resource-name) -(defvar x-colors) -(defun xw-defined-colors (&optional frame) - "Internal function called by `defined-colors', which see." - (or frame (setq frame (selected-frame))) - (let ((defined-colors nil)) - (dolist (this-color (or (mapcar 'car w32-color-map) x-colors)) - (and (color-supported-p this-color frame t) - (setq defined-colors (cons this-color defined-colors)))) - defined-colors)) - ;;;; Function keys ;;; make f10 activate the real menubar rather than the mini-buffer menu @@ -196,10 +186,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") "Report an error when a suspend is attempted." (error "Suspending an Emacs running under W32 makes no sense")) -(defvar image-library-alist) +(defvar dynamic-library-alist) -;;; Set default known names for image libraries -(setq image-library-alist +;;; Set default known names for external libraries +(setq dynamic-library-alist (list '(xpm "libxpm.dll" "xpm4.dll" "libXpm-nox4.dll") ;; Versions of libpng 1.4.x and later are incompatible with @@ -324,5 +314,4 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (provide 'w32-win) -;; arch-tag: 69fb1701-28c2-4890-b351-3d1fe4b4f166 ;;; w32-win.el ends here diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el index f62f6aca0d6..65cc3680aed 100644 --- a/lisp/term/w32console.el +++ b/lisp/term/w32console.el @@ -45,7 +45,7 @@ ("white" 15 65535 65535 65535)) "A list of VGA console colors, their indices and 16-bit RGB values.") -(declare-function x-setup-function-keys "w32-fns" (frame)) +(declare-function x-setup-function-keys "term/common-win" (frame)) (defun terminal-init-w32console () "Terminal initialization function for w32 console." @@ -62,4 +62,4 @@ (tty-set-up-initial-frame-faces) (run-hooks 'terminal-init-w32-hook)) -;; arch-tag: 3195fd5e-ab86-4a46-b1dc-4f7a8c8deff3 +;;; w32console.el ends here diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 8a2b01cf9be..8d3ead687e6 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -252,50 +252,6 @@ exists." (defconst x-pointer-invisible 255) -(defvar x-colors) - -(defun xw-defined-colors (&optional frame) - "Internal function called by `defined-colors'." - (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)) - -;;;; Function keys - -(defvar x-alternatives-map - (let ((map (make-sparse-keymap))) - ;; Map certain keypad keys into ASCII characters that people usually expect. - (define-key map [M-backspace] [?\M-\d]) - (define-key map [M-delete] [?\M-\d]) - (define-key map [M-tab] [?\M-\t]) - (define-key map [M-linefeed] [?\M-\n]) - (define-key map [M-clear] [?\M-\C-l]) - (define-key map [M-return] [?\M-\C-m]) - (define-key map [M-escape] [?\M-\e]) - (define-key map [iso-lefttab] [backtab]) - (define-key map [S-iso-lefttab] [backtab]) - map) - "Keymap of possible alternative meanings for some keys.") - -(defun x-setup-function-keys (frame) - "Set up `function-key-map' on the graphical frame FRAME." - ;; Don't do this twice on the same display, or it would break - ;; normal-erase-is-backspace-mode. - (unless (terminal-parameter frame 'x-setup-function-keys) - ;; Map certain keypad keys into ASCII characters that people usually expect. - (with-selected-frame frame - (let ((map (copy-keymap x-alternatives-map))) - (set-keymap-parent map (keymap-parent local-function-key-map)) - (set-keymap-parent local-function-key-map map))) - (set-terminal-parameter frame 'x-setup-function-keys t))) - ;;;; Keysyms (defun vendor-specific-keysyms (vendor) @@ -1192,83 +1148,25 @@ as returned by `x-server-vendor'." ;; #x0dde THAI MAIHANAKAT Thai -;;;; Selections and cut buffers +;;;; Selections ;; We keep track of the last text selected here, so we can check the ;; current selection against it, and avoid passing back our own text -;; from x-cut-buffer-or-selection-value. We track all three +;; from x-selection-value. We track both ;; separately in case another X application only sets one of them -;; (say the cut buffer) we aren't fooled by the PRIMARY or -;; CLIPBOARD selection staying the same. +;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same. (defvar x-last-selected-text-clipboard nil "The value of the CLIPBOARD X 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.") -(defvar x-last-selected-text-cut nil - "The value of the X cut buffer last time we selected or pasted text. -The actual text stored in the X cut buffer is what encoded from this value.") -(defvar x-last-selected-text-cut-encoded nil - "The value of the X cut buffer last time we selected or pasted text. -This is the actual text stored in the X cut buffer.") -(defvar x-last-cut-buffer-coding 'iso-latin-1 - "The coding we last used to encode/decode the text from the X cut buffer") - -(defvar x-cut-buffer-max 20000 ; Note this value is overridden below. - "Max number of characters to put in the cut buffer. -It is said that overlarge strings are slow to put into the cut buffer.") - -(defcustom x-select-enable-clipboard nil - "Non-nil means cutting and pasting uses the clipboard. -This is in addition to, but in preference to, the primary selection. - -On MS-Windows, this is non-nil by default, since Windows does not -support other types of selections. \(The primary selection that is -set by Emacs is not accessible to other programs on Windows.\)" - :type 'boolean - :group 'killing) -(defcustom x-select-enable-primary t +(defcustom x-select-enable-primary nil "Non-nil means cutting and pasting uses the primary selection." :type 'boolean - :group 'killing) - -(defun x-select-text (text &optional push) - "Select TEXT, a string, according to the window system. - -On X, put TEXT in the primary X selection. For backward -compatibility with older X applications, set the value of X cut -buffer 0 as well, and if the optional argument PUSH is non-nil, -rotate the cut buffers. If `x-select-enable-clipboard' is -non-nil, copy the text to the X clipboard as well. - -On Windows, make TEXT the current selection. If -`x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. The argument PUSH is ignored. - -On Nextstep, put TEXT in the pasteboard; PUSH is ignored." - ;; With multi-tty, this function may be called from a tty frame. - (when (eq (framep (selected-frame)) 'x) - ;; Don't send the cut buffer too much text. - ;; It becomes slow, and if really big it causes errors. - (cond ((>= (length text) x-cut-buffer-max) - (x-set-cut-buffer "" push) - (setq x-last-selected-text-cut "" - x-last-selected-text-cut-encoded "")) - (t - (setq x-last-selected-text-cut text - x-last-cut-buffer-coding 'iso-latin-1 - x-last-selected-text-cut-encoded - ;; ICCCM says cut buffer always contain ISO-Latin-1 - (encode-coding-string text 'iso-latin-1)) - (x-set-cut-buffer x-last-selected-text-cut-encoded push))) - (when x-select-enable-primary - (x-set-selection 'PRIMARY text) - (setq x-last-selected-text-primary text)) - (when x-select-enable-clipboard - (x-set-selection 'CLIPBOARD text) - (setq x-last-selected-text-clipboard text)))) + :group 'killing + :version "24.1") (defvar x-select-request-type nil "*Data type request for X selection. @@ -1290,7 +1188,7 @@ The value nil is the same as this list: ;; The return value is already decoded. If x-get-selection causes an ;; error, this function return nil. -(defun x-selection-value (type) +(defun x-selection-value-internal (type) (let ((request-type (or x-select-request-type '(UTF8_STRING COMPOUND_TEXT STRING))) text) @@ -1308,17 +1206,16 @@ The value nil is the same as this list: text)) ;; Return the value of the current X selection. -;; Consult the selection, and the cut buffer. Treat empty strings -;; as if they were unset. +;; Consult the 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-cut-buffer-or-selection-value () +(defun x-selection-value () ;; With multi-tty, this function may be called from a tty frame. (when (eq (framep (selected-frame)) 'x) - (let (clip-text primary-text cut-text) + (let (clip-text primary-text) (when x-select-enable-clipboard - (setq clip-text (x-selection-value 'CLIPBOARD)) + (setq clip-text (x-selection-value-internal 'CLIPBOARD)) (if (string= clip-text "") (setq clip-text nil)) ;; Check the CLIPBOARD selection for 'newness', is it different @@ -1337,7 +1234,7 @@ The value nil is the same as this list: (t (setq x-last-selected-text-clipboard clip-text))))) (when x-select-enable-primary - (setq primary-text (x-selection-value 'PRIMARY)) + (setq primary-text (x-selection-value-internal '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. @@ -1354,69 +1251,45 @@ The value nil is the same as this list: (t (setq x-last-selected-text-primary primary-text))))) - (setq cut-text (x-get-cut-buffer 0)) - - ;; Check the x cut buffer for 'newness', is it different - ;; from what we remebered them to be last time we did a - ;; cut/paste operation. - (setq cut-text - (let ((next-coding (or next-selection-coding-system 'iso-latin-1))) - (cond ;; check cut buffer - ((or (not cut-text) (string= cut-text "")) - (setq x-last-selected-text-cut nil)) - ;; This short cut doesn't work because x-get-cut-buffer - ;; always returns a newly created string. - ;; ((eq cut-text x-last-selected-text-cut) nil) - ((and (string= cut-text x-last-selected-text-cut-encoded) - (eq x-last-cut-buffer-coding next-coding)) - ;; See the comment above. No need of this recording. - ;; Record the newer string, - ;; so subsequent calls can use the `eq' test. - ;; (setq x-last-selected-text-cut cut-text) - nil) - (t - (setq x-last-selected-text-cut-encoded cut-text - x-last-cut-buffer-coding next-coding - x-last-selected-text-cut - ;; ICCCM says cut buffer always contain ISO-Latin-1, but - ;; use next-selection-coding-system if not nil. - (decode-coding-string - cut-text next-coding)))))) - ;; 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) primary, - ;; and cut buffer. So return the first one that has changed + ;; 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). ;; ;; NOTE: There will be cases where more than one of these has ;; changed and the new values differ. This indicates that ;; something like the following has happened since the last time ;; we looked at the selections: Application X set all the - ;; selections, then Application Y set only one or two of them (say - ;; just the cut-buffer). In this case since we don't have + ;; selections, then Application Y set only one of them. + ;; In this case since we don't have ;; timestamps there is no way to know what the 'correct' value to ;; return is. The nice thing to do would be to tell the user we ;; saw multiple possible selections and ask the user which was the ;; one they wanted. - ;; This code is still a big improvement because now the user can - ;; futz with the current selection and get emacs to pay attention - ;; to the cut buffer again (previously as soon as clipboard or - ;; primary had been set the cut buffer would essentially never be - ;; checked again). - (or clip-text primary-text cut-text) + (or clip-text primary-text) ))) +(define-obsolete-function-alias 'x-cut-buffer-or-selection-value + 'x-selection-value "24.1") + ;; 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-cut-buffer-or-selection-value) +(setq interprogram-paste-function 'x-selection-value) + +;; Make paste from other applications use the decoding in x-select-request-type +;; and not just STRING. +(defun x-get-selection-value () + "Get the current value of the PRIMARY selection. +Request data types in the order specified by `x-select-request-type'." + (x-selection-value-internal 'PRIMARY)) (defun x-clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (interactive "*") - (let ((clipboard-text (x-selection-value 'CLIPBOARD)) + (let ((clipboard-text (x-selection-value-internal 'CLIPBOARD)) (x-select-enable-clipboard t)) (if (and clipboard-text (> (length clipboard-text) 0)) (kill-new clipboard-text)) @@ -1473,9 +1346,6 @@ The value nil is the same as this list: ;; are the initial display. (eq initial-window-system 'x)) - (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) - x-cut-buffer-max)) - ;; Create the default fontset. (create-default-fontset) @@ -1560,12 +1430,12 @@ The value nil is the same as this list: ;; Enable CLIPBOARD copy/paste through menu bar commands. (menu-bar-enable-clipboard) - ;; Override Paste so it looks at CLIPBOARD first. - (define-key menu-bar-edit-menu [paste] - (append '(menu-item "Paste" x-clipboard-yank - :enable (not buffer-read-only) - :help "Paste (yank) text most recently cut/copied") - nil)) + ;; ;; Override Paste so it looks at CLIPBOARD first. + ;; (define-key menu-bar-edit-menu [paste] + ;; (append '(menu-item "Paste" x-clipboard-yank + ;; :enable (not buffer-read-only) + ;; :help "Paste (yank) text most recently cut/copied") + ;; nil)) (setq x-initialized t)) @@ -1705,5 +1575,4 @@ This uses `icon-map-list' to map icon file names to stock icon names." (provide 'x-win) -;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78 ;;; x-win.el ends here |