Mercurial > emacs
comparison lisp/term/ns-win.el @ 96757:18b856a0216f
(ns-handle-switch): Simplify. Handle the numeric case.
(ns-handle-numeric-switch): Just call ns-handle-switch.
(ns-handle-name-switch, ns-handle-nxopen, ns-handle-nxopentemp)
(ns-handle-args): Simplify using `pop'.
(ns-display-name): Define (used in frame.el).
(menu-bar-select-frame): Add (ignored) arg to more closely match the
original definition.
(ns-perform-service): Declare.
(ns-save-preferences): Use fewer `let's.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Thu, 17 Jul 2008 02:35:52 +0000 |
parents | 92f7bbffcb45 |
children | 970848353475 |
comparison
equal
deleted
inserted
replaced
96756:6bce8c5e3365 | 96757:18b856a0216f |
---|---|
84 | 84 |
85 (defvar ns-invocation-args nil) | 85 (defvar ns-invocation-args nil) |
86 (defvar ns-command-line-resources nil) | 86 (defvar ns-command-line-resources nil) |
87 | 87 |
88 ;; Handler for switches of the form "-switch value" or "-switch". | 88 ;; Handler for switches of the form "-switch value" or "-switch". |
89 (defun ns-handle-switch (switch) | 89 (defun ns-handle-switch (switch &optional numeric) |
90 (let ((aelt (assoc switch command-line-ns-option-alist))) | 90 (let ((aelt (assoc switch command-line-ns-option-alist))) |
91 (if aelt | 91 (if aelt |
92 (let ((param (nth 3 aelt)) | 92 (setq default-frame-alist |
93 (value (nth 4 aelt))) | 93 (cons (cons (nth 3 aelt) |
94 (if value | 94 (if numeric |
95 (setq default-frame-alist | 95 (string-to-number (pop ns-invocation-args)) |
96 (cons (cons param value) | 96 (or (nth 4 aelt) (pop ns-invocation-args)))) |
97 default-frame-alist)) | 97 default-frame-alist))))) |
98 (setq default-frame-alist | |
99 (cons (cons param | |
100 (car ns-invocation-args)) | |
101 default-frame-alist) | |
102 ns-invocation-args (cdr ns-invocation-args))))))) | |
103 | 98 |
104 ;; Handler for switches of the form "-switch n" | 99 ;; Handler for switches of the form "-switch n" |
105 (defun ns-handle-numeric-switch (switch) | 100 (defun ns-handle-numeric-switch (switch) |
106 (let ((aelt (assoc switch command-line-ns-option-alist))) | 101 (ns-handle-switch switch t)) |
107 (if aelt | |
108 (let ((param (nth 3 aelt))) | |
109 (setq default-frame-alist | |
110 (cons (cons param | |
111 (string-to-number (car ns-invocation-args))) | |
112 default-frame-alist) | |
113 ns-invocation-args | |
114 (cdr ns-invocation-args)))))) | |
115 | 102 |
116 ;; Make -iconic apply only to the initial frame! | 103 ;; Make -iconic apply only to the initial frame! |
117 (defun ns-handle-iconic (switch) | 104 (defun ns-handle-iconic (switch) |
118 (setq initial-frame-alist | 105 (setq initial-frame-alist |
119 (cons '(visibility . icon) initial-frame-alist))) | 106 (cons '(visibility . icon) initial-frame-alist))) |
121 ;; Handle the -name option, set the name of | 108 ;; Handle the -name option, set the name of |
122 ;; the initial frame. | 109 ;; the initial frame. |
123 (defun ns-handle-name-switch (switch) | 110 (defun ns-handle-name-switch (switch) |
124 (or (consp ns-invocation-args) | 111 (or (consp ns-invocation-args) |
125 (error "%s: missing argument to `%s' option" (invocation-name) switch)) | 112 (error "%s: missing argument to `%s' option" (invocation-name) switch)) |
126 (setq initial-frame-alist (cons (cons 'name (car ns-invocation-args)) | 113 (setq initial-frame-alist (cons (cons 'name (pop ns-invocation-args)) |
127 initial-frame-alist) | 114 initial-frame-alist))) |
128 ns-invocation-args (cdr ns-invocation-args))) | 115 |
116 ;; Set (but not used?) in frame.el. | |
117 (defvar ns-display-name nil | |
118 "The name of the NS display on which Emacs was started.") | |
129 | 119 |
130 ;; nsterm.m. | 120 ;; nsterm.m. |
131 (defvar ns-input-file) | 121 (defvar ns-input-file) |
132 | 122 |
133 (defun ns-handle-nxopen (switch) | 123 (defun ns-handle-nxopen (switch) |
134 (setq unread-command-events (append unread-command-events '(ns-open-file)) | 124 (setq unread-command-events (append unread-command-events '(ns-open-file)) |
135 ns-input-file (append ns-input-file (list (car ns-invocation-args))) | 125 ns-input-file (append ns-input-file (list (pop ns-invocation-args))))) |
136 ns-invocation-args (cdr ns-invocation-args))) | |
137 | 126 |
138 (defun ns-handle-nxopentemp (switch) | 127 (defun ns-handle-nxopentemp (switch) |
139 (setq unread-command-events (append unread-command-events '(ns-open-temp-file)) | 128 (setq unread-command-events (append unread-command-events |
140 ns-input-file (append ns-input-file (list (car ns-invocation-args))) | 129 '(ns-open-temp-file)) |
141 ns-invocation-args (cdr ns-invocation-args))) | 130 ns-input-file (append ns-input-file (list (pop ns-invocation-args))))) |
142 | 131 |
143 (defun ns-ignore-0-arg (switch) | 132 (defun ns-ignore-0-arg (switch) |
144 ) | 133 ) |
145 (defun ns-ignore-1-arg (switch) | 134 (defun ns-ignore-1-arg (switch) |
146 (setq ns-invocation-args (cdr ns-invocation-args))) | 135 (setq ns-invocation-args (cdr ns-invocation-args))) |
156 This function returns ARGS minus the arguments that have been processed." | 145 This function returns ARGS minus the arguments that have been processed." |
157 ;; We use ARGS to accumulate the args that we don't handle here, to return. | 146 ;; We use ARGS to accumulate the args that we don't handle here, to return. |
158 (setq ns-invocation-args args | 147 (setq ns-invocation-args args |
159 args nil) | 148 args nil) |
160 (while ns-invocation-args | 149 (while ns-invocation-args |
161 (let* ((this-switch (car ns-invocation-args)) | 150 (let* ((this-switch (pop ns-invocation-args)) |
162 (orig-this-switch this-switch) | 151 (orig-this-switch this-switch) |
163 completion argval aelt handler) | 152 completion argval aelt handler) |
164 (setq ns-invocation-args (cdr ns-invocation-args)) | |
165 ;; Check for long options with attached arguments | 153 ;; Check for long options with attached arguments |
166 ;; and separate out the attached option argument into argval. | 154 ;; and separate out the attached option argument into argval. |
167 (if (string-match "^--[^=]*=" this-switch) | 155 (if (string-match "^--[^=]*=" this-switch) |
168 (setq argval (substring this-switch (match-end 0)) | 156 (setq argval (substring this-switch (match-end 0)) |
169 this-switch (substring this-switch 0 (1- (match-end 0))))) | 157 this-switch (substring this-switch 0 (1- (match-end 0))))) |
653 (define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo) | 641 (define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo) |
654 (define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill) | 642 (define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill) |
655 | 643 |
656 | 644 |
657 ;;;; Windows menu | 645 ;;;; Windows menu |
658 (defun menu-bar-select-frame () | 646 (defun menu-bar-select-frame (&optional frame) |
659 (interactive) | 647 (interactive) |
660 (make-frame-visible last-command-event) | 648 (make-frame-visible last-command-event) |
661 (raise-frame last-command-event) | 649 (raise-frame last-command-event) |
662 (select-frame last-command-event)) | 650 (select-frame last-command-event)) |
663 | 651 |
743 (raise-frame frame) | 731 (raise-frame frame) |
744 (select-frame frame))) | 732 (select-frame frame))) |
745 | 733 |
746 | 734 |
747 ;;;; Services | 735 ;;;; Services |
736 (declare-function ns-perform-service "nsfns.m" (service send)) | |
737 | |
748 (defun ns-define-service (path) | 738 (defun ns-define-service (path) |
749 (let ((mapping [menu-bar services]) | 739 (let ((mapping [menu-bar services]) |
750 (service (mapconcat 'identity path "/")) | 740 (service (mapconcat 'identity path "/")) |
751 (name (intern | 741 (name (intern |
752 (subst-char-in-string | 742 (subst-char-in-string |
919 :charset-list '(unicode) | 909 :charset-list '(unicode) |
920 :post-read-conversion 'ns-utf8-nfd-post-read-conversion) | 910 :post-read-conversion 'ns-utf8-nfd-post-read-conversion) |
921 (set-file-name-coding-system 'utf-8-nfd))) | 911 (set-file-name-coding-system 'utf-8-nfd))) |
922 | 912 |
923 ;; PENDING: disable composition-based display for Indic scripts as it | 913 ;; PENDING: disable composition-based display for Indic scripts as it |
924 ;; is not working well under NS for some reason | 914 ;; is not working well under NS for some reason |
925 (set-char-table-range composition-function-table | 915 (set-char-table-range composition-function-table |
926 '(#x0900 . #x0DFF) nil) | 916 '(#x0900 . #x0DFF) nil) |
927 | 917 |
928 | 918 |
929 ;;;; Inter-app communications support. | 919 ;;;; Inter-app communications support. |
1040 (ns-set-resource nil "UseQuickdrawSmoothing" | 1030 (ns-set-resource nil "UseQuickdrawSmoothing" |
1041 (if ns-use-qd-smoothing "YES" "NO")) | 1031 (if ns-use-qd-smoothing "YES" "NO")) |
1042 (ns-set-resource nil "UseSystemHighlightColor" | 1032 (ns-set-resource nil "UseSystemHighlightColor" |
1043 (if ns-use-system-highlight-color "YES" "NO")) | 1033 (if ns-use-system-highlight-color "YES" "NO")) |
1044 ;; Default frame parameters | 1034 ;; Default frame parameters |
1045 (let ((p (frame-parameters))) | 1035 (let ((p (frame-parameters)) |
1046 (let ((f (assq 'font p))) | 1036 v) |
1047 (if f (ns-set-resource nil "Font" (ns-font-name (cdr f))))) | 1037 (if (setq v (assq 'font p)) |
1048 (let ((fs (assq 'fontsize p))) | 1038 (ns-set-resource nil "Font" (ns-font-name (cdr v)))) |
1049 (if fs (ns-set-resource nil "FontSize" (number-to-string (cdr fs))))) | 1039 (if (setq v (assq 'fontsize p)) |
1050 (let ((fgc (assq 'foreground-color p))) | 1040 (ns-set-resource nil "FontSize" (number-to-string (cdr v)))) |
1051 (if fgc (ns-set-resource nil "Foreground" (cdr fgc)))) | 1041 (if (setq v (assq 'foreground-color p)) |
1052 (let ((bgc (assq 'background-color p))) | 1042 (ns-set-resource nil "Foreground" (cdr v))) |
1053 (if bgc (ns-set-resource nil "Background" (cdr bgc)))) | 1043 (if (setq v (assq 'background-color p)) |
1054 (let ((cc (assq 'cursor-color p))) | 1044 (ns-set-resource nil "Background" (cdr v))) |
1055 (if cc (ns-set-resource nil "CursorColor" (cdr cc)))) | 1045 (if (setq v (assq 'cursor-color p)) |
1056 (let ((ct (assq 'cursor-type p))) | 1046 (ns-set-resource nil "CursorColor" (cdr v))) |
1057 (if ct (ns-set-resource nil "CursorType" | 1047 (if (setq v (assq 'cursor-type p)) |
1058 (if (symbolp (cdr ct)) | 1048 (ns-set-resource nil "CursorType" (if (symbolp (cdr v)) |
1059 (symbol-name (cdr ct)) (cdr ct))))) | 1049 (symbol-name (cdr v)) |
1060 (let ((under (assq 'underline p))) | 1050 (cdr v)))) |
1061 (if under (ns-set-resource nil "Underline" | 1051 (if (setq v (assq 'underline p)) |
1062 (cond ((eq (cdr under) t) "YES") | 1052 (ns-set-resource nil "Underline" |
1063 ((eq (cdr under) nil) "NO") | 1053 (case (cdr v) |
1064 (t (cdr under)))))) | 1054 ((t) "YES") |
1065 (let ((ibw (assq 'internal-border-width p))) | 1055 ((nil) "NO") |
1066 (if ibw (ns-set-resource nil "InternalBorderWidth" | 1056 (t (cdr v))))) |
1067 (number-to-string (cdr ibw))))) | 1057 (if (setq v (assq 'internal-border-width p)) |
1068 (let ((vsb (assq 'vertical-scroll-bars p))) | 1058 (ns-set-resource nil "InternalBorderWidth" |
1069 (if vsb (ns-set-resource nil "VerticalScrollBars" | 1059 (number-to-string v))) |
1070 (case (cdr vsb) | 1060 (if (setq v (assq 'vertical-scroll-bars p)) |
1071 ((t) "YES") | 1061 (ns-set-resource nil "VerticalScrollBars" |
1072 ((nil) "NO") | 1062 (case (cdr v) |
1073 ((left) "left") | 1063 ((t) "YES") |
1074 ((right) "right") | 1064 ((nil) "NO") |
1075 (t nil))))) | 1065 ((left) "left") |
1076 (let ((height (assq 'height p))) | 1066 ((right) "right") |
1077 (if height (ns-set-resource nil "Height" | 1067 (t nil)))) |
1078 (number-to-string (cdr height))))) | 1068 (if (setq v (assq 'height p)) |
1079 (let ((width (assq 'width p))) | 1069 (ns-set-resource nil "Height" (number-to-string (cdr v)))) |
1080 (if width (ns-set-resource nil "Width" | 1070 (if (setq v (assq 'width p)) |
1081 (number-to-string (cdr width))))) | 1071 (ns-set-resource nil "Width" (number-to-string (cdr v)))) |
1082 (let ((top (assq 'top p))) | 1072 (if (setq v (assq 'top p)) |
1083 (if top (ns-set-resource nil "Top" | 1073 (ns-set-resource nil "Top" (number-to-string (cdr v)))) |
1084 (number-to-string (cdr top))))) | 1074 (if (setq v (assq 'left p)) |
1085 (let ((left (assq 'left p))) | 1075 (ns-set-resource nil "Left" (number-to-string (cdr v)))) |
1086 (if left (ns-set-resource nil "Left" | |
1087 (number-to-string (cdr left))))) | |
1088 ;; These not fully supported | 1076 ;; These not fully supported |
1089 (let ((ar (assq 'auto-raise p))) | 1077 (if (setq v (assq 'auto-raise p)) |
1090 (if ar (ns-set-resource nil "AutoRaise" | 1078 (ns-set-resource nil "AutoRaise" (if (cdr v) "YES" "NO"))) |
1091 (if (cdr ar) "YES" "NO")))) | 1079 (if (setq v (assq 'auto-lower p)) |
1092 (let ((al (assq 'auto-lower p))) | 1080 (ns-set-resource nil "AutoLower" (if (cdr v) "YES" "NO"))) |
1093 (if al (ns-set-resource nil "AutoLower" | 1081 (if (setq v (assq 'menu-bar-lines p)) |
1094 (if (cdr al) "YES" "NO")))) | 1082 (ns-set-resource nil "Menus" (if (cdr v) "YES" "NO"))) |
1095 (let ((mbl (assq 'menu-bar-lines p))) | |
1096 (if mbl (ns-set-resource nil "Menus" | |
1097 (if (cdr mbl) "YES" "NO")))) | |
1098 ) | 1083 ) |
1099 (let ((fl (face-list))) | 1084 (let ((fl (face-list))) |
1100 (while (consp fl) | 1085 (while (consp fl) |
1101 (or (eq 'default (car fl)) | 1086 (or (eq 'default (car fl)) |
1102 ;; dont save Default* since it causes all created faces to | 1087 ;; dont save Default* since it causes all created faces to |
1407 ;; Return the value of the current NS selection. For compatibility | 1392 ;; Return the value of the current NS selection. For compatibility |
1408 ;; with older NS applications, this checks cut buffer 0 before | 1393 ;; with older NS applications, this checks cut buffer 0 before |
1409 ;; retrieving the value of the primary selection. | 1394 ;; retrieving the value of the primary selection. |
1410 (defun ns-pasteboard-value () | 1395 (defun ns-pasteboard-value () |
1411 (let (text) | 1396 (let (text) |
1412 | 1397 |
1413 ;; Consult the selection, then the cut buffer. Treat empty strings | 1398 ;; Consult the selection, then the cut buffer. Treat empty strings |
1414 ;; as if they were unset. | 1399 ;; as if they were unset. |
1415 (or text (setq text (ns-get-pasteboard))) | 1400 (or text (setq text (ns-get-pasteboard))) |
1416 (if (string= text "") (setq text nil)) | 1401 (if (string= text "") (setq text nil)) |
1417 | 1402 |
1418 (cond | 1403 (cond |
1419 ((not text) nil) | 1404 ((not text) nil) |
1420 ((eq text ns-last-selected-text) nil) | 1405 ((eq text ns-last-selected-text) nil) |
1421 ((string= text ns-last-selected-text) | 1406 ((string= text ns-last-selected-text) |
1422 ;; Record the newer string, so subsequent calls can use the `eq' test. | 1407 ;; Record the newer string, so subsequent calls can use the `eq' test. |