;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system
-;; Copyright (C) 1993, 1994, 2005, 2006, 2007, 2008
+;; Copyright (C) 1993, 1994, 2005, 2006, 2007, 2008, 2009
;; Free Software Foundation, Inc.
-;; Authors: Carl Edman, Christian Limpach, Scott Bender,
-;; Christophe de Dinechin, Adrian Robert
+;; Authors: Carl Edman
+;; Christian Limpach
+;; Scott Bender
+;; Christophe de Dinechin
+;; Adrian Robert
;; Keywords: terminals
;; This file is part of GNU Emacs.
(if (not (featurep 'ns))
- (error "%s: Loading ns-win.el but not compiled for GNUStep/MacOS"
+ (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS"
(invocation-name)))
(eval-when-compile (require 'cl))
;; Not needed?
;;(require 'ispell)
+(defgroup ns nil
+ "GNUstep/Mac OS X specific features."
+ :group 'environment)
+
;; nsterm.m
(defvar ns-version-string)
-(defvar ns-expand-space)
-(defvar ns-cursor-blink-rate)
(defvar ns-alternate-modifier)
;;;; Command line argument handling.
'(ns-open-temp-file))
ns-input-file (append ns-input-file (list (pop ns-invocation-args)))))
-(defun ns-ignore-0-arg (switch))
(defun ns-ignore-1-arg (switch)
(setq ns-invocation-args (cdr ns-invocation-args)))
(defun ns-ignore-2-arg (switch)
(setq args (cons orig-this-switch args)))))
(nreverse args))
-(defun x-parse-geometry (geom)
- "Parse a Nextstep-style geometry string STRING.
+(defun ns-parse-geometry (geom)
+ "Parse a Nextstep-style geometry string GEOM.
Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
The properties returned may include `top', `left', `height', and `width'."
(when (string-match "\\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\)\
;;;; Keyboard mapping.
-;; These tell read-char how to convert
-;; these special chars to ASCII.
+;; These tell read-char how to convert these special chars to ASCII.
+;;TODO: all terms have these, and at least the return mapping is necessary
+;; for tramp to recognize the enter key.
+;; Perhaps they should be moved into common code somewhere
+;; (when a window system is active).
+;; Remove if no problems for some time after 2008-08-06.
(put 'backspace 'ascii-character 127)
(put 'delete 'ascii-character 127)
(put 'tab 'ascii-character ?\t)
(put 'return 'ascii-character 13)
(put 'escape 'ascii-character ?\e)
-;; Map certain keypad keys into ASCII characters
-;; that people usually expect.
-(define-key function-key-map [backspace] [127])
-(define-key function-key-map [delete] [127])
-(define-key function-key-map [tab] [?\t])
-(define-key function-key-map [S-tab] [25])
-(define-key function-key-map [linefeed] [?\n])
-(define-key function-key-map [clear] [11])
-(define-key function-key-map [return] [13])
-(define-key function-key-map [escape] [?\e])
-(define-key function-key-map [M-backspace] [?\M-\d])
-(define-key function-key-map [M-delete] [?\M-\d])
-(define-key function-key-map [M-tab] [?\M-\t])
-(define-key function-key-map [M-linefeed] [?\M-\n])
-(define-key function-key-map [M-clear] [?\M-\013])
-(define-key function-key-map [M-return] [?\M-\015])
-(define-key function-key-map [M-escape] [?\M-\e])
+(defvar ns-alternatives-map
+ (let ((map (make-sparse-keymap)))
+ ;; Map certain keypad keys into ASCII characters
+ ;; that people usually expect.
+ (define-key map [backspace] [?\d])
+ (define-key map [delete] [?\d])
+ (define-key map [tab] [?\t])
+ (define-key map [S-tab] [25])
+ (define-key map [linefeed] [?\n])
+ (define-key map [clear] [?\C-l])
+ (define-key map [return] [?\C-m])
+ (define-key map [escape] [?\e])
+ (define-key map [M-backspace] [?\M-\d])
+ (define-key map [M-delete] [?\M-\d])
+ (define-key map [M-tab] [?\M-\t])
+ (define-key map [M-linefeed] [?\M-\n])
+ (define-key map [M-clear] [?\M-\C-l])
+ (define-key map [M-return] [?\M-\C-m])
+ (define-key map [M-escape] [?\M-\e])
+ map)
+ "Keymap of alternative meanings for some keys under Nextstep.")
;; Here are some Nextstep-like bindings for command key sequences.
-(define-key global-map [?\s-,] 'ns-popup-prefs-panel)
+(define-key global-map [?\s-,] 'customize)
(define-key global-map [?\s-'] 'next-multiframe-window)
(define-key global-map [?\s-`] 'other-frame)
(define-key global-map [?\s--] 'center-line)
(define-key global-map [kp-prior] 'scroll-down)
(define-key global-map [kp-next] 'scroll-up)
+;;; Allow shift-clicks to work similarly to under Nextstep
+(define-key global-map [S-mouse-1] 'mouse-save-then-kill)
+(global-unset-key [S-down-mouse-1])
+
;; Special Nextstep-generated events are converted to function keys. Here
;; are the bindings for them.
-(define-key global-map [ns-power-off]
- (lambda () (interactive) (save-buffers-kill-emacs t)))
+(define-key global-map [ns-power-off] 'save-buffers-kill-emacs)
(define-key global-map [ns-open-file] 'ns-find-file)
(define-key global-map [ns-open-temp-file] [ns-open-file])
(define-key global-map [ns-drag-file] 'ns-insert-file)
(define-key global-map [ns-drag-text] 'ns-insert-text)
(define-key global-map [ns-change-font] 'ns-respond-to-change-font)
(define-key global-map [ns-open-file-line] 'ns-open-file-select-line)
-(define-key global-map [ns-insert-working-text] 'ns-insert-working-text)
-(define-key global-map [ns-delete-working-text] 'ns-delete-working-text)
(define-key global-map [ns-spi-service-call] 'ns-spi-service-call)
+(define-key global-map [ns-new-frame] 'make-frame)
+(define-key global-map [ns-toggle-toolbar] 'ns-toggle-toolbar)
+(define-key global-map [ns-show-prefs] 'customize)
-
-;; Functions to set environment variables by running a subshell.
-;;; Idea based on Nextstep 4.2 distribution, this version of code
-;;; based on mac-read-environment-vars-from-shell () by David Reitter.
-;;; Mostly used only under ns-extended-platform-support-mode.
-
-(defun ns-make-command-string (cmdlist)
- (mapconcat 'identity cmdlist " ; "))
-
-;;;###autoload
-(defun ns-grabenv (&optional shell-path startup)
- "Set the Emacs environment using the output of a shell command.
-This runs a shell subprocess, and interpret its output as a
-series of environment variables to insert into the emacs
-environment.
-SHELL-PATH gives the path to the shell; if nil, this defaults to
-the current setting of `shell-file-name'.
-STARTUP is a list of commands for the shell to execute; if nil,
-this defaults to \"printenv\"."
- (interactive)
- (with-temp-buffer
- (let ((shell-file-name (if shell-path shell-path shell-file-name))
- (cmd (ns-make-command-string (if startup startup '("printenv")))))
- (shell-command cmd t)
- (while (search-forward-regexp "^\\([A-Za-z_0-9]+\\)=\\(.*\\)$" nil t)
- (setenv (match-string 1)
- (if (equal (match-string 1) "PATH")
- (concat (getenv "PATH") ":" (match-string 2))
- (match-string 2)))))))
-
;; Set up a number of aliases and other layers to pretend we're using
;; the Choi/Mitsuharu Carbon port.
(defvaralias 'mac-control-modifier 'ns-control-modifier)
(defvaralias 'mac-option-modifier 'ns-option-modifier)
(defvaralias 'mac-function-modifier 'ns-function-modifier)
+(declare-function ns-do-applescript "nsfns.m" (script))
(defalias 'do-applescript 'ns-do-applescript)
-
-(defvar menu-bar-ns-file-menu) ; below
-
-;; Toggle some additional Nextstep-like features that may interfere
-;; with users' expectations coming from emacs on other platforms.
-(define-minor-mode ns-extended-platform-support-mode
- "Toggle Nextstep extended platform support features.
- When this mode is active (no modeline indicator):
- - File menu is altered slightly in keeping with conventions.
- - Screen position is preserved in scrolling.
- - Transient mark mode is activated"
- :init-value nil
- :global t
- :group 'ns
- (if ns-extended-platform-support-mode
- (progn
- (defun ns-show-manual () "Show Emacs.app manual" (interactive) (info "ns-emacs"))
- (setq where-is-preferred-modifier 'super)
- (setq scroll-preserve-screen-position t)
- (transient-mark-mode 1)
-
- ;; Change file menu to simplify and add a couple of
- ;; Nextstep-specific items
- (easy-menu-remove-item global-map '("menu-bar") 'file)
- (easy-menu-add-item global-map '(menu-bar)
- (cons "File" menu-bar-ns-file-menu) 'edit)
- (define-key menu-bar-help-menu [ns-manual]
- '(menu-item "Emacs.app Manual" ns-show-manual)))
- (progn
- ;; Undo everything above.
- (fmakunbound 'ns-show-manual)
- (setq where-is-preferred-modifier 'nil)
- (setq scroll-preserve-screen-position nil)
- (transient-mark-mode 0)
- (easy-menu-remove-item global-map '("menu-bar") 'file)
- (easy-menu-add-item global-map '(menu-bar)
- (cons "File" menu-bar-file-menu) 'edit)
- (easy-menu-remove-item global-map '("menu-bar" "help-menu") 'ns-manual)
-)))
-
-
(defun x-setup-function-keys (frame)
"Set up function Keys for Nextstep for frame FRAME."
(unless (terminal-parameter frame 'x-setup-function-keys)
(with-selected-frame frame
(setq interprogram-cut-function 'x-select-text
interprogram-paste-function 'x-cut-buffer-or-selection-value)
- ;; (let ((map (copy-keymap x-alternatives-map)))
- ;; (set-keymap-parent map (keymap-parent local-function-key-map))
- ;; (set-keymap-parent local-function-key-map map))
+ (let ((map (copy-keymap ns-alternatives-map)))
+ (set-keymap-parent map (keymap-parent local-function-key-map))
+ (set-keymap-parent local-function-key-map map))
(setq system-key-alist
(list
(cons (logior (lsh 0 16) 1) 'ns-power-off)
(cons (logior (lsh 0 16) 6) 'ns-drag-text)
(cons (logior (lsh 0 16) 7) 'ns-change-font)
(cons (logior (lsh 0 16) 8) 'ns-open-file-line)
- (cons (logior (lsh 0 16) 9) 'ns-insert-working-text)
- (cons (logior (lsh 0 16) 10) 'ns-delete-working-text)
+; (cons (logior (lsh 0 16) 9) 'ns-insert-working-text)
+; (cons (logior (lsh 0 16) 10) 'ns-delete-working-text)
(cons (logior (lsh 0 16) 11) 'ns-spi-service-call)
- (cons (logior (lsh 1 16) 32) 'f1)
+ (cons (logior (lsh 0 16) 12) 'ns-new-frame)
+ (cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar)
+ (cons (logior (lsh 0 16) 14) 'ns-show-prefs)
+ (cons (logior (lsh 1 16) 32) 'f1)
(cons (logior (lsh 1 16) 33) 'f2)
(cons (logior (lsh 1 16) 34) 'f3)
(cons (logior (lsh 1 16) 35) 'f4)
(cons (logior (lsh 3 16) 25) 'S-tab)
(cons (logior (lsh 3 16) 27) 'escape)
(cons (logior (lsh 3 16) 127) 'delete)
- ))
- (set-terminal-parameter frame 'x-setup-function-keys t))))
-
-
-
-;;;; Miscellaneous mouse bindings.
-
-;;; Allow shift-clicks to work just like under Nextstep
-(defun mouse-extend-region (event)
- "Move point or mark so as to extend region.
-This should be bound to a mouse click event type."
- (interactive "e")
- (mouse-minibuffer-check event)
- (let ((posn (event-end event)))
- (if (not (windowp (posn-window posn)))
- (error "Cursor not in text area of window"))
- (select-window (posn-window posn))
- (cond
- ((not (numberp (posn-point posn))))
- ((or (not mark-active) (> (abs (- (posn-point posn) (point)))
- (abs (- (posn-point posn) (mark)))))
- (let ((point-save (point)))
- (unwind-protect
- (progn
- (goto-char (posn-point posn))
- (push-mark nil t t)
- (or transient-mark-mode
- (sit-for 1)))
- (goto-char point-save))))
- (t
- (goto-char (posn-point posn))))))
-
-(define-key global-map [S-mouse-1] 'mouse-extend-region)
-(global-unset-key [S-down-mouse-1])
+ )))
+ (set-terminal-parameter frame 'x-setup-function-keys t)))
;; Must come after keybindings.
-(fmakunbound 'clipboard-yank)
-(fmakunbound 'clipboard-kill-ring-save)
-(fmakunbound 'clipboard-kill-region)
-(fmakunbound 'menu-bar-enable-clipboard)
+;; (fmakunbound 'clipboard-yank)
+;; (fmakunbound 'clipboard-kill-ring-save)
+;; (fmakunbound 'clipboard-kill-region)
+;; (fmakunbound 'menu-bar-enable-clipboard)
;; Add a couple of menus and rearrange some others; easiest just to redo toplvl
;; Note keymap defns must be given last-to-first
(define-key global-map [menu-bar services]
(cons "Services" (make-sparse-keymap "Services")))
-(define-key global-map [menu-bar windows] (make-sparse-keymap "Windows"))
(define-key global-map [menu-bar buffer]
(cons "Buffers" global-buffers-menu-map))
;; (cons "Buffers" (make-sparse-keymap "Buffers")))
(define-key menu-bar-help-menu [info-panel]
'("About Emacs..." . ns-do-emacs-info-panel)))
-
-;;;; File menu, replaces standard under ns-extended-platform-support
-(defvar menu-bar-ns-file-menu (make-sparse-keymap "File"))
-(define-key menu-bar-ns-file-menu [one-window]
- '("Remove Splits" . delete-other-windows))
-(define-key menu-bar-ns-file-menu [split-window]
- '("Split Window" . split-window-vertically))
-
-(define-key menu-bar-ns-file-menu [separator-print] '("--"))
-
-(defvar ns-ps-print-menu-map (make-sparse-keymap "Postscript Print"))
-(define-key ns-ps-print-menu-map [ps-print-region]
- '("Region (B+W)" . ps-print-region))
-(define-key ns-ps-print-menu-map [ps-print-buffer]
- '("Buffer (B+W)" . ps-print-buffer))
-(define-key ns-ps-print-menu-map [ps-print-region-faces]
- '("Region" . ps-print-region-with-faces))
-(define-key ns-ps-print-menu-map [ps-print-buffer-faces]
- '("Buffer" . ps-print-buffer-with-faces))
-(define-key menu-bar-ns-file-menu [postscript-print]
- (cons "Postscript Print" ns-ps-print-menu-map))
-
-(define-key menu-bar-ns-file-menu [print-region]
- '("Print Region" . print-region))
-(define-key menu-bar-ns-file-menu [print-buffer]
- '("Print Buffer" . ns-print-buffer))
-
-(define-key menu-bar-ns-file-menu [separator-save] '("--"))
-
-(define-key menu-bar-ns-file-menu [recover-session]
- '("Recover Crashed Session" . recover-session))
-(define-key menu-bar-ns-file-menu [revert-buffer]
- '("Revert Buffer" . revert-buffer))
-(define-key menu-bar-ns-file-menu [write-file]
- '("Save Buffer As..." . ns-write-file-using-panel))
-(define-key menu-bar-ns-file-menu [save-buffer] '("Save Buffer" . save-buffer))
-
-(define-key menu-bar-ns-file-menu [kill-buffer]
- '("Kill Current Buffer" . kill-this-buffer))
-(define-key menu-bar-ns-file-menu [delete-this-frame]
- '("Close Frame" . delete-frame))
-
-(define-key menu-bar-ns-file-menu [separator-open] '("--"))
-
-(define-key menu-bar-ns-file-menu [insert-file]
- '("Insert File..." . insert-file))
-(define-key menu-bar-ns-file-menu [dired]
- '("Open Directory..." . ns-open-file-using-panel))
-(define-key menu-bar-ns-file-menu [open-file]
- '("Open File..." . ns-open-file-using-panel))
-(define-key menu-bar-ns-file-menu [make-frame]
- '("New Frame" . make-frame))
-
-
;;;; Edit menu: Modify slightly
;; Substitute a Copy function that works better under X (for GNUstep).
(define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill)
-;;;; Windows menu
-(defun menu-bar-select-frame (&optional frame)
- (interactive)
- (make-frame-visible last-command-event)
- (raise-frame last-command-event)
- (select-frame last-command-event))
-
-(defun menu-bar-update-frames ()
- ;; If user discards the Windows item, play along.
- (when (lookup-key (current-global-map) [menu-bar windows])
- (let ((frames (frame-list))
- (frames-menu (make-sparse-keymap "Select Frame")))
- (setcdr frames-menu
- (nconc
- (mapcar (lambda (frame)
- (list* frame
- (cdr (assq 'name (frame-parameters frame)))
- 'menu-bar-select-frame))
- frames)
- (cdr frames-menu)))
- (define-key frames-menu [separator-frames] '("--"))
- (define-key frames-menu [popup-color-panel]
- '("Colors..." . ns-popup-color-panel))
- (define-key frames-menu [popup-font-panel]
- '("Font Panel..." . ns-popup-font-panel))
- (define-key frames-menu [separator-arrange] '("--"))
- (define-key frames-menu [arrange-all-frames]
- '("Arrange All Frames" . ns-arrange-all-frames))
- (define-key frames-menu [arrange-visible-frames]
- '("Arrange Visible Frames" . ns-arrange-visible-frames))
- ;; Don't use delete-frame as event name
- ;; because that is a special event.
- (define-key (current-global-map) [menu-bar windows]
- (cons "Windows" frames-menu)))))
-
-(defun force-menu-bar-update-buffers ()
- ;; This is a hack to get around fact that we already checked
- ;; frame-or-buffer-changed-p and reset it, so menu-bar-update-buffers
- ;; does not pick up any change.
- (menu-bar-update-buffers t))
-
-(add-hook 'menu-bar-update-fab-hook 'menu-bar-update-frames)
-(add-hook 'menu-bar-update-fab-hook 'force-menu-bar-update-buffers)
-
-(defun menu-bar-update-frames-and-buffers ()
- (if (frame-or-buffer-changed-p)
- (run-hooks 'menu-bar-update-fab-hook)))
-
-(setq menu-bar-update-hook
- (delq 'menu-bar-update-buffers menu-bar-update-hook))
-(add-hook 'menu-bar-update-hook 'menu-bar-update-frames-and-buffers)
-
-(menu-bar-update-frames-and-buffers)
-
-
-;; ns-arrange functions contributed
-;; by Eberhard Mandler <mandler@dbag.ulm.DaimlerBenz.COM>
-(defun ns-arrange-all-frames ()
- "Arranges all frames according to topline"
- (interactive)
- (ns-arrange-frames t))
-
-(defun ns-arrange-visible-frames ()
- "Arranges all visible frames according to topline"
- (interactive)
- (ns-arrange-frames nil))
-
-(defun ns-arrange-frames ( vis)
- (let ((frame (next-frame))
- (end-frame (selected-frame))
- (inc-x 20) ;relative position of frames
- (inc-y 22)
- (x-pos 100) ;start position
- (y-pos 40)
- (done nil))
- (while (not done) ;cycle through all frames
- (if (not (or vis (eq (frame-visible-p frame) t)))
- (setq x-pos x-pos); do nothing; true case
- (set-frame-position frame x-pos y-pos)
- (setq x-pos (+ x-pos inc-x))
- (setq y-pos (+ y-pos inc-y))
- (raise-frame frame))
- (select-frame frame)
- (setq frame (next-frame))
- (setq done (equal frame end-frame)))
- (set-frame-position end-frame x-pos y-pos)
- (raise-frame frame)
- (select-frame frame)))
-
-
;;;; Services
(declare-function ns-perform-service "nsfns.m" (service send))
(define-key global-map mapping (cons (car path) name))))
name))
-(precompute-menubar-bindings)
-
;; nsterm.m
(defvar ns-input-spi-name)
(defvar ns-input-spi-arg)
+(declare-function dnd-open-file "dnd" (uri action))
+
(defun ns-spi-service-call ()
"Respond to a service request."
(interactive)
-;;;; Composed key sequence handling for Nextstep system input methods.
-;;;; (On Nextstep systems, input methods are provided for CJK
-;;;; characters, etc. which require multiple keystrokes, and during
-;;;; entry a partial ("working") result is typically shown in the
-;;;; editing window.)
+;; Composed key sequence handling for Nextstep system input methods.
+;; (On Nextstep systems, input methods are provided for CJK
+;; characters, etc. which require multiple keystrokes, and during
+;; entry a partial ("working") result is typically shown in the
+;; editing window.)
(defface ns-working-text-face
'((t :underline t))
:group 'ns)
(defvar ns-working-overlay nil
- "Overlay used to highlight working text during compose sequence insert.")
-(make-variable-buffer-local 'ns-working-overlay)
-(defvar ns-working-overlay-len 0
- "Length of working text during compose sequence insert.")
-(make-variable-buffer-local 'ns-working-overlay-len)
-
-;; Based on mac-win.el 2007/08/26 unicode-2. This will fail if called
-;; from an "interactive" function.
+ "Overlay used to highlight working text during compose sequence insert.
+When text is in th echo area, this just stores the length of the working text.")
+
+(defvar ns-working-text) ; nsterm.m
+
+;; Test if in echo area, based on mac-win.el 2007/08/26 unicode-2.
+;; This will fail if called from a NONASCII_KEYSTROKE event on the global map.
(defun ns-in-echo-area ()
"Whether, for purposes of inserting working composition text, the minibuffer
is currently being used."
(eq (get-char-property (1- (point)) 'composition)
(get-char-property (point) 'composition)))))))
-;; Currently not used, doesn't work because the 'interactive' here stays
-;; for subinvocations.
-(defun ns-insert-working-text ()
+;; The 'interactive' here stays for subinvocations, so the ns-in-echo-area
+;; always returns nil for some reason. If this WASN'T the case, we could
+;; map this to [ns-insert-working-text] and eliminate Fevals in nsterm.m.
+;; These functions test whether in echo area and delegate accordingly.
+(defun ns-put-working-text ()
(interactive)
- (if (ns-in-echo-area) (ns-echo-working-text) (ns-put-working-text)))
-
-(defvar ns-working-text) ; nsterm.m
+ (if (ns-in-echo-area) (ns-echo-working-text) (ns-insert-working-text)))
+(defun ns-unput-working-text ()
+ (interactive)
+ (ns-delete-working-text))
-(defun ns-put-working-text ()
- "Insert contents of ns-working-text as UTF8 string and mark with
-ns-working-overlay. Any previously existing working text is cleared first.
-The overlay is assigned the face ns-working-text-face."
+(defun ns-insert-working-text ()
+ "Insert contents of `ns-working-text' as UTF-8 string and mark with
+`ns-working-overlay'. Any previously existing working text is cleared first.
+The overlay is assigned the face `ns-working-text-face'."
+ ;; FIXME: if buffer is read-only, don't try to insert anything
+ ;; and if text is bound to a command, execute that instead (Bug#1453)
(interactive)
- (if ns-working-overlay (ns-delete-working-text))
+ (ns-delete-working-text)
(let ((start (point)))
(insert ns-working-text)
(overlay-put (setq ns-working-overlay (make-overlay start (point)
(current-buffer) nil t))
- 'face 'ns-working-text-face)
- (setq ns-working-overlay-len (+ ns-working-overlay-len (- (point) start)))))
+ 'face 'ns-working-text-face)))
(defun ns-echo-working-text ()
- "Echo contents of ns-working-text in message display area.
-See ns-insert-working-text."
- (if ns-working-overlay (ns-unecho-working-text))
+ "Echo contents of `ns-working-text' in message display area.
+See `ns-insert-working-text'."
+ (ns-delete-working-text)
(let* ((msg (current-message))
(msglen (length msg))
message-log-max)
- (setq ns-working-overlay-len (length ns-working-text))
+ (setq ns-working-overlay (length ns-working-text))
(setq msg (concat msg ns-working-text))
- (put-text-property msglen (+ msglen ns-working-overlay-len) 'face 'ns-working-text-face msg)
- (message "%s" msg)
- (setq ns-working-overlay t)))
+ (put-text-property msglen (+ msglen ns-working-overlay)
+ 'face 'ns-working-text-face msg)
+ (message "%s" msg)))
(defun ns-delete-working-text()
- "Delete working text and clear ns-working-overlay."
+ "Delete working text and clear `ns-working-overlay'."
(interactive)
- (delete-backward-char ns-working-overlay-len)
- (setq ns-working-overlay-len 0)
- (delete-overlay ns-working-overlay))
-
-(defun ns-unecho-working-text()
- "Delete working text from echo area and clear ns-working-overlay."
- (let ((msg (current-message))
- message-log-max)
- (setq msg (substring msg 0 (- (length msg) ns-working-overlay-len)))
- (setq ns-working-overlay-len 0)
- (setq ns-working-overlay nil)))
+ (cond
+ ((and (overlayp ns-working-overlay)
+ ;; Still alive?
+ (overlay-buffer ns-working-overlay))
+ (with-current-buffer (overlay-buffer ns-working-overlay)
+ (delete-region (overlay-start ns-working-overlay)
+ (overlay-end ns-working-overlay))
+ (delete-overlay ns-working-overlay)))
+ ((integerp ns-working-overlay)
+ (let ((msg (current-message))
+ message-log-max)
+ (setq msg (substring msg 0 (- (length msg) ns-working-overlay)))
+ (message "%s" msg))))
+ (setq ns-working-overlay nil))
(declare-function ns-convert-utf8-nfd-to-nfc "nsfns.m" (str))
(progn
(defun ns-utf8-nfd-post-read-conversion (length)
- "Calls ns-convert-utf8-nfd-to-nfc to compose char sequences."
+ "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences."
(save-excursion
(save-restriction
(narrow-to-region (point) (+ (point) length))
:post-read-conversion 'ns-utf8-nfd-post-read-conversion)
(set-file-name-coding-system 'utf-8-nfd)))
-;; PENDING: disable composition-based display for Indic scripts as it
-;; is not working well under Nextstep for some reason
-(set-char-table-range composition-function-table
- '(#x0900 . #x0DFF) nil)
;;;; Inter-app communications support.
(defvar ns-input-text) ; nsterm.m
(defun ns-insert-text ()
- "Insert contents of ns-input-text at point."
+ "Insert contents of `ns-input-text' at point."
(interactive)
(insert ns-input-text)
(setq ns-input-text nil))
(defun ns-insert-file ()
- "Insert contents of file ns-input-file like insert-file but with less
-prompting. If file is a directory perform a find-file on it."
+ "Insert contents of file `ns-input-file' like insert-file but with less
+prompting. If file is a directory perform a `find-file' on it."
(interactive)
(let ((f))
(setq f (car ns-input-file))
(t (read res)))))
;; nsterm.m
-(defvar ns-command-modifier)
-(defvar ns-control-modifier)
-(defvar ns-function-modifier)
-(defvar ns-antialias-text)
-(defvar ns-use-qd-smoothing)
-(defvar ns-use-system-highlight-color)
-
-(declare-function ns-set-resource "nsfns.m" (owner name value))
-(declare-function ns-font-name "nsfns.m" (name))
+
(declare-function ns-read-file-name "nsfns.m"
(prompt &optional dir isLoad init))
-(defun ns-save-preferences ()
- "Set all the defaults."
- (interactive)
- ;; Global preferences
- (ns-set-resource nil "AlternateModifier" (symbol-name ns-alternate-modifier))
- (ns-set-resource nil "CommandModifier" (symbol-name ns-command-modifier))
- (ns-set-resource nil "ControlModifier" (symbol-name ns-control-modifier))
- (ns-set-resource nil "FunctionModifier" (symbol-name ns-function-modifier))
- (ns-set-resource nil "CursorBlinkRate"
- (if ns-cursor-blink-rate
- (number-to-string ns-cursor-blink-rate)
- "NO"))
- (ns-set-resource nil "ExpandSpace"
- (if ns-expand-space
- (number-to-string ns-expand-space)
- "NO"))
- (ns-set-resource nil "GSFontAntiAlias" (if ns-antialias-text "YES" "NO"))
- (ns-set-resource nil "UseQuickdrawSmoothing"
- (if ns-use-qd-smoothing "YES" "NO"))
- (ns-set-resource nil "UseSystemHighlightColor"
- (if ns-use-system-highlight-color "YES" "NO"))
- ;; Default frame parameters
- (let ((p (frame-parameters))
- v)
- (if (setq v (assq 'font p))
- (ns-set-resource nil "Font" (ns-font-name (cdr v))))
- (if (setq v (assq 'fontsize p))
- (ns-set-resource nil "FontSize" (number-to-string (cdr v))))
- (if (setq v (assq 'foreground-color p))
- (ns-set-resource nil "Foreground" (cdr v)))
- (if (setq v (assq 'background-color p))
- (ns-set-resource nil "Background" (cdr v)))
- (if (setq v (assq 'cursor-color p))
- (ns-set-resource nil "CursorColor" (cdr v)))
- (if (setq v (assq 'cursor-type p))
- (ns-set-resource nil "CursorType" (if (symbolp (cdr v))
- (symbol-name (cdr v))
- (cdr v))))
- (if (setq v (assq 'underline p))
- (ns-set-resource nil "Underline"
- (case (cdr v)
- ((t) "YES")
- ((nil) "NO")
- (t (cdr v)))))
- (if (setq v (assq 'internal-border-width p))
- (ns-set-resource nil "InternalBorderWidth"
- (number-to-string (cdr v))))
- (if (setq v (assq 'vertical-scroll-bars p))
- (ns-set-resource nil "VerticalScrollBars"
- (case (cdr v)
- ((t) "YES")
- ((nil) "NO")
- ((left) "left")
- ((right) "right")
- (t nil))))
- (if (setq v (assq 'height p))
- (ns-set-resource nil "Height" (number-to-string (cdr v))))
- (if (setq v (assq 'width p))
- (ns-set-resource nil "Width" (number-to-string (cdr v))))
- (if (setq v (assq 'top p))
- (ns-set-resource nil "Top" (number-to-string (cdr v))))
- (if (setq v (assq 'left p))
- (ns-set-resource nil "Left" (number-to-string (cdr v))))
- ;; These not fully supported
- (if (setq v (assq 'auto-raise p))
- (ns-set-resource nil "AutoRaise" (if (cdr v) "YES" "NO")))
- (if (setq v (assq 'auto-lower p))
- (ns-set-resource nil "AutoLower" (if (cdr v) "YES" "NO")))
- (if (setq v (assq 'menu-bar-lines p))
- (ns-set-resource nil "Menus" (if (cdr v) "YES" "NO")))
- )
- (let ((fl (face-list)))
- (while (consp fl)
- (or (eq 'default (car fl))
- ;; dont save Default* since it causes all created faces to
- ;; inherit its values. The properties of the default face
- ;; have already been saved from the frame-parameters anyway.
- (let* ((name (symbol-name (car fl)))
- (font (face-font (car fl)))
- ;; (fontsize (face-fontsize (car fl)))
- (foreground (face-foreground (car fl)))
- (background (face-background (car fl)))
- (underline (face-underline-p (car fl)))
- (italic (face-italic-p (car fl)))
- (bold (face-bold-p (car fl)))
- (stipple (face-stipple (car fl))))
- ;; (ns-set-resource nil (concat name ".attributeFont")
- ;; (if font font nil))
- ;; (ns-set-resource nil (concat name ".attributeFontSize")
- ;; (if fontsize (number-to-string fontsize) nil))
- (ns-set-resource nil (concat name ".attributeForeground")
- (if foreground foreground nil))
- (ns-set-resource nil (concat name ".attributeBackground")
- (if background background nil))
- (ns-set-resource nil (concat name ".attributeUnderline")
- (if underline "YES" nil))
- (ns-set-resource nil (concat name ".attributeItalic")
- (if italic "YES" nil))
- (ns-set-resource nil (concat name ".attributeBold")
- (if bold "YES" nil))
- (and stipple
- (or (stringp stipple)
- (setq stipple (prin1-to-string stipple))))
- (ns-set-resource nil (concat name ".attributeStipple")
- (if stipple stipple nil))))
- (setq fl (cdr fl)))))
-
-(declare-function menu-bar-options-save-orig "ns-win" () t)
-
-;; call ns-save-preferences when menu-bar-options-save is called
-(fset 'menu-bar-options-save-orig (symbol-function 'menu-bar-options-save))
-(defun ns-save-options ()
- (interactive)
- (menu-bar-options-save-orig)
- (ns-save-preferences))
-(fset 'menu-bar-options-save (symbol-function 'ns-save-options))
-
-
;;;; File handling.
(defun ns-open-file-using-panel ()
(message ns-output-file)
(if ns-output-file (write-file ns-output-file))))
-(defvar ns-pop-up-frames 'fresh
- "*Non-nil means open files upon request from the Workspace in a new frame.
+(defcustom ns-pop-up-frames 'fresh
+ "Non-nil means open files upon request from the Workspace in a new frame.
If t, always do so. Any other non-nil value means open a new frame
-unless the current buffer is a scratch buffer.")
+unless the current buffer is a scratch buffer."
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (other :tag "Except for scratch buffer" fresh))
+ :version "23.1"
+ :group 'ns)
(declare-function ns-hide-emacs "nsfns.m" (on))
(defun ns-find-file ()
- "Do a find-file with the ns-input-file as argument."
+ "Do a `find-file' with the `ns-input-file' as argument."
(interactive)
(let ((f) (file) (bufwin1) (bufwin2))
(setq f (file-truename (car ns-input-file)))
"Switch to next visible frame."
(interactive)
(other-frame 1))
+
(defun ns-prev-frame ()
"Switch to previous visible frame."
(interactive)
;; If no position specified, make new frame offset by 25 from current.
(defvar parameters) ; dynamically bound in make-frame
-
(add-hook 'before-make-frame-hook
(lambda ()
(let ((left (cdr (assq 'left (frame-parameters))))
parameters))))))))
;; frame will be focused anyway, so select it
+;; (if this is not done, modeline is dimmed until first interaction)
(add-hook 'after-make-frame-functions 'select-frame)
-;; (defun ns-win-suspend-error ()
-;; (error "Suspending an emacs running under *Step/OS X makes no sense"))
-;; (add-hook 'suspend-hook 'ns-win-suspend-error)
-;; (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
-;; global-map)
+(defvar tool-bar-mode)
+(declare-function tool-bar-mode "tool-bar" (&optional arg))
;; Based on a function by David Reitter <dreitter@inf.ed.ac.uk> ;
;; see http://lists.gnu.org/archive/html/emacs-devel/2005-09/msg00681.html .
0 1)) ))
(if (not tool-bar-mode) (tool-bar-mode t)))
-(defvar ns-cursor-blink-mode) ; nsterm.m
-
-;; Redefine from frame.el.
-(define-minor-mode blink-cursor-mode
- "Toggle blinking cursor mode.
-With a numeric argument, turn blinking cursor mode on if ARG is positive,
-otherwise turn it off. When blinking cursor mode is enabled, the
-cursor of the selected window blinks.
-
-Note that this command is effective only when Emacs
-displays through a window system, because then Emacs does its own
-cursor display. On a text-only terminal, this is not implemented."
- :init-value (not (or noninteractive
- no-blinking-cursor
- (eq ns-cursor-blink-rate nil)))
- :initialize 'custom-initialize-safe-default
- :group 'cursor
- :global t
- (if blink-cursor-mode
- (setq ns-cursor-blink-mode t)
- (setq ns-cursor-blink-mode nil)))
-
;;;; Dialog-related functions.
+
;; Ask user for confirm before printing. Due to Kevin Rodgers.
(defun ns-print-buffer ()
"Interactive front-end to `print-buffer': asks for user confirmation first."
(error "Cancelled")))
(print-buffer)))
-(defun ns-yes-or-no-p (prompt)
- "Ask user a \"yes or no\" question using a Nextstep graphical panel.
-PROMPT is the prompt string."
- (interactive)
- (setq last-nonmenu-event nil)
- (yes-or-no-p prompt))
-
;;;; Font support.
(setq scalable-fonts-allowed t)
;; Set to use font panel instead
-(defalias 'generate-fontset-menu 'ns-popup-font-panel)
-(defalias 'mouse-set-font 'ns-popup-font-panel)
+(declare-function ns-popup-font-panel "nsfns.m" (&optional frame))
+(defalias 'generate-fontset-menu 'ns-popup-font-panel "Pop up the font panel.
+This function has been overloaded in Nextstep.")
+(defalias 'mouse-set-font 'ns-popup-font-panel "Pop up the font panel.
+This function has been overloaded in Nextstep.")
;; nsterm.m
(defvar ns-input-font)
(defvar ns-input-fontsize)
(defun ns-respond-to-change-font ()
- "Respond to changeFont: event, expecting ns-input-font and\n\
-ns-input-fontsize of new font."
+ "Respond to changeFont: event, expecting `ns-input-font' and\n\
+`ns-input-fontsize' of new font."
(interactive)
(modify-frame-parameters (selected-frame)
(list (cons 'font ns-input-font)
;; Default fontset for Mac OS X. This is mainly here to show how a fontset
;; can be set up manually. Ordinarily, fontsets are auto-created whenever
-;; a font is chosen by
+;; a font is chosen by
(defvar ns-standard-fontset-spec
;; Only some code supports this so far, so use uglier XLFD version
;; "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:Courier,han:Kai"
",")
"String of fontset spec of the standard fontset.
This defines a fontset consisting of the Courier and other fonts that
-come with OS X\".
-See the documentation of `create-fontset-from-fontset-spec for the format.")
+come with OS X.
+See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; Conditional on new-fontset so bootstrapping works on non-GUI compiles.
(if (fboundp 'new-fontset)
(progn
;; Setup the default fontset.
- (setup-default-fontset)
+ (create-default-fontset)
;; Create the standard fontset.
- (create-fontset-from-fontset-spec ns-standard-fontset-spec t)))
-
-;;(push (cons 'font "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard")
-;; default-frame-alist)
-
-;; Add some additional scripts to var we use for fontset generation.
-(setq script-representative-chars
- (cons '(kana #xff8a)
- (cons '(symbol #x2295 #x2287 #x25a1)
- script-representative-chars)))
+ (condition-case err
+ (create-fontset-from-fontset-spec ns-standard-fontset-spec t)
+ (error (display-warning
+ 'initialization
+ (format "Creation of the standard fontset failed: %s" err)
+ :error)))))
;;;; Pasteboard support.
(global-unset-key [vertical-scroll-bar mouse-1])
(global-unset-key [vertical-scroll-bar drag-mouse-1])
+(declare-function scroll-bar-scale "scroll-bar" (num-denom whole))
+
(defun ns-scroll-bar-move (event)
- "Scroll the frame according to an Nextstep scroller event."
+ "Scroll the frame according to a Nextstep scroller event."
(interactive "e")
(let* ((pos (event-end event))
(window (nth 0 pos))
(vertical-motion (/ (window-height window) 2) window))))
(defun ns-handle-scroll-bar-event (event)
- "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
+ "Handle scroll bar EVENT to emulate Nextstep style scrolling."
(interactive "e")
(let* ((position (event-start event))
(bar-part (nth 4 position))
(defvar x-colors (ns-list-colors)
"The list of colors defined in non-PANTONE color files.")
-(defvar colors x-colors
- "The list of colors defined in non-PANTONE color files.")
(defun xw-defined-colors (&optional frame)
"Return a list of colors supported for a particular frame.
;; Convenience and work-around for fact that set color fns now require named.
(defun ns-set-background-alpha (alpha)
- "Sets alpha (opacity) of background.
+ "Sets ALPHA (opacity) of background.
Set from 0.0 (fully transparent) to 1.0 (fully opaque; default).
Note, tranparency works better on Tiger (10.4) and higher."
(interactive "nSet background alpha to: ")
(defvar ns-input-color) ; nsterm.m
(defun ns-set-foreground-at-mouse ()
- "Set the foreground color at the mouse location to ns-input-color."
+ "Set the foreground color at the mouse location to `ns-input-color'."
(interactive)
(let* ((pos (mouse-position))
(frame (car pos))
(set-face-foreground face ns-input-color frame)))))
(defun ns-set-background-at-mouse ()
- "Set the background color at the mouse location to ns-input-color."
+ "Set the background color at the mouse location to `ns-input-color'."
(interactive)
(let* ((pos (mouse-position))
(frame (car pos))
(setq frame-title-format t
icon-title-format t)
-;; Set up browser connectivity.
-(defvar browse-url-generic-program)
-
-(setq browse-url-browser-function 'browse-url-generic)
-(setq browse-url-generic-program
- (cond ((eq system-type 'darwin) "open")
- ;; Otherwise, GNUstep.
- (t "gopen")))
-
(defvar ns-initialized nil
"Non-nil if Nextstep windowing has been initialized.")
(declare-function ns-list-services "nsfns.m" ())
+(declare-function x-open-connection "nsfns.m"
+ (display &optional xrm-string must-succeed))
;; Do the actual Nextstep Windows setup here; the above code just
;; defines functions and variables that we use now.