;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 1998
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999
;; Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
(delete-region (point) (+ (point) (length fill-prefix))))
(fixup-whitespace))))
+(defalias 'join-line #'delete-indentation) ; easier to find
+
(defun fixup-whitespace ()
"Fixup white space between objects around point.
Leave one space or none, according to the context."
(defun what-cursor-position (&optional detail)
"Print info on cursor position (on screen and within buffer).
-With prefix argument, print detailed info of a character on cursor position."
+Also describe the character after point, and give its character code
+in octal, decimal and hex. For a non-ASCII multibyte character,
+also give its encoding in the buffer's selected coding system,
+if any.
+
+With prefix argument, print additional details about that character,
+instead of the cursor position. This includes the character set name,
+the codes that identify the character within that character set,
+and the corresponding external character components.
+
+Each language environment may show different external character components."
(interactive "P")
(let* ((char (following-char))
(beg (point-min))
pos total percent beg end col hscroll)
(message "point=%d of %d(%d%%) column %d %s"
pos total percent col hscroll))
- (let ((str (if detail (format " %s" (split-char char)) "")))
- (if (or (/= beg 1) (/= end (1+ total)))
- (message "Char: %s (0%o, %d, 0x%x) %s point=%d of %d(%d%%) <%d - %d> column %d %s"
+ (let ((charset (char-charset char))
+ (coding-system buffer-file-coding-system)
+ slot external encoding-msg)
+ ;; To decided an external character code, we use
+ ;; charset-origin-alist property of buffer-file-coding-system.
+ ;; But, if buffer-file-coding-system is nil of undecided, use
+ ;; that property of default-buffer-file-coding-system. If
+ ;; that property value is nil, we don't show external
+ ;; character code.
+ (if (or (not coding-system)
+ (eq (coding-system-type coding-system) t))
+ (setq coding-system default-buffer-file-coding-system))
+ (if (and coding-system
+ (setq slot
+ (coding-system-get coding-system 'charset-origin-alist))
+ (setq slot (assq charset slot)))
+ (setq external (list (nth 1 slot) (funcall (nth 2 slot) char))))
+ (setq encoding-msg
+ (if external
+ (format "(0%o, %d, 0x%x, ext 0x%x)"
+ char char char (nth 1 external))
+ (format "(0%o, %d, 0x%x)" char char char)))
+ (if detail
+ ;; We show the detailed information of CHAR.
+ (let (internal)
+ (if (eq charset 'composition)
+ ;; For a composite character, we show the components
+ ;; only.
+ (setq internal (concat "(composition of \""
+ (decompose-composite-char char)
+ "\")")
+ external nil)
+ (setq internal (split-char char))
+ (unless external
+ (setq external (cons (charset-short-name charset)
+ (copy-sequence (cdr internal))))
+ (if (= (charset-iso-graphic-plane charset) 1)
+ (progn
+ (setcar (cdr external) (+ (nth 1 external) 128))
+ (if (nth 2 external)
+ (setcar (nthcdr 2 external)
+ (+ (nth 2 external) 128)))))))
+ (message "Char: %s %s %s %s"
+ (if (< char 256)
+ (single-key-description char)
+ (char-to-string char))
+ encoding-msg internal (or external "")))
+ (if (or (/= beg 1) (/= end (1+ total)))
+ (message "Char: %s %s point=%d of %d(%d%%) <%d - %d> column %d %s"
+ (if (< char 256)
+ (single-key-description char)
+ (char-to-string char))
+ encoding-msg pos total percent beg end col hscroll)
+ (message "Char: %s %s point=%d of %d(%d%%) column %d %s"
(if (< char 256)
(single-key-description char)
(char-to-string char))
- char char char str pos total percent beg end col hscroll)
- (message "Char: %s (0%o, %d, 0x%x)%s point=%d of %d(%d%%) column %d %s"
- (if (< char 256)
- (single-key-description char)
- (char-to-string char))
- char char char str pos total percent col hscroll))))))
+ encoding-msg pos total percent col hscroll)))))))
(defun fundamental-mode ()
"Major mode not specialized for anything in particular.
(null minibuffer-text-before-history))
(setq minibuffer-text-before-history (buffer-string)))
(if (< narg minimum)
- (error "End of history; no next item"))
+ (if minibuffer-default
+ (error "End of history; no next item")
+ (error "End of history; no default available")))
(if (> narg (length (symbol-value minibuffer-history-variable)))
(error "Beginning of history; no preceding item"))
(erase-buffer)
(defvar pending-undo-list nil
"Within a run of consecutive undo commands, list remaining to be undone.")
+(defvar undo-in-progress nil
+ "Non-nil while performing an undo.
+Some change-hooks test this variable to do something different.")
+
(defun undo-more (count)
"Undo back N undo-boundaries beyond what was already undone recently.
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
(or pending-undo-list
(error "No further undo information"))
- (setq pending-undo-list (primitive-undo count pending-undo-list)))
+ (let ((undo-in-progress t))
+ (setq pending-undo-list (primitive-undo count pending-undo-list))))
;; Deep copy of a list
(defun undo-copy-list (list)
(car (cdr (cdr (process-command process))))
(substring signal 0 -1))))
+(defvar shell-command-on-region-default-error-buffer nil
+ "*Name of buffer that `shell-command-on-region' uses for stderr.
+This buffer is used when `shell-command-on-region' is run interactively.
+A nil value for this variable means that output to stderr and stdout
+will be intermixed in the output stream.")
+
(defun shell-command-on-region (start end command
&optional output-buffer replace
error-buffer)
"Execute string COMMAND in inferior shell with region as input.
Normally display output (if any) in temp buffer `*Shell Command Output*';
-Prefix arg means replace the region with it.
+Prefix arg means replace the region with it. Return the exit code of
+COMMAND.
To specify a coding system for converting non-ASCII characters
in the input and output to the shell command, use \\[universal-coding-system-argument]
`buffer-file-coding-system'. If the output is going to replace the region,
then it is decoded from that same coding system.
-The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE,
-ERROR-BUFFER. If REPLACE is non-nil, that means insert the output
-in place of text from START to END, putting point and mark around it.
-Noninteractive callers can specify coding systems by binding
-`coding-system-for-read' and `coding-system-for-write'.
+The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER,
+REPLACE, ERROR-BUFFER. Noninteractive callers can specify coding
+systems by binding `coding-system-for-read' and
+`coding-system-for-write'.
If the output is one line, it is displayed in the echo area,
but it is nonetheless available in buffer `*Shell Command Output*'
insert output in the current buffer.
In either case, the output is inserted after point (leaving mark after it).
-If optional fifth argument ERROR-BUFFER is non-nil, it is a buffer
+If REPLACE, the optional fifth argument, is non-nil, that means insert
+the output in place of text from START to END, putting point and mark
+around it.
+
+If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
or buffer name to which to direct the command's standard error output.
-If it is nil, error output is mingled with regular output."
+If it is nil, error output is mingled with regular output.
+In an interactive call, the variable
+`shell-command-on-region-default-error-buffer' specifies the value
+of ERROR-BUFFER."
(interactive (let ((string
;; Do this before calling region-beginning
;; and region-end, in case subprocess output
(list (region-beginning) (region-end)
string
current-prefix-arg
- current-prefix-arg)))
+ current-prefix-arg
+ shell-command-on-region-default-error-buffer)))
(let ((error-file
(if error-buffer
(concat (file-name-directory temp-file-name-pattern)
(make-temp-name "scor"))
- nil)))
- (if (or replace
- (and output-buffer
- (not (or (bufferp output-buffer) (stringp output-buffer))))
- (equal (buffer-name (current-buffer)) "*Shell Command Output*"))
- ;; Replace specified region with output from command.
- (let ((swap (and replace (< start end))))
- ;; Don't muck with mark unless REPLACE says we should.
- (goto-char start)
- (and replace (push-mark))
- (call-process-region start end shell-file-name t
- (if error-file
- (list t error-file)
- t)
- nil shell-command-switch command)
- (let ((shell-buffer (get-buffer "*Shell Command Output*")))
- (and shell-buffer (not (eq shell-buffer (current-buffer)))
- (kill-buffer shell-buffer)))
- ;; Don't muck with mark unless REPLACE says we should.
- (and replace swap (exchange-point-and-mark)))
- ;; No prefix argument: put the output in a temp buffer,
- ;; replacing its entire contents.
- (let ((buffer (get-buffer-create
- (or output-buffer "*Shell Command Output*")))
- (success nil)
- (exit-status nil))
- (unwind-protect
- (if (eq buffer (current-buffer))
- ;; If the input is the same buffer as the output,
- ;; delete everything but the specified region,
- ;; then replace that region with the output.
- (progn (setq buffer-read-only nil)
- (delete-region (max start end) (point-max))
- (delete-region (point-min) (min start end))
- (setq exit-status
- (call-process-region (point-min) (point-max)
- shell-file-name t
- (if error-file
- (list t error-file)
- t)
- nil shell-command-switch command))
- (setq success t))
- ;; Clear the output buffer, then run the command with output there.
- (save-excursion
- (set-buffer buffer)
- (setq buffer-read-only nil)
- (erase-buffer))
- (setq exit-status
- (call-process-region start end shell-file-name nil
- (if error-file
- (list buffer error-file)
- buffer)
- nil shell-command-switch command))
- (setq success t))
- ;; Report the amount of output.
- (let ((lines (save-excursion
- (set-buffer buffer)
- (if (= (buffer-size) 0)
- 0
- (count-lines (point-min) (point-max))))))
- (cond ((= lines 0)
- (if success
- (message "(Shell command %sed with no output)"
- (if (equal 0 exit-status)
- "succeed"
- "fail")))
- (kill-buffer buffer))
- ((and success (= lines 1))
- (message "%s"
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min))
- (buffer-substring (point)
- (progn (end-of-line) (point))))))
- (t
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min)))
- (display-buffer buffer)))))))
- (if (and error-file (file-exists-p error-file))
- (save-excursion
- (set-buffer (get-buffer-create error-buffer))
- ;; Do no formatting while reading error file, for fear of looping.
- (format-insert-file error-file nil)
- (delete-file error-file)))))
+ nil))
+ exit-status)
+ (if (or replace
+ (and output-buffer
+ (not (or (bufferp output-buffer) (stringp output-buffer))))
+ (equal (buffer-name (current-buffer)) "*Shell Command Output*"))
+ ;; Replace specified region with output from command.
+ (let ((swap (and replace (< start end))))
+ ;; Don't muck with mark unless REPLACE says we should.
+ (goto-char start)
+ (and replace (push-mark))
+ (setq exit-status
+ (call-process-region start end shell-file-name t
+ (if error-file
+ (list t error-file)
+ t)
+ nil shell-command-switch command))
+ (let ((shell-buffer (get-buffer "*Shell Command Output*")))
+ (and shell-buffer (not (eq shell-buffer (current-buffer)))
+ (kill-buffer shell-buffer)))
+ ;; Don't muck with mark unless REPLACE says we should.
+ (and replace swap (exchange-point-and-mark)))
+ ;; No prefix argument: put the output in a temp buffer,
+ ;; replacing its entire contents.
+ (let ((buffer (get-buffer-create
+ (or output-buffer "*Shell Command Output*")))
+ (success nil))
+ (unwind-protect
+ (if (eq buffer (current-buffer))
+ ;; If the input is the same buffer as the output,
+ ;; delete everything but the specified region,
+ ;; then replace that region with the output.
+ (progn (setq buffer-read-only nil)
+ (delete-region (max start end) (point-max))
+ (delete-region (point-min) (min start end))
+ (setq exit-status
+ (call-process-region (point-min) (point-max)
+ shell-file-name t
+ (if error-file
+ (list t error-file)
+ t)
+ nil shell-command-switch
+ command)))
+ ;; Clear the output buffer, then run the command with
+ ;; output there.
+ (save-excursion
+ (set-buffer buffer)
+ (setq buffer-read-only nil)
+ (erase-buffer))
+ (setq exit-status
+ (call-process-region start end shell-file-name nil
+ (if error-file
+ (list buffer error-file)
+ buffer)
+ nil shell-command-switch command)))
+ (setq success (zerop exit-status))
+ ;; Report the amount of output.
+ (let ((lines (save-excursion
+ (set-buffer buffer)
+ (if (= (buffer-size) 0)
+ 0
+ (count-lines (point-min) (point-max))))))
+ (cond ((= lines 0)
+ (if success
+ (message "(Shell command %sed with no output)"
+ (if (equal 0 exit-status)
+ "succeed"
+ "fail")))
+ (kill-buffer buffer))
+ ((and success (= lines 1))
+ (message "%s"
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char (point-min))
+ (buffer-substring (point)
+ (progn (end-of-line) (point))))))
+ (t
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char (point-min)))
+ (display-buffer buffer)))))))
+ (if (and error-file (file-exists-p error-file))
+ (save-excursion
+ (set-buffer (get-buffer-create error-buffer))
+ ;; Do no formatting while reading error file, for fear of looping.
+ (format-insert-file error-file nil)
+ (delete-file error-file)))
+ exit-status))
(defun shell-command-to-string (command)
"Execute shell command COMMAND and return its output as a string."
interaction; you may want to use them instead of manipulating the kill
ring directly.")
-(defcustom kill-ring-max 30
+(defcustom kill-ring-max 60
"*Maximum length of kill ring before oldest elements are thrown away."
:type 'integer
:group 'killing)
(forward-line arg))))
arg))
+(defvar transpose-subr-start1)
+(defvar transpose-subr-start2)
+(defvar transpose-subr-end1)
+(defvar transpose-subr-end2)
+
(defun transpose-subr (mover arg)
- (let (start1 end1 start2 end2)
+ (let (transpose-subr-start1
+ transpose-subr-end1
+ transpose-subr-start2
+ transpose-subr-end2)
(if (= arg 0)
(progn
(save-excursion
(funcall mover 1)
- (setq end2 (point))
+ (setq transpose-subr-end2 (point))
(funcall mover -1)
- (setq start2 (point))
+ (setq transpose-subr-start2 (point))
(goto-char (mark))
(funcall mover 1)
- (setq end1 (point))
+ (setq transpose-subr-end1 (point))
(funcall mover -1)
- (setq start1 (point))
+ (setq transpose-subr-start1 (point))
(transpose-subr-1))
(exchange-point-and-mark))
(if (> arg 0)
(progn
(funcall mover -1)
- (setq start1 (point))
+ (setq transpose-subr-start1 (point))
(funcall mover 1)
- (setq end1 (point))
+ (setq transpose-subr-end1 (point))
(funcall mover arg)
- (setq end2 (point))
+ (setq transpose-subr-end2 (point))
(funcall mover (- arg))
- (setq start2 (point))
+ (setq transpose-subr-start2 (point))
(transpose-subr-1)
- (goto-char end2))
+ (goto-char transpose-subr-end2))
(funcall mover -1)
- (setq start2 (point))
+ (setq transpose-subr-start2 (point))
(funcall mover 1)
- (setq end2 (point))
+ (setq transpose-subr-end2 (point))
(funcall mover (1- arg))
- (setq start1 (point))
+ (setq transpose-subr-start1 (point))
(funcall mover (- arg))
- (setq end1 (point))
+ (setq transpose-subr-end1 (point))
(transpose-subr-1)))))
(defun transpose-subr-1 ()
- (if (> (min end1 end2) (max start1 start2))
+ (if (> (min transpose-subr-end1 transpose-subr-end2)
+ (max transpose-subr-start1 transpose-subr-start2))
(error "Don't have two things to transpose"))
- (let* ((word1 (buffer-substring start1 end1))
+ (let* ((word1 (buffer-substring transpose-subr-start1 transpose-subr-end1))
(len1 (length word1))
- (word2 (buffer-substring start2 end2))
+ (word2 (buffer-substring transpose-subr-start2 transpose-subr-end2))
(len2 (length word2)))
- (delete-region start2 end2)
- (goto-char start2)
+ (delete-region transpose-subr-start2 transpose-subr-end2)
+ (goto-char transpose-subr-start2)
(insert word1)
- (goto-char (if (< start1 start2) start1
- (+ start1 (- len1 len2))))
+ (goto-char (if (< transpose-subr-start1 transpose-subr-start2)
+ transpose-subr-start1
+ (+ transpose-subr-start1 (- len1 len2))))
(delete-region (point) (+ (point) len1))
(insert word2)))
\f
(save-excursion
(save-restriction
(let ((cs comment-start) (ce comment-end)
+ (cp (when comment-padding
+ (make-string comment-padding ? )))
numarg)
- (if (consp arg) (setq numarg t)
+ (if (consp arg) (setq numarg t)
(setq numarg (prefix-numeric-value arg))
;; For positive arg > 1, replicate the comment delims now,
;; then insert the replicated strings just once.
(setq cs (concat cs comment-start)
ce (concat ce comment-end))
(setq numarg (1- numarg))))
- (when comment-padding
- (setq cs (concat cs (make-string comment-padding ? ))))
;; Loop over all lines from BEG to END.
- (narrow-to-region beg end)
- (goto-char beg)
- (while (not (eobp))
- (if (or (eq numarg t) (< numarg 0))
- (progn
+ (narrow-to-region beg end)
+ (goto-char beg)
+ (if (or (eq numarg t) (< numarg 0))
+ (while (not (eobp))
+ (let (found-comment)
;; Delete comment start from beginning of line.
(if (eq numarg t)
(while (looking-at (regexp-quote cs))
+ (setq found-comment t)
(delete-char (length cs)))
(let ((count numarg))
(while (and (> 1 (setq count (1+ count)))
(looking-at (regexp-quote cs)))
+ (setq found-comment t)
(delete-char (length cs)))))
+ ;; Delete comment padding from beginning of line
+ (when (and found-comment comment-padding
+ (looking-at (regexp-quote cp)))
+ (delete-char comment-padding))
;; Delete comment end from end of line.
- (if (string= "" ce)
+ (if (string= "" ce)
nil
(if (eq numarg t)
(progn
;; this is questionable if comment-end ends in whitespace
;; that is pretty brain-damaged though
(skip-chars-backward " \t")
- (save-excursion
- (backward-char (length ce))
- (if (looking-at (regexp-quote ce))
- (delete-char (length ce))))))))
- (forward-line 1))
+ (if (>= (- (point) (point-min)) (length ce))
+ (save-excursion
+ (backward-char (length ce))
+ (if (looking-at (regexp-quote ce))
+ (delete-char (length ce)))))))))
+ (forward-line 1)))
+
+ (when comment-padding
+ (setq cs (concat cs cp)))
+ (while (not (eobp))
;; Insert at beginning and at end.
- (if (looking-at "[ \t]*$") ()
- (insert cs)
- (if (string= "" ce) ()
- (end-of-line)
- (insert ce)))
- (search-forward "\n" nil 'move)))))))
+ (if (looking-at "[ \t]*$") ()
+ (insert cs)
+ (if (string= "" ce) ()
+ (end-of-line)
+ (insert ce)))
+ (search-forward "\n" nil 'move)))))))
\f
(defun backward-word (arg)
"Move backward until encountering the end of a word.
(skip-chars-backward " \t")
;; Break the line after/before \c|.
(forward-char 1))))
- (if (and enable-kinsoku enable-multibyte-characters)
- (kinsoku (save-excursion
- (forward-line 0) (point))))
+ (if enable-multibyte-characters
+ ;; If we are going to break the line after or
+ ;; before a non-ascii character, we may have
+ ;; to run a special function for the charset
+ ;; of the character to find the correct break
+ ;; point.
+ (if (not (and (eq (charset-after (1- (point))) 'ascii)
+ (eq (charset-after (point)) 'ascii)))
+ (fill-find-break-point after-prefix)))
+
;; Let fill-point be set to the place where we end up.
+ ;; But move back before any whitespace here.
+ (skip-chars-backward " \t")
(point)))))
;; See whether the place we found is any good.
(defun turn-on-auto-fill ()
"Unconditionally turn on Auto Fill mode."
(auto-fill-mode 1))
+(custom-add-option 'text-mode-hook 'turn-on-auto-fill)
(defun set-fill-column (arg)
"Set `fill-column' to specified argument.
+Use \\[universal-argument] followed by a number to specify a column.
Just \\[universal-argument] as argument means to use the current column."
(interactive "P")
(if (consp arg)
"Toggle Line Number mode.
With arg, turn Line Number mode on iff arg is positive.
When Line Number mode is enabled, the line number appears
-in the mode line."
+in the mode line.
+
+Line numbers do not appear for very large buffers, see variable
+`line-number-display-limit'."
(interactive "P")
(setq line-number-mode
(if (null arg) (not line-number-mode)
(matching-paren (char-after blinkpos))))))
(if mismatch (setq blinkpos nil))
(if blinkpos
- (progn
+ ;; Don't log messages about paren matching.
+ (let (message-log-max)
(goto-char blinkpos)
(if (pos-visible-in-window-p)
(and blink-matching-paren-on-screen
(setq completion-base-size nil)
(run-hooks 'completion-list-mode-hook))
-(defvar completion-fixup-function nil
- "A function to customize how completions are identified in completion lists.
-`completion-setup-function' calls this function with no arguments
-each time it has found what it thinks is one completion.
-Point is at the end of the completion in the completion list buffer.
-If this function moves point, it can alter the end of that completion.")
-
(defvar completion-setup-hook nil
"Normal hook run at the end of setting up a completion list buffer.
When this hook is run, the current buffer is the one in which the
"Click \\[mouse-choose-completion] on a completion to select it.\n")))
(insert (substitute-command-keys
"In this buffer, type \\[choose-completion] to \
-select the completion near point.\n\n"))
- (forward-line 1)
- (while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t)
- (let ((beg (match-beginning 0))
- (end (point)))
- (if completion-fixup-function
- (funcall completion-fixup-function))
- (put-text-property beg (point) 'mouse-face 'highlight)
- (goto-char end))))))
+select the completion near point.\n\n")))))
(add-hook 'completion-setup-hook 'completion-setup-function)
;; to the following event.
(defun event-apply-alt-modifier (ignore-prompt)
+ "Add the Alt modifier to the following event.
+For example, type \\[event-apply-alt-modifier] & to enter Alt-&."
(vector (event-apply-modifier (read-event) 'alt 22 "A-")))
(defun event-apply-super-modifier (ignore-prompt)
+ "Add the Super modifier to the following event.
+For example, type \\[event-apply-super-modifier] & to enter Super-&."
(vector (event-apply-modifier (read-event) 'super 23 "s-")))
(defun event-apply-hyper-modifier (ignore-prompt)
+ "Add the Hyper modifier to the following event.
+For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&."
(vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
(defun event-apply-shift-modifier (ignore-prompt)
+ "Add the Shift modifier to the following event.
+For example, type \\[event-apply-shift-modifier] & to enter Shift-&."
(vector (event-apply-modifier (read-event) 'shift 25 "S-")))
(defun event-apply-control-modifier (ignore-prompt)
+ "Add the Ctrl modifier to the following event.
+For example, type \\[event-apply-control-modifier] & to enter Ctrl-&."
(vector (event-apply-modifier (read-event) 'control 26 "C-")))
(defun event-apply-meta-modifier (ignore-prompt)
+ "Add the Meta modifier to the following event.
+For example, type \\[event-apply-meta-modifier] & to enter Meta-&."
(vector (event-apply-modifier (read-event) 'meta 27 "M-")))
(defun event-apply-modifier (event symbol lshiftby prefix)