;;; simple.el --- basic editing commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2014 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
"Parent major mode from which special major modes should inherit."
(setq buffer-read-only t))
-;; Major mode meant to be the parent of programming modes.
-
-(defvar prog-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [?\C-\M-q] 'prog-indent-sexp)
- map)
- "Keymap used for programming modes.")
-
-(defun prog-indent-sexp (&optional defun)
- "Indent the expression after point.
-When interactively called with prefix, indent the enclosing defun
-instead."
- (interactive "P")
- (save-excursion
- (when defun
- (end-of-line)
- (beginning-of-defun))
- (let ((start (point))
- (end (progn (forward-sexp 1) (point))))
- (indent-region start end nil))))
-
-(define-derived-mode prog-mode fundamental-mode "Prog"
- "Major mode for editing programming language source code."
- (set (make-local-variable 'require-final-newline) mode-require-final-newline)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- ;; Any programming language is always written left to right.
- (setq bidi-paragraph-direction 'left-to-right))
-
;; Making and deleting lines.
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
"Propertized string representing a hard newline character.")
-(defun newline (&optional arg)
+(defun newline (&optional arg interactive)
"Insert a newline, and move to left margin of the new line if it's blank.
If option `use-hard-newlines' is non-nil, the newline is marked with the
text-property `hard'.
With ARG, insert that many newlines.
-Call `auto-fill-function' if the current column number is greater
-than the value of `fill-column' and ARG is nil."
- (interactive "*P")
+
+To turn off indentation by this command, disable Electric Indent mode
+\(see \\[electric-indent-mode]).
+
+Calls `auto-fill-function' if the current column number is greater
+than the value of `fill-column' and ARG is nil.
+A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
+ (interactive "*P\np")
(barf-if-buffer-read-only)
;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
;; Set last-command-event to tell self-insert what to insert.
;; starts a page.
(or was-page-start
(move-to-left-margin nil t)))))
- (unwind-protect
- (progn
- (add-hook 'post-self-insert-hook postproc)
+ (if (not interactive)
+ ;; FIXME: For non-interactive uses, many calls actually just want
+ ;; (insert "\n"), so maybe we should do just that, so as to avoid
+ ;; the risk of filling or running abbrevs unexpectedly.
+ (let ((post-self-insert-hook (list postproc)))
(self-insert-command (prefix-numeric-value arg)))
- ;; We first used let-binding to protect the hook, but that was naive
- ;; since add-hook affects the symbol-default value of the variable,
- ;; whereas the let-binding might only protect the buffer-local value.
- (remove-hook 'post-self-insert-hook postproc)))
+ (unwind-protect
+ (progn
+ (add-hook 'post-self-insert-hook postproc)
+ (self-insert-command (prefix-numeric-value arg)))
+ ;; We first used let-binding to protect the hook, but that was naive
+ ;; since add-hook affects the symbol-default value of the variable,
+ ;; whereas the let-binding might only protect the buffer-local value.
+ (remove-hook 'post-self-insert-hook postproc))))
nil)
(defun set-hard-newline-properties (from to)
column specified by the function `current-left-margin'."
(interactive "*")
(delete-horizontal-space t)
- (newline)
+ (newline 1 t)
(indent-according-to-mode))
(defun reindent-then-newline-and-indent ()
(delete-horizontal-space t))
(indent-according-to-mode)))
+(defcustom read-quoted-char-radix 8
+ "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
+Legitimate radix values are 8, 10 and 16."
+ :type '(choice (const 8) (const 10) (const 16))
+ :group 'editing-basics)
+
+(defun read-quoted-char (&optional prompt)
+ "Like `read-char', but do not allow quitting.
+Also, if the first character read is an octal digit,
+we read any number of octal digits and return the
+specified character code. Any nondigit terminates the sequence.
+If the terminator is RET, it is discarded;
+any other terminator is used itself as input.
+
+The optional argument PROMPT specifies a string to use to prompt the user.
+The variable `read-quoted-char-radix' controls which radix to use
+for numeric input."
+ (let ((message-log-max nil) done (first t) (code 0) translated)
+ (while (not done)
+ (let ((inhibit-quit first)
+ ;; Don't let C-h get the help message--only help function keys.
+ (help-char nil)
+ (help-form
+ "Type the special character you want to use,
+or the octal character code.
+RET terminates the character code and is discarded;
+any other non-digit terminates the character code and is then used as input."))
+ (setq translated (read-key (and prompt (format "%s-" prompt))))
+ (if inhibit-quit (setq quit-flag nil)))
+ (if (integerp translated)
+ (setq translated (char-resolve-modifiers translated)))
+ (cond ((null translated))
+ ((not (integerp translated))
+ (setq unread-command-events
+ (listify-key-sequence (this-single-command-raw-keys))
+ done t))
+ ((/= (logand translated ?\M-\^@) 0)
+ ;; Turn a meta-character into a character with the 0200 bit set.
+ (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
+ done t))
+ ((and (<= ?0 translated)
+ (< translated (+ ?0 (min 10 read-quoted-char-radix))))
+ (setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
+ (and prompt (setq prompt (message "%s %c" prompt translated))))
+ ((and (<= ?a (downcase translated))
+ (< (downcase translated)
+ (+ ?a -10 (min 36 read-quoted-char-radix))))
+ (setq code (+ (* code read-quoted-char-radix)
+ (+ 10 (- (downcase translated) ?a))))
+ (and prompt (setq prompt (message "%s %c" prompt translated))))
+ ((and (not first) (eq translated ?\C-m))
+ (setq done t))
+ ((not first)
+ (setq unread-command-events
+ (listify-key-sequence (this-single-command-raw-keys))
+ done t))
+ (t (setq code translated
+ done t)))
+ (setq first nil))
+ code))
+
(defun quoted-insert (arg)
"Read next input character and insert it.
This is useful for inserting control characters.
(/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
(point-min))))
(if (and arg (not (consp arg))) (forward-line 1)))
+(put 'beginning-of-buffer 'interactive-only
+ "use `(goto-char (point-min))' instead.")
(defun end-of-buffer (&optional arg)
"Move point to the end of the buffer.
;; then scroll specially to put it near, but not at, the bottom.
(overlay-recenter (point))
(recenter -3))))
+(put 'end-of-buffer 'interactive-only "use `(goto-char (point-max))' instead.")
(defcustom delete-active-region t
"Whether single-char deletion commands delete an active region.
:group 'killing
:version "24.1")
+(defvar region-extract-function
+ (lambda (delete)
+ (when (region-beginning)
+ (if (eq delete 'delete-only)
+ (delete-region (region-beginning) (region-end))
+ (filter-buffer-substring (region-beginning) (region-end) delete))))
+ "Function to get the region's content.
+Called with one argument DELETE.
+If DELETE is `delete-only', then only delete the region and the return value
+is undefined. If DELETE is nil, just return the content as a string.
+If anything else, delete the region and return its content as a string.")
+
(defun delete-backward-char (n &optional killflag)
"Delete the previous N characters (following if N is negative).
If Transient Mark mode is enabled, the mark is active, and N is 1,
(= n 1))
;; If a region is active, kill or delete it.
(if (eq delete-active-region 'kill)
- (kill-region (region-beginning) (region-end))
- (delete-region (region-beginning) (region-end))))
+ (kill-region (region-beginning) (region-end) 'region)
+ (funcall region-extract-function 'delete-only)))
;; In Overwrite mode, maybe untabify while deleting
((null (or (null overwrite-mode)
(<= n 0)
(insert-char ?\s (- ocol (current-column)) nil))))
;; Otherwise, do simple deletion.
(t (delete-char (- n) killflag))))
+(put 'delete-backward-char 'interactive-only 'delete-char)
(defun delete-forward-char (n &optional killflag)
"Delete the following N characters (previous if N is negative).
(= n 1))
;; If a region is active, kill or delete it.
(if (eq delete-active-region 'kill)
- (kill-region (region-beginning) (region-end))
- (delete-region (region-beginning) (region-end))))
+ (kill-region (region-beginning) (region-end) 'region)
+ (funcall region-extract-function 'delete-only)))
+
;; Otherwise, do simple deletion.
(t (delete-char n killflag))))
(if (eq selective-display t)
(re-search-forward "[\n\C-m]" nil 'end (1- line))
(forward-line (1- line)))))
+(put 'goto-line 'interactive-only 'forward-line)
(defun count-words-region (start end &optional arg)
"Count the number of words in the region.
Such arguments are used as in `read-from-minibuffer'.)"
;; Used for interactive spec `x'.
(read-from-minibuffer prompt initial-contents minibuffer-local-map
- t minibuffer-history))
+ t 'minibuffer-history))
(defun eval-minibuffer (prompt &optional initial-contents)
"Return value of Lisp expression read using the minibuffer.
in addition to the value printed by prin1 in functions which
display the result of expression evaluation."
(if (and (integerp value)
- (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
- (eq this-command last-command)
- (if (boundp 'edebug-active) edebug-active)))
+ (or (eq standard-output t)
+ (zerop (prefix-numeric-value current-prefix-arg))))
(let ((char-string
- (if (or (if (boundp 'edebug-active) edebug-active)
- (memq this-command '(eval-last-sexp eval-print-last-sexp)))
- (prin1-char value))))
+ (if (and (characterp value)
+ (char-displayable-p value))
+ (prin1-char value))))
(if char-string
(format " (#o%o, #x%x, %s)" value value char-string)
(format " (#o%o, #x%x)" value value)))))
Value is also consed on to front of the variable `values'.
Optional argument INSERT-VALUE non-nil (interactively,
with prefix argument) means insert the result into the current buffer
-instead of printing it in the echo area. Truncates long output
-according to the value of the variables `eval-expression-print-length'
+instead of printing it in the echo area. With a zero prefix arg,
+insert the result with no limit on the length and level of lists,
+and include additional formats for integers (octal, hexadecimal,
+and character). Truncates long output according to the value
+of the variables `eval-expression-print-length'
and `eval-expression-print-level'.
If `eval-expression-debug-on-error' is non-nil, which is the default,
(unless (eq old-value new-value)
(setq debug-on-error new-value))))
- (let ((print-length eval-expression-print-length)
- (print-level eval-expression-print-level)
+ (let ((print-length (and (not (zerop (prefix-numeric-value insert-value)))
+ eval-expression-print-length))
+ (print-level (and (not (zerop (prefix-numeric-value insert-value)))
+ eval-expression-print-level))
(deactivate-mark))
(if insert-value
(with-no-warnings
(let ((standard-output (current-buffer)))
- (prin1 (car values))))
+ (prog1
+ (prin1 (car values))
+ (when (zerop (prefix-numeric-value insert-value))
+ (let ((str (eval-expression-print-format (car values))))
+ (if str (princ str)))))))
(prog1
(prin1 (car values) t)
(let ((str (eval-expression-print-format (car values))))
;; add it to the history.
(or (equal newcmd (car command-history))
(setq command-history (cons newcmd command-history)))
- (eval newcmd))
+ (unwind-protect
+ (progn
+ ;; Trick called-interactively-p into thinking that `newcmd' is
+ ;; an interactive call (bug#14136).
+ (add-hook 'called-interactively-p-functions
+ #'repeat-complex-command--called-interactively-skip)
+ (eval newcmd))
+ (remove-hook 'called-interactively-p-functions
+ #'repeat-complex-command--called-interactively-skip)))
(if command-history
(error "Argument %d is beyond length of command history" arg)
(error "There are no previous complex commands to repeat")))))
+(defun repeat-complex-command--called-interactively-skip (i _frame1 frame2)
+ (and (eq 'eval (cadr frame2))
+ (eq 'repeat-complex-command
+ (cadr (backtrace-frame i #'called-interactively-p)))
+ 1))
+
(defvar extended-command-history nil)
(defun read-extended-command ()
The output appears in the buffer `*Async Shell Command*'.
That buffer is in shell mode.
+You can configure `async-shell-command-buffer' to specify what to do in
+case when `*Async Shell Command*' buffer is already taken by another
+running shell command. To run COMMAND without displaying the output
+in a window you can configure `display-buffer-alist' to use the action
+`display-buffer-no-window' for the buffer `*Async Shell Command*'.
+
In Elisp, you will often be better served by calling `start-process'
directly, since it offers more control and does not impose the use of a
shell (with its need to quote arguments)."
;; which comint sometimes adds for prompts.
(let ((inhibit-read-only t))
(erase-buffer))
- (display-buffer buffer)
+ (display-buffer buffer '(nil (allow-no-window . t)))
(setq default-directory directory)
(setq proc (start-process "Shell" buffer shell-file-name
shell-command-switch command))
Command Output*' is deleted.
Optional fourth arg OUTPUT-BUFFER specifies where to put the
-command's output. If the value is a buffer or buffer name, put
-the output there. Any other value, excluding nil, means to
-insert the output in the current buffer. In either case, the
-output is inserted after point (leaving mark after it).
+command's output. If the value is a buffer or buffer name,
+put the output there. If the value is nil, use the buffer
+`*Shell Command Output*'. Any other value, excluding nil,
+means to insert the output in the current buffer. In either case,
+the output is inserted after point (leaving mark after it).
Optional fifth arg REPLACE, if non-nil, means to insert the
output in place of text from START to END, putting point and mark
(display-buffer (button-get button 'process-buffer)))
(defun list-processes (&optional query-only buffer)
- "Display a list of all processes.
+ "Display a list of all processes that are Emacs sub-processes.
If optional argument QUERY-ONLY is non-nil, only processes with
the query-on-exit flag set are listed.
Any process listed as exited or signaled is actually eliminated
after the listing is made.
Optional argument BUFFER specifies a buffer to use, instead of
\"*Process List*\".
-The return value is always nil."
+The return value is always nil.
+
+This function lists only processes that were launched by Emacs. To
+see other processes running on the system, use `list-system-processes'."
(interactive)
(or (fboundp 'process-list)
(error "Asynchronous subprocesses are not supported on this system"))
nil)
\f
(defvar universal-argument-map
- (let ((map (make-sparse-keymap)))
- (define-key map [t] 'universal-argument-other-key)
- (define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
- (define-key map [switch-frame] nil)
+ (let ((map (make-sparse-keymap))
+ (universal-argument-minus
+ ;; For backward compatibility, minus with no modifiers is an ordinary
+ ;; command if digits have already been entered.
+ `(menu-item "" negative-argument
+ :filter ,(lambda (cmd)
+ (if (integerp prefix-arg) nil cmd)))))
+ (define-key map [switch-frame]
+ (lambda (e) (interactive "e")
+ (handle-switch-frame e) (universal-argument--mode)))
(define-key map [?\C-u] 'universal-argument-more)
- (define-key map [?-] 'universal-argument-minus)
+ (define-key map [?-] universal-argument-minus)
(define-key map [?0] 'digit-argument)
(define-key map [?1] 'digit-argument)
(define-key map [?2] 'digit-argument)
(define-key map [kp-7] 'digit-argument)
(define-key map [kp-8] 'digit-argument)
(define-key map [kp-9] 'digit-argument)
- (define-key map [kp-subtract] 'universal-argument-minus)
+ (define-key map [kp-subtract] universal-argument-minus)
map)
"Keymap used while processing \\[universal-argument].")
-(defvar universal-argument-num-events nil
- "Number of argument-specifying events read by `universal-argument'.
-`universal-argument-other-key' uses this to discard those events
-from (this-command-keys), and reread only the final command.")
-
-(defvar saved-overriding-map t
- "The saved value of `overriding-terminal-local-map'.
-That variable gets restored to this value on exiting \"universal
-argument mode\".")
-
-(defun save&set-overriding-map (map)
- "Set `overriding-terminal-local-map' to MAP."
- (when (eq saved-overriding-map t)
- (setq saved-overriding-map overriding-terminal-local-map)
- (setq overriding-terminal-local-map map)))
-
-(defun restore-overriding-map ()
- "Restore `overriding-terminal-local-map' to its saved value."
- (setq overriding-terminal-local-map saved-overriding-map)
- (setq saved-overriding-map t))
+(defun universal-argument--mode ()
+ (set-transient-map universal-argument-map))
(defun universal-argument ()
"Begin a numeric argument for the following command.
These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(interactive)
(setq prefix-arg (list 4))
- (setq universal-argument-num-events (length (this-command-keys)))
- (save&set-overriding-map universal-argument-map))
+ (universal-argument--mode))
-;; A subsequent C-u means to multiply the factor by 4 if we've typed
-;; nothing but C-u's; otherwise it means to terminate the prefix arg.
(defun universal-argument-more (arg)
+ ;; A subsequent C-u means to multiply the factor by 4 if we've typed
+ ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
(interactive "P")
- (if (consp arg)
- (setq prefix-arg (list (* 4 (car arg))))
- (if (eq arg '-)
- (setq prefix-arg (list -4))
- (setq prefix-arg arg)
- (restore-overriding-map)))
- (setq universal-argument-num-events (length (this-command-keys))))
+ (setq prefix-arg (if (consp arg)
+ (list (* 4 (car arg)))
+ (if (eq arg '-)
+ (list -4)
+ arg)))
+ (when (consp prefix-arg) (universal-argument--mode)))
(defun negative-argument (arg)
"Begin a negative numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
- (cond ((integerp arg)
- (setq prefix-arg (- arg)))
- ((eq arg '-)
- (setq prefix-arg nil))
- (t
- (setq prefix-arg '-)))
- (setq universal-argument-num-events (length (this-command-keys)))
- (save&set-overriding-map universal-argument-map))
+ (setq prefix-arg (cond ((integerp arg) (- arg))
+ ((eq arg '-) nil)
+ (t '-)))
+ (universal-argument--mode))
(defun digit-argument (arg)
"Part of the numeric argument for the next command.
last-command-event
(get last-command-event 'ascii-character)))
(digit (- (logand char ?\177) ?0)))
- (cond ((integerp arg)
- (setq prefix-arg (+ (* arg 10)
- (if (< arg 0) (- digit) digit))))
- ((eq arg '-)
- ;; Treat -0 as just -, so that -01 will work.
- (setq prefix-arg (if (zerop digit) '- (- digit))))
- (t
- (setq prefix-arg digit))))
- (setq universal-argument-num-events (length (this-command-keys)))
- (save&set-overriding-map universal-argument-map))
-
-;; For backward compatibility, minus with no modifiers is an ordinary
-;; command if digits have already been entered.
-(defun universal-argument-minus (arg)
- (interactive "P")
- (if (integerp arg)
- (universal-argument-other-key arg)
- (negative-argument arg)))
-
-;; Anything else terminates the argument and is left in the queue to be
-;; executed as a command.
-(defun universal-argument-other-key (arg)
- (interactive "P")
- (setq prefix-arg arg)
- (let* ((key (this-command-keys))
- (keylist (listify-key-sequence key)))
- (setq unread-command-events
- (append (nthcdr universal-argument-num-events keylist)
- unread-command-events)))
- (reset-this-command-lengths)
- (restore-overriding-map))
+ (setq prefix-arg (cond ((integerp arg)
+ (+ (* arg 10)
+ (if (< arg 0) (- digit) digit)))
+ ((eq arg '-)
+ ;; Treat -0 as just -, so that -01 will work.
+ (if (zerop digit) '- (- digit)))
+ (t
+ digit))))
+ (universal-argument--mode))
\f
(defvar filter-buffer-substring-functions nil
be copied into other buffers."
(funcall filter-buffer-substring-function beg end delete))
+;; FIXME: `with-wrapper-hook' is obsolete
(defun buffer-substring--filter (beg end &optional delete)
(with-wrapper-hook filter-buffer-substring-functions (beg end delete)
(cond
:group 'killing
:version "23.2")
-(defun kill-new (string &optional replace yank-handler)
+(defun kill-new (string &optional replace)
"Make STRING the latest kill in the kill ring.
Set `kill-ring-yank-pointer' to point to it.
If `interprogram-cut-function' is non-nil, apply it to STRING.
argument is not used by `insert-for-yank'. However, since Lisp code
may access and use elements from the kill ring directly, the STRING
argument should still be a \"useful\" string for such uses."
- (if (> (length string) 0)
- (if yank-handler
- (put-text-property 0 (length string)
- 'yank-handler yank-handler string))
- (if yank-handler
- (signal 'args-out-of-range
- (list string "yank-handler specified for empty string"))))
(unless (and kill-do-not-save-duplicates
;; Due to text properties such as 'yank-handler that
;; can alter the contents to yank, comparison using
(setq kill-ring-yank-pointer kill-ring)
(if interprogram-cut-function
(funcall interprogram-cut-function string)))
-(set-advertised-calling-convention
- 'kill-new '(string &optional replace) "23.3")
-(defun kill-append (string before-p &optional yank-handler)
+(defun kill-append (string before-p)
"Append STRING to the end of the latest kill in the kill ring.
If BEFORE-P is non-nil, prepend STRING to the kill.
If `interprogram-cut-function' is set, pass the resulting kill to it."
(let* ((cur (car kill-ring)))
(kill-new (if before-p (concat string cur) (concat cur string))
(or (= (length cur) 0)
- (equal yank-handler (get-text-property 0 'yank-handler cur)))
- yank-handler)))
-(set-advertised-calling-convention 'kill-append '(string before-p) "23.3")
+ (equal nil (get-text-property 0 'yank-handler cur))))))
(defcustom yank-pop-change-selection nil
"Whether rotating the kill ring changes the window system selection.
:type 'boolean
:group 'killing)
-(defun kill-region (beg end &optional yank-handler)
+(defun kill-region (beg end &optional region)
"Kill (\"cut\") text between point and mark.
This deletes the text from the buffer and saves it in the kill ring.
The command \\[yank] can retrieve it from there.
Any command that calls this function is a \"kill command\".
If the previous command was also a kill command,
the text killed this time appends to the text killed last time
-to make one entry in the kill ring."
- ;; Pass point first, then mark, because the order matters
- ;; when calling kill-append.
- (interactive (list (point) (mark)))
+to make one entry in the kill ring.
+
+The optional argument REGION if non-nil, indicates that we're not just killing
+some text between BEG and END, but we're killing the region."
+ ;; Pass mark first, then point, because the order matters when
+ ;; calling `kill-append'.
+ (interactive (list (mark) (point) 'region))
(unless (and beg end)
(error "The mark is not set now, so there is no region"))
(condition-case nil
- (let ((string (filter-buffer-substring beg end t)))
+ (let ((string (if region
+ (funcall region-extract-function 'delete)
+ (filter-buffer-substring beg end 'delete))))
(when string ;STRING is nil if BEG = END
;; Add that string to the kill ring, one way or another.
(if (eq last-command 'kill-region)
- (kill-append string (< end beg) yank-handler)
- (kill-new string nil yank-handler)))
+ (kill-append string (< end beg))
+ (kill-new string nil)))
(when (or string (eq last-command 'kill-region))
(setq this-command 'kill-region))
(setq deactivate-mark t)
;; We should beep, in case the user just isn't aware of this.
;; However, there's no harm in putting
;; the region's text in the kill ring, anyway.
- (copy-region-as-kill beg end)
+ (copy-region-as-kill beg end region)
;; Set this-command now, so it will be set even if we get an error.
(setq this-command 'kill-region)
;; This should barf, if appropriate, and give us the correct error.
(barf-if-buffer-read-only)
;; If the buffer isn't read-only, the text is.
(signal 'text-read-only (list (current-buffer)))))))
-(set-advertised-calling-convention 'kill-region '(beg end) "23.3")
;; copy-region-as-kill no longer sets this-command, because it's confusing
;; to get two copies of the text when the user accidentally types M-w and
;; then corrects it with the intended C-w.
-(defun copy-region-as-kill (beg end)
+(defun copy-region-as-kill (beg end &optional region)
"Save the region as if killed, but don't kill it.
In Transient Mark mode, deactivate the mark.
If `interprogram-cut-function' is non-nil, also save the text for a window
system cut and paste.
+The optional argument REGION if non-nil, indicates that we're not just copying
+some text between BEG and END, but we're copying the region.
+
This command's old key binding has been given to `kill-ring-save'."
- (interactive "r")
+ ;; Pass mark first, then point, because the order matters when
+ ;; calling `kill-append'.
+ (interactive (list (mark) (point)
+ (prefix-numeric-value current-prefix-arg)))
+ (let ((str (if region
+ (funcall region-extract-function nil)
+ (filter-buffer-substring beg end))))
(if (eq last-command 'kill-region)
- (kill-append (filter-buffer-substring beg end) (< end beg))
- (kill-new (filter-buffer-substring beg end)))
+ (kill-append str (< end beg))
+ (kill-new str)))
(setq deactivate-mark t)
nil)
-(defun kill-ring-save (beg end)
+(defun kill-ring-save (beg end &optional region)
"Save the region as if killed, but don't kill it.
In Transient Mark mode, deactivate the mark.
If `interprogram-cut-function' is non-nil, also save the text for a window
If you want to append the killed line to the last killed text,
use \\[append-next-kill] before \\[kill-ring-save].
+The optional argument REGION if non-nil, indicates that we're not just copying
+some text between BEG and END, but we're copying the region.
+
This command is similar to `copy-region-as-kill', except that it gives
visual feedback indicating the extent of the region being copied."
- (interactive "r")
- (copy-region-as-kill beg end)
+ ;; Pass mark first, then point, because the order matters when
+ ;; calling `kill-append'.
+ (interactive (list (mark) (point)
+ (prefix-numeric-value current-prefix-arg)))
+ (copy-region-as-kill beg end region)
;; This use of called-interactively-p is correct because the code it
;; controls just gives the user visual feedback.
(if (called-interactively-p 'interactive)
(buffer-substring-no-properties mark (+ mark len))))))))
(defun append-next-kill (&optional interactive)
- "Cause following command, if it kills, to append to previous kill.
+ "Cause following command, if it kills, to add to previous kill.
+If the next command kills forward from point, the kill is
+appended to the previous killed text. If the command kills
+backward, the kill is prepended. Kill commands that act on the
+region, such as `kill-region', are regarded as killing forward if
+point is after mark, and killing backward if point is before
+mark.
+
+If the next command is not a kill command, `append-next-kill' has
+no effect.
+
The argument is used for internal purposes; do not supply one."
(interactive "p")
;; We don't use (interactive-p), since that breaks kbd macros.
This is done prior to removing the properties specified by
`yank-excluded-properties'."
:group 'killing
+ :type '(repeat (cons (symbol :tag "property symbol")
+ function))
:version "24.3")
;; This is actually used in subr.el but defcustom does not work there.
(progn
(barf-if-buffer-read-only)
(read-buffer "Insert buffer: "
- (if (eq (selected-window) (next-window (selected-window)))
+ (if (eq (selected-window) (next-window))
(other-buffer (current-buffer))
- (window-buffer (next-window (selected-window))))
+ (window-buffer (next-window)))
t))))
(push-mark
(save-excursion
(insert-buffer-substring (get-buffer buffer))
(point)))
nil)
+(put 'insert-buffer 'interactive-only 'insert-buffer-substring)
(defun append-to-buffer (buffer start end)
"Append to specified buffer the text of the region.
(save-excursion
(insert-buffer-substring oldbuf start end)))))
\f
-(put 'mark-inactive 'error-conditions '(mark-inactive error))
-(put 'mark-inactive 'error-message (purecopy "The mark is not active now"))
+(define-error 'mark-inactive (purecopy "The mark is not active now"))
(defvar activate-mark-hook nil
"Hook run when the mark becomes active.
(marker-position (mark-marker))
(signal 'mark-inactive nil)))
+;; Behind display-selections-p.
+(declare-function x-selection-owner-p "xselect.c"
+ (&optional selection terminal))
+(declare-function x-selection-exists-p "xselect.c"
+ (&optional selection terminal))
+
(defun deactivate-mark (&optional force)
"Deactivate the mark.
If Transient Mark mode is disabled, this function normally does
(or (x-selection-owner-p 'PRIMARY)
(null (x-selection-exists-p 'PRIMARY))))
(x-set-selection 'PRIMARY
- (buffer-substring (region-beginning)
- (region-end))))))
+ (funcall region-extract-function nil)))))
(if (and (null force)
(or (eq transient-mark-mode 'lambda)
(and (eq (car-safe transient-mark-mode) 'only)
also checks the value of `use-empty-active-region'."
(and transient-mark-mode mark-active))
-(defvar mark-ring nil
+
+(defvar redisplay-unhighlight-region-function
+ (lambda (rol) (when (overlayp rol) (delete-overlay rol))))
+
+(defvar redisplay-highlight-region-function
+ (lambda (start end window rol)
+ (if (not (overlayp rol))
+ (let ((nrol (make-overlay start end)))
+ (funcall redisplay-unhighlight-region-function rol)
+ (overlay-put nrol 'window window)
+ (overlay-put nrol 'face 'region)
+ nrol)
+ (unless (and (eq (overlay-buffer rol) (current-buffer))
+ (eq (overlay-start rol) start)
+ (eq (overlay-end rol) end))
+ (move-overlay rol start end (current-buffer)))
+ rol)))
+
+(defun redisplay--update-region-highlight (window)
+ (with-current-buffer (window-buffer window)
+ (let ((rol (window-parameter window 'internal-region-overlay)))
+ (if (not (region-active-p))
+ (funcall redisplay-unhighlight-region-function rol)
+ (let* ((pt (window-point window))
+ (mark (mark))
+ (start (min pt mark))
+ (end (max pt mark))
+ (new
+ (funcall redisplay-highlight-region-function
+ start end window rol)))
+ (unless (equal new rol)
+ (set-window-parameter window 'internal-region-overlay
+ new)))))))
+
+(defun redisplay--update-region-highlights (windows)
+ (with-demoted-errors "redisplay--update-region-highlights: %S"
+ (if (null windows)
+ (redisplay--update-region-highlight (selected-window))
+ (unless (listp windows) (setq windows (window-list-1 nil nil t)))
+ (if highlight-nonselected-windows
+ (mapc #'redisplay--update-region-highlight windows)
+ (let ((msw (and (window-minibuffer-p) (minibuffer-selected-window))))
+ (dolist (w windows)
+ (if (or (eq w (selected-window)) (eq w msw))
+ (redisplay--update-region-highlight w)
+ (funcall redisplay-unhighlight-region-function
+ (window-parameter w 'internal-region-overlay)))))))))
+
+(add-function :before pre-redisplay-function
+ #'redisplay--update-region-highlights)
+
+
+(defvar-local mark-ring nil
"The list of former marks of the current buffer, most recent first.")
-(make-variable-buffer-local 'mark-ring)
(put 'mark-ring 'permanent-local t)
(defcustom mark-ring-max 16
(temp-highlight (eq (car-safe transient-mark-mode) 'only)))
(if (null omark)
(error "No mark set in this buffer"))
- (deactivate-mark)
(set-mark (point))
(goto-char omark)
(cond (temp-highlight
(defun next-line (&optional arg try-vscroll)
"Move cursor vertically down ARG lines.
Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
+Non-interactively, use TRY-VSCROLL to control whether to vscroll tall
+lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this
+function will not vscroll.
+
+ARG defaults to 1.
+
If there is no character in the target line exactly under the current column,
the cursor is positioned after the character in that line which spans this
column, or at the end of the line if it is not long enough.
(signal (car err) (cdr err))))
(line-move arg nil nil try-vscroll)))
nil)
+(put 'next-line 'interactive-only 'forward-line)
(defun previous-line (&optional arg try-vscroll)
"Move cursor vertically up ARG lines.
Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
+Non-interactively, use TRY-VSCROLL to control whether to vscroll tall
+lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this
+function will not vscroll.
+
+ARG defaults to 1.
+
If there is no character in the target line exactly over the current column,
the cursor is positioned after the character in that line which spans this
column, or at the end of the line if it is not long enough.
(signal (car err) (cdr err))))
(line-move (- arg) nil nil try-vscroll))
nil)
+(put 'previous-line 'interactive-only
+ "use `forward-line' with negative argument instead.")
(defcustom track-eol nil
"Non-nil means vertical motion starting at end of line keeps to ends of lines.
:group 'editing-basics
:version "23.1")
+;; Only used if display-graphic-p.
+(declare-function font-info "font.c" (name &optional frame))
+
+(defun default-font-height ()
+ "Return the height in pixels of the current buffer's default face font."
+ (let ((default-font (face-font 'default)))
+ (cond
+ ((and (display-multi-font-p)
+ ;; Avoid calling font-info if the frame's default font was
+ ;; not changed since the frame was created. That's because
+ ;; font-info is expensive for some fonts, see bug #14838.
+ (not (string= (frame-parameter nil 'font) default-font)))
+ (aref (font-info default-font) 3))
+ (t (frame-char-height)))))
+
+(defun default-line-height ()
+ "Return the pixel height of current buffer's default-face text line.
+
+The value includes `line-spacing', if any, defined for the buffer
+or the frame."
+ (let ((dfh (default-font-height))
+ (lsp (if (display-graphic-p)
+ (or line-spacing
+ (default-value 'line-spacing)
+ (frame-parameter nil 'line-spacing)
+ 0)
+ 0)))
+ (if (floatp lsp)
+ (setq lsp (* dfh lsp)))
+ (+ dfh lsp)))
+
+(defun window-screen-lines ()
+ "Return the number of screen lines in the text area of the selected window.
+
+This is different from `window-text-height' in that this function counts
+lines in units of the height of the font used by the default face displayed
+in the window, not in units of the frame's default font, and also accounts
+for `line-spacing', if any, defined for the window's buffer or frame.
+
+The value is a floating-point number."
+ (let ((canonical (window-text-height))
+ (fch (frame-char-height))
+ (dlh (default-line-height)))
+ (/ (* (float canonical) fch) dlh)))
+
;; Returns non-nil if partial move was done.
(defun line-move-partial (arg noerror to-end)
(if (< arg 0)
;; Move backward (up).
;; If already vscrolled, reduce vscroll
- (let ((vs (window-vscroll nil t)))
- (when (> vs (frame-char-height))
- (set-window-vscroll nil (- vs (frame-char-height)) t)))
+ (let ((vs (window-vscroll nil t))
+ (dlh (default-line-height)))
+ (when (> vs dlh)
+ (set-window-vscroll nil (- vs dlh) t)))
;; Move forward (down).
(let* ((lh (window-line-height -1))
+ (rowh (car lh))
(vpos (nth 1 lh))
(ypos (nth 2 lh))
(rbot (nth 3 lh))
- py vs)
+ (this-lh (window-line-height))
+ (this-height (car this-lh))
+ (this-ypos (nth 2 this-lh))
+ (dlh (default-line-height))
+ (wslines (window-screen-lines))
+ (edges (window-inside-pixel-edges))
+ (winh (- (nth 3 edges) (nth 1 edges) 1))
+ py vs last-line)
+ (if (> (mod wslines 1.0) 0.0)
+ (setq wslines (round (+ wslines 0.5))))
(when (or (null lh)
- (>= rbot (frame-char-height))
- (<= ypos (- (frame-char-height))))
+ (>= rbot dlh)
+ (<= ypos (- dlh))
+ (null this-lh)
+ (<= this-ypos (- dlh)))
(unless lh
(let ((wend (pos-visible-in-window-p t nil t)))
(setq rbot (nth 3 wend)
+ rowh (nth 4 wend)
vpos (nth 5 wend))))
+ (unless this-lh
+ (let ((wstart (pos-visible-in-window-p nil nil t)))
+ (setq this-ypos (nth 2 wstart)
+ this-height (nth 4 wstart))))
+ (setq py
+ (or (nth 1 this-lh)
+ (let ((ppos (posn-at-point))
+ col-row)
+ (setq col-row (posn-actual-col-row ppos))
+ (if col-row
+ (- (cdr col-row) (window-vscroll))
+ (cdr (posn-col-row ppos))))))
+ ;; VPOS > 0 means the last line is only partially visible.
+ ;; But if the part that is visible is at least as tall as the
+ ;; default font, that means the line is actually fully
+ ;; readable, and something like line-spacing is hidden. So in
+ ;; that case we accept the last line in the window as still
+ ;; visible, and consider the margin as starting one line
+ ;; later.
+ (if (and vpos (> vpos 0))
+ (if (and rowh
+ (>= rowh (default-font-height))
+ (< rowh dlh))
+ (setq last-line (min (- wslines scroll-margin) vpos))
+ (setq last-line (min (- wslines scroll-margin 1) (1- vpos)))))
(cond
- ;; If last line of window is fully visible, move forward.
- ((or (null rbot) (= rbot 0))
+ ;; If last line of window is fully visible, and vscrolling
+ ;; more would make this line invisible, move forward.
+ ((and (or (< (setq vs (window-vscroll nil t)) dlh)
+ (null this-height)
+ (<= this-height dlh))
+ (or (null rbot) (= rbot 0)))
nil)
- ;; If cursor is not in the bottom scroll margin, move forward.
- ((and (> vpos 0)
- (< (setq py
- (or (nth 1 (window-line-height))
- (let ((ppos (posn-at-point)))
- (cdr (or (posn-actual-col-row ppos)
- (posn-col-row ppos))))))
- (min (- (window-text-height) scroll-margin 1) (1- vpos))))
+ ;; If cursor is not in the bottom scroll margin, and the
+ ;; current line is is not too tall, move forward.
+ ((and (or (null this-height) (<= this-height winh))
+ vpos
+ (> vpos 0)
+ (< py last-line))
nil)
;; When already vscrolled, we vscroll some more if we can,
;; or clear vscroll and move forward at end of tall image.
- ((> (setq vs (window-vscroll nil t)) 0)
- (when (> rbot 0)
- (set-window-vscroll nil (+ vs (min rbot (frame-char-height))) t)))
+ ((> vs 0)
+ (when (or (and rbot (> rbot 0))
+ (and this-height (> this-height dlh)))
+ (set-window-vscroll nil (+ vs dlh) t)))
;; If cursor just entered the bottom scroll margin, move forward,
- ;; but also vscroll one line so redisplay won't recenter.
- ((and (> vpos 0)
- (= py (min (- (window-text-height) scroll-margin 1)
- (1- vpos))))
- (set-window-vscroll nil (frame-char-height) t)
+ ;; but also optionally vscroll one line so redisplay won't recenter.
+ ((and vpos
+ (> vpos 0)
+ (= py last-line))
+ ;; Don't vscroll if the partially-visible line at window
+ ;; bottom is not too tall (a.k.a. "just one more text
+ ;; line"): in that case, we do want redisplay to behave
+ ;; normally, i.e. recenter or whatever.
+ ;;
+ ;; Note: ROWH + RBOT from the value returned by
+ ;; pos-visible-in-window-p give the total height of the
+ ;; partially-visible glyph row at the end of the window. As
+ ;; we are dealing with floats, we disregard sub-pixel
+ ;; discrepancies between that and DLH.
+ (if (and rowh rbot (>= (- (+ rowh rbot) winh) 1))
+ (set-window-vscroll nil dlh t))
(line-move-1 arg noerror to-end)
t)
;; If there are lines above the last line, scroll-up one line.
- ((> vpos 0)
+ ((and vpos (> vpos 0))
(scroll-up 1)
t)
;; Finally, start vscroll.
(t
- (set-window-vscroll nil (frame-char-height) t)))))))
+ (set-window-vscroll nil dlh t)))))))
;; This is like line-move-1 except that it also performs
;; When the text in the window is scrolled to the left,
;; display-based motion doesn't make sense (because each
;; logical line occupies exactly one screen line).
- (not (> (window-hscroll) 0)))
- (line-move-visual arg noerror)
+ (not (> (window-hscroll) 0))
+ ;; Likewise when the text _was_ scrolled to the left
+ ;; when the current run of vertical motion commands
+ ;; started.
+ (not (and (memq last-command
+ `(next-line previous-line ,this-command))
+ auto-hscroll-mode
+ (numberp temporary-goal-column)
+ (>= temporary-goal-column
+ (- (window-width) hscroll-margin)))))
+ (prog1 (line-move-visual arg noerror)
+ ;; If we moved into a tall line, set vscroll to make
+ ;; scrolling through tall images more smooth.
+ (let ((lh (line-pixel-height))
+ (edges (window-inside-pixel-edges))
+ (dlh (default-line-height))
+ winh)
+ (setq winh (- (nth 3 edges) (nth 1 edges) 1))
+ (if (and (< arg 0)
+ (< (point) (window-start))
+ (> lh winh))
+ (set-window-vscroll
+ nil
+ (- lh dlh) t))))
(line-move-1 arg noerror to-end)))))
;; Display-based alternative to line-move-1.
(visual-line-mode 1))
(define-globalized-minor-mode global-visual-line-mode
- visual-line-mode turn-on-visual-line-mode
- :lighter " vl")
+ visual-line-mode turn-on-visual-line-mode)
\f
(defun transpose-chars (arg)
\f
(defun backward-word (&optional arg)
"Move backward until encountering the beginning of a word.
-With argument ARG, do this that many times."
+With argument ARG, do this that many times.
+If ARG is omitted or nil, move point backward one word."
(interactive "^p")
(forward-word (- (or arg 1))))
(setq selective-display
(and arg (prefix-numeric-value arg)))
(recenter current-vpos))
- (set-window-start (selected-window) (window-start (selected-window)))
+ (set-window-start (selected-window) (window-start))
(princ "selective-display set to " t)
(prin1 selective-display t)
(princ "." t))
START can be nil, if it was not found.
The function should return non-nil if the two tokens do not match.")
+(defvar blink-matching--overlay
+ (let ((ol (make-overlay (point) (point) nil t)))
+ (overlay-put ol 'face 'show-paren-match)
+ (delete-overlay ol)
+ ol)
+ "Overlay used to highlight the matching paren.")
+
(defun blink-matching-open ()
- "Move cursor momentarily to the beginning of the sexp before point."
+ "Momentarily highlight the beginning of the sexp before point."
(interactive)
(when (and (not (bobp))
blink-matching-paren)
(message "No matching parenthesis found"))))
((not blinkpos) nil)
((pos-visible-in-window-p blinkpos)
- ;; Matching open within window, temporarily move to blinkpos but only
- ;; if `blink-matching-paren-on-screen' is non-nil.
+ ;; Matching open within window, temporarily highlight char
+ ;; after blinkpos but only if `blink-matching-paren-on-screen'
+ ;; is non-nil.
(and blink-matching-paren-on-screen
(not show-paren-mode)
- (save-excursion
- (goto-char blinkpos)
- (sit-for blink-matching-delay))))
+ (unwind-protect
+ (progn
+ (move-overlay blink-matching--overlay blinkpos (1+ blinkpos)
+ (current-buffer))
+ (sit-for blink-matching-delay))
+ (delete-overlay blink-matching--overlay))))
(t
(save-excursion
(goto-char blinkpos)
(point))))))
(funcall blink-paren-function)))
+(put 'blink-paren-post-self-insert-function 'priority 100)
+
(add-hook 'post-self-insert-hook #'blink-paren-post-self-insert-function
;; Most likely, this hook is nil, so this arg doesn't matter,
;; but I use it as a reminder that this function usually
- ;; likes to be run after others since it does `sit-for'.
+ ;; likes to be run after others since it does
+ ;; `sit-for'. That's also the reason it get a `priority' prop
+ ;; of 100.
'append)
\f
;; This executes C-g typed while Emacs is waiting for a command.
(call-interactively `(lambda (arg)
(interactive ,prop)
arg))
- (read
- (read-string prompt nil
- 'set-variable-value-history
- (format "%S" (symbol-value var))))))))
+ (read-from-minibuffer prompt nil
+ read-expression-map t
+ 'set-variable-value-history
+ (format "%S" (symbol-value var)))))))
(list var val current-prefix-arg)))
(and (custom-variable-p variable)
(interactive)
(let ((buf completion-reference-buffer))
(if (one-window-p t)
- (if (window-dedicated-p (selected-window))
- (delete-frame (selected-frame)))
+ (if (window-dedicated-p) (delete-frame))
(delete-window (selected-window))
(if (get-buffer-window buf)
(select-window (get-buffer-window buf))))))
(normal (nth 1 keypad-normal)))
(put keypad 'ascii-character normal)
(define-key function-key-map (vector keypad) (vector normal))))
- '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
- (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
- (kp-space ?\s)
+ ;; See also kp-keys bound in bindings.el.
+ '((kp-space ?\s)
(kp-tab ?\t)
(kp-enter ?\r)
- (kp-multiply ?*)
- (kp-add ?+)
(kp-separator ?,)
- (kp-subtract ?-)
- (kp-decimal ?.)
- (kp-divide ?/)
(kp-equal ?=)
;; Do the same for various keys that are represented as symbols under
;; GUIs but naturally correspond to characters.
(if enabled
(progn
(define-key local-function-key-map [delete] [deletechar])
- (define-key local-function-key-map [kp-delete] [?\C-d])
+ (define-key local-function-key-map [kp-delete] [deletechar])
(define-key local-function-key-map [backspace] [?\C-?])
(dolist (b bindings)
;; Not sure if input-decode-map is really right, but
buffer-invisibility-spec)
(setq buffer-invisibility-spec nil)))
\f
+(defvar messages-buffer-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map special-mode-map)
+ (define-key map "g" nil) ; nothing to revert
+ map))
+
+(define-derived-mode messages-buffer-mode special-mode "Messages"
+ "Major mode used in the \"*Messages*\" buffer.")
+
+(defun messages-buffer ()
+ "Return the \"*Messages*\" buffer.
+If it does not exist, create and it switch it to `messages-buffer-mode'."
+ (or (get-buffer "*Messages*")
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (messages-buffer-mode)
+ (current-buffer))))
+
+\f
;; Minibuffer prompt stuff.
;;(defun minibuffer-prompt-modification (start end)
"Alist of packages known to cause problems in this version of Emacs.
Each element has the form (PACKAGE SYMBOL REGEXP STRING).
PACKAGE is either a regular expression to match file names, or a
-symbol (a feature name); see the documentation of
-`after-load-alist', to which this variable adds functions.
+symbol (a feature name), like for `with-eval-after-load'.
SYMBOL is either the name of a string variable, or `t'. Upon
loading PACKAGE, if SYMBOL is t or matches REGEXP, display a
warning using STRING as the message.")
(display-warning package (nth 3 list) :warning)))
(error nil)))
-(mapc (lambda (elem)
- (eval-after-load (car elem) `(bad-package-check ',(car elem))))
- bad-packages-alist)
+(dolist (elem bad-packages-alist)
+ (let ((pkg (car elem)))
+ (with-eval-after-load pkg
+ (bad-package-check pkg))))
+\f
+;;; Generic dispatcher commands
+
+;; Macro `define-alternatives' is used to create generic commands.
+;; Generic commands are these (like web, mail, news, encrypt, irc, etc.)
+;; that can have different alternative implementations where choosing
+;; among them is exclusively a matter of user preference.
+
+;; (define-alternatives COMMAND) creates a new interactive command
+;; M-x COMMAND and a customizable variable COMMAND-alternatives.
+;; Typically, the user will not need to customize this variable; packages
+;; wanting to add alternative implementations should use
+;;
+;; ;;;###autoload (push '("My impl name" . my-impl-symbol) COMMAND-alternatives
+
+(defmacro define-alternatives (command &rest customizations)
+ "Define new command `COMMAND'.
+The variable `COMMAND-alternatives' will contain alternative
+implementations of COMMAND, so that running `C-u M-x COMMAND'
+will allow the user to chose among them.
+CUSTOMIZATIONS, if non-nil, should be composed of alternating
+`defcustom' keywords and values to add to the declaration of
+`COMMAND-alternatives' (typically :group and :version)."
+ (let* ((command-name (symbol-name command))
+ (varalt-name (concat command-name "-alternatives"))
+ (varalt-sym (intern varalt-name))
+ (varimp-sym (intern (concat command-name "--implementation"))))
+ `(progn
+
+ (defcustom ,varalt-sym nil
+ ,(format "Alist of alternative implementations for the `%s' command.
+
+Each entry must be a pair (ALTNAME . ALTFUN), where:
+ALTNAME - The name shown at user to describe the alternative implementation.
+ALTFUN - The function called to implement this alternative."
+ command-name)
+ :type '(alist :key-type string :value-type function)
+ ,@customizations)
+
+ (defvar ,varimp-sym nil "Internal use only.")
+
+ (defun ,command (&optional arg)
+ ,(format "Run generic command `%s'.
+If used for the first time, or with interactive ARG, ask the user which
+implementation to use for `%s'. The variable `%s'
+contains the list of implementations currently supported for this command."
+ command-name command-name varalt-name)
+ (interactive "P")
+ (when (or arg (null ,varimp-sym))
+ (let ((val (completing-read
+ ,(format "Select implementation for command `%s': " command-name)
+ ,varalt-sym nil t)))
+ (unless (string-equal val "")
+ (customize-save-variable ',varimp-sym
+ (cdr (assoc-string val ,varalt-sym))))))
+ (if ,varimp-sym
+ (funcall ,varimp-sym)
+ (message ,(format "No implementation selected for command `%s'"
+ command-name)))))))
(provide 'simple)
HCoop / bpt / emacs.git / blobdiff