;;; Pre-command hook
(defun cua--pre-command-handler-1 ()
- (let ((movement (eq (get this-command 'CUA) 'move)))
-
- ;; Cancel prefix key timeout if user enters another key.
- (when cua--prefix-override-timer
- (if (timerp cua--prefix-override-timer)
- (cancel-timer cua--prefix-override-timer))
- (setq cua--prefix-override-timer nil))
-
- ;; Handle shifted cursor keys and other movement commands.
- ;; If region is not active, region is activated if key is shifted.
- ;; If region is active, region is cancelled if key is unshifted (and region not started with C-SPC).
- ;; If rectangle is active, expand rectangle in specified direction and ignore the movement.
- (if movement
- (cond
- ((if window-system
- (memq 'shift (event-modifiers
- (aref (this-single-command-raw-keys) 0)))
- (or
- (memq 'shift (event-modifiers
- (aref (this-single-command-keys) 0)))
- ;; See if raw escape sequence maps to a shifted event, e.g. S-up or C-S-home.
- (and (boundp 'local-function-key-map)
- local-function-key-map
- (let ((ev (lookup-key local-function-key-map
- (this-single-command-raw-keys))))
- (and (vector ev)
- (symbolp (setq ev (aref ev 0)))
- (string-match "S-" (symbol-name ev)))))))
- (unless mark-active
- (push-mark-command nil t))
- (setq cua--last-region-shifted t)
- (setq cua--explicit-region-start nil))
- ((or cua--explicit-region-start cua--rectangle)
- (unless mark-active
- (push-mark-command nil nil)))
- (t
- ;; If we set mark-active to nil here, the region highlight will not be
- ;; removed by the direct_output_ commands.
- (setq deactivate-mark t)))
-
- ;; Handle delete-selection property on other commands
- (if (and mark-active (not deactivate-mark))
- (let* ((ds (or (get this-command 'delete-selection)
- (get this-command 'pending-delete)))
- (nc (cond
- ((not ds) nil)
- ((eq ds 'yank)
- 'cua-paste)
- ((eq ds 'kill)
- (if cua--rectangle
- 'cua-copy-rectangle
- 'cua-copy-region))
- ((eq ds 'supersede)
- (if cua--rectangle
- 'cua-delete-rectangle
- 'cua-delete-region))
- (t
- (if cua--rectangle
- 'cua-delete-rectangle ;; replace?
- 'cua-replace-region)))))
- (if nc
- (setq this-original-command this-command
- this-command nc)))))
-
- ;; Detect extension of rectangles by mouse or other movement
- (setq cua--buffer-and-point-before-command
- (if cua--rectangle (cons (current-buffer) (point))))))
+ ;; Cancel prefix key timeout if user enters another key.
+ (when cua--prefix-override-timer
+ (if (timerp cua--prefix-override-timer)
+ (cancel-timer cua--prefix-override-timer))
+ (setq cua--prefix-override-timer nil))
+
+ (cond
+ ;; Only symbol commands can have necessary properties
+ ((not (symbolp this-command))
+ nil)
+
+ ;; Handle delete-selection property on non-movement commands
+ ((not (eq (get this-command 'CUA) 'move))
+ (when (and mark-active (not deactivate-mark))
+ (let* ((ds (or (get this-command 'delete-selection)
+ (get this-command 'pending-delete)))
+ (nc (cond
+ ((not ds) nil)
+ ((eq ds 'yank)
+ 'cua-paste)
+ ((eq ds 'kill)
+ (if cua--rectangle
+ 'cua-copy-rectangle
+ 'cua-copy-region))
+ ((eq ds 'supersede)
+ (if cua--rectangle
+ 'cua-delete-rectangle
+ 'cua-delete-region))
+ (t
+ (if cua--rectangle
+ 'cua-delete-rectangle ;; replace?
+ 'cua-replace-region)))))
+ (if nc
+ (setq this-original-command this-command
+ this-command nc)))))
+
+ ;; Handle shifted cursor keys and other movement commands.
+ ;; If region is not active, region is activated if key is shifted.
+ ;; If region is active, region is cancelled if key is unshifted (and region not started with C-SPC).
+ ;; If rectangle is active, expand rectangle in specified direction and ignore the movement.
+ ((if window-system
+ (memq 'shift (event-modifiers
+ (aref (this-single-command-raw-keys) 0)))
+ (or
+ (memq 'shift (event-modifiers
+ (aref (this-single-command-keys) 0)))
+ ;; See if raw escape sequence maps to a shifted event, e.g. S-up or C-S-home.
- (and (boundp 'function-key-map)
- function-key-map
- (let ((ev (lookup-key function-key-map
++ (and (boundp 'local-function-key-map)
++ local-function-key-map
++ (let ((ev (lookup-key local-function-key-map
+ (this-single-command-raw-keys))))
+ (and (vector ev)
+ (symbolp (setq ev (aref ev 0)))
+ (string-match "S-" (symbol-name ev)))))))
+ (unless mark-active
+ (push-mark-command nil t))
+ (setq cua--last-region-shifted t)
+ (setq cua--explicit-region-start nil))
+
+ ;; Set mark if user explicitly said to do so
+ ((or cua--explicit-region-start cua--rectangle)
+ (unless mark-active
+ (push-mark-command nil nil)))
+
+ ;; Else clear mark after this command.
+ (t
+ ;; If we set mark-active to nil here, the region highlight will not be
+ ;; removed by the direct_output_ commands.
+ (setq deactivate-mark t)))
+
+ ;; Detect extension of rectangles by mouse or other movement
+ (setq cua--buffer-and-point-before-command
+ (if cua--rectangle (cons (current-buffer) (point)))))
(defun cua--pre-command-handler ()
(when cua-mode
(when prev
(setq string (concat prev string))
(process-put proc 'previous-string nil)))
- ;; If the input is multiple lines,
- ;; process each line individually.
- (while (string-match "\n" string)
- (let ((request (substring string 0 (match-beginning 0)))
- (coding-system (and default-enable-multibyte-characters
- (or file-name-coding-system
- default-file-name-coding-system)))
- client nowait eval
- (files nil)
- (lineno 1)
- (tmp-frame nil) ; Sometimes used to embody the selected display.
- (columnno 0))
- ;; Remove this line from STRING.
- (setq string (substring string (match-end 0)))
- (setq client (cons proc nil))
- (while (string-match "[^ ]* " request)
- (let ((arg (substring request (match-beginning 0) (1- (match-end 0)))))
- (setq request (substring request (match-end 0)))
- (cond
- ((equal "-nowait" arg) (setq nowait t))
- ((equal "-eval" arg) (setq eval t))
- ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
- (let ((display (server-unquote-arg (match-string 1 request))))
- (setq request (substring request (match-end 0)))
- (condition-case err
- (setq tmp-frame (server-select-display display))
- (error (process-send-string proc (nth 1 err))
- (setq request "")))))
- ;; ARG is a line number option.
- ((string-match "\\`\\+[0-9]+\\'" arg)
- (setq lineno (string-to-number (substring arg 1))))
- ;; ARG is line number:column option.
- ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg)
- (setq lineno (string-to-number (match-string 1 arg))
- columnno (string-to-number (match-string 2 arg))))
- (t
- ;; Undo the quoting that emacsclient does
- ;; for certain special characters.
- (setq arg (server-unquote-arg arg))
- ;; Now decode the file name if necessary.
- (if coding-system
- (setq arg (decode-coding-string arg coding-system)))
- (if eval
- (let* (errorp
- (v (condition-case errobj
- (eval (car (read-from-string arg)))
- (error (setq errorp t) errobj))))
- (when v
- (with-temp-buffer
- (let ((standard-output (current-buffer)))
- (if errorp (princ "error: "))
- (pp v)
- ;; Suppress the error rose when the pipe to PROC is closed.
- (condition-case err
- (process-send-region proc (point-min) (point-max))
- (file-error nil)
- (error nil))
- ))))
- ;; ARG is a file name.
- ;; Collapse multiple slashes to single slashes.
- (setq arg (command-line-normalize-file-name arg))
- (push (list arg lineno columnno) files))
- (setq lineno 1)
- (setq columnno 0)))))
- (when files
- (run-hooks 'pre-command-hook)
- (server-visit-files files client nowait)
- (run-hooks 'post-command-hook))
- ;; CLIENT is now a list (CLIENTNUM BUFFERS...)
- (if (null (cdr client))
- ;; This client is empty; get rid of it immediately.
- (progn
- (delete-process proc)
- (server-log "Close empty client" proc))
- ;; We visited some buffer for this client.
- (or nowait (push client server-clients))
- (unless (or isearch-mode (minibufferp))
- (server-switch-buffer (nth 1 client))
- (run-hooks 'server-switch-hook)
- (unless nowait
- (message "%s" (substitute-command-keys
- "When done with a buffer, type \\[server-edit]")))))
- ;; If the temporary frame is still the selected frame, make it
- ;; real. If not (which can happen if the user's customizations
- ;; call pop-to-buffer etc.), delete it to avoid preserving the
- ;; connection after the last real frame is deleted.
- (if tmp-frame
- (if (eq (selected-frame) tmp-frame)
- (set-frame-parameter tmp-frame 'visibility t)
- (delete-frame tmp-frame)))))
- ;; Save for later any partial line that remains.
- (when (> (length string) 0)
- (process-put proc 'previous-string string)))
+ (condition-case err
+ (progn
+ (server-add-client proc)
+ ;; If the input is multiple lines,
+ ;; process each line individually.
+ (while (string-match "\n" string)
+ (let ((request (substring string 0 (match-beginning 0)))
+ (coding-system (and default-enable-multibyte-characters
+ (or file-name-coding-system
+ default-file-name-coding-system)))
+ (client (server-client proc))
+ current-frame
+ nowait ; t if emacsclient does not want to wait for us.
+ frame ; The frame that was opened for the client (if any).
+ display ; Open the frame on this display.
+ dontkill ; t if the client should not be killed.
+ env
+ dir
+ (files nil)
+ (lineno 1)
+ (columnno 0))
+ ;; Remove this line from STRING.
+ (setq string (substring string (match-end 0)))
+ (while (string-match " *[^ ]* " request)
+ (let ((arg (substring request (match-beginning 0) (1- (match-end 0)))))
+ (setq request (substring request (match-end 0)))
+ (cond
+ ;; -version CLIENT-VERSION:
+ ;; Check version numbers, signal an error if there is a mismatch.
+ ((and (equal "-version" arg)
+ (string-match "\\([0-9.]+\\) " request))
+ (let* ((client-version (match-string 1 request))
+ (truncated-emacs-version
+ (substring emacs-version 0 (length client-version))))
+ (setq request (substring request (match-end 0)))
+ (if (equal client-version truncated-emacs-version)
+ (progn
+ (server-send-string proc "-good-version \n")
+ (server-client-set client 'version client-version))
+ (error (concat "Version mismatch: Emacs is "
+ truncated-emacs-version
+ ", emacsclient is " client-version)))))
+
+ ;; -nowait: Emacsclient won't wait for a result.
+ ((equal "-nowait" arg) (setq nowait t))
+
+ ;; -current-frame: Don't create frames.
+ ((equal "-current-frame" arg) (setq current-frame t))
+
+ ;; -display DISPLAY:
+ ;; Open X frames on the given display instead of the default.
+ ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
+ (setq display (match-string 1 request)
+ request (substring request (match-end 0))))
+
+ ;; -window-system: Open a new X frame.
+ ((equal "-window-system" arg)
+ (unless (server-client-get client 'version)
+ (error "Protocol error; make sure to use the correct version of emacsclient"))
+ (unless current-frame
+ (if (fboundp 'x-create-frame)
+ (let ((params (if nowait
+ ;; Flag frame as client-created, but use a dummy client.
+ ;; This will prevent the frame from being deleted when
+ ;; emacsclient quits while also preventing
+ ;; `server-save-buffers-kill-terminal' from unexpectedly
+ ;; killing emacs on that frame.
+ (list (cons 'client 'nowait) (cons 'environment env))
+ (list (cons 'client proc) (cons 'environment env)))))
+ (setq frame (make-frame-on-display
+ (or display
+ (frame-parameter nil 'display)
+ (getenv "DISPLAY")
+ (error "Please specify display"))
+ params))
+ (server-log (format "%s created" frame) proc)
+ ;; XXX We need to ensure the parameters are
+ ;; really set because Emacs forgets unhandled
+ ;; initialization parameters for X frames at
+ ;; the moment.
+ (modify-frame-parameters frame params)
+ (select-frame frame)
+ (server-client-set client 'frame frame)
+ (server-client-set client 'terminal (frame-terminal frame))
+
+ ;; Display *scratch* by default.
+ (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
+ (if dir (setq default-directory dir))
+
+ (setq dontkill t))
+ ;; This emacs does not support X.
+ (server-log "Window system unsupported" proc)
+ (server-send-string proc "-window-system-unsupported \n")
+ (setq dontkill t))))
+
+ ;; -resume: Resume a suspended tty frame.
+ ((equal "-resume" arg)
+ (let ((terminal (server-client-get client 'terminal)))
+ (setq dontkill t)
+ (when (eq (terminal-live-p terminal) t)
+ (resume-tty terminal))))
+
+ ;; -suspend: Suspend the client's frame. (In case we
+ ;; get out of sync, and a C-z sends a SIGTSTP to
+ ;; emacsclient.)
+ ((equal "-suspend" arg)
+ (let ((terminal (server-client-get client 'terminal)))
+ (setq dontkill t)
+ (when (eq (terminal-live-p terminal) t)
+ (suspend-tty terminal))))
+
+ ;; -ignore COMMENT: Noop; useful for debugging emacsclient.
+ ;; (The given comment appears in the server log.)
+ ((and (equal "-ignore" arg) (string-match "\\([^ ]*\\) " request))
+ (setq dontkill t
+ request (substring request (match-end 0))))
+
+ ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client.
+ ((and (equal "-tty" arg) (string-match "\\([^ ]*\\) \\([^ ]*\\) " request))
+ (let ((tty (server-unquote-arg (match-string 1 request)))
+ (type (server-unquote-arg (match-string 2 request))))
+ (setq request (substring request (match-end 0)))
+ (unless (server-client-get client 'version)
+ (error "Protocol error; make sure you use the correct version of emacsclient"))
+ (unless current-frame
+ (server-with-environment env
+ '("LANG" "LC_CTYPE" "LC_ALL"
+ ;; For tgetent(3); list according to ncurses(3).
+ "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
+ "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
+ "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO"
+ "TERMINFO_DIRS" "TERMPATH")
+ (setq frame (make-frame-on-tty tty type
+ ;; Ignore nowait here; we always need to clean
+ ;; up opened ttys when the client dies.
+ `((client . ,proc)
+ (environment . ,env)))))
+ (select-frame frame)
+ (server-client-set client 'frame frame)
+ (server-client-set client 'tty (terminal-name frame))
+ (server-client-set client 'terminal (frame-terminal frame))
+
+ ;; Display *scratch* by default.
+ (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
+ (if dir (setq default-directory dir))
+
+ ;; Reply with our pid.
+ (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
+ (setq dontkill t))))
+
+ ;; -position LINE: Go to the given line in the next file.
+ ((and (equal "-position" arg) (string-match "\\(\\+[0-9]+\\) " request))
+ (setq lineno (string-to-number (substring (match-string 1 request) 1))
+ request (substring request (match-end 0))))
+
+ ;; -position LINE:COLUMN: Set point to the given position in the next file.
+ ((and (equal "-position" arg) (string-match "\\+\\([0-9]+\\):\\([0-9]+\\) " request))
+ (setq lineno (string-to-number (match-string 1 request))
+ columnno (string-to-number (match-string 2 request))
+ request (substring request (match-end 0))))
+
+ ;; -file FILENAME: Load the given file.
+ ((and (equal "-file" arg) (string-match "\\([^ ]+\\) " request))
+ (let ((file (server-unquote-arg (match-string 1 request))))
+ (setq request (substring request (match-end 0)))
+ (if coding-system
+ (setq file (decode-coding-string file coding-system)))
+ (setq file (command-line-normalize-file-name file))
+ (push (list file lineno columnno) files)
+ (server-log (format "New file: %s (%d:%d)" file lineno columnno) proc))
+ (setq lineno 1
+ columnno 0))
+
+ ;; -eval EXPR: Evaluate a Lisp expression.
+ ((and (equal "-eval" arg) (string-match "\\([^ ]+\\) " request))
+ (let ((expr (server-unquote-arg (match-string 1 request))))
+ (setq request (substring request (match-end 0)))
+ (if coding-system
+ (setq expr (decode-coding-string expr coding-system)))
+ (let ((v (eval (car (read-from-string expr)))))
+ (when (and (not frame) v)
+ (with-temp-buffer
+ (let ((standard-output (current-buffer)))
+ (pp v)
+ (server-send-string
+ proc (format "-print %s\n"
+ (server-quote-arg
+ (buffer-substring-no-properties (point-min)
+ (point-max)))))))))
+ (setq lineno 1
+ columnno 0)))
+
+ ;; -env NAME=VALUE: An environment variable.
+ ((and (equal "-env" arg) (string-match "\\([^ ]+\\) " request))
+ (let ((var (server-unquote-arg (match-string 1 request))))
+ ;; XXX Variables should be encoded as in getenv/setenv.
+ (setq request (substring request (match-end 0)))
+ (setq env (cons var env))))
+
+ ;; -dir DIRNAME: The cwd of the emacsclient process.
+ ((and (equal "-dir" arg) (string-match "\\([^ ]+\\) " request))
+ (setq dir (server-unquote-arg (match-string 1 request)))
+ (setq request (substring request (match-end 0)))
+ (if coding-system
+ (setq dir (decode-coding-string dir coding-system)))
+ (setq dir (command-line-normalize-file-name dir)))
+
+ ;; Unknown command.
+ (t (error "Unknown command: %s" arg)))))
+
+ (let (buffers)
+ (when files
+ (run-hooks 'pre-command-hook)
+ (setq buffers (server-visit-files files client nowait))
+ (run-hooks 'post-command-hook))
+
+ (when frame
+ (with-selected-frame frame
+ (display-startup-echo-area-message)
+ (unless inhibit-splash-screen
+ (condition-case err
+ ;; This looks scary because `fancy-splash-screens'
+ ;; will call `recursive-edit' from a process filter.
+ ;; However, that should be safe to do now.
- (display-splash-screen)
++ (display-splash-screen t)
+ ;; `recursive-edit' will throw an error if Emacs is
+ ;; already doing a recursive edit elsewhere. Catch it
+ ;; here so that we can finish normally.
+ (error nil)))))
+
+ ;; Delete the client if necessary.
+ (cond
+ (nowait
+ ;; Client requested nowait; return immediately.
+ (server-log "Close nowait client" proc)
+ (server-delete-client proc))
+ ((and (not dontkill) (null buffers))
+ ;; This client is empty; get rid of it immediately.
+ (server-log "Close empty client" proc)
+ (server-delete-client proc)))
+ (cond
+ ((or isearch-mode (minibufferp))
+ nil)
+ ((and frame (null buffers))
+ (message "%s" (substitute-command-keys
+ "When done with this frame, type \\[delete-frame]")))
+ ((not (null buffers))
+ (server-switch-buffer (car buffers))
+ (run-hooks 'server-switch-hook)
+ (unless nowait
+ (message "%s" (substitute-command-keys
+ "When done with a buffer, type \\[server-edit]"))))))))
+
+ ;; Save for later any partial line that remains.
+ (when (> (length string) 0)
+ (process-put proc 'previous-string string)))
+ ;; condition-case
+ (error (ignore-errors
+ (server-send-string
+ proc (concat "-error " (server-quote-arg (error-message-string err))))
+ (setq string "")
+ (server-log (error-message-string err) proc)
+ (delete-process proc)))))
(defun server-goto-line-column (file-line-col)
+ "Move point to the position indicated in FILE-LINE-COL.
+FILE-LINE-COL should be a three-element list as described in
+`server-visit-files'."
(goto-line (nth 1 file-line-col))
(let ((column-number (nth 2 file-line-col)))
(if (> column-number 0)
(custom-reevaluate-setting 'mouse-wheel-up-event)
(custom-reevaluate-setting 'file-name-shadow-mode)
(custom-reevaluate-setting 'send-mail-function)
+ (custom-reevaluate-setting 'focus-follows-mouse)
+ (normal-erase-is-backspace-setup-frame)
+
;; Register default TTY colors for the case the terminal hasn't a
- ;; terminal init file.
- (unless (memq window-system '(x w32 mac))
- ;; We do this regardles of whether the terminal supports colors
- ;; or not, since they can switch that support on or off in
- ;; mid-session by setting the tty-color-mode frame parameter.
- (tty-register-default-colors))
+ ;; terminal init file. We do this regardles of whether the terminal
+ ;; supports colors or not and regardless the current display type,
+ ;; since users can connect to color-capable terminals and also
+ ;; switch color support on or off in mid-session by setting the
+ ;; tty-color-mode frame parameter.
+ (tty-register-default-colors)
;; Record whether the tool-bar is present before the user and site
;; init files are processed. frame-notice-user-settings uses this
(setq splash-buffer (current-buffer))
(catch 'stop-splashing
(unwind-protect
- (let ((map (make-sparse-keymap))
- (cursor-type nil))
- (use-local-map map)
- (define-key map [switch-frame] 'ignore)
+ (let* ((map (make-sparse-keymap))
++ (cursor-type nil)
+ (overriding-local-map map)
+ ;; Catch if our frame is deleted; the delete-frame
+ ;; event is unreliable and is handled by
+ ;; `special-event-map' anyway.
+ (delete-frame-functions (cons 'fancy-splash-delete-frame
+ delete-frame-functions)))
(define-key map [t] 'fancy-splash-default-action)
(define-key map [mouse-movement] 'ignore)
(define-key map [mode-line t] 'ignore)
- (setq cursor-type nil
- display-hourglass nil
+ (define-key map [select-window] 'ignore)
+ (setq display-hourglass nil
minor-mode-map-alist nil
emulation-mode-map-alists nil
buffer-undo-list t
(setq display-hourglass old-hourglass
minor-mode-map-alist old-minor-mode-map-alist
emulation-mode-map-alists old-emulation-mode-map-alists)
- (kill-buffer splash-buffer)))))
+ (kill-buffer splash-buffer)
+ (when (frame-live-p frame)
+ (select-frame frame)
+ (switch-to-buffer fancy-splash-outer-buffer))))))
- ;; If hide-on-input is non-nil, don't hide the buffer on input.
+ ;; If hide-on-input is nil, don't hide the buffer on input.
(if (or (window-minibuffer-p)
(window-dedicated-p (selected-window)))
(pop-to-buffer (current-buffer))
(let (fancy-splash-outer-buffer)
(fancy-splash-head)
(dolist (text fancy-splash-text)
- (apply #'fancy-splash-insert text))
+ (apply #'fancy-splash-insert text)
+ (insert "\n"))
+ (skip-chars-backward "\n")
+ (delete-region (point) (point-max))
+ (insert "\n")
(fancy-splash-tail)
(set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (if (and view-read-only (not view-mode))
+ (view-mode-enter nil 'kill-buffer))
(goto-char (point-min)))))
+
(defun fancy-splash-frame ()
"Return the frame to use for the fancy splash screen.
Returning non-nil does not mean we should necessarily
of Emacs and modify it; type \\[describe-copying] to see the conditions.
Type \\[describe-distribution] for information on getting the latest version."))))
- ;; The rest of the startup screen is the same on all
- ;; kinds of terminals.
-
- ;; Give information on recovering, if there was a crash.
- (and auto-save-list-file-prefix
- ;; Don't signal an error if the
- ;; directory for auto-save-list files
- ;; does not yet exist.
- (file-directory-p (file-name-directory
- auto-save-list-file-prefix))
- (directory-files
- (file-name-directory auto-save-list-file-prefix)
- nil
- (concat "\\`"
- (regexp-quote (file-name-nondirectory
- auto-save-list-file-prefix)))
- t)
- (insert "\n\nIf an Emacs session crashed recently, "
- "type Meta-x recover-session RET\nto recover"
- " the files you were editing."))
+ ;; The rest of the startup screen is the same on all
+ ;; kinds of terminals.
+
+ ;; Give information on recovering, if there was a crash.
+ (and auto-save-list-file-prefix
+ ;; Don't signal an error if the
+ ;; directory for auto-save-list files
+ ;; does not yet exist.
+ (file-directory-p (file-name-directory
+ auto-save-list-file-prefix))
+ (directory-files
+ (file-name-directory auto-save-list-file-prefix)
+ nil
+ (concat "\\`"
+ (regexp-quote (file-name-nondirectory
+ auto-save-list-file-prefix)))
+ t)
+ (insert "\n\nIf an Emacs session crashed recently, "
- "type M-x recover-session RET\nto recover"
++ "type Meta-x recover-session RET\nto recover"
+ " the files you were editing."))
;; Display the input that we set up in the buffer.
(set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (if (and view-read-only (not view-mode))
+ (view-mode-enter nil 'kill-buffer))
(goto-char (point-min))
- (if (or (window-minibuffer-p)
- (window-dedicated-p (selected-window)))
- ;; If hide-on-input is nil, creating a new frame will
- ;; generate enough events that the subsequent `sit-for'
- ;; will immediately return anyway.
- (pop-to-buffer (current-buffer))
- (if hide-on-input
- (if hide-on-input
- (if (or (window-minibuffer-p)
- (window-dedicated-p (selected-window)))
- ;; If hide-on-input is nil, creating a new frame will
- ;; generate enough events that the subsequent `sit-for'
- ;; will immediately return anyway.
- nil ;; (pop-to-buffer (current-buffer))
++ (if hide-on-input
++ (if (or (window-minibuffer-p)
++ (window-dedicated-p (selected-window)))
++ ;; If hide-on-input is nil, creating a new frame will
++ ;; generate enough events that the subsequent `sit-for'
++ ;; will immediately return anyway.
++ nil ;; (pop-to-buffer (current-buffer))
(save-window-excursion
- (switch-to-buffer (current-buffer))
- (sit-for 120)))
- (condition-case nil
- (switch-to-buffer (current-buffer))
- ;; In case the window is dedicated or something.
- (error (pop-to-buffer (current-buffer))))))
+ (switch-to-buffer (current-buffer))
+ (sit-for 120))
- (switch-to-buffer (current-buffer)))))
++ (condition-case nil
++ (switch-to-buffer (current-buffer))))))
;; Unwind ... ensure splash buffer is killed
(if hide-on-input
- (kill-buffer "GNU Emacs")))))
+ (kill-buffer "GNU Emacs")
+ (switch-to-buffer "GNU Emacs")
+ (rename-buffer "*About GNU Emacs*" t)))))
(defun startup-echo-area-message ()
(defun display-splash-screen (&optional hide-on-input)
"Display splash screen according to display.
Fancy splash screens are used on graphic displays,
- normal otherwise."
- (interactive)
+ normal otherwise.
+ With a prefix argument, any user input hides the splash screen."
+ (interactive "P")
- (if (use-fancy-splash-screens-p)
- (fancy-splash-screens hide-on-input)
- (normal-splash-screen hide-on-input)))
-
+ ;; Prevent recursive calls from server-process-filter.
+ (if (not (get-buffer "GNU Emacs"))
+ (if (use-fancy-splash-screens-p)
+ (fancy-splash-screens hide-on-input)
+ (normal-splash-screen hide-on-input))))
(defun command-line-1 (command-line-args-left)
- (or noninteractive (input-pending-p) init-file-had-error
- ;; t if the init file says to inhibit the echo area startup message.
- (and inhibit-startup-echo-area-message
- user-init-file
- (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
- (equal inhibit-startup-echo-area-message
- (if (equal init-file-user "")
- (user-login-name)
- init-file-user)))
- ;; Wasn't set with custom; see if .emacs has a setq.
- (let ((buffer (get-buffer-create " *temp*")))
- (prog1
- (condition-case nil
- (save-excursion
- (set-buffer buffer)
- (insert-file-contents user-init-file)
- (re-search-forward
- (concat
- "([ \t\n]*setq[ \t\n]+"
- "inhibit-startup-echo-area-message[ \t\n]+"
- (regexp-quote
- (prin1-to-string
- (if (equal init-file-user "")
- (user-login-name)
- init-file-user)))
- "[ \t\n]*)")
- nil t))
- (error nil))
- (kill-buffer buffer)))))
- ;; display-splash-screen at the end of command-line-1 calls
- ;; use-fancy-splash-screens-p. This can cause image.el to be
- ;; loaded, putting "Loading image... done" in the echo area.
- ;; This hides startup-echo-area-message. So
- ;; use-fancy-splash-screens-p is called here simply to get the
- ;; loading of image.el (if needed) out of the way before
- ;; display-startup-echo-area-message runs.
- (progn
- (use-fancy-splash-screens-p)
- (display-startup-echo-area-message)))
+ (display-startup-echo-area-message)
;; Delay 2 seconds after an init file error message
;; was displayed, so user can read it.
(or clip-text primary-text cut-text)
))
-\f
-;; Do the actual X Windows setup here; the above code just defines
-;; functions and variables that we use now.
-
-(setq command-line-args (x-handle-args command-line-args))
-
-;; Make sure we have a valid resource name.
-(or (stringp x-resource-name)
- (let (i)
- (setq x-resource-name (invocation-name))
-
- ;; Change any . or * characters in x-resource-name to hyphens,
- ;; so as not to choke when we use it in X resource queries.
- (while (setq i (string-match "[.*]" x-resource-name))
- (aset x-resource-name i ?-))))
-
-(x-open-connection (or x-display-name
- (setq x-display-name (getenv "DISPLAY")))
- x-command-line-resources
- ;; Exit Emacs with fatal error if this fails.
- t)
-
-(setq frame-creation-function 'x-create-frame-with-faces)
-
-(setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100)
- x-cut-buffer-max))
-
-;; Setup the default fontset.
-(setup-default-fontset)
-
-;; Create the standard fontset.
-(create-fontset-from-fontset-spec standard-fontset-spec t)
-
-;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
-(create-fontset-from-x-resource)
-
-;; Try to create a fontset from a font specification which comes
-;; from initial-frame-alist, default-frame-alist, or X resource.
-;; A font specification in command line argument (i.e. -fn XXXX)
-;; should be already in default-frame-alist as a `font'
-;; parameter. However, any font specifications in site-start
-;; library, user's init file (.emacs), and default.el are not
-;; yet handled here.
-
-(let ((font (or (cdr (assq 'font initial-frame-alist))
- (cdr (assq 'font default-frame-alist))
- (x-get-resource "font" "Font")))
- xlfd-fields resolved-name)
- (if (and font
- (not (query-fontset font))
- (setq resolved-name (x-resolve-font-name font))
- (setq xlfd-fields (x-decompose-font-name font)))
- (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum))
- (new-fontset font (x-complement-fontset-spec xlfd-fields nil))
- ;; Create a fontset from FONT. The fontset name is
- ;; generated from FONT.
- (create-fontset-from-ascii-font font resolved-name "startup"))))
-
-;; Apply a geometry resource to the initial frame. Put it at the end
-;; of the alist, so that anything specified on the command line takes
-;; precedence.
-(let* ((res-geometry (x-get-resource "geometry" "Geometry"))
- parsed)
- (if res-geometry
- (progn
- (setq parsed (x-parse-geometry res-geometry))
- ;; If the resource specifies a position,
- ;; call the position and size "user-specified".
- (if (or (assq 'top parsed) (assq 'left parsed))
- (setq parsed (cons '(user-position . t)
- (cons '(user-size . t) parsed))))
- ;; All geometry parms apply to the initial frame.
- (setq initial-frame-alist (append initial-frame-alist parsed))
- ;; The size parms apply to all frames.
- (if (assq 'height parsed)
- (setq default-frame-alist
- (cons (cons 'height (cdr (assq 'height parsed)))
- default-frame-alist)))
- (if (assq 'width parsed)
- (setq default-frame-alist
- (cons (cons 'width (cdr (assq 'width parsed)))
- default-frame-alist))))))
-
-;; Check the reverseVideo resource.
-(let ((case-fold-search t))
- (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
- (if (and rv
- (string-match "^\\(true\\|yes\\|on\\)$" rv))
- (setq default-frame-alist
- (cons '(reverse . t) default-frame-alist)))))
+(defun x-clipboard-yank ()
+ "Insert the clipboard contents, or the last stretch of killed text."
+ (interactive "*")
+ (let ((clipboard-text (x-selection-value 'CLIPBOARD))
+ (x-select-enable-clipboard t))
+ (if (and clipboard-text (> (length clipboard-text) 0))
+ (kill-new clipboard-text))
+ (yank)))
+
++(defun x-menu-bar-open (&optional frame)
++ "Open the menu bar if `menu-bar-mode' is on. otherwise call `tmm-menubar'."
++ (interactive "i")
++ (if menu-bar-mode (menu-bar-open frame)
++ (tmm-menubar)))
+
-;; Set x-selection-timeout, measured in milliseconds.
-(let ((res-selection-timeout
- (x-get-resource "selectionTimeout" "SelectionTimeout")))
- (setq x-selection-timeout 20000)
- (if res-selection-timeout
- (setq x-selection-timeout (string-to-number res-selection-timeout))))
+\f
+;;; Window system initialization.
(defun x-win-suspend-error ()
(error "Suspending an Emacs running under X makes no sense"))
;;; Code:
-
+(defvar xterm-function-map (make-sparse-keymap)
+ "Function key map overrides for xterm.")
+
+;; xterm from X.org 6.8.2 uses these key definitions.
+(define-key xterm-function-map "\eOP" [f1])
+(define-key xterm-function-map "\eOQ" [f2])
+(define-key xterm-function-map "\eOR" [f3])
+(define-key xterm-function-map "\eOS" [f4])
+(define-key xterm-function-map "\e[15~" [f5])
+(define-key xterm-function-map "\e[17~" [f6])
+(define-key xterm-function-map "\e[18~" [f7])
+(define-key xterm-function-map "\e[19~" [f8])
+(define-key xterm-function-map "\e[20~" [f9])
+(define-key xterm-function-map "\e[21~" [f10])
+(define-key xterm-function-map "\e[23~" [f11])
+(define-key xterm-function-map "\e[24~" [f12])
+
+(define-key xterm-function-map "\eO2P" [S-f1])
+(define-key xterm-function-map "\eO2Q" [S-f2])
+(define-key xterm-function-map "\eO2R" [S-f3])
+(define-key xterm-function-map "\eO2S" [S-f4])
+(define-key xterm-function-map "\e[15;2~" [S-f5])
+(define-key xterm-function-map "\e[17;2~" [S-f6])
+(define-key xterm-function-map "\e[18;2~" [S-f7])
+(define-key xterm-function-map "\e[19;2~" [S-f8])
+(define-key xterm-function-map "\e[20;2~" [S-f9])
+(define-key xterm-function-map "\e[21;2~" [S-f10])
+(define-key xterm-function-map "\e[23;2~" [S-f11])
+(define-key xterm-function-map "\e[24;2~" [S-f12])
+
+(define-key xterm-function-map "\eO5P" [C-f1])
+(define-key xterm-function-map "\eO5Q" [C-f2])
+(define-key xterm-function-map "\eO5R" [C-f3])
+(define-key xterm-function-map "\eO5S" [C-f4])
+(define-key xterm-function-map "\e[15;5~" [C-f5])
+(define-key xterm-function-map "\e[17;5~" [C-f6])
+(define-key xterm-function-map "\e[18;5~" [C-f7])
+(define-key xterm-function-map "\e[19;5~" [C-f8])
+(define-key xterm-function-map "\e[20;5~" [C-f9])
+(define-key xterm-function-map "\e[21;5~" [C-f10])
+(define-key xterm-function-map "\e[23;5~" [C-f11])
+(define-key xterm-function-map "\e[24;5~" [C-f12])
+
+(define-key xterm-function-map "\eO6P" [C-S-f1])
+(define-key xterm-function-map "\eO6Q" [C-S-f2])
+(define-key xterm-function-map "\eO6R" [C-S-f3])
+(define-key xterm-function-map "\eO6S" [C-S-f4])
+(define-key xterm-function-map "\e[15;6~" [C-S-f5])
+(define-key xterm-function-map "\e[17;6~" [C-S-f6])
+(define-key xterm-function-map "\e[18;6~" [C-S-f7])
+(define-key xterm-function-map "\e[19;6~" [C-S-f8])
+(define-key xterm-function-map "\e[20;6~" [C-S-f9])
+(define-key xterm-function-map "\e[21;6~" [C-S-f10])
+(define-key xterm-function-map "\e[23;6~" [C-S-f11])
+(define-key xterm-function-map "\e[24;6~" [C-S-f12])
+
+(define-key xterm-function-map "\eO3P" [A-f1])
+(define-key xterm-function-map "\eO3Q" [A-f2])
+(define-key xterm-function-map "\eO3R" [A-f3])
+(define-key xterm-function-map "\eO3S" [A-f4])
+(define-key xterm-function-map "\e[15;3~" [A-f5])
+(define-key xterm-function-map "\e[17;3~" [A-f6])
+(define-key xterm-function-map "\e[18;3~" [A-f7])
+(define-key xterm-function-map "\e[19;3~" [A-f8])
+(define-key xterm-function-map "\e[20;3~" [A-f9])
+(define-key xterm-function-map "\e[21;3~" [A-f10])
+(define-key xterm-function-map "\e[23;3~" [A-f11])
+(define-key xterm-function-map "\e[24;3~" [A-f12])
+
+(define-key xterm-function-map "\eOA" [up])
+(define-key xterm-function-map "\eOB" [down])
+(define-key xterm-function-map "\eOC" [right])
+(define-key xterm-function-map "\eOD" [left])
+(define-key xterm-function-map "\eOF" [end])
+(define-key xterm-function-map "\eOH" [home])
+
+(define-key xterm-function-map "\e[1;2A" [S-up])
+(define-key xterm-function-map "\e[1;2B" [S-down])
+(define-key xterm-function-map "\e[1;2C" [S-right])
+(define-key xterm-function-map "\e[1;2D" [S-left])
+(define-key xterm-function-map "\e[1;2F" [S-end])
+(define-key xterm-function-map "\e[1;2H" [S-home])
+
+(define-key xterm-function-map "\e[1;5A" [C-up])
+(define-key xterm-function-map "\e[1;5B" [C-down])
+(define-key xterm-function-map "\e[1;5C" [C-right])
+(define-key xterm-function-map "\e[1;5D" [C-left])
+(define-key xterm-function-map "\e[1;5F" [C-end])
+(define-key xterm-function-map "\e[1;5H" [C-home])
+
+(define-key xterm-function-map "\e[1;6A" [C-S-up])
+(define-key xterm-function-map "\e[1;6B" [C-S-down])
+(define-key xterm-function-map "\e[1;6C" [C-S-right])
+(define-key xterm-function-map "\e[1;6D" [C-S-left])
+(define-key xterm-function-map "\e[1;6F" [C-S-end])
+(define-key xterm-function-map "\e[1;6H" [C-S-home])
+
+(define-key xterm-function-map "\e[1;3A" [A-up])
+(define-key xterm-function-map "\e[1;3B" [A-down])
+(define-key xterm-function-map "\e[1;3C" [A-right])
+(define-key xterm-function-map "\e[1;3D" [A-left])
+(define-key xterm-function-map "\e[1;3F" [A-end])
+(define-key xterm-function-map "\e[1;3H" [A-home])
+
+(define-key xterm-function-map "\e[2~" [insert])
+(define-key xterm-function-map "\e[3~" [delete])
+(define-key xterm-function-map "\e[5~" [prior])
+(define-key xterm-function-map "\e[6~" [next])
+
+(define-key xterm-function-map "\e[2;2~" [S-insert])
+(define-key xterm-function-map "\e[3;2~" [S-delete])
+(define-key xterm-function-map "\e[5;2~" [S-prior])
+(define-key xterm-function-map "\e[6;2~" [S-next])
+
+(define-key xterm-function-map "\e[2;5~" [C-insert])
+(define-key xterm-function-map "\e[3;5~" [C-delete])
+(define-key xterm-function-map "\e[5;5~" [C-prior])
+(define-key xterm-function-map "\e[6;5~" [C-next])
+
+(define-key xterm-function-map "\e[2;6~" [C-S-insert])
+(define-key xterm-function-map "\e[3;6~" [C-S-delete])
+(define-key xterm-function-map "\e[5;6~" [C-S-prior])
+(define-key xterm-function-map "\e[6;6~" [C-S-next])
+
+(define-key xterm-function-map "\e[2;3~" [A-insert])
+(define-key xterm-function-map "\e[3;3~" [A-delete])
+(define-key xterm-function-map "\e[5;3~" [A-prior])
+(define-key xterm-function-map "\e[6;3~" [A-next])
+
+(define-key xterm-function-map "\e[4~" [select])
+(define-key xterm-function-map "\e[29~" [print])
+
+;; These keys are available in xterm starting from version 216
+;; if the modifyOtherKeys resource is set to 1.
+
++(define-key xterm-function-map "\e[27;5;9~" [C-tab])
++(define-key xterm-function-map "\e[27;5;13~" [C-return])
+(define-key xterm-function-map "\e[27;5;39~" [?\C-\'])
++(define-key xterm-function-map "\e[27;5;44~" [?\C-,])
+(define-key xterm-function-map "\e[27;5;45~" [?\C--])
-
- (define-key xterm-function-map "\e[27;5;59~" [?\C-\;])
++(define-key xterm-function-map "\e[27;5;46~" [?\C-.])
++(define-key xterm-function-map "\e[27;5;47~" [?\C-/])
+(define-key xterm-function-map "\e[27;5;48~" [?\C-0])
+(define-key xterm-function-map "\e[27;5;49~" [?\C-1])
+;; Not all C-DIGIT keys have a distinct binding.
+(define-key xterm-function-map "\e[27;5;57~" [?\C-9])
-
++(define-key xterm-function-map "\e[27;5;59~" [(C-\;)])
+(define-key xterm-function-map "\e[27;5;61~" [?\C-=])
-
++(define-key xterm-function-map "\e[27;5;92~" [?\C-\\])
+
+(define-key xterm-function-map "\e[27;6;33~" [?\C-!])
+(define-key xterm-function-map "\e[27;6;34~" [?\C-\"])
+(define-key xterm-function-map "\e[27;6;35~" [?\C-#])
+(define-key xterm-function-map "\e[27;6;36~" [?\C-$])
+(define-key xterm-function-map "\e[27;6;37~" [?\C-%])
+(define-key xterm-function-map "\e[27;6;38~" [(C-&)])
+(define-key xterm-function-map "\e[27;6;40~" [?\C-(])
+(define-key xterm-function-map "\e[27;6;41~" [?\C-)])
+(define-key xterm-function-map "\e[27;6;42~" [?\C-*])
+(define-key xterm-function-map "\e[27;6;43~" [?\C-+])
- (define-key xterm-function-map "\e[27;5;9~" [C-tab])
- (define-key xterm-function-map "\e[27;5;13~" [C-return])
- (define-key xterm-function-map "\e[27;5;44~" [?\C-,])
- (define-key xterm-function-map "\e[27;5;46~" [?\C-.])
- (define-key xterm-function-map "\e[27;5;47~" [?\C-/])
- (define-key xterm-function-map "\e[27;5;92~" [?\C-\\])
-
- (define-key xterm-function-map "\e[27;2;9~" [S-tab])
- (define-key xterm-function-map "\e[27;2;13~" [S-return])
-
- (define-key xterm-function-map "\e[27;6;9~" [(C-S-tab)])
+(define-key xterm-function-map "\e[27;6;58~" [?\C-:])
+(define-key xterm-function-map "\e[27;6;60~" [?\C-<])
+(define-key xterm-function-map "\e[27;6;62~" [?\C->])
+(define-key xterm-function-map "\e[27;6;63~" [(C-\?)])
+
-
++;; These are the strings emitted for various C-M- combinations
++;; for keyboards that the Meta and Alt modifiers are on the same
++;; key (usually labeled "Alt").
++(define-key xterm-function-map "\e[27;13;9~" [(C-M-tab)])
++(define-key xterm-function-map "\e[27;13;13~" [(C-M-return)])
+
++(define-key xterm-function-map "\e[27;13;39~" [?\C-\M-\'])
++(define-key xterm-function-map "\e[27;13;44~" [?\C-\M-,])
++(define-key xterm-function-map "\e[27;13;45~" [?\C-\M--])
+(define-key xterm-function-map "\e[27;13;46~" [?\C-\M-.])
++(define-key xterm-function-map "\e[27;13;47~" [?\C-\M-/])
++(define-key xterm-function-map "\e[27;13;48~" [?\C-\M-0])
++(define-key xterm-function-map "\e[27;13;49~" [?\C-\M-1])
++(define-key xterm-function-map "\e[27;13;50~" [?\C-\M-2])
++(define-key xterm-function-map "\e[27;13;51~" [?\C-\M-3])
++(define-key xterm-function-map "\e[27;13;52~" [?\C-\M-4])
++(define-key xterm-function-map "\e[27;13;53~" [?\C-\M-5])
++(define-key xterm-function-map "\e[27;13;54~" [?\C-\M-6])
++(define-key xterm-function-map "\e[27;13;55~" [?\C-\M-7])
++(define-key xterm-function-map "\e[27;13;56~" [?\C-\M-8])
++(define-key xterm-function-map "\e[27;13;57~" [?\C-\M-9])
++(define-key xterm-function-map "\e[27;13;59~" [?\C-\M-\;])
++(define-key xterm-function-map "\e[27;13;61~" [?\C-\M-=])
++(define-key xterm-function-map "\e[27;13;92~" [?\C-\M-\\])
++
++(define-key xterm-function-map "\e[27;14;33~" [?\C-\M-!])
++(define-key xterm-function-map "\e[27;14;34~" [?\C-\M-\"])
++(define-key xterm-function-map "\e[27;14;35~" [?\C-\M-#])
++(define-key xterm-function-map "\e[27;14;36~" [?\C-\M-$])
++(define-key xterm-function-map "\e[27;14;37~" [?\C-\M-%])
++(define-key xterm-function-map "\e[27;14;38~" [(C-M-&)])
++(define-key xterm-function-map "\e[27;14;40~" [?\C-\M-(])
++(define-key xterm-function-map "\e[27;14;41~" [?\C-\M-)])
++(define-key xterm-function-map "\e[27;14;42~" [?\C-\M-*])
++(define-key xterm-function-map "\e[27;14;43~" [?\C-\M-+])
++(define-key xterm-function-map "\e[27;14;58~" [?\C-\M-:])
++(define-key xterm-function-map "\e[27;14;60~" [?\C-\M-<])
++(define-key xterm-function-map "\e[27;14;62~" [?\C-\M->])
++(define-key xterm-function-map "\e[27;14;63~" [(C-M-\?)])
++
++(define-key xterm-function-map "\e[27;7;9~" [(C-M-tab)])
++(define-key xterm-function-map "\e[27;7;13~" [(C-M-return)])
++
++(define-key xterm-function-map "\e[27;7;39~" [?\C-\M-\'])
++(define-key xterm-function-map "\e[27;7;44~" [?\C-\M-,])
++(define-key xterm-function-map "\e[27;7;45~" [?\C-\M--])
++(define-key xterm-function-map "\e[27;7;46~" [?\C-\M-.])
++(define-key xterm-function-map "\e[27;7;47~" [?\C-\M-/])
++(define-key xterm-function-map "\e[27;7;48~" [?\C-\M-0])
++(define-key xterm-function-map "\e[27;7;49~" [?\C-\M-1])
++(define-key xterm-function-map "\e[27;7;50~" [?\C-\M-2])
++(define-key xterm-function-map "\e[27;7;51~" [?\C-\M-3])
++(define-key xterm-function-map "\e[27;7;52~" [?\C-\M-4])
++(define-key xterm-function-map "\e[27;7;53~" [?\C-\M-5])
++(define-key xterm-function-map "\e[27;7;54~" [?\C-\M-6])
++(define-key xterm-function-map "\e[27;7;55~" [?\C-\M-7])
++(define-key xterm-function-map "\e[27;7;56~" [?\C-\M-8])
++(define-key xterm-function-map "\e[27;7;57~" [?\C-\M-9])
++(define-key xterm-function-map "\e[27;7;59~" [?\C-\M-\;])
++(define-key xterm-function-map "\e[27;7;61~" [?\C-\M-=])
++(define-key xterm-function-map "\e[27;7;92~" [?\C-\M-\\])
++
++(define-key xterm-function-map "\e[27;8;33~" [?\C-\M-!])
++(define-key xterm-function-map "\e[27;8;34~" [?\C-\M-\"])
++(define-key xterm-function-map "\e[27;8;35~" [?\C-\M-#])
++(define-key xterm-function-map "\e[27;8;36~" [?\C-\M-$])
++(define-key xterm-function-map "\e[27;8;37~" [?\C-\M-%])
++(define-key xterm-function-map "\e[27;8;38~" [(C-M-&)])
++(define-key xterm-function-map "\e[27;8;40~" [?\C-\M-(])
++(define-key xterm-function-map "\e[27;8;41~" [?\C-\M-)])
++(define-key xterm-function-map "\e[27;8;42~" [?\C-\M-*])
++(define-key xterm-function-map "\e[27;8;43~" [?\C-\M-+])
++(define-key xterm-function-map "\e[27;8;58~" [?\C-\M-:])
++(define-key xterm-function-map "\e[27;8;60~" [?\C-\M-<])
++(define-key xterm-function-map "\e[27;8;62~" [?\C-\M->])
++(define-key xterm-function-map "\e[27;8;63~" [(C-M-\?)])
++
++(define-key xterm-function-map "\e[27;2;9~" [S-tab])
++(define-key xterm-function-map "\e[27;2;13~" [S-return])
++
++(define-key xterm-function-map "\e[27;6;9~" [(C-S-tab)])
++(define-key xterm-function-map "\e[27;6;13~" [(C-S-return)])
+
+;; Other versions of xterm might emit these.
+(define-key xterm-function-map "\e[A" [up])
+(define-key xterm-function-map "\e[B" [down])
+(define-key xterm-function-map "\e[C" [right])
+(define-key xterm-function-map "\e[D" [left])
+(define-key xterm-function-map "\e[1~" [home])
+
+(define-key xterm-function-map "\e[1;2A" [S-up])
+(define-key xterm-function-map "\e[1;2B" [S-down])
+(define-key xterm-function-map "\e[1;2C" [S-right])
+(define-key xterm-function-map "\e[1;2D" [S-left])
+(define-key xterm-function-map "\e[1;2F" [S-end])
+(define-key xterm-function-map "\e[1;2H" [S-home])
+
+(define-key xterm-function-map "\e[1;5A" [C-up])
+(define-key xterm-function-map "\e[1;5B" [C-down])
+(define-key xterm-function-map "\e[1;5C" [C-right])
+(define-key xterm-function-map "\e[1;5D" [C-left])
+(define-key xterm-function-map "\e[1;5F" [C-end])
+(define-key xterm-function-map "\e[1;5H" [C-home])
+
+(define-key xterm-function-map "\e[11~" [f1])
+(define-key xterm-function-map "\e[12~" [f2])
+(define-key xterm-function-map "\e[13~" [f3])
+(define-key xterm-function-map "\e[14~" [f4])
+
(defun terminal-init-xterm ()
"Terminal initialization function for xterm."
;; rxvt terminals sometimes set the TERM variable to "xterm", but
dispextern.h atimer.h systime.h region-cache.h $(config_h)
keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h charset.h \
commands.h frame.h window.h macros.h disptab.h keyboard.h syssignal.h \
- systty.h systime.h dispextern.h syntax.h $(INTERVAL_SRC) blockinput.h \
+ systime.h dispextern.h syntax.h $(INTERVAL_SRC) blockinput.h \
atimer.h xterm.h puresize.h msdos.h keymap.h w32term.h macterm.h $(config_h)
keymap.o: keymap.c buffer.h commands.h keyboard.h termhooks.h blockinput.h \
- atimer.h systime.h puresize.h charset.h intervals.h $(config_h)
+ atimer.h systime.h puresize.h charset.h intervals.h keymap.h window.h \
+ $(config_h)
lastfile.o: lastfile.c $(config_h)
macros.o: macros.c window.h buffer.h commands.h macros.h keyboard.h \
dispextern.h $(config_h)
Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth;
+ Lisp_Object Qinhibit_face_set_after_frame_default;
Lisp_Object Qface_set_after_frame_default;
-
Lisp_Object Vterminal_frame;
Lisp_Object Vdefault_frame_alist;
Lisp_Object Vdefault_frame_scroll_bars;
if (NATNUMP (param_index)
&& (XFASTINT (param_index)
< sizeof (frame_parms)/sizeof (frame_parms[0]))
- && rif->frame_parm_handlers[XINT (param_index)])
- (*(rif->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
-
+ && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
+ (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
+ unbind_to (count, Qnil);
}
}
}
}
}
- DEFUN ("x-menu-bar-open", Fx_menu_bar_open, Sx_menu_bar_open, 0, 1, "i",
-DEFUN ("menu-bar-open", Fmenu_bar_open, Smenu_bar_open, 0, 1, "i",
++DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_internal, 0, 1, "i",
doc: /* Start key navigation of the menu bar in FRAME.
This initially opens the first menu bar item and you can then navigate with the
arrow keys, select a menu entry with the return key or cancel with the
#ifdef USE_GTK
- DEFUN ("x-menu-bar-open", Fx_menu_bar_open, Sx_menu_bar_open, 0, 1, "i",
-DEFUN ("menu-bar-open", Fmenu_bar_open, Smenu_bar_open, 0, 1, "i",
++DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_internal, 0, 1, "i",
doc: /* Start key navigation of the menu bar in FRAME.
This initially opens the first menu bar item and you can then navigate with the
arrow keys, select a menu entry with the return key or cancel with the
defsubr (&Sx_popup_menu);
#if defined (USE_GTK) || defined (USE_X_TOOLKIT)
- defsubr (&Sx_menu_bar_open);
- Fdefalias (intern ("accelerate-menu"),
- intern (Sx_menu_bar_open.symbol_name),
- Qnil);
- defsubr (&Smenu_bar_open);
- Ffset (intern ("accelerate-menu"), intern (Smenu_bar_open.symbol_name));
++ defsubr (&Sx_menu_bar_open_internal);
++ Ffset (intern ("accelerate-menu"),
++ intern (Sx_menu_bar_open_internal.symbol_name));
#endif
#ifdef HAVE_MENUS
extern frame_parm_handler x_frame_parm_handlers[];
static struct redisplay_interface x_redisplay_interface =
-{
- x_frame_parm_handlers,
- x_produce_glyphs,
- x_write_glyphs,
- x_insert_glyphs,
- x_clear_end_of_line,
- x_scroll_run,
- x_after_update_window_line,
- x_update_window_begin,
- x_update_window_end,
- x_cursor_to,
- x_flush,
+ {
+ x_frame_parm_handlers,
+ x_produce_glyphs,
+ x_write_glyphs,
+ x_insert_glyphs,
+ x_clear_end_of_line,
+ x_scroll_run,
+ x_after_update_window_line,
+ x_update_window_begin,
+ x_update_window_end,
+ x_cursor_to,
+ x_flush,
#ifdef XFlush
- x_flush,
+ x_flush,
#else
- 0, /* flush_display_optional */
-#endif
- x_clear_window_mouse_face,
- x_get_glyph_overhangs,
- x_fix_overlapping_area,
- x_draw_fringe_bitmap,
- 0, /* define_fringe_bitmap */
- 0, /* destroy_fringe_bitmap */
- x_per_char_metric,
- x_encode_char,
- x_compute_glyph_string_overhangs,
- x_draw_glyph_string,
- x_define_frame_cursor,
- x_clear_frame_area,
- x_draw_window_cursor,
- x_draw_vertical_window_border,
- x_shift_glyphs_for_insert
-};
+ 0, /* flush_display_optional */
+#endif
+ x_clear_window_mouse_face,
+ x_get_glyph_overhangs,
+ x_fix_overlapping_area,
+ x_draw_fringe_bitmap,
+ 0, /* define_fringe_bitmap */
+ 0, /* destroy_fringe_bitmap */
+ x_per_char_metric,
+ x_encode_char,
+ x_compute_glyph_string_overhangs,
+ x_draw_glyph_string,
+ x_define_frame_cursor,
+ x_clear_frame_area,
+ x_draw_window_cursor,
+ x_draw_vertical_window_border,
+ x_shift_glyphs_for_insert
+ };
+
+
+/* This function is called when the last frame on a display is deleted. */
+void
+x_delete_terminal (struct terminal *terminal)
+{
+ struct x_display_info *dpyinfo = terminal->display_info.x;
+ int i;
+
+ /* Protect against recursive calls. Fdelete_frame in
+ delete_terminal calls us back when it deletes our last frame. */
+ if (terminal->deleted)
+ return;
+
+ BLOCK_INPUT;
+ /* Free the fonts in the font table. */
+ for (i = 0; i < dpyinfo->n_fonts; i++)
+ if (dpyinfo->font_table[i].name)
+ {
+ XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
+ }
+
+ x_destroy_all_bitmaps (dpyinfo);
+ XSetCloseDownMode (dpyinfo->display, DestroyAll);
+
- #ifdef USE_X_TOOLKIT
- XtCloseDisplay (dpyinfo->display);
- #else
+#ifdef USE_GTK
+ xg_display_close (dpyinfo->display);
++#else
++#ifdef USE_X_TOOLKIT
++ XtCloseDisplay (dpyinfo->display);
+#else
+ XCloseDisplay (dpyinfo->display);
+#endif
- #endif
++#endif /* ! USE_GTK */
+
+ x_delete_display (dpyinfo);
+ UNBLOCK_INPUT;
+}
+
+
+static struct terminal *
+x_create_terminal (struct x_display_info *dpyinfo)
+{
+ struct terminal *terminal;
+
+ terminal = create_terminal ();
+
+ terminal->type = output_x_window;
+ terminal->display_info.x = dpyinfo;
+ dpyinfo->terminal = terminal;
+
+ /* kboard is initialized in x_term_init. */
+
+ terminal->clear_frame_hook = x_clear_frame;
+ terminal->ins_del_lines_hook = x_ins_del_lines;
+ terminal->delete_glyphs_hook = x_delete_glyphs;
+ terminal->ring_bell_hook = XTring_bell;
+ terminal->reset_terminal_modes_hook = XTreset_terminal_modes;
+ terminal->set_terminal_modes_hook = XTset_terminal_modes;
+ terminal->update_begin_hook = x_update_begin;
+ terminal->update_end_hook = x_update_end;
+ terminal->set_terminal_window_hook = XTset_terminal_window;
+ terminal->read_socket_hook = XTread_socket;
+ terminal->frame_up_to_date_hook = XTframe_up_to_date;
+ terminal->mouse_position_hook = XTmouse_position;
+ terminal->frame_rehighlight_hook = XTframe_rehighlight;
+ terminal->frame_raise_lower_hook = XTframe_raise_lower;
+ terminal->set_vertical_scroll_bar_hook = XTset_vertical_scroll_bar;
+ terminal->condemn_scroll_bars_hook = XTcondemn_scroll_bars;
+ terminal->redeem_scroll_bar_hook = XTredeem_scroll_bar;
+ terminal->judge_scroll_bars_hook = XTjudge_scroll_bars;
+
+ terminal->delete_frame_hook = x_destroy_window;
+ terminal->delete_terminal_hook = x_delete_terminal;
+
+ terminal->rif = &x_redisplay_interface;
+ terminal->scroll_region_ok = 1; /* We'll scroll partial frames. */
+ terminal->char_ins_del_ok = 1;
+ terminal->line_ins_del_ok = 1; /* We'll just blt 'em. */
+ terminal->fast_clear_end_of_line = 1; /* X does this well. */
+ terminal->memory_below_frame = 0; /* We don't remember what scrolls
+ off the bottom. */
+
+ return terminal;
+}
void
x_initialize ()
HCoop / bpt / emacs.git / commitdiff