-;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system
+;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 1994, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2005-2013 Free Software Foundation, Inc.
;; Authors: Carl Edman
;; Christian Limpach
;; this file, which works in close coordination with src/nsfns.m.
;;; Code:
-
-
-(if (not (featurep 'ns))
+(eval-when-compile (require 'cl-lib))
+(or (featurep 'ns)
(error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS"
- (invocation-name)))
-
-(eval-when-compile (require 'cl))
+ (invocation-name)))
-;; Documentation-purposes only: actually loaded in loadup.el
+;; Documentation-purposes only: actually loaded in loadup.el.
(require 'frame)
(require 'mouse)
(require 'faces)
-(require 'easymenu)
(require 'menu-bar)
(require 'fontset)
-;; Not needed?
-;;(require 'ispell)
-
(defgroup ns nil
"GNUstep/Mac OS X specific features."
:group 'environment)
-;; nsterm.m
-(defvar ns-version-string)
-(defvar ns-alternate-modifier)
-(defvar ns-right-alternate-modifier)
-
;;;; Command line argument handling.
-(defvar ns-invocation-args nil)
-(defvar ns-command-line-resources nil)
-
-;; Handler for switches of the form "-switch value" or "-switch".
-(defun ns-handle-switch (switch &optional numeric)
- (let ((aelt (assoc switch command-line-ns-option-alist)))
- (if aelt
- (setq default-frame-alist
- (cons (cons (nth 3 aelt)
- (if numeric
- (string-to-number (pop ns-invocation-args))
- (or (nth 4 aelt) (pop ns-invocation-args))))
- default-frame-alist)))))
-
-;; Handler for switches of the form "-switch n"
-(defun ns-handle-numeric-switch (switch)
- (ns-handle-switch switch t))
-
-;; Make -iconic apply only to the initial frame!
-(defun ns-handle-iconic (switch)
- (setq initial-frame-alist
- (cons '(visibility . icon) initial-frame-alist)))
-
-;; Handle the -name option, set the name of the initial frame.
-(defun ns-handle-name-switch (switch)
- (or (consp ns-invocation-args)
- (error "%s: missing argument to `%s' option" (invocation-name) switch))
- (setq initial-frame-alist (cons (cons 'name (pop ns-invocation-args))
- initial-frame-alist)))
-
-;; Set (but not used?) in frame.el.
-(defvar x-display-name nil
- "The name of the window display on which Emacs was started.
-On X, the display name of individual X frames is recorded in the
-`display' frame parameter.")
+(defvar x-invocation-args)
+(defvar ns-command-line-resources nil) ; FIXME unused?
;; nsterm.m.
(defvar ns-input-file)
-(defun ns-handle-nxopen (switch)
- (setq unread-command-events (append unread-command-events '(ns-open-file))
- ns-input-file (append ns-input-file (list (pop ns-invocation-args)))))
+(defun ns-handle-nxopen (_switch &optional temp)
+ (setq unread-command-events (append unread-command-events
+ (if temp '(ns-open-temp-file)
+ '(ns-open-file)))
+ ns-input-file (append ns-input-file (list (pop x-invocation-args)))))
(defun ns-handle-nxopentemp (switch)
- (setq unread-command-events (append unread-command-events
- '(ns-open-temp-file))
- ns-input-file (append ns-input-file (list (pop ns-invocation-args)))))
-
-(defun ns-ignore-1-arg (switch)
- (setq ns-invocation-args (cdr ns-invocation-args)))
-(defun ns-ignore-2-arg (switch)
- (setq ns-invocation-args (cddr ns-invocation-args)))
-
-(defun ns-handle-args (args)
- "Process Nextstep-related command line options.
-This is run before the user's startup file is loaded.
-The options in ARGS are copied to `ns-invocation-args'.
-The Nextstep-related settings are then applied using the handlers
-defined in `command-line-ns-option-alist'.
-The return value is ARGS minus the number of arguments processed."
- ;; We use ARGS to accumulate the args that we don't handle here, to return.
- (setq ns-invocation-args args
- args nil)
- (while ns-invocation-args
- (let* ((this-switch (pop ns-invocation-args))
- (orig-this-switch this-switch)
- completion argval aelt handler)
- ;; Check for long options with attached arguments
- ;; and separate out the attached option argument into argval.
- (if (string-match "^--[^=]*=" this-switch)
- (setq argval (substring this-switch (match-end 0))
- this-switch (substring this-switch 0 (1- (match-end 0)))))
- ;; Complete names of long options.
- (if (string-match "^--" this-switch)
- (progn
- (setq completion (try-completion this-switch
- command-line-ns-option-alist))
- (if (eq completion t)
- ;; Exact match for long option.
- nil
- (if (stringp completion)
- (let ((elt (assoc completion command-line-ns-option-alist)))
- ;; Check for abbreviated long option.
- (or elt
- (error "Option `%s' is ambiguous" this-switch))
- (setq this-switch completion))))))
- (setq aelt (assoc this-switch command-line-ns-option-alist))
- (if aelt (setq handler (nth 2 aelt)))
- (if handler
- (if argval
- (let ((ns-invocation-args
- (cons argval ns-invocation-args)))
- (funcall handler this-switch))
- (funcall handler this-switch))
- (setq args (cons orig-this-switch args)))))
- (nreverse args))
+ (ns-handle-nxopen switch t))
+
+(defun ns-ignore-1-arg (_switch)
+ (setq x-invocation-args (cdr x-invocation-args)))
(defun ns-parse-geometry (geom)
"Parse a Nextstep-style geometry string GEOM.
;;;; Keyboard mapping.
-;; These tell read-char how to convert these special chars to ASCII.
-(put 'S-tab 'ascii-character (logior 16 ?\t))
-
-(defvar ns-alternatives-map
- (let ((map (make-sparse-keymap)))
- ;; Map certain keypad keys into ASCII characters
- ;; that people usually expect.
- (define-key map [S-tab] [25])
- (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.")
+(define-obsolete-variable-alias 'ns-alternatives-map 'x-alternatives-map "24.1")
;; Here are some Nextstep-like bindings for command key sequences.
(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-~] 'ns-prev-frame)
(define-key global-map [?\s--] 'center-line)
(define-key global-map [?\s-:] 'ispell)
(define-key global-map [?\s-\;] 'ispell-next)
(define-key global-map [end] 'end-of-buffer)
(define-key global-map [kp-home] 'beginning-of-buffer)
(define-key global-map [kp-end] 'end-of-buffer)
-(define-key global-map [kp-prior] 'scroll-down)
-(define-key global-map [kp-next] 'scroll-up)
+(define-key global-map [kp-prior] 'scroll-down-command)
+(define-key global-map [kp-next] 'scroll-up-command)
-;;; Allow shift-clicks to work similarly to under Nextstep
+;; 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.
+;; are the bindings for them. Note, these keys are actually declared in
+;; x-setup-function-keys in common-win.
(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-file] 'ns-find-file)
(define-key global-map [ns-drag-color] 'ns-set-foreground-at-mouse)
(define-key global-map [S-ns-drag-color] 'ns-set-background-at-mouse)
(define-key global-map [ns-drag-text] 'ns-insert-text)
(defvaralias 'mac-allow-anti-aliasing 'ns-antialias-text)
(defvaralias 'mac-command-modifier 'ns-command-modifier)
+(defvaralias 'mac-right-command-modifier 'ns-right-command-modifier)
(defvaralias 'mac-control-modifier 'ns-control-modifier)
+(defvaralias 'mac-right-control-modifier 'ns-right-control-modifier)
(defvaralias 'mac-option-modifier 'ns-option-modifier)
(defvaralias 'mac-right-option-modifier 'ns-right-option-modifier)
(defvaralias 'mac-function-modifier 'ns-function-modifier)
(declare-function ns-do-applescript "nsfns.m" (script))
(defalias 'do-applescript 'ns-do-applescript)
-(defun x-setup-function-keys (frame)
- "Set up `function-key-map' on the graphical 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 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) 2) 'ns-open-file)
- (cons (logior (lsh 0 16) 3) 'ns-open-temp-file)
- (cons (logior (lsh 0 16) 4) 'ns-drag-file)
- (cons (logior (lsh 0 16) 5) 'ns-drag-color)
- (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) 11) 'ns-spi-service-call)
- (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 1 16) 36) 'f5)
- (cons (logior (lsh 1 16) 37) 'f6)
- (cons (logior (lsh 1 16) 38) 'f7)
- (cons (logior (lsh 1 16) 39) 'f8)
- (cons (logior (lsh 1 16) 40) 'f9)
- (cons (logior (lsh 1 16) 41) 'f10)
- (cons (logior (lsh 1 16) 42) 'f11)
- (cons (logior (lsh 1 16) 43) 'f12)
- (cons (logior (lsh 1 16) 44) 'kp-insert)
- (cons (logior (lsh 1 16) 45) 'kp-delete)
- (cons (logior (lsh 1 16) 46) 'kp-home)
- (cons (logior (lsh 1 16) 47) 'kp-end)
- (cons (logior (lsh 1 16) 48) 'kp-prior)
- (cons (logior (lsh 1 16) 49) 'kp-next)
- (cons (logior (lsh 1 16) 50) 'print-screen)
- (cons (logior (lsh 1 16) 51) 'scroll-lock)
- (cons (logior (lsh 1 16) 52) 'pause)
- (cons (logior (lsh 1 16) 53) 'system)
- (cons (logior (lsh 1 16) 54) 'break)
- (cons (logior (lsh 1 16) 56) 'please-tell-carl-what-this-key-is-called-56)
- (cons (logior (lsh 1 16) 61) 'please-tell-carl-what-this-key-is-called-61)
- (cons (logior (lsh 1 16) 62) 'please-tell-carl-what-this-key-is-called-62)
- (cons (logior (lsh 1 16) 63) 'please-tell-carl-what-this-key-is-called-63)
- (cons (logior (lsh 1 16) 64) 'please-tell-carl-what-this-key-is-called-64)
- (cons (logior (lsh 1 16) 69) 'please-tell-carl-what-this-key-is-called-69)
- (cons (logior (lsh 1 16) 70) 'please-tell-carl-what-this-key-is-called-70)
- (cons (logior (lsh 1 16) 71) 'please-tell-carl-what-this-key-is-called-71)
- (cons (logior (lsh 1 16) 72) 'please-tell-carl-what-this-key-is-called-72)
- (cons (logior (lsh 1 16) 73) 'please-tell-carl-what-this-key-is-called-73)
- (cons (logior (lsh 2 16) 3) 'kp-enter)
- (cons (logior (lsh 2 16) 9) 'kp-tab)
- (cons (logior (lsh 2 16) 28) 'kp-quit)
- (cons (logior (lsh 2 16) 35) 'kp-hash)
- (cons (logior (lsh 2 16) 42) 'kp-multiply)
- (cons (logior (lsh 2 16) 43) 'kp-add)
- (cons (logior (lsh 2 16) 44) 'kp-separator)
- (cons (logior (lsh 2 16) 45) 'kp-subtract)
- (cons (logior (lsh 2 16) 46) 'kp-decimal)
- (cons (logior (lsh 2 16) 47) 'kp-divide)
- (cons (logior (lsh 2 16) 48) 'kp-0)
- (cons (logior (lsh 2 16) 49) 'kp-1)
- (cons (logior (lsh 2 16) 50) 'kp-2)
- (cons (logior (lsh 2 16) 51) 'kp-3)
- (cons (logior (lsh 2 16) 52) 'kp-4)
- (cons (logior (lsh 2 16) 53) 'kp-5)
- (cons (logior (lsh 2 16) 54) 'kp-6)
- (cons (logior (lsh 2 16) 55) 'kp-7)
- (cons (logior (lsh 2 16) 56) 'kp-8)
- (cons (logior (lsh 2 16) 57) 'kp-9)
- (cons (logior (lsh 2 16) 60) 'kp-less)
- (cons (logior (lsh 2 16) 61) 'kp-equal)
- (cons (logior (lsh 2 16) 62) 'kp-more)
- (cons (logior (lsh 2 16) 64) 'kp-at)
- (cons (logior (lsh 2 16) 92) 'kp-backslash)
- (cons (logior (lsh 2 16) 96) 'kp-backtick)
- (cons (logior (lsh 2 16) 124) 'kp-bar)
- (cons (logior (lsh 2 16) 126) 'kp-tilde)
- (cons (logior (lsh 2 16) 157) 'kp-mu)
- (cons (logior (lsh 2 16) 165) 'kp-yen)
- (cons (logior (lsh 2 16) 167) 'kp-paragraph)
- (cons (logior (lsh 2 16) 172) 'left)
- (cons (logior (lsh 2 16) 173) 'up)
- (cons (logior (lsh 2 16) 174) 'right)
- (cons (logior (lsh 2 16) 175) 'down)
- (cons (logior (lsh 2 16) 176) 'kp-ring)
- (cons (logior (lsh 2 16) 201) 'kp-square)
- (cons (logior (lsh 2 16) 204) 'kp-cube)
- (cons (logior (lsh 3 16) 8) 'backspace)
- (cons (logior (lsh 3 16) 9) 'tab)
- (cons (logior (lsh 3 16) 10) 'linefeed)
- (cons (logior (lsh 3 16) 11) 'clear)
- (cons (logior (lsh 3 16) 13) 'return)
- (cons (logior (lsh 3 16) 18) 'pause)
- (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)))
-
-
-;; 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] (make-sparse-keymap "menu-bar"))
-
-(setq menu-bar-final-items
- (cond ((eq system-type 'darwin)
- '(buffer windows services help-menu))
- ;; Otherwise, GNUstep.
- (t
- '(buffer windows services hide-app quit))))
-
-;; Add standard top-level items to GNUstep menu.
-(unless (eq system-type 'darwin)
- (define-key global-map [menu-bar quit] '("Quit" . save-buffers-kill-emacs))
- (define-key global-map [menu-bar hide-app] '("Hide" . ns-do-hide-emacs)))
-
-(define-key global-map [menu-bar services]
- (cons "Services" (make-sparse-keymap "Services")))
-(define-key global-map [menu-bar buffer]
- (cons "Buffers" global-buffers-menu-map))
-;; (cons "Buffers" (make-sparse-keymap "Buffers")))
-(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
-(define-key global-map [menu-bar options] (cons "Options" menu-bar-options-menu))
-(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
-(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu))
-
-;; If running under GNUstep, rename "Help" to "Info"
-(cond ((eq system-type 'darwin)
- (define-key global-map [menu-bar help-menu]
- (cons "Help" menu-bar-help-menu)))
- (t
- (let ((contents (reverse (cdr menu-bar-help-menu))))
- (setq menu-bar-help-menu
- (append (list 'keymap) (cdr contents) (list "Info"))))
- (define-key global-map [menu-bar help-menu]
- (cons "Info" menu-bar-help-menu))))
-
-(if (not (eq system-type 'darwin))
- ;; in OS X it's in the app menu already
- (define-key menu-bar-help-menu [info-panel]
- '("About Emacs..." . ns-do-emacs-info-panel)))
-
-;;;; Edit menu: Modify slightly
-
-;; Substitute a Copy function that works better under X (for GNUstep).
-(easy-menu-remove-item global-map '("menu-bar" "edit") 'copy)
-(define-key-after menu-bar-edit-menu [copy]
- '(menu-item "Copy" ns-copy-including-secondary
- :enable mark-active
- :help "Copy text in region between mark and current position")
- 'cut)
-
-;; Change to same precondition as select-and-paste, as we don't have
-;; `x-selection-exists-p'.
-(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste)
-(define-key-after menu-bar-edit-menu [paste]
- '(menu-item "Paste" yank
- :enable (and (cdr yank-menu) (not buffer-read-only))
- :help "Paste (yank) text most recently cut/copied")
- 'copy)
-
-;; Change text to be more consistent with surrounding menu items `paste', etc.
-(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste-from-menu)
-(define-key-after menu-bar-edit-menu [select-paste]
- '(menu-item "Select and Paste" yank-menu
- :enable (and (cdr yank-menu) (not buffer-read-only))
- :help "Choose a string from the kill ring and paste it")
- 'paste)
-
-;; Separate undo from cut/paste section, add spell for platform consistency.
-(define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo)
-(define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill)
-
-
;;;; Services
(declare-function ns-perform-service "nsfns.m" (service send))
(mapconcat 'identity (cons "ns-service" path) "-")))))
;; This defines the function.
(defalias name
- (lexical-let ((service service))
- (lambda (arg)
- (interactive "p")
- (let* ((in-string
- (cond ((stringp arg) arg)
- (mark-active
- (buffer-substring (region-beginning) (region-end)))))
- (out-string (ns-perform-service service in-string)))
- (cond
- ((stringp arg) out-string)
- ((and out-string (or (not in-string)
- (not (string= in-string out-string))))
- (if mark-active (delete-region (region-beginning) (region-end)))
- (insert out-string)
- (setq deactivate-mark nil)))))))
+ (lambda (arg)
+ (interactive "p")
+ (let* ((in-string
+ (cond ((stringp arg) arg)
+ (mark-active
+ (buffer-substring (region-beginning) (region-end)))))
+ (out-string (ns-perform-service service in-string)))
+ (cond
+ ((stringp arg) out-string)
+ ((and out-string (or (not in-string)
+ (not (string= in-string out-string))))
+ (if mark-active (delete-region (region-beginning) (region-end)))
+ (insert out-string)
+ (setq deactivate-mark nil))))))
(cond
((lookup-key global-map mapping)
(while (cdr path)
(t (error (concat "Service " ns-input-spi-name " not recognized")))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-
;; 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
;;;; OS X file system Unicode UTF-8 NFD (decomposed form) support
;; Lisp code based on utf-8m.el, by Seiji Zenitani, Eiji Honjoh, and
;; Carsten Bormann.
-(if (eq system-type 'darwin)
- (progn
-
- (defun ns-utf8-nfd-post-read-conversion (length)
- "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences."
- (save-excursion
- (save-restriction
- (narrow-to-region (point) (+ (point) length))
- (let ((str (buffer-string)))
- (delete-region (point-min) (point-max))
- (insert (ns-convert-utf8-nfd-to-nfc str))
- (- (point-max) (point-min))
- ))))
-
- (define-coding-system 'utf-8-nfd
- "UTF-8 NFD (decomposed) encoding."
- :coding-type 'utf-8
- :mnemonic ?U
- :charset-list '(unicode)
- :post-read-conversion 'ns-utf8-nfd-post-read-conversion)
- (set-file-name-coding-system 'utf-8-nfd)))
-
-
+(when (eq system-type 'darwin)
+ (defun ns-utf8-nfd-post-read-conversion (length)
+ "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point) (+ (point) length))
+ (let ((str (buffer-string)))
+ (delete-region (point-min) (point-max))
+ (insert (ns-convert-utf8-nfd-to-nfc str))
+ (- (point-max) (point-min))))))
+
+ (define-coding-system 'utf-8-nfd
+ "UTF-8 NFD (decomposed) encoding."
+ :coding-type 'utf-8
+ :mnemonic ?U
+ :charset-list '(unicode)
+ :post-read-conversion 'ns-utf8-nfd-post-read-conversion)
+ (set-file-name-coding-system 'utf-8-nfd))
;;;; Inter-app communications support.
"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))
- (setq ns-input-file (cdr ns-input-file))
+ (let ((f (pop ns-input-file)))
(if (file-directory-p f)
(find-file f)
- (push-mark (+ (point) (car (cdr (insert-file-contents f))))))))
+ (push-mark (+ (point) (cadr (insert-file-contents f)))))))
(defvar ns-select-overlay nil
"Overlay used to highlight areas in files requested by Nextstep apps.")
(add-hook 'first-change-hook 'ns-unselect-line)
-
-
;;;; Preferences handling.
(declare-function ns-get-resource "nsfns.m" (owner name))
;; nsterm.m
(declare-function ns-read-file-name "nsfns.m"
- (prompt &optional dir isLoad init))
+ (prompt &optional dir mustmatch init dir_only_p))
;;;; File handling.
+(defun x-file-dialog (prompt dir default_filename mustmatch only_dir_p)
+"Read file name, prompting with PROMPT in directory DIR.
+Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
+selection box, if specified. If MUSTMATCH is non-nil, the returned file
+or directory must exist.
+
+This function is only defined on NS, MS Windows, and X Windows with the
+Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored.
+Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories."
+ (ns-read-file-name prompt dir mustmatch default_filename only_dir_p))
+
(defun ns-open-file-using-panel ()
"Pop up open-file panel, and load the result in a buffer."
(interactive)
(defun ns-find-file ()
"Do a `find-file' with the `ns-input-file' as argument."
(interactive)
- (let ((f) (file) (bufwin1) (bufwin2))
- (setq f (file-truename (expand-file-name (car ns-input-file)
- command-line-default-directory)))
- (setq ns-input-file (cdr ns-input-file))
- (setq file (find-file-noselect f))
- (setq bufwin1 (get-buffer-window file 'visible))
- (setq bufwin2 (get-buffer-window "*scratch*" 'visibile))
+ (let* ((f (file-truename
+ (expand-file-name (pop ns-input-file)
+ command-line-default-directory)))
+ (file (find-file-noselect f))
+ (bufwin1 (get-buffer-window file 'visible))
+ (bufwin2 (get-buffer-window "*scratch*" 'visible)))
(cond
(bufwin1
(select-frame (window-frame bufwin1))
(ns-hide-emacs 'activate)
(find-file f)))))
-
-
;;;; Frame-related functions.
-;; Don't show the frame name; that's redundant with Nextstep.
-(setq-default mode-line-frame-identification '(" "))
+;; nsterm.m
+(defvar ns-alternate-modifier)
+(defvar ns-right-alternate-modifier)
+(defvar ns-right-command-modifier)
+(defvar ns-right-control-modifier)
;; You say tomAYto, I say tomAHto..
(defvaralias 'ns-option-modifier 'ns-alternate-modifier)
parameters))))))))
;; frame will be focused anyway, so select it
-;; (if this is not done, modeline is dimmed until first interaction)
+;; (if this is not done, mode line is dimmed until first interaction)
(add-hook 'after-make-frame-functions 'select-frame)
(defvar tool-bar-mode)
(if (not tool-bar-mode) (tool-bar-mode t)))
-
;;;; 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)))
-
;;;; Font support.
;; Needed for font listing functions under both backend and normal
`ns-input-fontsize' of new font."
(interactive)
(modify-frame-parameters (selected-frame)
- (list (cons 'font ns-input-font)
- (cons 'fontsize ns-input-fontsize)))
+ (list (cons 'fontsize ns-input-fontsize)))
+ (modify-frame-parameters (selected-frame)
+ (list (cons 'font ns-input-font)))
(set-frame-font ns-input-font))
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.
- (create-default-fontset)
- ;; Create the standard fontset.
- (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)))))
-
(defvar ns-reg-to-script) ; nsfont.m
;; This maps font registries (not exposed by NS APIs for font selection) to
-;; unicode scripts (which can be mapped to unicode character ranges which are).
+;; Unicode scripts (which can be mapped to Unicode character ranges which are).
;; See ../international/fontset.el
(setq ns-reg-to-script
'(("iso8859-1" . latin)
;;;; Pasteboard support.
-(declare-function ns-get-cut-buffer-internal "nsselect.m" (buffer))
+(declare-function ns-get-selection-internal "nsselect.m" (buffer))
+(declare-function ns-store-selection-internal "nsselect.m" (buffer string))
+
+(define-obsolete-function-alias 'ns-get-cut-buffer-internal
+ 'ns-get-selection-internal "24.1")
+(define-obsolete-function-alias 'ns-store-cut-buffer-internal
+ 'ns-store-selection-internal "24.1")
+
(defun ns-get-pasteboard ()
"Returns the value of the pasteboard."
- (ns-get-cut-buffer-internal 'PRIMARY))
-
-(declare-function ns-store-cut-buffer-internal "nsselect.m" (buffer string))
+ (ns-get-selection-internal 'CLIPBOARD))
(defun ns-set-pasteboard (string)
"Store STRING into the pasteboard of the Nextstep display server."
;; Check the data type of STRING.
(if (not (stringp string)) (error "Nonstring given to pasteboard"))
- (ns-store-cut-buffer-internal 'PRIMARY string))
+ (ns-store-selection-internal 'CLIPBOARD string))
;; We keep track of the last text selected here, so we can check the
;; current selection against it, and avoid passing back our own text
-;; from x-cut-buffer-or-selection-value.
+;; from x-selection-value.
(defvar ns-last-selected-text nil)
-(defun x-select-text (text &optional push)
- "Select TEXT, a string, according to the window system.
-
-On X, put TEXT in the primary X selection. For backward
-compatibility with older X applications, set the value of X cut
-buffer 0 as well, and if the optional argument PUSH is non-nil,
-rotate the cut buffers. If `x-select-enable-clipboard' is
-non-nil, copy the text to the X clipboard as well.
-
-On Windows, make TEXT the current selection. If
-`x-select-enable-clipboard' is non-nil, copy the text to the
-clipboard as well. The argument PUSH is ignored.
-
-On Nextstep, put TEXT in the pasteboard; PUSH is ignored."
- ;; Don't send the pasteboard too much text.
- ;; It becomes slow, and if really big it causes errors.
- (ns-set-pasteboard text)
- (setq ns-last-selected-text text))
-
;; Return the value of the current Nextstep selection. For
;; compatibility with older Nextstep applications, this checks cut
;; buffer 0 before retrieving the value of the primary selection.
-(defun x-cut-buffer-or-selection-value ()
+(defun x-selection-value ()
(let (text)
-
- ;; Consult the selection, then the cut buffer. Treat empty strings
- ;; as if they were unset.
+ ;; Consult the selection. Treat empty strings as if they were unset.
(or text (setq text (ns-get-pasteboard)))
(if (string= text "") (setq text nil))
-
(cond
((not text) nil)
((eq text ns-last-selected-text) nil)
(defun ns-copy-including-secondary ()
(interactive)
(call-interactively 'kill-ring-save)
- (ns-store-cut-buffer-internal 'SECONDARY
- (buffer-substring (point) (mark t))))
+ (ns-store-selection-internal 'SECONDARY
+ (buffer-substring (point) (mark t))))
(defun ns-paste-secondary ()
(interactive)
- (insert (ns-get-cut-buffer-internal 'SECONDARY)))
-
+ (insert (ns-get-selection-internal 'SECONDARY)))
;;;; Scrollbar handling.
;;;; Color support.
-(declare-function ns-list-colors "nsfns.m" (&optional frame))
-
-(defvar x-colors (ns-list-colors)
- "List of basic colors available on color displays.
-For X, the list comes from the `rgb.txt' file,v 10.41 94/02/20.
-For Nextstep, this is a list of non-PANTONE colors returned by
-the operating system.")
-
-(defun xw-defined-colors (&optional frame)
- "Internal function called by `defined-colors'."
- (or frame (setq frame (selected-frame)))
- (let ((all-colors x-colors)
- (this-color nil)
- (defined-colors nil))
- (while all-colors
- (setq this-color (car all-colors)
- all-colors (cdr all-colors))
- ;; (and (face-color-supported-p frame this-color t)
- (setq defined-colors (cons this-color defined-colors))) ;;)
- defined-colors))
-
;; Functions for color panel + drag
(defun ns-face-at-pos (pos)
(let* ((frame (car pos))
((not window-pos)
nil)
((eq window-pos 'mode-line)
- 'modeline)
+ 'mode-line)
((eq window-pos 'vertical-line)
'default)
((consp window-pos)
(declare-function ns-list-services "nsfns.m" ())
(declare-function x-open-connection "nsfns.m"
(display &optional xrm-string must-succeed))
+(declare-function ns-set-resource "nsfns.m" (owner name value))
;; Do the actual Nextstep Windows setup here; the above code just
;; defines functions and variables that we use now.
(defun ns-initialize-window-system ()
"Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing."
+ (cl-assert (not ns-initialized))
;; PENDING: not needed?
- (setq command-line-args (ns-handle-args command-line-args))
+ (setq command-line-args (x-handle-args command-line-args))
+
+ ;; Setup the default fontset.
+ (create-default-fontset)
+ ;; Create the standard fontset.
+ (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)))
(x-open-connection (system-name) nil t)
;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings.
(menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
+ ;; OS X Lion introduces PressAndHold, which is unsupported by this port.
+ ;; See this thread for more details:
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html
+ (ns-set-resource nil "ApplePressAndHoldEnabled" "NO")
+
+ (x-apply-session-resources)
(setq ns-initialized t))
-(add-to-list 'handle-args-function-alist '(ns . ns-handle-args))
+(add-to-list 'display-format-alist '("\\`ns\\'" . ns))
+(add-to-list 'handle-args-function-alist '(ns . x-handle-args))
(add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces))
(add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system))
(provide 'ns-win)
-;; arch-tag: eb138a45-4e2e-4d68-b1c9-a39665731644
;;; ns-win.el ends here
HCoop / bpt / emacs.git / blobdiff