Commit | Line | Data |
---|---|---|
c0642f6d GM |
1 | ;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system |
2 | ||
a5e1066d GM |
3 | ;; Copyright (C) 1993, 1994, 2005, 2006, 2007, 2008 |
4 | ;; Free Software Foundation, Inc. | |
c0642f6d | 5 | |
82a330df CY |
6 | ;; Authors: Carl Edman, Christian Limpach, Scott Bender, |
7 | ;; Christophe de Dinechin, Adrian Robert | |
c0642f6d GM |
8 | ;; Keywords: terminals |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation, either version 3 of the License, or | |
15 | ;; (at your option) any later version. | |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
edfda783 AR |
24 | |
25 | ;;; Commentary: | |
26 | ||
a5a1b464 CY |
27 | ;; ns-win.el: this file is loaded from ../lisp/startup.el when it |
28 | ;; recognizes that Nextstep windows are to be used. Command line | |
29 | ;; switches are parsed and those pertaining to Nextstep are processed | |
30 | ;; and removed from the command line. The Nextstep display is opened | |
31 | ;; and hooks are set for popping up the initial window. | |
edfda783 AR |
32 | |
33 | ;; startup.el will then examine startup files, and eventually call the hooks | |
34 | ;; which create the first window (s). | |
35 | ||
a5a1b464 CY |
36 | ;; A number of other Nextstep convenience functions are defined in |
37 | ;; this file, which works in close coordination with src/nsfns.m. | |
edfda783 AR |
38 | |
39 | ;;; Code: | |
40 | ||
41 | ||
42 | (if (not (featurep 'ns-windowing)) | |
a5a1b464 | 43 | (error "%s: Loading ns-win.el but not compiled for GNUStep/MacOS" |
edfda783 AR |
44 | (invocation-name))) |
45 | ||
ebe68042 SM |
46 | (eval-when-compile (require 'cl)) |
47 | ||
edfda783 AR |
48 | ;; Documentation-purposes only: actually loaded in loadup.el |
49 | (require 'frame) | |
50 | (require 'mouse) | |
51 | (require 'faces) | |
52 | (require 'easymenu) | |
53 | (require 'menu-bar) | |
54 | (require 'fontset) | |
55 | ||
ebe68042 SM |
56 | ;; Not needed? |
57 | ;;(require 'ispell) | |
edfda783 | 58 | |
c0642f6d GM |
59 | ;; nsterm.m |
60 | (defvar ns-version-string) | |
61 | (defvar ns-expand-space) | |
62 | (defvar ns-cursor-blink-rate) | |
63 | (defvar ns-alternate-modifier) | |
64 | ||
65 | (declare-function ns-server-vendor "nsfns.m" (&optional display)) | |
66 | (declare-function ns-server-version "nsfns.m" (&optional display)) | |
67 | ||
edfda783 AR |
68 | ;;;; Command line argument handling. |
69 | ||
70 | (defvar ns-invocation-args nil) | |
71 | (defvar ns-command-line-resources nil) | |
72 | ||
73 | ;; Handler for switches of the form "-switch value" or "-switch". | |
d377ef4a | 74 | (defun ns-handle-switch (switch &optional numeric) |
edfda783 AR |
75 | (let ((aelt (assoc switch command-line-ns-option-alist))) |
76 | (if aelt | |
d377ef4a GM |
77 | (setq default-frame-alist |
78 | (cons (cons (nth 3 aelt) | |
79 | (if numeric | |
80 | (string-to-number (pop ns-invocation-args)) | |
81 | (or (nth 4 aelt) (pop ns-invocation-args)))) | |
82 | default-frame-alist))))) | |
edfda783 AR |
83 | |
84 | ;; Handler for switches of the form "-switch n" | |
85 | (defun ns-handle-numeric-switch (switch) | |
d377ef4a | 86 | (ns-handle-switch switch t)) |
edfda783 AR |
87 | |
88 | ;; Make -iconic apply only to the initial frame! | |
89 | (defun ns-handle-iconic (switch) | |
90 | (setq initial-frame-alist | |
91 | (cons '(visibility . icon) initial-frame-alist))) | |
92 | ||
82a330df | 93 | ;; Handle the -name option, set the name of the initial frame. |
edfda783 AR |
94 | (defun ns-handle-name-switch (switch) |
95 | (or (consp ns-invocation-args) | |
96 | (error "%s: missing argument to `%s' option" (invocation-name) switch)) | |
d377ef4a GM |
97 | (setq initial-frame-alist (cons (cons 'name (pop ns-invocation-args)) |
98 | initial-frame-alist))) | |
99 | ||
100 | ;; Set (but not used?) in frame.el. | |
101 | (defvar ns-display-name nil | |
a5a1b464 | 102 | "The name of the Nextstep display on which Emacs was started.") |
edfda783 | 103 | |
c0642f6d GM |
104 | ;; nsterm.m. |
105 | (defvar ns-input-file) | |
106 | ||
edfda783 AR |
107 | (defun ns-handle-nxopen (switch) |
108 | (setq unread-command-events (append unread-command-events '(ns-open-file)) | |
d377ef4a | 109 | ns-input-file (append ns-input-file (list (pop ns-invocation-args))))) |
edfda783 AR |
110 | |
111 | (defun ns-handle-nxopentemp (switch) | |
d377ef4a GM |
112 | (setq unread-command-events (append unread-command-events |
113 | '(ns-open-temp-file)) | |
114 | ns-input-file (append ns-input-file (list (pop ns-invocation-args))))) | |
edfda783 | 115 | |
82a330df | 116 | (defun ns-ignore-0-arg (switch)) |
edfda783 AR |
117 | (defun ns-ignore-1-arg (switch) |
118 | (setq ns-invocation-args (cdr ns-invocation-args))) | |
119 | (defun ns-ignore-2-arg (switch) | |
120 | (setq ns-invocation-args (cddr ns-invocation-args))) | |
121 | ||
122 | (defun ns-handle-args (args) | |
a5a1b464 | 123 | "Process Nextstep-related command line options. |
82a330df | 124 | This is run before the user's startup file is loaded. |
a5a1b464 CY |
125 | The options in ARGS are copied to `ns-invocation-args'. |
126 | The Nextstep-related settings are then applied using the handlers | |
82a330df | 127 | defined in `command-line-ns-option-alist'. |
a5a1b464 | 128 | The return value is ARGS minus the number of arguments processed." |
edfda783 AR |
129 | ;; We use ARGS to accumulate the args that we don't handle here, to return. |
130 | (setq ns-invocation-args args | |
131 | args nil) | |
132 | (while ns-invocation-args | |
d377ef4a | 133 | (let* ((this-switch (pop ns-invocation-args)) |
edfda783 AR |
134 | (orig-this-switch this-switch) |
135 | completion argval aelt handler) | |
edfda783 AR |
136 | ;; Check for long options with attached arguments |
137 | ;; and separate out the attached option argument into argval. | |
138 | (if (string-match "^--[^=]*=" this-switch) | |
139 | (setq argval (substring this-switch (match-end 0)) | |
140 | this-switch (substring this-switch 0 (1- (match-end 0))))) | |
141 | ;; Complete names of long options. | |
142 | (if (string-match "^--" this-switch) | |
143 | (progn | |
144 | (setq completion (try-completion this-switch | |
145 | command-line-ns-option-alist)) | |
146 | (if (eq completion t) | |
147 | ;; Exact match for long option. | |
148 | nil | |
149 | (if (stringp completion) | |
150 | (let ((elt (assoc completion command-line-ns-option-alist))) | |
151 | ;; Check for abbreviated long option. | |
152 | (or elt | |
153 | (error "Option `%s' is ambiguous" this-switch)) | |
154 | (setq this-switch completion)))))) | |
155 | (setq aelt (assoc this-switch command-line-ns-option-alist)) | |
156 | (if aelt (setq handler (nth 2 aelt))) | |
157 | (if handler | |
158 | (if argval | |
159 | (let ((ns-invocation-args | |
160 | (cons argval ns-invocation-args))) | |
161 | (funcall handler this-switch)) | |
162 | (funcall handler this-switch)) | |
163 | (setq args (cons orig-this-switch args))))) | |
164 | (nreverse args)) | |
165 | ||
166 | (defun x-parse-geometry (geom) | |
a5a1b464 | 167 | "Parse a Nextstep-style geometry string STRING. |
edfda783 AR |
168 | Returns an alist of the form ((top . TOP), (left . LEFT) ... ). |
169 | The properties returned may include `top', `left', `height', and `width'." | |
a5a1b464 CY |
170 | (when (string-match "\\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\)\ |
171 | \\( \\([0-9]+\\) ?\\)?\\)?\\)?" | |
172 | geom) | |
173 | (apply | |
174 | 'append | |
175 | (list | |
176 | (list (cons 'top (string-to-number (match-string 1 geom)))) | |
177 | (if (match-string 3 geom) | |
178 | (list (cons 'left (string-to-number (match-string 3 geom))))) | |
179 | (if (match-string 5 geom) | |
180 | (list (cons 'height (string-to-number (match-string 5 geom))))) | |
181 | (if (match-string 7 geom) | |
182 | (list (cons 'width (string-to-number (match-string 7 geom))))))))) | |
edfda783 AR |
183 | |
184 | ;;;; Keyboard mapping. | |
185 | ||
186 | ;; These tell read-char how to convert | |
187 | ;; these special chars to ASCII. | |
188 | (put 'backspace 'ascii-character 127) | |
189 | (put 'delete 'ascii-character 127) | |
190 | (put 'tab 'ascii-character ?\t) | |
191 | (put 'S-tab 'ascii-character (logior 16 ?\t)) | |
192 | (put 'linefeed 'ascii-character ?\n) | |
193 | (put 'clear 'ascii-character 12) | |
194 | (put 'return 'ascii-character 13) | |
195 | (put 'escape 'ascii-character ?\e) | |
196 | ||
197 | ;; Map certain keypad keys into ASCII characters | |
198 | ;; that people usually expect. | |
199 | (define-key function-key-map [backspace] [127]) | |
200 | (define-key function-key-map [delete] [127]) | |
201 | (define-key function-key-map [tab] [?\t]) | |
202 | (define-key function-key-map [S-tab] [25]) | |
203 | (define-key function-key-map [linefeed] [?\n]) | |
204 | (define-key function-key-map [clear] [11]) | |
205 | (define-key function-key-map [return] [13]) | |
206 | (define-key function-key-map [escape] [?\e]) | |
207 | (define-key function-key-map [M-backspace] [?\M-\d]) | |
208 | (define-key function-key-map [M-delete] [?\M-\d]) | |
209 | (define-key function-key-map [M-tab] [?\M-\t]) | |
210 | (define-key function-key-map [M-linefeed] [?\M-\n]) | |
211 | (define-key function-key-map [M-clear] [?\M-\013]) | |
212 | (define-key function-key-map [M-return] [?\M-\015]) | |
213 | (define-key function-key-map [M-escape] [?\M-\e]) | |
214 | ||
215 | ||
a5a1b464 | 216 | ;; Here are some Nextstep-like bindings for command key sequences. |
edfda783 AR |
217 | (define-key global-map [?\s-,] 'ns-popup-prefs-panel) |
218 | (define-key global-map [?\s-'] 'next-multiframe-window) | |
219 | (define-key global-map [?\s-`] 'other-frame) | |
220 | (define-key global-map [?\s--] 'center-line) | |
221 | (define-key global-map [?\s-:] 'ispell) | |
222 | (define-key global-map [?\s-\;] 'ispell-next) | |
223 | (define-key global-map [?\s-?] 'info) | |
224 | (define-key global-map [?\s-^] 'kill-some-buffers) | |
225 | (define-key global-map [?\s-&] 'kill-this-buffer) | |
226 | (define-key global-map [?\s-C] 'ns-popup-color-panel) | |
227 | (define-key global-map [?\s-D] 'dired) | |
228 | (define-key global-map [?\s-E] 'edit-abbrevs) | |
229 | (define-key global-map [?\s-L] 'shell-command) | |
230 | (define-key global-map [?\s-M] 'manual-entry) | |
231 | (define-key global-map [?\s-S] 'ns-write-file-using-panel) | |
232 | (define-key global-map [?\s-a] 'mark-whole-buffer) | |
233 | (define-key global-map [?\s-c] 'ns-copy-including-secondary) | |
234 | (define-key global-map [?\s-d] 'isearch-repeat-backward) | |
235 | (define-key global-map [?\s-e] 'isearch-yank-kill) | |
236 | (define-key global-map [?\s-f] 'isearch-forward) | |
237 | (define-key global-map [?\s-g] 'isearch-repeat-forward) | |
238 | (define-key global-map [?\s-h] 'ns-do-hide-emacs) | |
239 | (define-key global-map [?\s-H] 'ns-do-hide-others) | |
240 | (define-key global-map [?\s-j] 'exchange-point-and-mark) | |
241 | (define-key global-map [?\s-k] 'kill-this-buffer) | |
242 | (define-key global-map [?\s-l] 'goto-line) | |
243 | (define-key global-map [?\s-m] 'iconify-frame) | |
244 | (define-key global-map [?\s-n] 'make-frame) | |
245 | (define-key global-map [?\s-o] 'ns-open-file-using-panel) | |
246 | (define-key global-map [?\s-p] 'ns-print-buffer) | |
247 | (define-key global-map [?\s-q] 'save-buffers-kill-emacs) | |
248 | (define-key global-map [?\s-s] 'save-buffer) | |
249 | (define-key global-map [?\s-t] 'ns-popup-font-panel) | |
250 | (define-key global-map [?\s-u] 'revert-buffer) | |
251 | (define-key global-map [?\s-v] 'yank) | |
252 | (define-key global-map [?\s-w] 'delete-frame) | |
253 | (define-key global-map [?\s-x] 'kill-region) | |
254 | (define-key global-map [?\s-y] 'ns-paste-secondary) | |
255 | (define-key global-map [?\s-z] 'undo) | |
256 | (define-key global-map [?\s-|] 'shell-command-on-region) | |
257 | (define-key global-map [s-kp-bar] 'shell-command-on-region) | |
ebe68042 | 258 | ;; (as in Terminal.app) |
edfda783 AR |
259 | (define-key global-map [s-right] 'ns-next-frame) |
260 | (define-key global-map [s-left] 'ns-prev-frame) | |
261 | ||
262 | (define-key global-map [home] 'beginning-of-buffer) | |
263 | (define-key global-map [end] 'end-of-buffer) | |
264 | (define-key global-map [kp-home] 'beginning-of-buffer) | |
265 | (define-key global-map [kp-end] 'end-of-buffer) | |
266 | (define-key global-map [kp-prior] 'scroll-down) | |
267 | (define-key global-map [kp-next] 'scroll-up) | |
268 | ||
269 | ||
a5a1b464 | 270 | ;; Special Nextstep-generated events are converted to function keys. Here |
edfda783 AR |
271 | ;; are the bindings for them. |
272 | (define-key global-map [ns-power-off] | |
ebe68042 | 273 | (lambda () (interactive) (save-buffers-kill-emacs t))) |
edfda783 AR |
274 | (define-key global-map [ns-open-file] 'ns-find-file) |
275 | (define-key global-map [ns-open-temp-file] [ns-open-file]) | |
276 | (define-key global-map [ns-drag-file] 'ns-insert-file) | |
277 | (define-key global-map [ns-drag-color] 'ns-set-foreground-at-mouse) | |
278 | (define-key global-map [S-ns-drag-color] 'ns-set-background-at-mouse) | |
279 | (define-key global-map [ns-drag-text] 'ns-insert-text) | |
280 | (define-key global-map [ns-change-font] 'ns-respond-to-change-font) | |
281 | (define-key global-map [ns-open-file-line] 'ns-open-file-select-line) | |
282 | (define-key global-map [ns-insert-working-text] 'ns-insert-working-text) | |
283 | (define-key global-map [ns-delete-working-text] 'ns-delete-working-text) | |
284 | (define-key global-map [ns-spi-service-call] 'ns-spi-service-call) | |
285 | ||
286 | ||
287 | ||
b90cc058 | 288 | ;; Functions to set environment variables by running a subshell. |
a5a1b464 CY |
289 | ;;; Idea based on Nextstep 4.2 distribution, this version of code |
290 | ;;; based on mac-read-environment-vars-from-shell () by David Reitter. | |
b90cc058 CY |
291 | ;;; Mostly used only under ns-extended-platform-support-mode. |
292 | ||
293 | (defun ns-make-command-string (cmdlist) | |
a5e1066d | 294 | (mapconcat 'identity cmdlist " ; ")) |
b90cc058 CY |
295 | |
296 | ;;;###autoload | |
297 | (defun ns-grabenv (&optional shell-path startup) | |
298 | "Set the Emacs environment using the output of a shell command. | |
299 | This runs a shell subprocess, and interpret its output as a | |
300 | series of environment variables to insert into the emacs | |
301 | environment. | |
302 | SHELL-PATH gives the path to the shell; if nil, this defaults to | |
303 | the current setting of `shell-file-name'. | |
304 | STARTUP is a list of commands for the shell to execute; if nil, | |
305 | this defaults to \"printenv\"." | |
306 | (interactive) | |
307 | (with-temp-buffer | |
308 | (let ((shell-file-name (if shell-path shell-path shell-file-name)) | |
309 | (cmd (ns-make-command-string (if startup startup '("printenv"))))) | |
310 | (shell-command cmd t) | |
311 | (while (search-forward-regexp "^\\([A-Za-z_0-9]+\\)=\\(.*\\)$" nil t) | |
312 | (setenv (match-string 1) | |
313 | (if (equal (match-string 1) "PATH") | |
314 | (concat (getenv "PATH") ":" (match-string 2)) | |
315 | (match-string 2))))))) | |
2f93961f CY |
316 | |
317 | ;; Set up a number of aliases and other layers to pretend we're using | |
318 | ;; the Choi/Mitsuharu Carbon port. | |
319 | ||
320 | (defvaralias 'mac-allow-anti-aliasing 'ns-antialias-text) | |
321 | (defvaralias 'mac-command-modifier 'ns-command-modifier) | |
322 | (defvaralias 'mac-control-modifier 'ns-control-modifier) | |
323 | (defvaralias 'mac-option-modifier 'ns-option-modifier) | |
324 | (defvaralias 'mac-function-modifier 'ns-function-modifier) | |
edfda783 AR |
325 | |
326 | ;; alt-up/down scrolling a la Stuart.app | |
327 | ;; only activated if ns-extended-platform-support is on | |
328 | (defun up-one () (interactive) (scroll-up 1)) | |
329 | (defun down-one () (interactive) (scroll-down 1)) | |
330 | (defun left-one () (interactive) (scroll-left 1)) | |
331 | (defun right-one () (interactive) (scroll-right 1)) | |
332 | ||
c0642f6d GM |
333 | (defvar menu-bar-ns-file-menu) ; below |
334 | ||
a5a1b464 CY |
335 | ;; Toggle some additional Nextstep-like features that may interfere |
336 | ;; with users' expectations coming from emacs on other platforms. | |
edfda783 | 337 | (define-minor-mode ns-extended-platform-support-mode |
a5a1b464 | 338 | "Toggle Nextstep extended platform support features. |
edfda783 | 339 | When this mode is active (no modeline indicator): |
38f4308d | 340 | - File menu is altered slightly in keeping with conventions. |
edfda783 | 341 | - Meta-up, meta-down are bound to scroll window up and down one line. |
38f4308d AR |
342 | - Screen position is preserved in scrolling. |
343 | - Transient mark mode is activated" | |
edfda783 AR |
344 | :init-value nil |
345 | :global t | |
346 | :group 'ns | |
347 | (if ns-extended-platform-support-mode | |
348 | (progn | |
ebe68042 SM |
349 | (global-set-key [M-up] 'down-one) |
350 | (global-set-key [M-down] 'up-one) | |
351 | ;; These conflict w/word-left, word-right. | |
352 | ;;(global-set-key [M-left] 'left-one) | |
353 | ;;(global-set-key [M-right] 'right-one) | |
354 | ||
355 | (setq scroll-preserve-screen-position t) | |
356 | (transient-mark-mode 1) | |
357 | ||
a5a1b464 CY |
358 | ;; Change file menu to simplify and add a couple of |
359 | ;; Nextstep-specific items | |
ebe68042 SM |
360 | (easy-menu-remove-item global-map '("menu-bar") 'file) |
361 | (easy-menu-add-item global-map '(menu-bar) | |
362 | (cons "File" menu-bar-ns-file-menu) 'edit)) | |
edfda783 | 363 | (progn |
ebe68042 SM |
364 | ;; Undo everything above. |
365 | (global-unset-key [M-up]) | |
366 | (global-unset-key [M-down]) | |
367 | (setq scroll-preserve-screen-position nil) | |
368 | (transient-mark-mode 0) | |
369 | (easy-menu-remove-item global-map '("menu-bar") 'file) | |
370 | (easy-menu-add-item global-map '(menu-bar) | |
371 | (cons "File" menu-bar-file-menu) 'edit)))) | |
edfda783 AR |
372 | |
373 | ||
374 | (defun x-setup-function-keys (frame) | |
a5a1b464 | 375 | "Set up function Keys for Nextstep for frame FRAME." |
edfda783 AR |
376 | (unless (terminal-parameter frame 'x-setup-function-keys) |
377 | (with-selected-frame frame | |
378 | (setq interprogram-cut-function 'ns-select-text | |
379 | interprogram-paste-function 'ns-pasteboard-value) | |
ebe68042 SM |
380 | ;; (let ((map (copy-keymap x-alternatives-map))) |
381 | ;; (set-keymap-parent map (keymap-parent local-function-key-map)) | |
382 | ;; (set-keymap-parent local-function-key-map map)) | |
383 | (setq system-key-alist | |
384 | (list | |
385 | (cons (logior (lsh 0 16) 1) 'ns-power-off) | |
386 | (cons (logior (lsh 0 16) 2) 'ns-open-file) | |
387 | (cons (logior (lsh 0 16) 3) 'ns-open-temp-file) | |
388 | (cons (logior (lsh 0 16) 4) 'ns-drag-file) | |
389 | (cons (logior (lsh 0 16) 5) 'ns-drag-color) | |
390 | (cons (logior (lsh 0 16) 6) 'ns-drag-text) | |
391 | (cons (logior (lsh 0 16) 7) 'ns-change-font) | |
392 | (cons (logior (lsh 0 16) 8) 'ns-open-file-line) | |
393 | (cons (logior (lsh 0 16) 9) 'ns-insert-working-text) | |
394 | (cons (logior (lsh 0 16) 10) 'ns-delete-working-text) | |
395 | (cons (logior (lsh 0 16) 11) 'ns-spi-service-call) | |
396 | (cons (logior (lsh 1 16) 32) 'f1) | |
397 | (cons (logior (lsh 1 16) 33) 'f2) | |
398 | (cons (logior (lsh 1 16) 34) 'f3) | |
399 | (cons (logior (lsh 1 16) 35) 'f4) | |
400 | (cons (logior (lsh 1 16) 36) 'f5) | |
401 | (cons (logior (lsh 1 16) 37) 'f6) | |
402 | (cons (logior (lsh 1 16) 38) 'f7) | |
403 | (cons (logior (lsh 1 16) 39) 'f8) | |
404 | (cons (logior (lsh 1 16) 40) 'f9) | |
405 | (cons (logior (lsh 1 16) 41) 'f10) | |
406 | (cons (logior (lsh 1 16) 42) 'f11) | |
407 | (cons (logior (lsh 1 16) 43) 'f12) | |
408 | (cons (logior (lsh 1 16) 44) 'kp-insert) | |
409 | (cons (logior (lsh 1 16) 45) 'kp-delete) | |
410 | (cons (logior (lsh 1 16) 46) 'kp-home) | |
411 | (cons (logior (lsh 1 16) 47) 'kp-end) | |
412 | (cons (logior (lsh 1 16) 48) 'kp-prior) | |
413 | (cons (logior (lsh 1 16) 49) 'kp-next) | |
414 | (cons (logior (lsh 1 16) 50) 'print-screen) | |
415 | (cons (logior (lsh 1 16) 51) 'scroll-lock) | |
416 | (cons (logior (lsh 1 16) 52) 'pause) | |
417 | (cons (logior (lsh 1 16) 53) 'system) | |
418 | (cons (logior (lsh 1 16) 54) 'break) | |
419 | (cons (logior (lsh 1 16) 56) 'please-tell-carl-what-this-key-is-called-56) | |
420 | (cons (logior (lsh 1 16) 61) 'please-tell-carl-what-this-key-is-called-61) | |
421 | (cons (logior (lsh 1 16) 62) 'please-tell-carl-what-this-key-is-called-62) | |
422 | (cons (logior (lsh 1 16) 63) 'please-tell-carl-what-this-key-is-called-63) | |
423 | (cons (logior (lsh 1 16) 64) 'please-tell-carl-what-this-key-is-called-64) | |
424 | (cons (logior (lsh 1 16) 69) 'please-tell-carl-what-this-key-is-called-69) | |
425 | (cons (logior (lsh 1 16) 70) 'please-tell-carl-what-this-key-is-called-70) | |
426 | (cons (logior (lsh 1 16) 71) 'please-tell-carl-what-this-key-is-called-71) | |
427 | (cons (logior (lsh 1 16) 72) 'please-tell-carl-what-this-key-is-called-72) | |
428 | (cons (logior (lsh 1 16) 73) 'please-tell-carl-what-this-key-is-called-73) | |
429 | (cons (logior (lsh 2 16) 3) 'kp-enter) | |
430 | (cons (logior (lsh 2 16) 9) 'kp-tab) | |
431 | (cons (logior (lsh 2 16) 28) 'kp-quit) | |
432 | (cons (logior (lsh 2 16) 35) 'kp-hash) | |
433 | (cons (logior (lsh 2 16) 42) 'kp-multiply) | |
434 | (cons (logior (lsh 2 16) 43) 'kp-add) | |
435 | (cons (logior (lsh 2 16) 44) 'kp-separator) | |
436 | (cons (logior (lsh 2 16) 45) 'kp-subtract) | |
437 | (cons (logior (lsh 2 16) 46) 'kp-decimal) | |
438 | (cons (logior (lsh 2 16) 47) 'kp-divide) | |
439 | (cons (logior (lsh 2 16) 48) 'kp-0) | |
440 | (cons (logior (lsh 2 16) 49) 'kp-1) | |
441 | (cons (logior (lsh 2 16) 50) 'kp-2) | |
442 | (cons (logior (lsh 2 16) 51) 'kp-3) | |
443 | (cons (logior (lsh 2 16) 52) 'kp-4) | |
444 | (cons (logior (lsh 2 16) 53) 'kp-5) | |
445 | (cons (logior (lsh 2 16) 54) 'kp-6) | |
446 | (cons (logior (lsh 2 16) 55) 'kp-7) | |
447 | (cons (logior (lsh 2 16) 56) 'kp-8) | |
448 | (cons (logior (lsh 2 16) 57) 'kp-9) | |
449 | (cons (logior (lsh 2 16) 60) 'kp-less) | |
450 | (cons (logior (lsh 2 16) 61) 'kp-equal) | |
451 | (cons (logior (lsh 2 16) 62) 'kp-more) | |
452 | (cons (logior (lsh 2 16) 64) 'kp-at) | |
453 | (cons (logior (lsh 2 16) 92) 'kp-backslash) | |
454 | (cons (logior (lsh 2 16) 96) 'kp-backtick) | |
455 | (cons (logior (lsh 2 16) 124) 'kp-bar) | |
456 | (cons (logior (lsh 2 16) 126) 'kp-tilde) | |
457 | (cons (logior (lsh 2 16) 157) 'kp-mu) | |
458 | (cons (logior (lsh 2 16) 165) 'kp-yen) | |
459 | (cons (logior (lsh 2 16) 167) 'kp-paragraph) | |
460 | (cons (logior (lsh 2 16) 172) 'left) | |
461 | (cons (logior (lsh 2 16) 173) 'up) | |
462 | (cons (logior (lsh 2 16) 174) 'right) | |
463 | (cons (logior (lsh 2 16) 175) 'down) | |
464 | (cons (logior (lsh 2 16) 176) 'kp-ring) | |
465 | (cons (logior (lsh 2 16) 201) 'kp-square) | |
466 | (cons (logior (lsh 2 16) 204) 'kp-cube) | |
467 | (cons (logior (lsh 3 16) 8) 'backspace) | |
468 | (cons (logior (lsh 3 16) 9) 'tab) | |
469 | (cons (logior (lsh 3 16) 10) 'linefeed) | |
470 | (cons (logior (lsh 3 16) 11) 'clear) | |
471 | (cons (logior (lsh 3 16) 13) 'return) | |
472 | (cons (logior (lsh 3 16) 18) 'pause) | |
473 | (cons (logior (lsh 3 16) 25) 'S-tab) | |
474 | (cons (logior (lsh 3 16) 27) 'escape) | |
475 | (cons (logior (lsh 3 16) 127) 'delete) | |
476 | )) | |
477 | (set-terminal-parameter frame 'x-setup-function-keys t)))) | |
edfda783 AR |
478 | |
479 | ||
480 | ||
481 | ;;;; Miscellaneous mouse bindings. | |
482 | ||
a5a1b464 | 483 | ;;; Allow shift-clicks to work just like under Nextstep |
edfda783 AR |
484 | (defun mouse-extend-region (event) |
485 | "Move point or mark so as to extend region. | |
486 | This should be bound to a mouse click event type." | |
487 | (interactive "e") | |
488 | (mouse-minibuffer-check event) | |
489 | (let ((posn (event-end event))) | |
490 | (if (not (windowp (posn-window posn))) | |
491 | (error "Cursor not in text area of window")) | |
492 | (select-window (posn-window posn)) | |
493 | (cond | |
494 | ((not (numberp (posn-point posn)))) | |
495 | ((or (not mark-active) (> (abs (- (posn-point posn) (point))) | |
496 | (abs (- (posn-point posn) (mark))))) | |
497 | (let ((point-save (point))) | |
498 | (unwind-protect | |
499 | (progn | |
500 | (goto-char (posn-point posn)) | |
501 | (push-mark nil t t) | |
502 | (or transient-mark-mode | |
503 | (sit-for 1))) | |
504 | (goto-char point-save)))) | |
505 | (t | |
506 | (goto-char (posn-point posn)))))) | |
507 | ||
508 | (define-key global-map [S-mouse-1] 'mouse-extend-region) | |
509 | (global-unset-key [S-down-mouse-1]) | |
510 | ||
511 | ||
512 | ||
ebe68042 | 513 | ;; Must come after keybindings. |
edfda783 AR |
514 | |
515 | (fmakunbound 'clipboard-yank) | |
516 | (fmakunbound 'clipboard-kill-ring-save) | |
517 | (fmakunbound 'clipboard-kill-region) | |
518 | (fmakunbound 'menu-bar-enable-clipboard) | |
519 | ||
520 | ;; Add a couple of menus and rearrange some others; easiest just to redo toplvl | |
521 | ;; Note keymap defns must be given last-to-first | |
522 | (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")) | |
523 | ||
ebe68042 SM |
524 | (setq menu-bar-final-items |
525 | (cond ((eq system-type 'darwin) | |
526 | '(buffer windows services help-menu)) | |
527 | ;; Otherwise, GNUstep. | |
528 | (t | |
529 | '(buffer windows services hide-app quit)))) | |
edfda783 | 530 | |
ebe68042 SM |
531 | ;; Add standard top-level items to GNUstep menu. |
532 | (unless (eq system-type 'darwin) | |
533 | (define-key global-map [menu-bar quit] '("Quit" . save-buffers-kill-emacs)) | |
534 | (define-key global-map [menu-bar hide-app] '("Hide" . ns-do-hide-emacs))) | |
edfda783 AR |
535 | |
536 | (define-key global-map [menu-bar services] | |
537 | (cons "Services" (make-sparse-keymap "Services"))) | |
538 | (define-key global-map [menu-bar windows] (make-sparse-keymap "Windows")) | |
539 | (define-key global-map [menu-bar buffer] | |
540 | (cons "Buffers" global-buffers-menu-map)) | |
541 | ;; (cons "Buffers" (make-sparse-keymap "Buffers"))) | |
542 | (define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu)) | |
543 | (define-key global-map [menu-bar options] (cons "Options" menu-bar-options-menu)) | |
544 | (define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu)) | |
545 | (define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu)) | |
546 | ||
547 | ;; If running under GNUstep, rename "Help" to "Info" | |
548 | (cond ((eq system-type 'darwin) | |
549 | (define-key global-map [menu-bar help-menu] | |
550 | (cons "Help" menu-bar-help-menu))) | |
551 | (t | |
552 | (let ((contents (reverse (cdr menu-bar-help-menu)))) | |
553 | (setq menu-bar-help-menu | |
554 | (append (list 'keymap) (cdr contents) (list "Info")))) | |
555 | (define-key global-map [menu-bar help-menu] | |
556 | (cons "Info" menu-bar-help-menu)))) | |
557 | ||
edfda783 AR |
558 | (if (not (eq system-type 'darwin)) |
559 | ;; in OS X it's in the app menu already | |
560 | (define-key menu-bar-help-menu [info-panel] | |
561 | '("About Emacs..." . ns-do-emacs-info-panel))) | |
562 | ||
563 | ||
564 | ;;;; File menu, replaces standard under ns-extended-platform-support | |
565 | (defvar menu-bar-ns-file-menu (make-sparse-keymap "File")) | |
566 | (define-key menu-bar-ns-file-menu [one-window] | |
567 | '("Remove Splits" . delete-other-windows)) | |
568 | (define-key menu-bar-ns-file-menu [split-window] | |
569 | '("Split Window" . split-window-vertically)) | |
570 | ||
571 | (define-key menu-bar-ns-file-menu [separator-print] '("--")) | |
572 | ||
573 | (defvar ns-ps-print-menu-map (make-sparse-keymap "Postscript Print")) | |
574 | (define-key ns-ps-print-menu-map [ps-print-region] | |
575 | '("Region (B+W)" . ps-print-region)) | |
576 | (define-key ns-ps-print-menu-map [ps-print-buffer] | |
577 | '("Buffer (B+W)" . ps-print-buffer)) | |
578 | (define-key ns-ps-print-menu-map [ps-print-region-faces] | |
579 | '("Region" . ps-print-region-with-faces)) | |
580 | (define-key ns-ps-print-menu-map [ps-print-buffer-faces] | |
c469837a | 581 | '("Buffer" . ps-print-buffer-with-faces)) |
edfda783 AR |
582 | (define-key menu-bar-ns-file-menu [postscript-print] |
583 | (cons "Postscript Print" ns-ps-print-menu-map)) | |
584 | ||
585 | (define-key menu-bar-ns-file-menu [print-region] | |
586 | '("Print Region" . print-region)) | |
587 | (define-key menu-bar-ns-file-menu [print-buffer] | |
588 | '("Print Buffer" . ns-print-buffer)) | |
589 | ||
590 | (define-key menu-bar-ns-file-menu [separator-save] '("--")) | |
591 | ||
592 | (define-key menu-bar-ns-file-menu [recover-session] | |
593 | '("Recover Crashed Session" . recover-session)) | |
594 | (define-key menu-bar-ns-file-menu [revert-buffer] | |
595 | '("Revert Buffer" . revert-buffer)) | |
596 | (define-key menu-bar-ns-file-menu [write-file] | |
597 | '("Save Buffer As..." . ns-write-file-using-panel)) | |
598 | (define-key menu-bar-ns-file-menu [save-buffer] '("Save Buffer" . save-buffer)) | |
599 | ||
600 | (define-key menu-bar-ns-file-menu [kill-buffer] | |
601 | '("Kill Current Buffer" . kill-this-buffer)) | |
602 | (define-key menu-bar-ns-file-menu [delete-this-frame] | |
603 | '("Close Frame" . delete-frame)) | |
604 | ||
605 | (define-key menu-bar-ns-file-menu [separator-open] '("--")) | |
606 | ||
607 | (define-key menu-bar-ns-file-menu [insert-file] | |
608 | '("Insert File..." . insert-file)) | |
609 | (define-key menu-bar-ns-file-menu [dired] | |
610 | '("Open Directory..." . ns-open-file-using-panel)) | |
611 | (define-key menu-bar-ns-file-menu [open-file] | |
612 | '("Open File..." . ns-open-file-using-panel)) | |
613 | (define-key menu-bar-ns-file-menu [make-frame] | |
614 | '("New Frame" . make-frame)) | |
615 | ||
616 | ||
617 | ;;;; Edit menu: Modify slightly | |
618 | ||
ebe68042 | 619 | ;; Substitute a Copy function that works better under X (for GNUstep). |
edfda783 AR |
620 | (easy-menu-remove-item global-map '("menu-bar" "edit") 'copy) |
621 | (define-key-after menu-bar-edit-menu [copy] | |
622 | '(menu-item "Copy" ns-copy-including-secondary | |
ebe68042 SM |
623 | :enable mark-active |
624 | :help "Copy text in region between mark and current position") | |
edfda783 AR |
625 | 'cut) |
626 | ||
ebe68042 SM |
627 | ;; Change to same precondition as select-and-paste, as we don't have |
628 | ;; `x-selection-exists-p'. | |
edfda783 AR |
629 | (easy-menu-remove-item global-map '("menu-bar" "edit") 'paste) |
630 | (define-key-after menu-bar-edit-menu [paste] | |
631 | '(menu-item "Paste" yank | |
ebe68042 SM |
632 | :enable (and (cdr yank-menu) (not buffer-read-only)) |
633 | :help "Paste (yank) text most recently cut/copied") | |
edfda783 AR |
634 | 'copy) |
635 | ||
ebe68042 | 636 | ;; Change text to be more consistent with surrounding menu items `paste', etc. |
edfda783 AR |
637 | (easy-menu-remove-item global-map '("menu-bar" "edit") 'paste-from-menu) |
638 | (define-key-after menu-bar-edit-menu [select-paste] | |
639 | '(menu-item "Select and Paste" yank-menu | |
ebe68042 SM |
640 | :enable (and (cdr yank-menu) (not buffer-read-only)) |
641 | :help "Choose a string from the kill ring and paste it") | |
edfda783 AR |
642 | 'paste) |
643 | ||
ebe68042 | 644 | ;; Separate undo from cut/paste section, add spell for platform consistency. |
edfda783 AR |
645 | (define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo) |
646 | (define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill) | |
647 | ||
648 | ||
649 | ;;;; Windows menu | |
d377ef4a | 650 | (defun menu-bar-select-frame (&optional frame) |
edfda783 AR |
651 | (interactive) |
652 | (make-frame-visible last-command-event) | |
653 | (raise-frame last-command-event) | |
654 | (select-frame last-command-event)) | |
655 | ||
656 | (defun menu-bar-update-frames () | |
657 | ;; If user discards the Windows item, play along. | |
ebe68042 SM |
658 | (when (lookup-key (current-global-map) [menu-bar windows]) |
659 | (let ((frames (frame-list)) | |
660 | (frames-menu (make-sparse-keymap "Select Frame"))) | |
661 | (setcdr frames-menu | |
662 | (nconc | |
663 | (mapcar (lambda (frame) | |
664 | (list* frame | |
665 | (cdr (assq 'name (frame-parameters frame))) | |
666 | 'menu-bar-select-frame)) | |
667 | frames) | |
668 | (cdr frames-menu))) | |
669 | (define-key frames-menu [separator-frames] '("--")) | |
670 | (define-key frames-menu [popup-color-panel] | |
671 | '("Colors..." . ns-popup-color-panel)) | |
672 | (define-key frames-menu [popup-font-panel] | |
673 | '("Font Panel..." . ns-popup-font-panel)) | |
674 | (define-key frames-menu [separator-arrange] '("--")) | |
675 | (define-key frames-menu [arrange-all-frames] | |
676 | '("Arrange All Frames" . ns-arrange-all-frames)) | |
677 | (define-key frames-menu [arrange-visible-frames] | |
678 | '("Arrange Visible Frames" . ns-arrange-visible-frames)) | |
679 | ;; Don't use delete-frame as event name | |
680 | ;; because that is a special event. | |
681 | (define-key (current-global-map) [menu-bar windows] | |
682 | (cons "Windows" frames-menu))))) | |
edfda783 AR |
683 | |
684 | (defun force-menu-bar-update-buffers () | |
685 | ;; This is a hack to get around fact that we already checked | |
686 | ;; frame-or-buffer-changed-p and reset it, so menu-bar-update-buffers | |
687 | ;; does not pick up any change. | |
688 | (menu-bar-update-buffers t)) | |
689 | ||
690 | (add-hook 'menu-bar-update-fab-hook 'menu-bar-update-frames) | |
691 | (add-hook 'menu-bar-update-fab-hook 'force-menu-bar-update-buffers) | |
692 | ||
693 | (defun menu-bar-update-frames-and-buffers () | |
694 | (if (frame-or-buffer-changed-p) | |
695 | (run-hooks 'menu-bar-update-fab-hook))) | |
696 | ||
697 | (setq menu-bar-update-hook | |
698 | (delq 'menu-bar-update-buffers menu-bar-update-hook)) | |
699 | (add-hook 'menu-bar-update-hook 'menu-bar-update-frames-and-buffers) | |
700 | ||
701 | (menu-bar-update-frames-and-buffers) | |
702 | ||
703 | ||
704 | ;; ns-arrange functions contributed | |
705 | ;; by Eberhard Mandler <mandler@dbag.ulm.DaimlerBenz.COM> | |
706 | (defun ns-arrange-all-frames () | |
707 | "Arranges all frames according to topline" | |
708 | (interactive) | |
709 | (ns-arrange-frames t)) | |
710 | ||
711 | (defun ns-arrange-visible-frames () | |
712 | "Arranges all visible frames according to topline" | |
713 | (interactive) | |
714 | (ns-arrange-frames nil)) | |
715 | ||
716 | (defun ns-arrange-frames ( vis) | |
717 | (let ((frame (next-frame)) | |
718 | (end-frame (selected-frame)) | |
719 | (inc-x 20) ;relative position of frames | |
720 | (inc-y 22) | |
721 | (x-pos 100) ;start position | |
722 | (y-pos 40) | |
723 | (done nil)) | |
724 | (while (not done) ;cycle through all frames | |
725 | (if (not (or vis (eq (frame-visible-p frame) t))) | |
ebe68042 | 726 | (setq x-pos x-pos); do nothing; true case |
edfda783 AR |
727 | (set-frame-position frame x-pos y-pos) |
728 | (setq x-pos (+ x-pos inc-x)) | |
729 | (setq y-pos (+ y-pos inc-y)) | |
730 | (raise-frame frame)) | |
731 | (select-frame frame) | |
732 | (setq frame (next-frame)) | |
733 | (setq done (equal frame end-frame))) | |
734 | (set-frame-position end-frame x-pos y-pos) | |
735 | (raise-frame frame) | |
736 | (select-frame frame))) | |
737 | ||
738 | ||
739 | ;;;; Services | |
d377ef4a GM |
740 | (declare-function ns-perform-service "nsfns.m" (service send)) |
741 | ||
edfda783 AR |
742 | (defun ns-define-service (path) |
743 | (let ((mapping [menu-bar services]) | |
744 | (service (mapconcat 'identity path "/")) | |
745 | (name (intern | |
ebe68042 SM |
746 | (subst-char-in-string |
747 | ?\s ?- | |
748 | (mapconcat 'identity (cons "ns-service" path) "-"))))) | |
749 | ;; This defines the function. | |
750 | (defalias name | |
751 | (lexical-let ((service service)) | |
752 | (lambda (arg) | |
753 | (interactive "p") | |
754 | (let* ((in-string | |
755 | (cond ((stringp arg) arg) | |
756 | (mark-active | |
757 | (buffer-substring (region-beginning) (region-end))))) | |
758 | (out-string (ns-perform-service service in-string))) | |
759 | (cond | |
760 | ((stringp arg) out-string) | |
761 | ((and out-string (or (not in-string) | |
762 | (not (string= in-string out-string)))) | |
763 | (if mark-active (delete-region (region-beginning) (region-end))) | |
764 | (insert out-string) | |
765 | (setq deactivate-mark nil))))))) | |
edfda783 AR |
766 | (cond |
767 | ((lookup-key global-map mapping) | |
768 | (while (cdr path) | |
769 | (setq mapping (vconcat mapping (list (intern (car path))))) | |
770 | (if (not (keymapp (lookup-key global-map mapping))) | |
771 | (define-key global-map mapping | |
772 | (cons (car path) (make-sparse-keymap (car path))))) | |
773 | (setq path (cdr path))) | |
774 | (setq mapping (vconcat mapping (list (intern (car path))))) | |
775 | (define-key global-map mapping (cons (car path) name)))) | |
776 | name)) | |
777 | ||
778 | (precompute-menubar-bindings) | |
779 | ||
c0642f6d GM |
780 | ;; nsterm.m |
781 | (defvar ns-input-spi-name) | |
782 | (defvar ns-input-spi-arg) | |
783 | ||
edfda783 | 784 | (defun ns-spi-service-call () |
82a330df | 785 | "Respond to a service request." |
edfda783 AR |
786 | (interactive) |
787 | (cond ((string-equal ns-input-spi-name "open-selection") | |
788 | (switch-to-buffer (generate-new-buffer "*untitled*")) | |
789 | (insert ns-input-spi-arg)) | |
790 | ((string-equal ns-input-spi-name "open-file") | |
791 | (dnd-open-file ns-input-spi-arg nil)) | |
792 | ((string-equal ns-input-spi-name "mail-selection") | |
793 | (compose-mail) | |
794 | (rfc822-goto-eoh) | |
795 | (forward-line 1) | |
796 | (insert ns-input-spi-arg)) | |
797 | ((string-equal ns-input-spi-name "mail-to") | |
798 | (compose-mail ns-input-spi-arg)) | |
799 | (t (error (concat "Service " ns-input-spi-name " not recognized"))))) | |
800 | ||
801 | ||
802 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
803 | ||
804 | ||
805 | ||
a5a1b464 CY |
806 | ;;;; Composed key sequence handling for Nextstep system input methods. |
807 | ;;;; (On Nextstep systems, input methods are provided for CJK | |
808 | ;;;; characters, etc. which require multiple keystrokes, and during | |
809 | ;;;; entry a partial ("working") result is typically shown in the | |
810 | ;;;; editing window.) | |
edfda783 AR |
811 | |
812 | (defface ns-working-text-face | |
813 | '((t :underline t)) | |
814 | "Face used to highlight working text during compose sequence insert." | |
815 | :group 'ns) | |
816 | ||
817 | (defvar ns-working-overlay nil | |
818 | "Overlay used to highlight working text during compose sequence insert.") | |
819 | (make-variable-buffer-local 'ns-working-overlay) | |
820 | (defvar ns-working-overlay-len 0 | |
821 | "Length of working text during compose sequence insert.") | |
822 | (make-variable-buffer-local 'ns-working-overlay-len) | |
823 | ||
ebe68042 SM |
824 | ;; Based on mac-win.el 2007/08/26 unicode-2. This will fail if called |
825 | ;; from an "interactive" function. | |
edfda783 AR |
826 | (defun ns-in-echo-area () |
827 | "Whether, for purposes of inserting working composition text, the minibuffer | |
828 | is currently being used." | |
829 | (or isearch-mode | |
830 | (and cursor-in-echo-area (current-message)) | |
831 | ;; Overlay strings are not shown in some cases. | |
832 | (get-char-property (point) 'invisible) | |
833 | (and (not (bobp)) | |
834 | (or (and (get-char-property (point) 'display) | |
835 | (eq (get-char-property (1- (point)) 'display) | |
836 | (get-char-property (point) 'display))) | |
837 | (and (get-char-property (point) 'composition) | |
838 | (eq (get-char-property (1- (point)) 'composition) | |
839 | (get-char-property (point) 'composition))))))) | |
840 | ||
ebe68042 SM |
841 | ;; Currently not used, doesn't work because the 'interactive' here stays |
842 | ;; for subinvocations. | |
edfda783 AR |
843 | (defun ns-insert-working-text () |
844 | (interactive) | |
845 | (if (ns-in-echo-area) (ns-echo-working-text) (ns-put-working-text))) | |
846 | ||
c0642f6d GM |
847 | (defvar ns-working-text) ; nsterm.m |
848 | ||
edfda783 AR |
849 | (defun ns-put-working-text () |
850 | "Insert contents of ns-working-text as UTF8 string and mark with | |
851 | ns-working-overlay. Any previously existing working text is cleared first. | |
852 | The overlay is assigned the face ns-working-text-face." | |
853 | (interactive) | |
854 | (if ns-working-overlay (ns-delete-working-text)) | |
855 | (let ((start (point))) | |
856 | (insert ns-working-text) | |
857 | (overlay-put (setq ns-working-overlay (make-overlay start (point) | |
858 | (current-buffer) nil t)) | |
859 | 'face 'ns-working-text-face) | |
860 | (setq ns-working-overlay-len (+ ns-working-overlay-len (- (point) start))))) | |
861 | ||
862 | (defun ns-echo-working-text () | |
863 | "Echo contents of ns-working-text in message display area. | |
864 | See ns-insert-working-text." | |
865 | (if ns-working-overlay (ns-unecho-working-text)) | |
866 | (let* ((msg (current-message)) | |
867 | (msglen (length msg)) | |
868 | message-log-max) | |
869 | (setq ns-working-overlay-len (length ns-working-text)) | |
870 | (setq msg (concat msg ns-working-text)) | |
871 | (put-text-property msglen (+ msglen ns-working-overlay-len) 'face 'ns-working-text-face msg) | |
872 | (message "%s" msg) | |
873 | (setq ns-working-overlay t))) | |
874 | ||
875 | (defun ns-delete-working-text() | |
876 | "Delete working text and clear ns-working-overlay." | |
877 | (interactive) | |
878 | (delete-backward-char ns-working-overlay-len) | |
879 | (setq ns-working-overlay-len 0) | |
880 | (delete-overlay ns-working-overlay)) | |
881 | ||
882 | (defun ns-unecho-working-text() | |
883 | "Delete working text from echo area and clear ns-working-overlay." | |
884 | (let ((msg (current-message)) | |
885 | message-log-max) | |
886 | (setq msg (substring msg 0 (- (length msg) ns-working-overlay-len))) | |
887 | (setq ns-working-overlay-len 0) | |
888 | (setq ns-working-overlay nil))) | |
889 | ||
890 | ||
c0642f6d GM |
891 | (declare-function ns-convert-utf8-nfd-to-nfc "nsfns.m" (str)) |
892 | ||
edfda783 AR |
893 | ;;;; OS X file system Unicode UTF-8 NFD (decomposed form) support |
894 | ;; Lisp code based on utf-8m.el, by Seiji Zenitani, Eiji Honjoh, and | |
895 | ;; Carsten Bormann. | |
896 | (if (eq system-type 'darwin) | |
897 | (progn | |
898 | ||
899 | (defun ns-utf8-nfd-post-read-conversion (length) | |
900 | "Calls ns-convert-utf8-nfd-to-nfc to compose char sequences." | |
901 | (save-excursion | |
902 | (save-restriction | |
903 | (narrow-to-region (point) (+ (point) length)) | |
904 | (let ((str (buffer-string))) | |
905 | (delete-region (point-min) (point-max)) | |
906 | (insert (ns-convert-utf8-nfd-to-nfc str)) | |
907 | (- (point-max) (point-min)) | |
908 | )))) | |
909 | ||
910 | (define-coding-system 'utf-8-nfd | |
911 | "UTF-8 NFD (decomposed) encoding." | |
912 | :coding-type 'utf-8 | |
913 | :mnemonic ?U | |
914 | :charset-list '(unicode) | |
915 | :post-read-conversion 'ns-utf8-nfd-post-read-conversion) | |
916 | (set-file-name-coding-system 'utf-8-nfd))) | |
917 | ||
918 | ;; PENDING: disable composition-based display for Indic scripts as it | |
a5a1b464 | 919 | ;; is not working well under Nextstep for some reason |
edfda783 | 920 | (set-char-table-range composition-function-table |
ebe68042 | 921 | '(#x0900 . #x0DFF) nil) |
edfda783 AR |
922 | |
923 | ||
924 | ;;;; Inter-app communications support. | |
925 | ||
c0642f6d GM |
926 | (defvar ns-input-text) ; nsterm.m |
927 | ||
edfda783 AR |
928 | (defun ns-insert-text () |
929 | "Insert contents of ns-input-text at point." | |
930 | (interactive) | |
931 | (insert ns-input-text) | |
932 | (setq ns-input-text nil)) | |
c0642f6d | 933 | |
edfda783 AR |
934 | (defun ns-insert-file () |
935 | "Insert contents of file ns-input-file like insert-file but with less | |
936 | prompting. If file is a directory perform a find-file on it." | |
937 | (interactive) | |
938 | (let ((f)) | |
939 | (setq f (car ns-input-file)) | |
940 | (setq ns-input-file (cdr ns-input-file)) | |
941 | (if (file-directory-p f) | |
942 | (find-file f) | |
943 | (push-mark (+ (point) (car (cdr (insert-file-contents f)))))))) | |
944 | ||
945 | (defvar ns-select-overlay nil | |
a5a1b464 | 946 | "Overlay used to highlight areas in files requested by Nextstep apps.") |
edfda783 AR |
947 | (make-variable-buffer-local 'ns-select-overlay) |
948 | ||
c0642f6d GM |
949 | (defvar ns-input-line) ; nsterm.m |
950 | ||
edfda783 | 951 | (defun ns-open-file-select-line () |
b90cc058 CY |
952 | "Open a buffer containing the file `ns-input-file'. |
953 | Lines are highlighted according to `ns-input-line'." | |
edfda783 AR |
954 | (interactive) |
955 | (ns-find-file) | |
956 | (cond | |
957 | ((and ns-input-line (buffer-modified-p)) | |
958 | (if ns-select-overlay | |
959 | (setq ns-select-overlay (delete-overlay ns-select-overlay))) | |
960 | (deactivate-mark) | |
961 | (goto-line (if (consp ns-input-line) | |
962 | (min (car ns-input-line) (cdr ns-input-line)) | |
963 | ns-input-line))) | |
964 | (ns-input-line | |
965 | (if (not ns-select-overlay) | |
966 | (overlay-put (setq ns-select-overlay (make-overlay (point-min) (point-min))) | |
967 | 'face 'highlight)) | |
968 | (let ((beg (save-excursion | |
969 | (goto-line (if (consp ns-input-line) | |
970 | (min (car ns-input-line) (cdr ns-input-line)) | |
971 | ns-input-line)) | |
972 | (point))) | |
973 | (end (save-excursion | |
974 | (goto-line (+ 1 (if (consp ns-input-line) | |
975 | (max (car ns-input-line) (cdr ns-input-line)) | |
976 | ns-input-line))) | |
977 | (point)))) | |
978 | (move-overlay ns-select-overlay beg end) | |
979 | (deactivate-mark) | |
980 | (goto-char beg))) | |
981 | (t | |
982 | (if ns-select-overlay | |
983 | (setq ns-select-overlay (delete-overlay ns-select-overlay)))))) | |
984 | ||
985 | (defun ns-unselect-line () | |
a5a1b464 | 986 | "Removes any Nextstep highlight a buffer may contain." |
edfda783 AR |
987 | (if ns-select-overlay |
988 | (setq ns-select-overlay (delete-overlay ns-select-overlay)))) | |
989 | ||
990 | (add-hook 'first-change-hook 'ns-unselect-line) | |
991 | ||
992 | ||
993 | ||
994 | ;;;; Preferences handling. | |
c0642f6d | 995 | (declare-function ns-get-resource "nsfns.m" (owner name)) |
edfda783 AR |
996 | |
997 | (defun get-lisp-resource (arg1 arg2) | |
998 | (let ((res (ns-get-resource arg1 arg2))) | |
999 | (cond | |
1000 | ((not res) 'unbound) | |
1001 | ((string-equal (upcase res) "YES") t) | |
1002 | ((string-equal (upcase res) "NO") nil) | |
1003 | (t (read res))))) | |
1004 | ||
c0642f6d GM |
1005 | ;; nsterm.m |
1006 | (defvar ns-command-modifier) | |
1007 | (defvar ns-control-modifier) | |
1008 | (defvar ns-function-modifier) | |
1009 | (defvar ns-antialias-text) | |
1010 | (defvar ns-use-qd-smoothing) | |
1011 | (defvar ns-use-system-highlight-color) | |
1012 | ||
1013 | (declare-function ns-set-resource "nsfns.m" (owner name value)) | |
1014 | (declare-function ns-font-name "nsfns.m" (name)) | |
1015 | (declare-function ns-read-file-name "nsfns.m" | |
1016 | (prompt &optional dir isLoad init)) | |
1017 | ||
edfda783 AR |
1018 | (defun ns-save-preferences () |
1019 | "Set all the defaults." | |
1020 | (interactive) | |
1021 | ;; Global preferences | |
1022 | (ns-set-resource nil "AlternateModifier" (symbol-name ns-alternate-modifier)) | |
1023 | (ns-set-resource nil "CommandModifier" (symbol-name ns-command-modifier)) | |
1024 | (ns-set-resource nil "ControlModifier" (symbol-name ns-control-modifier)) | |
1025 | (ns-set-resource nil "FunctionModifier" (symbol-name ns-function-modifier)) | |
1026 | (ns-set-resource nil "CursorBlinkRate" | |
ebe68042 SM |
1027 | (if ns-cursor-blink-rate |
1028 | (number-to-string ns-cursor-blink-rate) | |
1029 | "NO")) | |
edfda783 | 1030 | (ns-set-resource nil "ExpandSpace" |
ebe68042 SM |
1031 | (if ns-expand-space |
1032 | (number-to-string ns-expand-space) | |
1033 | "NO")) | |
edfda783 AR |
1034 | (ns-set-resource nil "GSFontAntiAlias" (if ns-antialias-text "YES" "NO")) |
1035 | (ns-set-resource nil "UseQuickdrawSmoothing" | |
1036 | (if ns-use-qd-smoothing "YES" "NO")) | |
1037 | (ns-set-resource nil "UseSystemHighlightColor" | |
1038 | (if ns-use-system-highlight-color "YES" "NO")) | |
1039 | ;; Default frame parameters | |
d377ef4a GM |
1040 | (let ((p (frame-parameters)) |
1041 | v) | |
1042 | (if (setq v (assq 'font p)) | |
1043 | (ns-set-resource nil "Font" (ns-font-name (cdr v)))) | |
1044 | (if (setq v (assq 'fontsize p)) | |
1045 | (ns-set-resource nil "FontSize" (number-to-string (cdr v)))) | |
1046 | (if (setq v (assq 'foreground-color p)) | |
1047 | (ns-set-resource nil "Foreground" (cdr v))) | |
1048 | (if (setq v (assq 'background-color p)) | |
1049 | (ns-set-resource nil "Background" (cdr v))) | |
1050 | (if (setq v (assq 'cursor-color p)) | |
1051 | (ns-set-resource nil "CursorColor" (cdr v))) | |
1052 | (if (setq v (assq 'cursor-type p)) | |
1053 | (ns-set-resource nil "CursorType" (if (symbolp (cdr v)) | |
1054 | (symbol-name (cdr v)) | |
1055 | (cdr v)))) | |
1056 | (if (setq v (assq 'underline p)) | |
1057 | (ns-set-resource nil "Underline" | |
1058 | (case (cdr v) | |
1059 | ((t) "YES") | |
1060 | ((nil) "NO") | |
1061 | (t (cdr v))))) | |
1062 | (if (setq v (assq 'internal-border-width p)) | |
1063 | (ns-set-resource nil "InternalBorderWidth" | |
a5e1066d | 1064 | (number-to-string (cdr v)))) |
d377ef4a GM |
1065 | (if (setq v (assq 'vertical-scroll-bars p)) |
1066 | (ns-set-resource nil "VerticalScrollBars" | |
1067 | (case (cdr v) | |
1068 | ((t) "YES") | |
1069 | ((nil) "NO") | |
1070 | ((left) "left") | |
1071 | ((right) "right") | |
1072 | (t nil)))) | |
1073 | (if (setq v (assq 'height p)) | |
1074 | (ns-set-resource nil "Height" (number-to-string (cdr v)))) | |
1075 | (if (setq v (assq 'width p)) | |
1076 | (ns-set-resource nil "Width" (number-to-string (cdr v)))) | |
1077 | (if (setq v (assq 'top p)) | |
1078 | (ns-set-resource nil "Top" (number-to-string (cdr v)))) | |
1079 | (if (setq v (assq 'left p)) | |
1080 | (ns-set-resource nil "Left" (number-to-string (cdr v)))) | |
edfda783 | 1081 | ;; These not fully supported |
d377ef4a GM |
1082 | (if (setq v (assq 'auto-raise p)) |
1083 | (ns-set-resource nil "AutoRaise" (if (cdr v) "YES" "NO"))) | |
1084 | (if (setq v (assq 'auto-lower p)) | |
1085 | (ns-set-resource nil "AutoLower" (if (cdr v) "YES" "NO"))) | |
1086 | (if (setq v (assq 'menu-bar-lines p)) | |
1087 | (ns-set-resource nil "Menus" (if (cdr v) "YES" "NO"))) | |
edfda783 AR |
1088 | ) |
1089 | (let ((fl (face-list))) | |
1090 | (while (consp fl) | |
1091 | (or (eq 'default (car fl)) | |
1092 | ;; dont save Default* since it causes all created faces to | |
1093 | ;; inherit its values. The properties of the default face | |
1094 | ;; have already been saved from the frame-parameters anyway. | |
1095 | (let* ((name (symbol-name (car fl))) | |
1096 | (font (face-font (car fl))) | |
ebe68042 | 1097 | ;; (fontsize (face-fontsize (car fl))) |
edfda783 AR |
1098 | (foreground (face-foreground (car fl))) |
1099 | (background (face-background (car fl))) | |
1100 | (underline (face-underline-p (car fl))) | |
1101 | (italic (face-italic-p (car fl))) | |
1102 | (bold (face-bold-p (car fl))) | |
1103 | (stipple (face-stipple (car fl)))) | |
ebe68042 SM |
1104 | ;; (ns-set-resource nil (concat name ".attributeFont") |
1105 | ;; (if font font nil)) | |
1106 | ;; (ns-set-resource nil (concat name ".attributeFontSize") | |
1107 | ;; (if fontsize (number-to-string fontsize) nil)) | |
edfda783 | 1108 | (ns-set-resource nil (concat name ".attributeForeground") |
ebe68042 | 1109 | (if foreground foreground nil)) |
edfda783 | 1110 | (ns-set-resource nil (concat name ".attributeBackground") |
ebe68042 | 1111 | (if background background nil)) |
edfda783 | 1112 | (ns-set-resource nil (concat name ".attributeUnderline") |
ebe68042 | 1113 | (if underline "YES" nil)) |
edfda783 | 1114 | (ns-set-resource nil (concat name ".attributeItalic") |
ebe68042 | 1115 | (if italic "YES" nil)) |
edfda783 | 1116 | (ns-set-resource nil (concat name ".attributeBold") |
ebe68042 | 1117 | (if bold "YES" nil)) |
edfda783 AR |
1118 | (and stipple |
1119 | (or (stringp stipple) | |
1120 | (setq stipple (prin1-to-string stipple)))) | |
1121 | (ns-set-resource nil (concat name ".attributeStipple") | |
ebe68042 | 1122 | (if stipple stipple nil)))) |
edfda783 AR |
1123 | (setq fl (cdr fl))))) |
1124 | ||
c0642f6d GM |
1125 | (declare-function menu-bar-options-save-orig "ns-win" () t) |
1126 | ||
edfda783 AR |
1127 | ;; call ns-save-preferences when menu-bar-options-save is called |
1128 | (fset 'menu-bar-options-save-orig (symbol-function 'menu-bar-options-save)) | |
1129 | (defun ns-save-options () | |
1130 | (interactive) | |
1131 | (menu-bar-options-save-orig) | |
1132 | (ns-save-preferences)) | |
1133 | (fset 'menu-bar-options-save (symbol-function 'ns-save-options)) | |
1134 | ||
1135 | ||
1136 | ;;;; File handling. | |
1137 | ||
1138 | (defun ns-open-file-using-panel () | |
1139 | "Pop up open-file panel, and load the result in a buffer." | |
1140 | (interactive) | |
ebe68042 | 1141 | ;; Prompt dir defaultName isLoad initial. |
edfda783 AR |
1142 | (setq ns-input-file (ns-read-file-name "Select File to Load" nil t nil)) |
1143 | (if ns-input-file | |
1144 | (and (setq ns-input-file (list ns-input-file)) (ns-find-file)))) | |
1145 | ||
1146 | (defun ns-write-file-using-panel () | |
1147 | "Pop up save-file panel, and save buffer in resulting name." | |
1148 | (interactive) | |
1149 | (let (ns-output-file) | |
ebe68042 | 1150 | ;; Prompt dir defaultName isLoad initial. |
edfda783 AR |
1151 | (setq ns-output-file (ns-read-file-name "Save As" nil nil nil)) |
1152 | (message ns-output-file) | |
1153 | (if ns-output-file (write-file ns-output-file)))) | |
1154 | ||
c0642f6d GM |
1155 | (defvar ns-pop-up-frames 'fresh |
1156 | "*Non-nil means open files upon request from the Workspace in a new frame. | |
1157 | If t, always do so. Any other non-nil value means open a new frame | |
1158 | unless the current buffer is a scratch buffer.") | |
1159 | ||
1160 | (declare-function ns-hide-emacs "nsfns.m" (on)) | |
1161 | ||
edfda783 AR |
1162 | (defun ns-find-file () |
1163 | "Do a find-file with the ns-input-file as argument." | |
1164 | (interactive) | |
1165 | (let ((f) (file) (bufwin1) (bufwin2)) | |
1166 | (setq f (file-truename (car ns-input-file))) | |
1167 | (setq ns-input-file (cdr ns-input-file)) | |
1168 | (setq file (find-file-noselect f)) | |
1169 | (setq bufwin1 (get-buffer-window file 'visible)) | |
1170 | (setq bufwin2 (get-buffer-window "*scratch*" 'visibile)) | |
1171 | (cond | |
1172 | (bufwin1 | |
1173 | (select-frame (window-frame bufwin1)) | |
1174 | (raise-frame (window-frame bufwin1)) | |
1175 | (select-window bufwin1)) | |
1176 | ((and (eq ns-pop-up-frames 'fresh) bufwin2) | |
1177 | (ns-hide-emacs 'activate) | |
1178 | (select-frame (window-frame bufwin2)) | |
1179 | (raise-frame (window-frame bufwin2)) | |
1180 | (select-window bufwin2) | |
1181 | (find-file f)) | |
1182 | (ns-pop-up-frames | |
1183 | (ns-hide-emacs 'activate) | |
1184 | (let ((pop-up-frames t)) (pop-to-buffer file nil))) | |
1185 | (t | |
1186 | (ns-hide-emacs 'activate) | |
1187 | (find-file f))))) | |
1188 | ||
1189 | ||
1190 | ||
1191 | ;;;; Frame-related functions. | |
1192 | ||
a5a1b464 | 1193 | ;; Don't show the frame name; that's redundant with Nextstep. |
edfda783 AR |
1194 | (setq-default mode-line-frame-identification '(" ")) |
1195 | ||
edfda783 AR |
1196 | ;; You say tomAYto, I say tomAHto.. |
1197 | (defvaralias 'ns-option-modifier 'ns-alternate-modifier) | |
1198 | ||
1199 | (defun ns-do-hide-emacs () | |
1200 | (interactive) | |
1201 | (ns-hide-emacs t)) | |
1202 | ||
c0642f6d GM |
1203 | (declare-function ns-hide-others "nsfns.m" ()) |
1204 | ||
edfda783 AR |
1205 | (defun ns-do-hide-others () |
1206 | (interactive) | |
1207 | (ns-hide-others)) | |
1208 | ||
c0642f6d GM |
1209 | (declare-function ns-emacs-info-panel "nsfns.m" ()) |
1210 | ||
edfda783 AR |
1211 | (defun ns-do-emacs-info-panel () |
1212 | (interactive) | |
1213 | (ns-emacs-info-panel)) | |
1214 | ||
1215 | (defun ns-next-frame () | |
1216 | "Switch to next visible frame." | |
1217 | (interactive) | |
1218 | (other-frame 1)) | |
1219 | (defun ns-prev-frame () | |
1220 | "Switch to previous visible frame." | |
1221 | (interactive) | |
1222 | (other-frame -1)) | |
1223 | ||
ebe68042 | 1224 | ;; If no position specified, make new frame offset by 25 from current. |
e5744c66 GM |
1225 | (defvar parameters) ; dynamically bound in make-frame |
1226 | ||
edfda783 | 1227 | (add-hook 'before-make-frame-hook |
ebe68042 SM |
1228 | (lambda () |
1229 | (let ((left (cdr (assq 'left (frame-parameters)))) | |
1230 | (top (cdr (assq 'top (frame-parameters))))) | |
1231 | (if (consp left) (setq left (cadr left))) | |
1232 | (if (consp top) (setq top (cadr top))) | |
1233 | (cond | |
1234 | ((or (assq 'top parameters) (assq 'left parameters))) | |
1235 | ((or (not left) (not top))) | |
1236 | (t | |
1237 | (setq parameters (cons (cons 'left (+ left 25)) | |
1238 | (cons (cons 'top (+ top 25)) | |
1239 | parameters)))))))) | |
1240 | ||
1241 | ;; frame will be focused anyway, so select it | |
edfda783 AR |
1242 | (add-hook 'after-make-frame-functions 'select-frame) |
1243 | ||
ebe68042 SM |
1244 | ;; (defun ns-win-suspend-error () |
1245 | ;; (error "Suspending an emacs running under *Step/OS X makes no sense")) | |
1246 | ;; (add-hook 'suspend-hook 'ns-win-suspend-error) | |
1247 | ;; (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame | |
1248 | ;; global-map) | |
edfda783 AR |
1249 | |
1250 | ;; Based on a function by David Reitter <dreitter@inf.ed.ac.uk> ; | |
1251 | ;; see http://lists.gnu.org/archive/html/emacs-devel/2005-09/msg00681.html . | |
1252 | (defun ns-toggle-toolbar (&optional frame) | |
1253 | "Switches the tool bar on and off in frame FRAME. | |
1254 | If FRAME is nil, the change applies to the selected frame." | |
1255 | (interactive) | |
ebe68042 SM |
1256 | (modify-frame-parameters |
1257 | frame (list (cons 'tool-bar-lines | |
edfda783 AR |
1258 | (if (> (or (frame-parameter frame 'tool-bar-lines) 0) 0) |
1259 | 0 1)) )) | |
1260 | (if (not tool-bar-mode) (tool-bar-mode t))) | |
1261 | ||
c0642f6d GM |
1262 | (defvar ns-cursor-blink-mode) ; nsterm.m |
1263 | ||
ebe68042 | 1264 | ;; Redefine from frame.el. |
edfda783 AR |
1265 | (define-minor-mode blink-cursor-mode |
1266 | "Toggle blinking cursor mode. | |
1267 | With a numeric argument, turn blinking cursor mode on if ARG is positive, | |
1268 | otherwise turn it off. When blinking cursor mode is enabled, the | |
1269 | cursor of the selected window blinks. | |
1270 | ||
1271 | Note that this command is effective only when Emacs | |
1272 | displays through a window system, because then Emacs does its own | |
1273 | cursor display. On a text-only terminal, this is not implemented." | |
1274 | :init-value (not (or noninteractive | |
1275 | no-blinking-cursor | |
1276 | (eq ns-cursor-blink-rate nil))) | |
1277 | :initialize 'custom-initialize-safe-default | |
1278 | :group 'cursor | |
1279 | :global t | |
1280 | (if blink-cursor-mode | |
1281 | (setq ns-cursor-blink-mode t) | |
1282 | (setq ns-cursor-blink-mode nil))) | |
1283 | ||
1284 | ||
1285 | ||
1286 | ;;;; Dialog-related functions. | |
1287 | ||
1288 | ;; Ask user for confirm before printing. Due to Kevin Rodgers. | |
1289 | (defun ns-print-buffer () | |
1290 | "Interactive front-end to `print-buffer': asks for user confirmation first." | |
1291 | (interactive) | |
1292 | (if (and (interactive-p) | |
ebe68042 SM |
1293 | (or (listp last-nonmenu-event) |
1294 | (and (char-or-string-p (event-basic-type last-command-event)) | |
1295 | (memq 'super (event-modifiers last-command-event))))) | |
1296 | (let ((last-nonmenu-event (if (listp last-nonmenu-event) | |
1297 | last-nonmenu-event | |
1298 | ;; Fake it: | |
1299 | `(mouse-1 POSITION 1)))) | |
1300 | (if (y-or-n-p (format "Print buffer %s? " (buffer-name))) | |
1301 | (print-buffer) | |
edfda783 AR |
1302 | (error "Cancelled"))) |
1303 | (print-buffer))) | |
1304 | ||
1305 | (defun ns-yes-or-no-p (prompt) | |
a5a1b464 CY |
1306 | "Ask user a \"yes or no\" question using a Nextstep graphical panel. |
1307 | PROMPT is the prompt string." | |
edfda783 | 1308 | (interactive) |
ebe68042 SM |
1309 | (setq last-nonmenu-event nil) |
1310 | (yes-or-no-p prompt)) | |
edfda783 AR |
1311 | |
1312 | ||
1313 | ;;;; Font support. | |
1314 | ||
1315 | (defalias 'x-list-fonts 'ns-list-fonts) | |
1316 | ;; Needed for font listing functions under both backend and normal | |
1317 | (setq scalable-fonts-allowed t) | |
1318 | ||
1319 | ;; Set to use font panel instead | |
1320 | (defalias 'generate-fontset-menu 'ns-popup-font-panel) | |
1321 | (defalias 'mouse-set-font 'ns-popup-font-panel) | |
1322 | ||
c0642f6d GM |
1323 | ;; nsterm.m |
1324 | (defvar ns-input-font) | |
1325 | (defvar ns-input-fontsize) | |
1326 | ||
edfda783 AR |
1327 | (defun ns-respond-to-change-font () |
1328 | "Respond to changeFont: event, expecting ns-input-font and\n\ | |
1329 | ns-input-fontsize of new font." | |
1330 | (interactive) | |
1331 | (modify-frame-parameters (selected-frame) | |
1332 | (list (cons 'font ns-input-font) | |
1333 | (cons 'fontsize ns-input-fontsize))) | |
1334 | (set-frame-font ns-input-font)) | |
1335 | ||
1336 | ||
1337 | ;; Default fontset for Mac OS X. This is mainly here to show how a fontset | |
1338 | ;; can be set up manually. Ordinarily, fontsets are auto-created whenever | |
1339 | ;; a font is chosen by | |
1340 | (defvar ns-standard-fontset-spec | |
ebe68042 SM |
1341 | ;; Only some code supports this so far, so use uglier XLFD version |
1342 | ;; "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:Courier,han:Kai" | |
1343 | (mapconcat 'identity | |
1344 | '("-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard" | |
1345 | "latin:-*-Courier-*-*-*-*-10-*-*-*-*-*-iso10646-1" | |
1346 | "han:-*-Kai-*-*-*-*-10-*-*-*-*-*-iso10646-1" | |
1347 | "cyrillic:-*-Trebuchet$MS-*-*-*-*-10-*-*-*-*-*-iso10646-1") | |
1348 | ",") | |
1349 | "String of fontset spec of the standard fontset. | |
edfda783 AR |
1350 | This defines a fontset consisting of the Courier and other fonts that |
1351 | come with OS X\". | |
1352 | See the documentation of `create-fontset-from-fontset-spec for the format.") | |
1353 | ||
ebe68042 | 1354 | ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles. |
edfda783 AR |
1355 | (if (fboundp 'new-fontset) |
1356 | (progn | |
1357 | ;; Setup the default fontset. | |
1358 | (setup-default-fontset) | |
1359 | ;; Create the standard fontset. | |
ebe68042 | 1360 | (create-fontset-from-fontset-spec ns-standard-fontset-spec t))) |
edfda783 | 1361 | |
ebe68042 SM |
1362 | ;;(push (cons 'font "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard") |
1363 | ;; default-frame-alist) | |
edfda783 | 1364 | |
ebe68042 | 1365 | ;; Add some additional scripts to var we use for fontset generation. |
edfda783 AR |
1366 | (setq script-representative-chars |
1367 | (cons '(kana #xff8a) | |
1368 | (cons '(symbol #x2295 #x2287 #x25a1) | |
ebe68042 | 1369 | script-representative-chars))) |
edfda783 AR |
1370 | |
1371 | ||
1372 | ;;;; Pasteboard support. | |
1373 | ||
c0642f6d GM |
1374 | (declare-function ns-get-cut-buffer-internal "nsselect.m" (buffer)) |
1375 | ||
edfda783 AR |
1376 | (defun ns-get-pasteboard () |
1377 | "Returns the value of the pasteboard." | |
1378 | (ns-get-cut-buffer-internal 'PRIMARY)) | |
1379 | ||
c0642f6d GM |
1380 | (declare-function ns-store-cut-buffer-internal "nsselect.m" (buffer string)) |
1381 | ||
edfda783 | 1382 | (defun ns-set-pasteboard (string) |
a5a1b464 | 1383 | "Store STRING into the pasteboard of the Nextstep display server." |
edfda783 AR |
1384 | ;; Check the data type of STRING. |
1385 | (if (not (stringp string)) (error "Nonstring given to pasteboard")) | |
1386 | (ns-store-cut-buffer-internal 'PRIMARY string)) | |
1387 | ||
ebe68042 SM |
1388 | ;; We keep track of the last text selected here, so we can check the |
1389 | ;; current selection against it, and avoid passing back our own text | |
1390 | ;; from ns-pasteboard-value. | |
edfda783 AR |
1391 | (defvar ns-last-selected-text nil) |
1392 | ||
edfda783 | 1393 | (defun ns-select-text (text &optional push) |
ebe68042 | 1394 | "Put TEXT, a string, on the pasteboard." |
edfda783 AR |
1395 | ;; Don't send the pasteboard too much text. |
1396 | ;; It becomes slow, and if really big it causes errors. | |
1397 | (ns-set-pasteboard text) | |
1398 | (setq ns-last-selected-text text)) | |
1399 | ||
a5a1b464 CY |
1400 | ;; Return the value of the current Nextstep selection. For |
1401 | ;; compatibility with older Nextstep applications, this checks cut | |
1402 | ;; buffer 0 before retrieving the value of the primary selection. | |
edfda783 AR |
1403 | (defun ns-pasteboard-value () |
1404 | (let (text) | |
d377ef4a | 1405 | |
edfda783 AR |
1406 | ;; Consult the selection, then the cut buffer. Treat empty strings |
1407 | ;; as if they were unset. | |
1408 | (or text (setq text (ns-get-pasteboard))) | |
1409 | (if (string= text "") (setq text nil)) | |
d377ef4a | 1410 | |
edfda783 AR |
1411 | (cond |
1412 | ((not text) nil) | |
1413 | ((eq text ns-last-selected-text) nil) | |
1414 | ((string= text ns-last-selected-text) | |
1415 | ;; Record the newer string, so subsequent calls can use the `eq' test. | |
1416 | (setq ns-last-selected-text text) | |
1417 | nil) | |
1418 | (t | |
1419 | (setq ns-last-selected-text text))))) | |
1420 | ||
1421 | (defun ns-copy-including-secondary () | |
1422 | (interactive) | |
1423 | (call-interactively 'kill-ring-save) | |
1424 | (ns-store-cut-buffer-internal 'SECONDARY | |
1425 | (buffer-substring (point) (mark t)))) | |
1426 | (defun ns-paste-secondary () | |
1427 | (interactive) | |
1428 | (insert (ns-get-cut-buffer-internal 'SECONDARY))) | |
1429 | ||
1430 | ;; PENDING: not sure what to do here.. for now interprog- are set in | |
ebe68042 | 1431 | ;; init-fn-keys, and unsure whether these x- settings have an effect. |
edfda783 AR |
1432 | ;;(setq interprogram-cut-function 'ns-select-text |
1433 | ;; interprogram-paste-function 'ns-pasteboard-value) | |
ebe68042 | 1434 | ;; These only needed if above not working. |
edfda783 AR |
1435 | (defalias 'x-select-text 'ns-select-text) |
1436 | (defalias 'x-cut-buffer-or-selection-value 'ns-pasteboard-value) | |
1437 | (defalias 'x-disown-selection-internal 'ns-disown-selection-internal) | |
1438 | (defalias 'x-get-selection-internal 'ns-get-selection-internal) | |
1439 | (defalias 'x-own-selection-internal 'ns-own-selection-internal) | |
1440 | ||
1441 | (set-face-background 'region "ns_selection_color") | |
1442 | ||
1443 | ||
1444 | ||
1445 | ;;;; Scrollbar handling. | |
1446 | ||
1447 | (global-set-key [vertical-scroll-bar down-mouse-1] 'ns-handle-scroll-bar-event) | |
1448 | (global-unset-key [vertical-scroll-bar mouse-1]) | |
1449 | (global-unset-key [vertical-scroll-bar drag-mouse-1]) | |
1450 | ||
1451 | (defun ns-scroll-bar-move (event) | |
a5a1b464 | 1452 | "Scroll the frame according to an Nextstep scroller event." |
edfda783 AR |
1453 | (interactive "e") |
1454 | (let* ((pos (event-end event)) | |
1455 | (window (nth 0 pos)) | |
1456 | (scale (nth 2 pos))) | |
1457 | (save-excursion | |
1458 | (set-buffer (window-buffer window)) | |
1459 | (cond | |
1460 | ((eq (car scale) (cdr scale)) | |
1461 | (goto-char (point-max))) | |
1462 | ((= (car scale) 0) | |
1463 | (goto-char (point-min))) | |
1464 | (t | |
1465 | (goto-char (+ (point-min) 1 | |
1466 | (scroll-bar-scale scale (- (point-max) (point-min))))))) | |
1467 | (beginning-of-line) | |
1468 | (set-window-start window (point)) | |
1469 | (vertical-motion (/ (window-height window) 2) window)))) | |
1470 | ||
1471 | (defun ns-handle-scroll-bar-event (event) | |
1472 | "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling." | |
1473 | (interactive "e") | |
1474 | (let* ((position (event-start event)) | |
1475 | (bar-part (nth 4 position)) | |
1476 | (window (nth 0 position)) | |
1477 | (old-window (selected-window))) | |
1478 | (cond | |
1479 | ((eq bar-part 'ratio) | |
1480 | (ns-scroll-bar-move event)) | |
1481 | ((eq bar-part 'handle) | |
1482 | (if (eq window (selected-window)) | |
1483 | (track-mouse (ns-scroll-bar-move event)) | |
ebe68042 | 1484 | ;; track-mouse faster for selected window, slower for unselected. |
edfda783 AR |
1485 | (ns-scroll-bar-move event))) |
1486 | (t | |
1487 | (select-window window) | |
1488 | (cond | |
1489 | ((eq bar-part 'up) | |
1490 | (goto-char (window-start window)) | |
1491 | (scroll-down 1)) | |
1492 | ((eq bar-part 'above-handle) | |
1493 | (scroll-down)) | |
1494 | ((eq bar-part 'below-handle) | |
1495 | (scroll-up)) | |
1496 | ((eq bar-part 'down) | |
1497 | (goto-char (window-start window)) | |
1498 | (scroll-up 1))) | |
1499 | (select-window old-window))))) | |
1500 | ||
1501 | ||
1502 | ;;;; Color support. | |
1503 | ||
c0642f6d GM |
1504 | (declare-function ns-list-colors "nsfns.m" (&optional frame)) |
1505 | ||
edfda783 AR |
1506 | (defvar x-colors (ns-list-colors) |
1507 | "The list of colors defined in non-PANTONE color files.") | |
1508 | (defvar colors x-colors | |
1509 | "The list of colors defined in non-PANTONE color files.") | |
1510 | ||
1511 | (defun ns-defined-colors (&optional frame) | |
1512 | "Return a list of colors supported for a particular frame. | |
1513 | The argument FRAME specifies which frame to try. | |
a5a1b464 | 1514 | The value may be different for frames on different Nextstep displays." |
edfda783 AR |
1515 | (or frame (setq frame (selected-frame))) |
1516 | (let ((all-colors x-colors) | |
1517 | (this-color nil) | |
1518 | (defined-colors nil)) | |
1519 | (while all-colors | |
1520 | (setq this-color (car all-colors) | |
1521 | all-colors (cdr all-colors)) | |
ebe68042 SM |
1522 | ;; (and (face-color-supported-p frame this-color t) |
1523 | (setq defined-colors (cons this-color defined-colors))) ;;) | |
edfda783 AR |
1524 | defined-colors)) |
1525 | (defalias 'x-defined-colors 'ns-defined-colors) | |
1526 | (defalias 'xw-defined-colors 'ns-defined-colors) | |
1527 | ||
c0642f6d GM |
1528 | (declare-function ns-set-alpha "nsfns.m" (color alpha)) |
1529 | ||
edfda783 AR |
1530 | ;; Convenience and work-around for fact that set color fns now require named. |
1531 | (defun ns-set-background-alpha (alpha) | |
1532 | "Sets alpha (opacity) of background. | |
1533 | Set from 0.0 (fully transparent) to 1.0 (fully opaque; default). | |
1534 | Note, tranparency works better on Tiger (10.4) and higher." | |
1535 | (interactive "nSet background alpha to: ") | |
1536 | (let ((bgcolor (cdr (assq 'background-color (frame-parameters))))) | |
1537 | (set-frame-parameter (selected-frame) | |
1538 | 'background-color (ns-set-alpha bgcolor alpha)))) | |
1539 | ||
1540 | ;; Functions for color panel + drag | |
1541 | (defun ns-face-at-pos (pos) | |
1542 | (let* ((frame (car pos)) | |
1543 | (frame-pos (cons (cadr pos) (cddr pos))) | |
1544 | (window (window-at (car frame-pos) (cdr frame-pos) frame)) | |
1545 | (window-pos (coordinates-in-window-p frame-pos window)) | |
1546 | (buffer (window-buffer window)) | |
1547 | (edges (window-edges window))) | |
1548 | (cond | |
1549 | ((not window-pos) | |
1550 | nil) | |
1551 | ((eq window-pos 'mode-line) | |
1552 | 'modeline) | |
1553 | ((eq window-pos 'vertical-line) | |
1554 | 'default) | |
1555 | ((consp window-pos) | |
1556 | (save-excursion | |
1557 | (set-buffer buffer) | |
1558 | (let ((p (car (compute-motion (window-start window) | |
1559 | (cons (nth 0 edges) (nth 1 edges)) | |
1560 | (window-end window) | |
1561 | frame-pos | |
1562 | (- (window-width window) 1) | |
1563 | nil | |
1564 | window)))) | |
1565 | (cond | |
1566 | ((eq p (window-point window)) | |
1567 | 'cursor) | |
1568 | ((and mark-active (< (region-beginning) p) (< p (region-end))) | |
1569 | 'region) | |
1570 | (t | |
1571 | (let ((faces (get-char-property p 'face window))) | |
1572 | (if (consp faces) (car faces) faces))))))) | |
1573 | (t | |
1574 | nil)))) | |
1575 | ||
c0642f6d GM |
1576 | (defvar ns-input-color) ; nsterm.m |
1577 | ||
edfda783 AR |
1578 | (defun ns-set-foreground-at-mouse () |
1579 | "Set the foreground color at the mouse location to ns-input-color." | |
1580 | (interactive) | |
1581 | (let* ((pos (mouse-position)) | |
1582 | (frame (car pos)) | |
1583 | (face (ns-face-at-pos pos))) | |
1584 | (cond | |
1585 | ((eq face 'cursor) | |
c0642f6d | 1586 | (modify-frame-parameters frame (list (cons 'cursor-color |
edfda783 AR |
1587 | ns-input-color)))) |
1588 | ((not face) | |
1589 | (modify-frame-parameters frame (list (cons 'foreground-color | |
1590 | ns-input-color)))) | |
1591 | (t | |
1592 | (set-face-foreground face ns-input-color frame))))) | |
1593 | ||
1594 | (defun ns-set-background-at-mouse () | |
1595 | "Set the background color at the mouse location to ns-input-color." | |
1596 | (interactive) | |
1597 | (let* ((pos (mouse-position)) | |
1598 | (frame (car pos)) | |
1599 | (face (ns-face-at-pos pos))) | |
1600 | (cond | |
1601 | ((eq face 'cursor) | |
1602 | (modify-frame-parameters frame (list (cons 'cursor-color | |
1603 | ns-input-color)))) | |
1604 | ((not face) | |
1605 | (modify-frame-parameters frame (list (cons 'background-color | |
1606 | ns-input-color)))) | |
1607 | (t | |
1608 | (set-face-background face ns-input-color frame))))) | |
1609 | ||
1610 | ||
1611 | ||
ebe68042 | 1612 | ;; Misc aliases. |
edfda783 AR |
1613 | (defalias 'x-display-mm-width 'ns-display-mm-width) |
1614 | (defalias 'x-display-mm-height 'ns-display-mm-height) | |
1615 | (defalias 'x-display-backing-store 'ns-display-backing-store) | |
1616 | (defalias 'x-display-save-under 'ns-display-save-under) | |
1617 | (defalias 'x-display-visual-class 'ns-display-visual-class) | |
1618 | (defalias 'x-display-screens 'ns-display-screens) | |
1619 | (defalias 'x-focus-frame 'ns-focus-frame) | |
1620 | ||
a5a1b464 | 1621 | ;; Set some options to be as Nextstep-like as possible. |
edfda783 AR |
1622 | (setq frame-title-format t |
1623 | icon-title-format t) | |
1624 | ||
ebe68042 | 1625 | ;; Set up browser connectivity. |
c0642f6d GM |
1626 | (defvar browse-url-generic-program) |
1627 | ||
edfda783 | 1628 | (setq browse-url-browser-function 'browse-url-generic) |
ebe68042 SM |
1629 | (setq browse-url-generic-program |
1630 | (cond ((eq system-type 'darwin) "open") | |
1631 | ;; Otherwise, GNUstep. | |
1632 | (t "gopen"))) | |
edfda783 AR |
1633 | |
1634 | ||
1635 | (defvar ns-initialized nil | |
a5a1b464 | 1636 | "Non-nil if Nextstep windowing has been initialized.") |
edfda783 | 1637 | |
c0642f6d GM |
1638 | (declare-function ns-open-connection "nsfns.m" |
1639 | (display &optional resource_string must_succeed)) | |
1640 | ||
1641 | (declare-function ns-list-services "nsfns.m" ()) | |
1642 | ||
a5a1b464 CY |
1643 | ;; Do the actual Nextstep Windows setup here; the above code just |
1644 | ;; defines functions and variables that we use now. | |
edfda783 | 1645 | (defun ns-initialize-window-system () |
a5a1b464 | 1646 | "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing." |
edfda783 | 1647 | |
ebe68042 | 1648 | ;; PENDING: not needed? |
edfda783 AR |
1649 | (setq command-line-args (ns-handle-args command-line-args)) |
1650 | ||
1651 | (ns-open-connection (system-name) nil t) | |
1652 | ||
ebe68042 SM |
1653 | (dolist (service (ns-list-services)) |
1654 | (if (eq (car service) 'undefined) | |
1655 | (ns-define-service (cdr service)) | |
1656 | (define-key global-map (vector (car service)) | |
1657 | (ns-define-service (cdr service))))) | |
edfda783 AR |
1658 | |
1659 | (if (and (eq (get-lisp-resource nil "NXAutoLaunch") t) | |
1660 | (eq (get-lisp-resource nil "HideOnAutoLaunch") t)) | |
1661 | (add-hook 'after-init-hook 'ns-do-hide-emacs)) | |
1662 | ||
ebe68042 | 1663 | ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings. |
edfda783 AR |
1664 | (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1)) |
1665 | (mouse-wheel-mode 1) | |
1666 | ||
1667 | (setq ns-initialized t)) | |
1668 | ||
1669 | (add-to-list 'handle-args-function-alist '(ns . ns-handle-args)) | |
1670 | (add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces)) | |
1671 | (add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system)) | |
1672 | ||
1673 | ||
1674 | (provide 'ns-win) | |
1675 | ||
0ae1e5e5 | 1676 | ;; arch-tag: eb138a45-4e2e-4d68-b1c9-a39665731644 |
edfda783 | 1677 | ;;; ns-win.el ends here |