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