(syms_of_lread) <force_load_messages>: New variable.
[bpt/emacs.git] / lisp / term / ns-win.el
CommitLineData
c0642f6d
GM
1;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system
2
ae940284 3;; Copyright (C) 1993, 1994, 2005, 2006, 2007, 2008, 2009
a5e1066d 4;; Free Software Foundation, Inc.
c0642f6d 5
c5220417
GM
6;; Authors: Carl Edman
7;; Christian Limpach
8;; Scott Bender
9;; Christophe de Dinechin
10;; Adrian Robert
c0642f6d
GM
11;; Keywords: terminals
12
13;; This file is part of GNU Emacs.
14
15;; GNU Emacs is free software: you can redistribute it and/or modify
16;; it under the terms of the GNU General Public License as published by
17;; the Free Software Foundation, either version 3 of the License, or
18;; (at your option) any later version.
19
20;; GNU Emacs is distributed in the hope that it will be useful,
21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23;; GNU General Public License for more details.
24
25;; You should have received a copy of the GNU General Public License
26;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
edfda783
AR
27
28;;; Commentary:
29
a5a1b464
CY
30;; ns-win.el: this file is loaded from ../lisp/startup.el when it
31;; recognizes that Nextstep windows are to be used. Command line
32;; switches are parsed and those pertaining to Nextstep are processed
33;; and removed from the command line. The Nextstep display is opened
34;; and hooks are set for popping up the initial window.
edfda783
AR
35
36;; startup.el will then examine startup files, and eventually call the hooks
37;; which create the first window (s).
38
a5a1b464
CY
39;; A number of other Nextstep convenience functions are defined in
40;; this file, which works in close coordination with src/nsfns.m.
edfda783
AR
41
42;;; Code:
43
44
601fb9b8 45(if (not (featurep 'ns))
3dcdb6ea 46 (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS"
edfda783
AR
47 (invocation-name)))
48
ebe68042
SM
49(eval-when-compile (require 'cl))
50
edfda783
AR
51;; Documentation-purposes only: actually loaded in loadup.el
52(require 'frame)
53(require 'mouse)
54(require 'faces)
55(require 'easymenu)
56(require 'menu-bar)
57(require 'fontset)
58
ebe68042
SM
59;; Not needed?
60;;(require 'ispell)
edfda783 61
20bc68dd
GM
62(defgroup ns nil
63 "GNUstep/Mac OS X specific features."
64 :group 'environment)
65
c0642f6d
GM
66;; nsterm.m
67(defvar ns-version-string)
c0642f6d
GM
68(defvar ns-alternate-modifier)
69
edfda783
AR
70;;;; Command line argument handling.
71
72(defvar ns-invocation-args nil)
73(defvar ns-command-line-resources nil)
74
75;; Handler for switches of the form "-switch value" or "-switch".
d377ef4a 76(defun ns-handle-switch (switch &optional numeric)
edfda783
AR
77 (let ((aelt (assoc switch command-line-ns-option-alist)))
78 (if aelt
d377ef4a
GM
79 (setq default-frame-alist
80 (cons (cons (nth 3 aelt)
81 (if numeric
82 (string-to-number (pop ns-invocation-args))
83 (or (nth 4 aelt) (pop ns-invocation-args))))
84 default-frame-alist)))))
edfda783
AR
85
86;; Handler for switches of the form "-switch n"
87(defun ns-handle-numeric-switch (switch)
d377ef4a 88 (ns-handle-switch switch t))
edfda783
AR
89
90;; Make -iconic apply only to the initial frame!
91(defun ns-handle-iconic (switch)
92 (setq initial-frame-alist
93 (cons '(visibility . icon) initial-frame-alist)))
94
82a330df 95;; Handle the -name option, set the name of the initial frame.
edfda783
AR
96(defun ns-handle-name-switch (switch)
97 (or (consp ns-invocation-args)
98 (error "%s: missing argument to `%s' option" (invocation-name) switch))
d377ef4a
GM
99 (setq initial-frame-alist (cons (cons 'name (pop ns-invocation-args))
100 initial-frame-alist)))
101
102;; Set (but not used?) in frame.el.
9e50ff0c 103(defvar x-display-name nil
a5a1b464 104 "The name of the Nextstep display on which Emacs was started.")
edfda783 105
c0642f6d
GM
106;; nsterm.m.
107(defvar ns-input-file)
108
edfda783
AR
109(defun ns-handle-nxopen (switch)
110 (setq unread-command-events (append unread-command-events '(ns-open-file))
d377ef4a 111 ns-input-file (append ns-input-file (list (pop ns-invocation-args)))))
edfda783
AR
112
113(defun ns-handle-nxopentemp (switch)
d377ef4a
GM
114 (setq unread-command-events (append unread-command-events
115 '(ns-open-temp-file))
116 ns-input-file (append ns-input-file (list (pop ns-invocation-args)))))
edfda783 117
edfda783
AR
118(defun ns-ignore-1-arg (switch)
119 (setq ns-invocation-args (cdr ns-invocation-args)))
120(defun ns-ignore-2-arg (switch)
121 (setq ns-invocation-args (cddr ns-invocation-args)))
122
123(defun ns-handle-args (args)
a5a1b464 124 "Process Nextstep-related command line options.
82a330df 125This is run before the user's startup file is loaded.
a5a1b464
CY
126The options in ARGS are copied to `ns-invocation-args'.
127The Nextstep-related settings are then applied using the handlers
82a330df 128defined in `command-line-ns-option-alist'.
a5a1b464 129The return value is ARGS minus the number of arguments processed."
edfda783
AR
130 ;; We use ARGS to accumulate the args that we don't handle here, to return.
131 (setq ns-invocation-args args
132 args nil)
133 (while ns-invocation-args
d377ef4a 134 (let* ((this-switch (pop ns-invocation-args))
edfda783
AR
135 (orig-this-switch this-switch)
136 completion argval aelt handler)
edfda783
AR
137 ;; Check for long options with attached arguments
138 ;; and separate out the attached option argument into argval.
139 (if (string-match "^--[^=]*=" this-switch)
140 (setq argval (substring this-switch (match-end 0))
141 this-switch (substring this-switch 0 (1- (match-end 0)))))
142 ;; Complete names of long options.
143 (if (string-match "^--" this-switch)
144 (progn
145 (setq completion (try-completion this-switch
146 command-line-ns-option-alist))
147 (if (eq completion t)
148 ;; Exact match for long option.
149 nil
150 (if (stringp completion)
151 (let ((elt (assoc completion command-line-ns-option-alist)))
152 ;; Check for abbreviated long option.
153 (or elt
154 (error "Option `%s' is ambiguous" this-switch))
155 (setq this-switch completion))))))
156 (setq aelt (assoc this-switch command-line-ns-option-alist))
157 (if aelt (setq handler (nth 2 aelt)))
158 (if handler
159 (if argval
160 (let ((ns-invocation-args
161 (cons argval ns-invocation-args)))
162 (funcall handler this-switch))
163 (funcall handler this-switch))
164 (setq args (cons orig-this-switch args)))))
165 (nreverse args))
166
489382c5 167(defun ns-parse-geometry (geom)
ba0c843d 168 "Parse a Nextstep-style geometry string GEOM.
edfda783
AR
169Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
170The properties returned may include `top', `left', `height', and `width'."
a5a1b464
CY
171 (when (string-match "\\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\)\
172\\( \\([0-9]+\\) ?\\)?\\)?\\)?"
173 geom)
174 (apply
175 'append
176 (list
177 (list (cons 'top (string-to-number (match-string 1 geom))))
178 (if (match-string 3 geom)
179 (list (cons 'left (string-to-number (match-string 3 geom)))))
180 (if (match-string 5 geom)
181 (list (cons 'height (string-to-number (match-string 5 geom)))))
182 (if (match-string 7 geom)
183 (list (cons 'width (string-to-number (match-string 7 geom)))))))))
edfda783
AR
184
185;;;; Keyboard mapping.
186
6742a9d2
AR
187;; These tell read-char how to convert these special chars to ASCII.
188;;TODO: all terms have these, and at least the return mapping is necessary
189;; for tramp to recognize the enter key.
190;; Perhaps they should be moved into common code somewhere
191;; (when a window system is active).
55e8d9a5 192;; Remove if no problems for some time after 2008-08-06.
6742a9d2
AR
193(put 'backspace 'ascii-character 127)
194(put 'delete 'ascii-character 127)
195(put 'tab 'ascii-character ?\t)
196(put 'S-tab 'ascii-character (logior 16 ?\t))
197(put 'linefeed 'ascii-character ?\n)
198(put 'clear 'ascii-character 12)
199(put 'return 'ascii-character 13)
200(put 'escape 'ascii-character ?\e)
55e8d9a5
AR
201
202
203(defvar ns-alternatives-map
204 (let ((map (make-sparse-keymap)))
205 ;; Map certain keypad keys into ASCII characters
206 ;; that people usually expect.
207 (define-key map [backspace] [?\d])
208 (define-key map [delete] [?\d])
209 (define-key map [tab] [?\t])
210 (define-key map [S-tab] [25])
211 (define-key map [linefeed] [?\n])
212 (define-key map [clear] [?\C-l])
213 (define-key map [return] [?\C-m])
214 (define-key map [escape] [?\e])
215 (define-key map [M-backspace] [?\M-\d])
216 (define-key map [M-delete] [?\M-\d])
217 (define-key map [M-tab] [?\M-\t])
218 (define-key map [M-linefeed] [?\M-\n])
219 (define-key map [M-clear] [?\M-\C-l])
220 (define-key map [M-return] [?\M-\C-m])
221 (define-key map [M-escape] [?\M-\e])
222 map)
2b4e72e1 223 "Keymap of alternative meanings for some keys under Nextstep.")
edfda783 224
a5a1b464 225;; Here are some Nextstep-like bindings for command key sequences.
4c785fa7 226(define-key global-map [?\s-,] 'customize)
edfda783
AR
227(define-key global-map [?\s-'] 'next-multiframe-window)
228(define-key global-map [?\s-`] 'other-frame)
229(define-key global-map [?\s--] 'center-line)
230(define-key global-map [?\s-:] 'ispell)
231(define-key global-map [?\s-\;] 'ispell-next)
232(define-key global-map [?\s-?] 'info)
233(define-key global-map [?\s-^] 'kill-some-buffers)
234(define-key global-map [?\s-&] 'kill-this-buffer)
235(define-key global-map [?\s-C] 'ns-popup-color-panel)
236(define-key global-map [?\s-D] 'dired)
237(define-key global-map [?\s-E] 'edit-abbrevs)
238(define-key global-map [?\s-L] 'shell-command)
239(define-key global-map [?\s-M] 'manual-entry)
240(define-key global-map [?\s-S] 'ns-write-file-using-panel)
241(define-key global-map [?\s-a] 'mark-whole-buffer)
242(define-key global-map [?\s-c] 'ns-copy-including-secondary)
243(define-key global-map [?\s-d] 'isearch-repeat-backward)
244(define-key global-map [?\s-e] 'isearch-yank-kill)
245(define-key global-map [?\s-f] 'isearch-forward)
246(define-key global-map [?\s-g] 'isearch-repeat-forward)
247(define-key global-map [?\s-h] 'ns-do-hide-emacs)
248(define-key global-map [?\s-H] 'ns-do-hide-others)
249(define-key global-map [?\s-j] 'exchange-point-and-mark)
250(define-key global-map [?\s-k] 'kill-this-buffer)
251(define-key global-map [?\s-l] 'goto-line)
252(define-key global-map [?\s-m] 'iconify-frame)
253(define-key global-map [?\s-n] 'make-frame)
254(define-key global-map [?\s-o] 'ns-open-file-using-panel)
255(define-key global-map [?\s-p] 'ns-print-buffer)
256(define-key global-map [?\s-q] 'save-buffers-kill-emacs)
257(define-key global-map [?\s-s] 'save-buffer)
258(define-key global-map [?\s-t] 'ns-popup-font-panel)
259(define-key global-map [?\s-u] 'revert-buffer)
260(define-key global-map [?\s-v] 'yank)
261(define-key global-map [?\s-w] 'delete-frame)
262(define-key global-map [?\s-x] 'kill-region)
263(define-key global-map [?\s-y] 'ns-paste-secondary)
264(define-key global-map [?\s-z] 'undo)
265(define-key global-map [?\s-|] 'shell-command-on-region)
266(define-key global-map [s-kp-bar] 'shell-command-on-region)
ebe68042 267;; (as in Terminal.app)
edfda783
AR
268(define-key global-map [s-right] 'ns-next-frame)
269(define-key global-map [s-left] 'ns-prev-frame)
270
271(define-key global-map [home] 'beginning-of-buffer)
272(define-key global-map [end] 'end-of-buffer)
273(define-key global-map [kp-home] 'beginning-of-buffer)
274(define-key global-map [kp-end] 'end-of-buffer)
275(define-key global-map [kp-prior] 'scroll-down)
276(define-key global-map [kp-next] 'scroll-up)
277
55e8d9a5
AR
278;;; Allow shift-clicks to work similarly to under Nextstep
279(define-key global-map [S-mouse-1] 'mouse-save-then-kill)
280(global-unset-key [S-down-mouse-1])
281
edfda783 282
a5a1b464 283;; Special Nextstep-generated events are converted to function keys. Here
edfda783 284;; are the bindings for them.
c6c62e78 285(define-key global-map [ns-power-off] 'save-buffers-kill-emacs)
edfda783
AR
286(define-key global-map [ns-open-file] 'ns-find-file)
287(define-key global-map [ns-open-temp-file] [ns-open-file])
288(define-key global-map [ns-drag-file] 'ns-insert-file)
289(define-key global-map [ns-drag-color] 'ns-set-foreground-at-mouse)
290(define-key global-map [S-ns-drag-color] 'ns-set-background-at-mouse)
291(define-key global-map [ns-drag-text] 'ns-insert-text)
292(define-key global-map [ns-change-font] 'ns-respond-to-change-font)
293(define-key global-map [ns-open-file-line] 'ns-open-file-select-line)
edfda783 294(define-key global-map [ns-spi-service-call] 'ns-spi-service-call)
4e622592 295(define-key global-map [ns-new-frame] 'make-frame)
33b35792 296(define-key global-map [ns-toggle-toolbar] 'ns-toggle-toolbar)
c6c62e78 297(define-key global-map [ns-show-prefs] 'customize)
edfda783
AR
298
299
2f93961f
CY
300;; Set up a number of aliases and other layers to pretend we're using
301;; the Choi/Mitsuharu Carbon port.
302
303(defvaralias 'mac-allow-anti-aliasing 'ns-antialias-text)
304(defvaralias 'mac-command-modifier 'ns-command-modifier)
305(defvaralias 'mac-control-modifier 'ns-control-modifier)
306(defvaralias 'mac-option-modifier 'ns-option-modifier)
307(defvaralias 'mac-function-modifier 'ns-function-modifier)
406aaa6f 308(declare-function ns-do-applescript "nsfns.m" (script))
583ff3c3
AR
309(defalias 'do-applescript 'ns-do-applescript)
310
edfda783 311(defun x-setup-function-keys (frame)
a5a1b464 312 "Set up function Keys for Nextstep for frame FRAME."
edfda783
AR
313 (unless (terminal-parameter frame 'x-setup-function-keys)
314 (with-selected-frame frame
9e50ff0c
DN
315 (setq interprogram-cut-function 'x-select-text
316 interprogram-paste-function 'x-cut-buffer-or-selection-value)
55e8d9a5
AR
317 (let ((map (copy-keymap ns-alternatives-map)))
318 (set-keymap-parent map (keymap-parent local-function-key-map))
319 (set-keymap-parent local-function-key-map map))
ebe68042
SM
320 (setq system-key-alist
321 (list
322 (cons (logior (lsh 0 16) 1) 'ns-power-off)
323 (cons (logior (lsh 0 16) 2) 'ns-open-file)
324 (cons (logior (lsh 0 16) 3) 'ns-open-temp-file)
325 (cons (logior (lsh 0 16) 4) 'ns-drag-file)
326 (cons (logior (lsh 0 16) 5) 'ns-drag-color)
327 (cons (logior (lsh 0 16) 6) 'ns-drag-text)
328 (cons (logior (lsh 0 16) 7) 'ns-change-font)
329 (cons (logior (lsh 0 16) 8) 'ns-open-file-line)
33b35792
AR
330; (cons (logior (lsh 0 16) 9) 'ns-insert-working-text)
331; (cons (logior (lsh 0 16) 10) 'ns-delete-working-text)
ebe68042 332 (cons (logior (lsh 0 16) 11) 'ns-spi-service-call)
4c785fa7
DR
333 (cons (logior (lsh 0 16) 12) 'ns-new-frame)
334 (cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar)
335 (cons (logior (lsh 0 16) 14) 'ns-show-prefs)
336 (cons (logior (lsh 1 16) 32) 'f1)
ebe68042
SM
337 (cons (logior (lsh 1 16) 33) 'f2)
338 (cons (logior (lsh 1 16) 34) 'f3)
339 (cons (logior (lsh 1 16) 35) 'f4)
340 (cons (logior (lsh 1 16) 36) 'f5)
341 (cons (logior (lsh 1 16) 37) 'f6)
342 (cons (logior (lsh 1 16) 38) 'f7)
343 (cons (logior (lsh 1 16) 39) 'f8)
344 (cons (logior (lsh 1 16) 40) 'f9)
345 (cons (logior (lsh 1 16) 41) 'f10)
346 (cons (logior (lsh 1 16) 42) 'f11)
347 (cons (logior (lsh 1 16) 43) 'f12)
348 (cons (logior (lsh 1 16) 44) 'kp-insert)
349 (cons (logior (lsh 1 16) 45) 'kp-delete)
350 (cons (logior (lsh 1 16) 46) 'kp-home)
351 (cons (logior (lsh 1 16) 47) 'kp-end)
352 (cons (logior (lsh 1 16) 48) 'kp-prior)
353 (cons (logior (lsh 1 16) 49) 'kp-next)
354 (cons (logior (lsh 1 16) 50) 'print-screen)
355 (cons (logior (lsh 1 16) 51) 'scroll-lock)
356 (cons (logior (lsh 1 16) 52) 'pause)
357 (cons (logior (lsh 1 16) 53) 'system)
358 (cons (logior (lsh 1 16) 54) 'break)
359 (cons (logior (lsh 1 16) 56) 'please-tell-carl-what-this-key-is-called-56)
360 (cons (logior (lsh 1 16) 61) 'please-tell-carl-what-this-key-is-called-61)
361 (cons (logior (lsh 1 16) 62) 'please-tell-carl-what-this-key-is-called-62)
362 (cons (logior (lsh 1 16) 63) 'please-tell-carl-what-this-key-is-called-63)
363 (cons (logior (lsh 1 16) 64) 'please-tell-carl-what-this-key-is-called-64)
364 (cons (logior (lsh 1 16) 69) 'please-tell-carl-what-this-key-is-called-69)
365 (cons (logior (lsh 1 16) 70) 'please-tell-carl-what-this-key-is-called-70)
366 (cons (logior (lsh 1 16) 71) 'please-tell-carl-what-this-key-is-called-71)
367 (cons (logior (lsh 1 16) 72) 'please-tell-carl-what-this-key-is-called-72)
368 (cons (logior (lsh 1 16) 73) 'please-tell-carl-what-this-key-is-called-73)
369 (cons (logior (lsh 2 16) 3) 'kp-enter)
370 (cons (logior (lsh 2 16) 9) 'kp-tab)
371 (cons (logior (lsh 2 16) 28) 'kp-quit)
372 (cons (logior (lsh 2 16) 35) 'kp-hash)
373 (cons (logior (lsh 2 16) 42) 'kp-multiply)
374 (cons (logior (lsh 2 16) 43) 'kp-add)
375 (cons (logior (lsh 2 16) 44) 'kp-separator)
376 (cons (logior (lsh 2 16) 45) 'kp-subtract)
377 (cons (logior (lsh 2 16) 46) 'kp-decimal)
378 (cons (logior (lsh 2 16) 47) 'kp-divide)
379 (cons (logior (lsh 2 16) 48) 'kp-0)
380 (cons (logior (lsh 2 16) 49) 'kp-1)
381 (cons (logior (lsh 2 16) 50) 'kp-2)
382 (cons (logior (lsh 2 16) 51) 'kp-3)
383 (cons (logior (lsh 2 16) 52) 'kp-4)
384 (cons (logior (lsh 2 16) 53) 'kp-5)
385 (cons (logior (lsh 2 16) 54) 'kp-6)
386 (cons (logior (lsh 2 16) 55) 'kp-7)
387 (cons (logior (lsh 2 16) 56) 'kp-8)
388 (cons (logior (lsh 2 16) 57) 'kp-9)
389 (cons (logior (lsh 2 16) 60) 'kp-less)
390 (cons (logior (lsh 2 16) 61) 'kp-equal)
391 (cons (logior (lsh 2 16) 62) 'kp-more)
392 (cons (logior (lsh 2 16) 64) 'kp-at)
393 (cons (logior (lsh 2 16) 92) 'kp-backslash)
394 (cons (logior (lsh 2 16) 96) 'kp-backtick)
395 (cons (logior (lsh 2 16) 124) 'kp-bar)
396 (cons (logior (lsh 2 16) 126) 'kp-tilde)
397 (cons (logior (lsh 2 16) 157) 'kp-mu)
398 (cons (logior (lsh 2 16) 165) 'kp-yen)
399 (cons (logior (lsh 2 16) 167) 'kp-paragraph)
400 (cons (logior (lsh 2 16) 172) 'left)
401 (cons (logior (lsh 2 16) 173) 'up)
402 (cons (logior (lsh 2 16) 174) 'right)
403 (cons (logior (lsh 2 16) 175) 'down)
404 (cons (logior (lsh 2 16) 176) 'kp-ring)
405 (cons (logior (lsh 2 16) 201) 'kp-square)
406 (cons (logior (lsh 2 16) 204) 'kp-cube)
407 (cons (logior (lsh 3 16) 8) 'backspace)
408 (cons (logior (lsh 3 16) 9) 'tab)
409 (cons (logior (lsh 3 16) 10) 'linefeed)
410 (cons (logior (lsh 3 16) 11) 'clear)
411 (cons (logior (lsh 3 16) 13) 'return)
412 (cons (logior (lsh 3 16) 18) 'pause)
413 (cons (logior (lsh 3 16) 25) 'S-tab)
414 (cons (logior (lsh 3 16) 27) 'escape)
415 (cons (logior (lsh 3 16) 127) 'delete)
55e8d9a5
AR
416 )))
417 (set-terminal-parameter frame 'x-setup-function-keys t)))
edfda783
AR
418
419
420
ebe68042 421;; Must come after keybindings.
edfda783 422
c6c62e78
DR
423;; (fmakunbound 'clipboard-yank)
424;; (fmakunbound 'clipboard-kill-ring-save)
425;; (fmakunbound 'clipboard-kill-region)
426;; (fmakunbound 'menu-bar-enable-clipboard)
edfda783
AR
427
428;; Add a couple of menus and rearrange some others; easiest just to redo toplvl
429;; Note keymap defns must be given last-to-first
430(define-key global-map [menu-bar] (make-sparse-keymap "menu-bar"))
431
ebe68042
SM
432(setq menu-bar-final-items
433 (cond ((eq system-type 'darwin)
434 '(buffer windows services help-menu))
435 ;; Otherwise, GNUstep.
436 (t
437 '(buffer windows services hide-app quit))))
edfda783 438
ebe68042
SM
439;; Add standard top-level items to GNUstep menu.
440(unless (eq system-type 'darwin)
441 (define-key global-map [menu-bar quit] '("Quit" . save-buffers-kill-emacs))
442 (define-key global-map [menu-bar hide-app] '("Hide" . ns-do-hide-emacs)))
edfda783
AR
443
444(define-key global-map [menu-bar services]
445 (cons "Services" (make-sparse-keymap "Services")))
edfda783
AR
446(define-key global-map [menu-bar buffer]
447 (cons "Buffers" global-buffers-menu-map))
448;; (cons "Buffers" (make-sparse-keymap "Buffers")))
449(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
450(define-key global-map [menu-bar options] (cons "Options" menu-bar-options-menu))
451(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
452(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu))
453
454;; If running under GNUstep, rename "Help" to "Info"
455(cond ((eq system-type 'darwin)
456 (define-key global-map [menu-bar help-menu]
457 (cons "Help" menu-bar-help-menu)))
458 (t
459 (let ((contents (reverse (cdr menu-bar-help-menu))))
460 (setq menu-bar-help-menu
461 (append (list 'keymap) (cdr contents) (list "Info"))))
462 (define-key global-map [menu-bar help-menu]
463 (cons "Info" menu-bar-help-menu))))
464
edfda783
AR
465(if (not (eq system-type 'darwin))
466 ;; in OS X it's in the app menu already
467 (define-key menu-bar-help-menu [info-panel]
468 '("About Emacs..." . ns-do-emacs-info-panel)))
469
edfda783
AR
470;;;; Edit menu: Modify slightly
471
ebe68042 472;; Substitute a Copy function that works better under X (for GNUstep).
edfda783
AR
473(easy-menu-remove-item global-map '("menu-bar" "edit") 'copy)
474(define-key-after menu-bar-edit-menu [copy]
475 '(menu-item "Copy" ns-copy-including-secondary
ebe68042
SM
476 :enable mark-active
477 :help "Copy text in region between mark and current position")
edfda783
AR
478 'cut)
479
ebe68042
SM
480;; Change to same precondition as select-and-paste, as we don't have
481;; `x-selection-exists-p'.
edfda783
AR
482(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste)
483(define-key-after menu-bar-edit-menu [paste]
484 '(menu-item "Paste" yank
ebe68042
SM
485 :enable (and (cdr yank-menu) (not buffer-read-only))
486 :help "Paste (yank) text most recently cut/copied")
edfda783
AR
487 'copy)
488
ebe68042 489;; Change text to be more consistent with surrounding menu items `paste', etc.
edfda783
AR
490(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste-from-menu)
491(define-key-after menu-bar-edit-menu [select-paste]
492 '(menu-item "Select and Paste" yank-menu
ebe68042
SM
493 :enable (and (cdr yank-menu) (not buffer-read-only))
494 :help "Choose a string from the kill ring and paste it")
edfda783
AR
495 'paste)
496
ebe68042 497;; Separate undo from cut/paste section, add spell for platform consistency.
edfda783
AR
498(define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo)
499(define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill)
500
edfda783
AR
501
502;;;; Services
d377ef4a
GM
503(declare-function ns-perform-service "nsfns.m" (service send))
504
edfda783
AR
505(defun ns-define-service (path)
506 (let ((mapping [menu-bar services])
507 (service (mapconcat 'identity path "/"))
508 (name (intern
ebe68042
SM
509 (subst-char-in-string
510 ?\s ?-
511 (mapconcat 'identity (cons "ns-service" path) "-")))))
512 ;; This defines the function.
513 (defalias name
514 (lexical-let ((service service))
515 (lambda (arg)
516 (interactive "p")
517 (let* ((in-string
518 (cond ((stringp arg) arg)
519 (mark-active
520 (buffer-substring (region-beginning) (region-end)))))
521 (out-string (ns-perform-service service in-string)))
522 (cond
523 ((stringp arg) out-string)
524 ((and out-string (or (not in-string)
525 (not (string= in-string out-string))))
526 (if mark-active (delete-region (region-beginning) (region-end)))
527 (insert out-string)
528 (setq deactivate-mark nil)))))))
edfda783
AR
529 (cond
530 ((lookup-key global-map mapping)
531 (while (cdr path)
532 (setq mapping (vconcat mapping (list (intern (car path)))))
533 (if (not (keymapp (lookup-key global-map mapping)))
534 (define-key global-map mapping
535 (cons (car path) (make-sparse-keymap (car path)))))
536 (setq path (cdr path)))
537 (setq mapping (vconcat mapping (list (intern (car path)))))
538 (define-key global-map mapping (cons (car path) name))))
539 name))
540
c0642f6d
GM
541;; nsterm.m
542(defvar ns-input-spi-name)
543(defvar ns-input-spi-arg)
544
f2d9c15f
GM
545(declare-function dnd-open-file "dnd" (uri action))
546
edfda783 547(defun ns-spi-service-call ()
82a330df 548 "Respond to a service request."
edfda783
AR
549 (interactive)
550 (cond ((string-equal ns-input-spi-name "open-selection")
551 (switch-to-buffer (generate-new-buffer "*untitled*"))
552 (insert ns-input-spi-arg))
553 ((string-equal ns-input-spi-name "open-file")
554 (dnd-open-file ns-input-spi-arg nil))
555 ((string-equal ns-input-spi-name "mail-selection")
556 (compose-mail)
557 (rfc822-goto-eoh)
558 (forward-line 1)
559 (insert ns-input-spi-arg))
560 ((string-equal ns-input-spi-name "mail-to")
561 (compose-mail ns-input-spi-arg))
562 (t (error (concat "Service " ns-input-spi-name " not recognized")))))
563
564
565;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
566
567
568
43c660bc
SM
569;; Composed key sequence handling for Nextstep system input methods.
570;; (On Nextstep systems, input methods are provided for CJK
571;; characters, etc. which require multiple keystrokes, and during
572;; entry a partial ("working") result is typically shown in the
573;; editing window.)
edfda783
AR
574
575(defface ns-working-text-face
576 '((t :underline t))
577 "Face used to highlight working text during compose sequence insert."
578 :group 'ns)
579
580(defvar ns-working-overlay nil
43c660bc
SM
581 "Overlay used to highlight working text during compose sequence insert.
582When text is in th echo area, this just stores the length of the working text.")
edfda783 583
33b35792
AR
584(defvar ns-working-text) ; nsterm.m
585
586;; Test if in echo area, based on mac-win.el 2007/08/26 unicode-2.
587;; This will fail if called from a NONASCII_KEYSTROKE event on the global map.
edfda783
AR
588(defun ns-in-echo-area ()
589 "Whether, for purposes of inserting working composition text, the minibuffer
590is currently being used."
591 (or isearch-mode
592 (and cursor-in-echo-area (current-message))
593 ;; Overlay strings are not shown in some cases.
594 (get-char-property (point) 'invisible)
595 (and (not (bobp))
596 (or (and (get-char-property (point) 'display)
597 (eq (get-char-property (1- (point)) 'display)
598 (get-char-property (point) 'display)))
599 (and (get-char-property (point) 'composition)
600 (eq (get-char-property (1- (point)) 'composition)
601 (get-char-property (point) 'composition)))))))
602
9d8f6d31
AR
603;; The 'interactive' here stays for subinvocations, so the ns-in-echo-area
604;; always returns nil for some reason. If this WASN'T the case, we could
605;; map this to [ns-insert-working-text] and eliminate Fevals in nsterm.m.
33b35792 606;; These functions test whether in echo area and delegate accordingly.
9d8f6d31 607(defun ns-put-working-text ()
edfda783 608 (interactive)
9d8f6d31 609 (if (ns-in-echo-area) (ns-echo-working-text) (ns-insert-working-text)))
33b35792
AR
610(defun ns-unput-working-text ()
611 (interactive)
43c660bc 612 (ns-delete-working-text))
c0642f6d 613
9d8f6d31 614(defun ns-insert-working-text ()
2b4e72e1 615 "Insert contents of `ns-working-text' as UTF-8 string and mark with
43c660bc
SM
616`ns-working-overlay'. Any previously existing working text is cleared first.
617The overlay is assigned the face `ns-working-text-face'."
618 ;; FIXME: if buffer is read-only, don't try to insert anything
619 ;; and if text is bound to a command, execute that instead (Bug#1453)
edfda783 620 (interactive)
43c660bc 621 (ns-delete-working-text)
edfda783
AR
622 (let ((start (point)))
623 (insert ns-working-text)
624 (overlay-put (setq ns-working-overlay (make-overlay start (point)
625 (current-buffer) nil t))
43c660bc 626 'face 'ns-working-text-face)))
edfda783
AR
627
628(defun ns-echo-working-text ()
2b4e72e1 629 "Echo contents of `ns-working-text' in message display area.
43c660bc
SM
630See `ns-insert-working-text'."
631 (ns-delete-working-text)
edfda783
AR
632 (let* ((msg (current-message))
633 (msglen (length msg))
634 message-log-max)
43c660bc 635 (setq ns-working-overlay (length ns-working-text))
edfda783 636 (setq msg (concat msg ns-working-text))
43c660bc 637 (put-text-property msglen (+ msglen ns-working-overlay)
08324aaa 638 'face 'ns-working-text-face msg)
43c660bc 639 (message "%s" msg)))
edfda783
AR
640
641(defun ns-delete-working-text()
43c660bc 642 "Delete working text and clear `ns-working-overlay'."
edfda783 643 (interactive)
43c660bc
SM
644 (cond
645 ((and (overlayp ns-working-overlay)
646 ;; Still alive?
647 (overlay-buffer ns-working-overlay))
648 (with-current-buffer (overlay-buffer ns-working-overlay)
649 (delete-region (overlay-start ns-working-overlay)
650 (overlay-end ns-working-overlay))
651 (delete-overlay ns-working-overlay)))
652 ((integerp ns-working-overlay)
653 (let ((msg (current-message))
654 message-log-max)
655 (setq msg (substring msg 0 (- (length msg) ns-working-overlay)))
656 (message "%s" msg))))
657 (setq ns-working-overlay nil))
edfda783
AR
658
659
c0642f6d
GM
660(declare-function ns-convert-utf8-nfd-to-nfc "nsfns.m" (str))
661
edfda783
AR
662;;;; OS X file system Unicode UTF-8 NFD (decomposed form) support
663;; Lisp code based on utf-8m.el, by Seiji Zenitani, Eiji Honjoh, and
664;; Carsten Bormann.
665(if (eq system-type 'darwin)
666 (progn
667
668 (defun ns-utf8-nfd-post-read-conversion (length)
2b4e72e1 669 "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences."
edfda783
AR
670 (save-excursion
671 (save-restriction
672 (narrow-to-region (point) (+ (point) length))
673 (let ((str (buffer-string)))
674 (delete-region (point-min) (point-max))
675 (insert (ns-convert-utf8-nfd-to-nfc str))
676 (- (point-max) (point-min))
677 ))))
678
679 (define-coding-system 'utf-8-nfd
680 "UTF-8 NFD (decomposed) encoding."
681 :coding-type 'utf-8
682 :mnemonic ?U
683 :charset-list '(unicode)
684 :post-read-conversion 'ns-utf8-nfd-post-read-conversion)
685 (set-file-name-coding-system 'utf-8-nfd)))
686
edfda783
AR
687
688
689;;;; Inter-app communications support.
690
c0642f6d
GM
691(defvar ns-input-text) ; nsterm.m
692
edfda783 693(defun ns-insert-text ()
2b4e72e1 694 "Insert contents of `ns-input-text' at point."
edfda783
AR
695 (interactive)
696 (insert ns-input-text)
697 (setq ns-input-text nil))
c0642f6d 698
edfda783 699(defun ns-insert-file ()
2b4e72e1
JB
700 "Insert contents of file `ns-input-file' like insert-file but with less
701prompting. If file is a directory perform a `find-file' on it."
edfda783
AR
702 (interactive)
703 (let ((f))
704 (setq f (car ns-input-file))
705 (setq ns-input-file (cdr ns-input-file))
706 (if (file-directory-p f)
707 (find-file f)
708 (push-mark (+ (point) (car (cdr (insert-file-contents f))))))))
709
710(defvar ns-select-overlay nil
a5a1b464 711 "Overlay used to highlight areas in files requested by Nextstep apps.")
edfda783
AR
712(make-variable-buffer-local 'ns-select-overlay)
713
c0642f6d
GM
714(defvar ns-input-line) ; nsterm.m
715
edfda783 716(defun ns-open-file-select-line ()
b90cc058
CY
717 "Open a buffer containing the file `ns-input-file'.
718Lines are highlighted according to `ns-input-line'."
edfda783
AR
719 (interactive)
720 (ns-find-file)
721 (cond
722 ((and ns-input-line (buffer-modified-p))
723 (if ns-select-overlay
724 (setq ns-select-overlay (delete-overlay ns-select-overlay)))
725 (deactivate-mark)
726 (goto-line (if (consp ns-input-line)
727 (min (car ns-input-line) (cdr ns-input-line))
728 ns-input-line)))
729 (ns-input-line
730 (if (not ns-select-overlay)
731 (overlay-put (setq ns-select-overlay (make-overlay (point-min) (point-min)))
732 'face 'highlight))
733 (let ((beg (save-excursion
734 (goto-line (if (consp ns-input-line)
735 (min (car ns-input-line) (cdr ns-input-line))
736 ns-input-line))
737 (point)))
738 (end (save-excursion
739 (goto-line (+ 1 (if (consp ns-input-line)
740 (max (car ns-input-line) (cdr ns-input-line))
741 ns-input-line)))
742 (point))))
743 (move-overlay ns-select-overlay beg end)
744 (deactivate-mark)
745 (goto-char beg)))
746 (t
747 (if ns-select-overlay
748 (setq ns-select-overlay (delete-overlay ns-select-overlay))))))
749
750(defun ns-unselect-line ()
a5a1b464 751 "Removes any Nextstep highlight a buffer may contain."
edfda783
AR
752 (if ns-select-overlay
753 (setq ns-select-overlay (delete-overlay ns-select-overlay))))
754
755(add-hook 'first-change-hook 'ns-unselect-line)
756
757
758
759;;;; Preferences handling.
c0642f6d 760(declare-function ns-get-resource "nsfns.m" (owner name))
edfda783
AR
761
762(defun get-lisp-resource (arg1 arg2)
763 (let ((res (ns-get-resource arg1 arg2)))
764 (cond
765 ((not res) 'unbound)
766 ((string-equal (upcase res) "YES") t)
767 ((string-equal (upcase res) "NO") nil)
768 (t (read res)))))
769
c0642f6d 770;; nsterm.m
c6c62e78 771
c0642f6d
GM
772(declare-function ns-read-file-name "nsfns.m"
773 (prompt &optional dir isLoad init))
774
edfda783
AR
775;;;; File handling.
776
777(defun ns-open-file-using-panel ()
778 "Pop up open-file panel, and load the result in a buffer."
779 (interactive)
ebe68042 780 ;; Prompt dir defaultName isLoad initial.
edfda783
AR
781 (setq ns-input-file (ns-read-file-name "Select File to Load" nil t nil))
782 (if ns-input-file
783 (and (setq ns-input-file (list ns-input-file)) (ns-find-file))))
784
785(defun ns-write-file-using-panel ()
786 "Pop up save-file panel, and save buffer in resulting name."
787 (interactive)
788 (let (ns-output-file)
ebe68042 789 ;; Prompt dir defaultName isLoad initial.
edfda783
AR
790 (setq ns-output-file (ns-read-file-name "Save As" nil nil nil))
791 (message ns-output-file)
792 (if ns-output-file (write-file ns-output-file))))
793
73f6360c
GM
794(defcustom ns-pop-up-frames 'fresh
795 "Non-nil means open files upon request from the Workspace in a new frame.
c0642f6d 796If t, always do so. Any other non-nil value means open a new frame
73f6360c
GM
797unless the current buffer is a scratch buffer."
798 :type '(choice (const :tag "Never" nil)
799 (const :tag "Always" t)
800 (other :tag "Except for scratch buffer" fresh))
801 :version "23.1"
802 :group 'ns)
c0642f6d
GM
803
804(declare-function ns-hide-emacs "nsfns.m" (on))
805
edfda783 806(defun ns-find-file ()
2b4e72e1 807 "Do a `find-file' with the `ns-input-file' as argument."
edfda783
AR
808 (interactive)
809 (let ((f) (file) (bufwin1) (bufwin2))
810 (setq f (file-truename (car ns-input-file)))
811 (setq ns-input-file (cdr ns-input-file))
812 (setq file (find-file-noselect f))
813 (setq bufwin1 (get-buffer-window file 'visible))
814 (setq bufwin2 (get-buffer-window "*scratch*" 'visibile))
815 (cond
816 (bufwin1
817 (select-frame (window-frame bufwin1))
818 (raise-frame (window-frame bufwin1))
819 (select-window bufwin1))
820 ((and (eq ns-pop-up-frames 'fresh) bufwin2)
821 (ns-hide-emacs 'activate)
822 (select-frame (window-frame bufwin2))
823 (raise-frame (window-frame bufwin2))
824 (select-window bufwin2)
825 (find-file f))
826 (ns-pop-up-frames
827 (ns-hide-emacs 'activate)
828 (let ((pop-up-frames t)) (pop-to-buffer file nil)))
829 (t
830 (ns-hide-emacs 'activate)
831 (find-file f)))))
832
833
834
835;;;; Frame-related functions.
836
a5a1b464 837;; Don't show the frame name; that's redundant with Nextstep.
edfda783
AR
838(setq-default mode-line-frame-identification '(" "))
839
edfda783
AR
840;; You say tomAYto, I say tomAHto..
841(defvaralias 'ns-option-modifier 'ns-alternate-modifier)
842
843(defun ns-do-hide-emacs ()
844 (interactive)
845 (ns-hide-emacs t))
846
c0642f6d
GM
847(declare-function ns-hide-others "nsfns.m" ())
848
edfda783
AR
849(defun ns-do-hide-others ()
850 (interactive)
851 (ns-hide-others))
852
c0642f6d
GM
853(declare-function ns-emacs-info-panel "nsfns.m" ())
854
edfda783
AR
855(defun ns-do-emacs-info-panel ()
856 (interactive)
857 (ns-emacs-info-panel))
858
859(defun ns-next-frame ()
860 "Switch to next visible frame."
861 (interactive)
862 (other-frame 1))
2b4e72e1 863
edfda783
AR
864(defun ns-prev-frame ()
865 "Switch to previous visible frame."
866 (interactive)
867 (other-frame -1))
868
ebe68042 869;; If no position specified, make new frame offset by 25 from current.
e5744c66 870(defvar parameters) ; dynamically bound in make-frame
edfda783 871(add-hook 'before-make-frame-hook
ebe68042
SM
872 (lambda ()
873 (let ((left (cdr (assq 'left (frame-parameters))))
874 (top (cdr (assq 'top (frame-parameters)))))
875 (if (consp left) (setq left (cadr left)))
876 (if (consp top) (setq top (cadr top)))
877 (cond
878 ((or (assq 'top parameters) (assq 'left parameters)))
879 ((or (not left) (not top)))
880 (t
881 (setq parameters (cons (cons 'left (+ left 25))
882 (cons (cons 'top (+ top 25))
883 parameters))))))))
884
885;; frame will be focused anyway, so select it
55e8d9a5 886;; (if this is not done, modeline is dimmed until first interaction)
edfda783
AR
887(add-hook 'after-make-frame-functions 'select-frame)
888
f2d9c15f
GM
889(defvar tool-bar-mode)
890(declare-function tool-bar-mode "tool-bar" (&optional arg))
891
edfda783
AR
892;; Based on a function by David Reitter <dreitter@inf.ed.ac.uk> ;
893;; see http://lists.gnu.org/archive/html/emacs-devel/2005-09/msg00681.html .
894(defun ns-toggle-toolbar (&optional frame)
895 "Switches the tool bar on and off in frame FRAME.
896 If FRAME is nil, the change applies to the selected frame."
897 (interactive)
ebe68042
SM
898 (modify-frame-parameters
899 frame (list (cons 'tool-bar-lines
edfda783
AR
900 (if (> (or (frame-parameter frame 'tool-bar-lines) 0) 0)
901 0 1)) ))
902 (if (not tool-bar-mode) (tool-bar-mode t)))
903
edfda783
AR
904
905
906;;;; Dialog-related functions.
907
33b35792 908
edfda783
AR
909;; Ask user for confirm before printing. Due to Kevin Rodgers.
910(defun ns-print-buffer ()
911 "Interactive front-end to `print-buffer': asks for user confirmation first."
912 (interactive)
913 (if (and (interactive-p)
ebe68042
SM
914 (or (listp last-nonmenu-event)
915 (and (char-or-string-p (event-basic-type last-command-event))
916 (memq 'super (event-modifiers last-command-event)))))
917 (let ((last-nonmenu-event (if (listp last-nonmenu-event)
918 last-nonmenu-event
919 ;; Fake it:
920 `(mouse-1 POSITION 1))))
921 (if (y-or-n-p (format "Print buffer %s? " (buffer-name)))
922 (print-buffer)
edfda783
AR
923 (error "Cancelled")))
924 (print-buffer)))
925
edfda783
AR
926
927;;;; Font support.
928
edfda783
AR
929;; Needed for font listing functions under both backend and normal
930(setq scalable-fonts-allowed t)
931
932;; Set to use font panel instead
406aaa6f 933(declare-function ns-popup-font-panel "nsfns.m" (&optional frame))
28571246 934(defalias 'x-select-font 'ns-popup-font-panel "Pop up the font panel.
2b4e72e1 935This function has been overloaded in Nextstep.")
4c785fa7 936(defalias 'mouse-set-font 'ns-popup-font-panel "Pop up the font panel.
2b4e72e1 937This function has been overloaded in Nextstep.")
edfda783 938
c0642f6d
GM
939;; nsterm.m
940(defvar ns-input-font)
941(defvar ns-input-fontsize)
942
edfda783 943(defun ns-respond-to-change-font ()
2b4e72e1
JB
944 "Respond to changeFont: event, expecting `ns-input-font' and\n\
945`ns-input-fontsize' of new font."
edfda783
AR
946 (interactive)
947 (modify-frame-parameters (selected-frame)
948 (list (cons 'font ns-input-font)
949 (cons 'fontsize ns-input-fontsize)))
950 (set-frame-font ns-input-font))
951
952
953;; Default fontset for Mac OS X. This is mainly here to show how a fontset
954;; can be set up manually. Ordinarily, fontsets are auto-created whenever
2b4e72e1 955;; a font is chosen by
edfda783 956(defvar ns-standard-fontset-spec
ebe68042
SM
957 ;; Only some code supports this so far, so use uglier XLFD version
958 ;; "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:Courier,han:Kai"
959 (mapconcat 'identity
960 '("-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard"
961 "latin:-*-Courier-*-*-*-*-10-*-*-*-*-*-iso10646-1"
962 "han:-*-Kai-*-*-*-*-10-*-*-*-*-*-iso10646-1"
963 "cyrillic:-*-Trebuchet$MS-*-*-*-*-10-*-*-*-*-*-iso10646-1")
964 ",")
965 "String of fontset spec of the standard fontset.
edfda783 966This defines a fontset consisting of the Courier and other fonts that
2b4e72e1
JB
967come with OS X.
968See the documentation of `create-fontset-from-fontset-spec' for the format.")
edfda783 969
ebe68042 970;; Conditional on new-fontset so bootstrapping works on non-GUI compiles.
edfda783
AR
971(if (fboundp 'new-fontset)
972 (progn
973 ;; Setup the default fontset.
2c035993 974 (create-default-fontset)
edfda783 975 ;; Create the standard fontset.
2c035993
KH
976 (condition-case err
977 (create-fontset-from-fontset-spec ns-standard-fontset-spec t)
2b4e72e1 978 (error (display-warning
2c035993
KH
979 'initialization
980 (format "Creation of the standard fontset failed: %s" err)
981 :error)))))
edfda783 982
edfda783
AR
983
984;;;; Pasteboard support.
985
c0642f6d
GM
986(declare-function ns-get-cut-buffer-internal "nsselect.m" (buffer))
987
edfda783
AR
988(defun ns-get-pasteboard ()
989 "Returns the value of the pasteboard."
990 (ns-get-cut-buffer-internal 'PRIMARY))
991
c0642f6d
GM
992(declare-function ns-store-cut-buffer-internal "nsselect.m" (buffer string))
993
edfda783 994(defun ns-set-pasteboard (string)
a5a1b464 995 "Store STRING into the pasteboard of the Nextstep display server."
edfda783
AR
996 ;; Check the data type of STRING.
997 (if (not (stringp string)) (error "Nonstring given to pasteboard"))
998 (ns-store-cut-buffer-internal 'PRIMARY string))
999
ebe68042
SM
1000;; We keep track of the last text selected here, so we can check the
1001;; current selection against it, and avoid passing back our own text
9e50ff0c 1002;; from x-cut-buffer-or-selection-value.
edfda783
AR
1003(defvar ns-last-selected-text nil)
1004
9e50ff0c 1005(defun x-select-text (text &optional push)
ebe68042 1006 "Put TEXT, a string, on the pasteboard."
edfda783
AR
1007 ;; Don't send the pasteboard too much text.
1008 ;; It becomes slow, and if really big it causes errors.
1009 (ns-set-pasteboard text)
1010 (setq ns-last-selected-text text))
1011
a5a1b464
CY
1012;; Return the value of the current Nextstep selection. For
1013;; compatibility with older Nextstep applications, this checks cut
1014;; buffer 0 before retrieving the value of the primary selection.
9e50ff0c 1015(defun x-cut-buffer-or-selection-value ()
edfda783 1016 (let (text)
d377ef4a 1017
edfda783
AR
1018 ;; Consult the selection, then the cut buffer. Treat empty strings
1019 ;; as if they were unset.
1020 (or text (setq text (ns-get-pasteboard)))
1021 (if (string= text "") (setq text nil))
d377ef4a 1022
edfda783
AR
1023 (cond
1024 ((not text) nil)
1025 ((eq text ns-last-selected-text) nil)
1026 ((string= text ns-last-selected-text)
1027 ;; Record the newer string, so subsequent calls can use the `eq' test.
1028 (setq ns-last-selected-text text)
1029 nil)
1030 (t
1031 (setq ns-last-selected-text text)))))
1032
1033(defun ns-copy-including-secondary ()
1034 (interactive)
1035 (call-interactively 'kill-ring-save)
1036 (ns-store-cut-buffer-internal 'SECONDARY
1037 (buffer-substring (point) (mark t))))
1038(defun ns-paste-secondary ()
1039 (interactive)
1040 (insert (ns-get-cut-buffer-internal 'SECONDARY)))
1041
1042;; PENDING: not sure what to do here.. for now interprog- are set in
ebe68042 1043;; init-fn-keys, and unsure whether these x- settings have an effect.
9e50ff0c
DN
1044;;(setq interprogram-cut-function 'x-select-text
1045;; interprogram-paste-function 'x-cut-buffer-or-selection-value)
ebe68042 1046;; These only needed if above not working.
edfda783
AR
1047
1048(set-face-background 'region "ns_selection_color")
1049
1050
1051
1052;;;; Scrollbar handling.
1053
1054(global-set-key [vertical-scroll-bar down-mouse-1] 'ns-handle-scroll-bar-event)
1055(global-unset-key [vertical-scroll-bar mouse-1])
1056(global-unset-key [vertical-scroll-bar drag-mouse-1])
1057
f2d9c15f
GM
1058(declare-function scroll-bar-scale "scroll-bar" (num-denom whole))
1059
edfda783 1060(defun ns-scroll-bar-move (event)
55e8d9a5 1061 "Scroll the frame according to a Nextstep scroller event."
edfda783
AR
1062 (interactive "e")
1063 (let* ((pos (event-end event))
1064 (window (nth 0 pos))
1065 (scale (nth 2 pos)))
1066 (save-excursion
1067 (set-buffer (window-buffer window))
1068 (cond
1069 ((eq (car scale) (cdr scale))
1070 (goto-char (point-max)))
1071 ((= (car scale) 0)
1072 (goto-char (point-min)))
1073 (t
1074 (goto-char (+ (point-min) 1
1075 (scroll-bar-scale scale (- (point-max) (point-min)))))))
1076 (beginning-of-line)
1077 (set-window-start window (point))
1078 (vertical-motion (/ (window-height window) 2) window))))
1079
1080(defun ns-handle-scroll-bar-event (event)
55e8d9a5 1081 "Handle scroll bar EVENT to emulate Nextstep style scrolling."
edfda783
AR
1082 (interactive "e")
1083 (let* ((position (event-start event))
1084 (bar-part (nth 4 position))
1085 (window (nth 0 position))
1086 (old-window (selected-window)))
1087 (cond
1088 ((eq bar-part 'ratio)
1089 (ns-scroll-bar-move event))
1090 ((eq bar-part 'handle)
1091 (if (eq window (selected-window))
1092 (track-mouse (ns-scroll-bar-move event))
ebe68042 1093 ;; track-mouse faster for selected window, slower for unselected.
edfda783
AR
1094 (ns-scroll-bar-move event)))
1095 (t
1096 (select-window window)
1097 (cond
1098 ((eq bar-part 'up)
1099 (goto-char (window-start window))
1100 (scroll-down 1))
1101 ((eq bar-part 'above-handle)
1102 (scroll-down))
1103 ((eq bar-part 'below-handle)
1104 (scroll-up))
1105 ((eq bar-part 'down)
1106 (goto-char (window-start window))
1107 (scroll-up 1)))
1108 (select-window old-window)))))
1109
1110
1111;;;; Color support.
1112
c0642f6d
GM
1113(declare-function ns-list-colors "nsfns.m" (&optional frame))
1114
edfda783
AR
1115(defvar x-colors (ns-list-colors)
1116 "The list of colors defined in non-PANTONE color files.")
edfda783 1117
9e50ff0c 1118(defun xw-defined-colors (&optional frame)
edfda783
AR
1119 "Return a list of colors supported for a particular frame.
1120The argument FRAME specifies which frame to try.
a5a1b464 1121The value may be different for frames on different Nextstep displays."
edfda783
AR
1122 (or frame (setq frame (selected-frame)))
1123 (let ((all-colors x-colors)
1124 (this-color nil)
1125 (defined-colors nil))
1126 (while all-colors
1127 (setq this-color (car all-colors)
1128 all-colors (cdr all-colors))
ebe68042
SM
1129 ;; (and (face-color-supported-p frame this-color t)
1130 (setq defined-colors (cons this-color defined-colors))) ;;)
edfda783 1131 defined-colors))
edfda783 1132
edfda783
AR
1133;; Functions for color panel + drag
1134(defun ns-face-at-pos (pos)
1135 (let* ((frame (car pos))
1136 (frame-pos (cons (cadr pos) (cddr pos)))
1137 (window (window-at (car frame-pos) (cdr frame-pos) frame))
1138 (window-pos (coordinates-in-window-p frame-pos window))
1139 (buffer (window-buffer window))
1140 (edges (window-edges window)))
1141 (cond
1142 ((not window-pos)
1143 nil)
1144 ((eq window-pos 'mode-line)
1145 'modeline)
1146 ((eq window-pos 'vertical-line)
1147 'default)
1148 ((consp window-pos)
1149 (save-excursion
1150 (set-buffer buffer)
1151 (let ((p (car (compute-motion (window-start window)
1152 (cons (nth 0 edges) (nth 1 edges))
1153 (window-end window)
1154 frame-pos
1155 (- (window-width window) 1)
1156 nil
1157 window))))
1158 (cond
1159 ((eq p (window-point window))
1160 'cursor)
1161 ((and mark-active (< (region-beginning) p) (< p (region-end)))
1162 'region)
1163 (t
1164 (let ((faces (get-char-property p 'face window)))
1165 (if (consp faces) (car faces) faces)))))))
1166 (t
1167 nil))))
1168
c0642f6d
GM
1169(defvar ns-input-color) ; nsterm.m
1170
edfda783 1171(defun ns-set-foreground-at-mouse ()
2b4e72e1 1172 "Set the foreground color at the mouse location to `ns-input-color'."
edfda783
AR
1173 (interactive)
1174 (let* ((pos (mouse-position))
1175 (frame (car pos))
1176 (face (ns-face-at-pos pos)))
1177 (cond
1178 ((eq face 'cursor)
c0642f6d 1179 (modify-frame-parameters frame (list (cons 'cursor-color
edfda783
AR
1180 ns-input-color))))
1181 ((not face)
1182 (modify-frame-parameters frame (list (cons 'foreground-color
1183 ns-input-color))))
1184 (t
1185 (set-face-foreground face ns-input-color frame)))))
1186
1187(defun ns-set-background-at-mouse ()
2b4e72e1 1188 "Set the background color at the mouse location to `ns-input-color'."
edfda783
AR
1189 (interactive)
1190 (let* ((pos (mouse-position))
1191 (frame (car pos))
1192 (face (ns-face-at-pos pos)))
1193 (cond
1194 ((eq face 'cursor)
1195 (modify-frame-parameters frame (list (cons 'cursor-color
1196 ns-input-color))))
1197 ((not face)
1198 (modify-frame-parameters frame (list (cons 'background-color
1199 ns-input-color))))
1200 (t
1201 (set-face-background face ns-input-color frame)))))
1202
a5a1b464 1203;; Set some options to be as Nextstep-like as possible.
edfda783
AR
1204(setq frame-title-format t
1205 icon-title-format t)
1206
edfda783
AR
1207
1208(defvar ns-initialized nil
a5a1b464 1209 "Non-nil if Nextstep windowing has been initialized.")
edfda783 1210
c0642f6d 1211(declare-function ns-list-services "nsfns.m" ())
b51a3365 1212(declare-function x-open-connection "nsfns.m"
f2d9c15f 1213 (display &optional xrm-string must-succeed))
c0642f6d 1214
a5a1b464
CY
1215;; Do the actual Nextstep Windows setup here; the above code just
1216;; defines functions and variables that we use now.
edfda783 1217(defun ns-initialize-window-system ()
a5a1b464 1218 "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing."
edfda783 1219
ebe68042 1220 ;; PENDING: not needed?
edfda783
AR
1221 (setq command-line-args (ns-handle-args command-line-args))
1222
9e50ff0c 1223 (x-open-connection (system-name) nil t)
edfda783 1224
ebe68042
SM
1225 (dolist (service (ns-list-services))
1226 (if (eq (car service) 'undefined)
1227 (ns-define-service (cdr service))
1228 (define-key global-map (vector (car service))
1229 (ns-define-service (cdr service)))))
edfda783
AR
1230
1231 (if (and (eq (get-lisp-resource nil "NXAutoLaunch") t)
1232 (eq (get-lisp-resource nil "HideOnAutoLaunch") t))
1233 (add-hook 'after-init-hook 'ns-do-hide-emacs))
1234
ebe68042 1235 ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings.
edfda783
AR
1236 (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
1237 (mouse-wheel-mode 1)
1238
1239 (setq ns-initialized t))
1240
1241(add-to-list 'handle-args-function-alist '(ns . ns-handle-args))
1242(add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces))
1243(add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system))
1244
1245
1246(provide 'ns-win)
1247
0ae1e5e5 1248;; arch-tag: eb138a45-4e2e-4d68-b1c9-a39665731644
edfda783 1249;;; ns-win.el ends here