;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
(defun newline (&optional arg)
- "Insert a newline and move to left margin of the new line.
+ "Insert a newline, and move to left margin of the new line if it's blank.
The newline is marked with the text-property `hard'.
With arg, insert that many newlines.
In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
(interactive "*P")
+ (barf-if-buffer-read-only)
;; Inserting a newline at the end of a line produces better redisplay in
;; try_window_id than inserting at the beginning of a line, and the textual
;; result is the same. So, if we're at beginning of line, pretend to be at
(let ((flag (and (not (bobp))
(bolp)
(< (or (previous-property-change (point)) -2)
- (- (point) 2)))))
+ (- (point) 2))))
+ (was-page-start (and (bolp)
+ (looking-at page-delimiter)))
+ (beforepos (point)))
(if flag (backward-char 1))
;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
;; Set last-command-char to tell self-insert what to insert.
(let ((last-command-char ?\n)
;; Don't auto-fill if we have a numeric argument.
- (auto-fill-function (if arg nil auto-fill-function)))
- (self-insert-command (prefix-numeric-value arg)))
+ ;; Also not if flag is true (it would fill wrong line);
+ ;; there is no need to since we're at BOL.
+ (auto-fill-function (if (or arg flag) nil auto-fill-function)))
+ (unwind-protect
+ (self-insert-command (prefix-numeric-value arg))
+ ;; If we get an error in self-insert-command, put point at right place.
+ (if flag (forward-char 1))))
+ ;; If we did *not* get an error, cancel that forward-char.
+ (if flag (backward-char 1))
;; Mark the newline(s) `hard'.
(if use-hard-newlines
(let* ((from (- (point) (if arg (prefix-numeric-value arg) 1)))
(if (and (listp sticky) (not (memq 'hard sticky)))
(put-text-property from (point) 'rear-nonsticky
(cons 'hard sticky)))))
- (if flag (forward-char 1)))
- (move-to-left-margin nil t)
+ ;; If the newline leaves the previous line blank,
+ ;; and we have a left margin, delete that from the blank line.
+ (or flag
+ (save-excursion
+ (goto-char beforepos)
+ (beginning-of-line)
+ (and (looking-at "[ \t]$")
+ (> (current-left-margin) 0)
+ (delete-region (point) (progn (end-of-line) (point))))))
+ (if flag (forward-char 1))
+ ;; Indent the line after the newline, except in one case:
+ ;; when we added the newline at the beginning of a line
+ ;; which starts a page.
+ (or was-page-start
+ (move-to-left-margin nil t)))
nil)
(defun open-line (arg)
"Insert a newline and leave point before it.
If there is a fill prefix and/or a left-margin, insert them on the new line
-if the line would have been empty.
+if the line would have been blank.
With arg N, insert N newlines."
(interactive "*p")
(let* ((do-fill-prefix (and fill-prefix (bolp)))
(do-left-margin (and (bolp) (> (current-left-margin) 0)))
(loc (point)))
+ (newline arg)
+ (goto-char loc)
(while (> arg 0)
- (if do-left-margin (indent-to (current-left-margin)))
- (if do-fill-prefix (insert-and-inherit fill-prefix))
- (newline 1)
+ (cond ((bolp)
+ (if do-left-margin (indent-to (current-left-margin)))
+ (if do-fill-prefix (insert-and-inherit fill-prefix))))
+ (forward-line 1)
(setq arg (1- arg)))
- (goto-char loc))
- (end-of-line))
+ (goto-char loc)
+ (end-of-line)))
(defun split-line ()
"Split current line, moving portion beyond point vertically down."
(delete-char 1)))
(forward-char -1)
(setq count (1- count)))))
- (delete-backward-char arg killp)
- ;; In overwrite mode, back over columns while clearing them out,
- ;; unless at end of line.
- (and overwrite-mode (not (eolp))
- (save-excursion (insert-char ?\ arg))))
+ (delete-backward-char arg killp))
(defun zap-to-char (arg char)
"Kill up to and including ARG'th occurrence of CHAR.
(count-lines start end) (- end start)))
(defun what-line ()
- "Print the current line number (in the buffer) of point."
+ "Print the current buffer line number and narrowed line number of point."
(interactive)
- (save-restriction
- (widen)
+ (let ((opoint (point)) start)
(save-excursion
- (beginning-of-line)
- (message "Line %d"
- (1+ (count-lines 1 (point)))))))
+ (save-restriction
+ (goto-char (point-min))
+ (widen)
+ (beginning-of-line)
+ (setq start (point))
+ (goto-char opoint)
+ (beginning-of-line)
+ (if (/= start 1)
+ (message "line %d (narrowed line %d)"
+ (1+ (count-lines 1 (point)))
+ (1+ (count-lines start (point))))
+ (message "Line %d" (1+ (count-lines 1 (point)))))))))
+
(defun count-lines (start end)
"Return number of lines between START and END.
read-expression-map t
'(command-history . 1))))
;; If command was added to command-history as a string,
- ;; get rid of that. We want only evallable expressions there.
+ ;; get rid of that. We want only evaluable expressions there.
(if (stringp (car command-history))
(setq command-history (cdr command-history)))
(cons 'command-history arg))))
;; If command was added to command-history as a string,
- ;; get rid of that. We want only evallable expressions there.
+ ;; get rid of that. We want only evaluable expressions there.
(if (stringp (car command-history))
(setq command-history (cdr command-history)))
'minibuffer-history-search-history)))
;; Use the last regexp specified, by default, if input is empty.
(list (if (string= regexp "")
- (setcar minibuffer-history-search-history
- (nth 1 minibuffer-history-search-history))
+ (if minibuffer-history-search-history
+ (car minibuffer-history-search-history)
+ (error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
(let ((history (symbol-value minibuffer-history-variable))
If COMMAND ends in ampersand, execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
+That buffer is in shell mode.
-Otherwise, COMMAND is executed synchronously. The output appears
-in the buffer `*Shell Command Output*'.
+Otherwise, COMMAND is executed synchronously. The output appears in the
+buffer `*Shell Command Output*'.
If the output is one line, it is displayed in the echo area *as well*,
but it is nonetheless available in buffer `*Shell Command Output*',
even though that buffer is not automatically displayed.
(interactive (list (read-from-minibuffer "Shell command: "
nil nil nil 'shell-command-history)
current-prefix-arg))
- (if (and output-buffer
- (not (or (bufferp output-buffer) (stringp output-buffer))))
- (progn (barf-if-buffer-read-only)
- (push-mark)
- ;; We do not use -f for csh; we will not support broken use of
- ;; .cshrcs. Even the BSD csh manual says to use
- ;; "if ($?prompt) exit" before things which are not useful
- ;; non-interactively. Besides, if someone wants their other
- ;; aliases for shell commands then they can still have them.
- (call-process shell-file-name nil t nil
- shell-command-switch command)
- ;; This is like exchange-point-and-mark, but doesn't activate the mark.
- ;; It is cleaner to avoid activation, even though the command
- ;; loop would deactivate the mark because we inserted text.
- (goto-char (prog1 (mark t)
- (set-marker (mark-marker) (point)
- (current-buffer)))))
- ;; Preserve the match data in case called from a program.
- (let ((data (match-data)))
- (unwind-protect
+ ;; Look for a handler in case default-directory is a remote file name.
+ (let ((handler
+ (find-file-name-handler (directory-file-name default-directory)
+ 'shell-command)))
+ (if handler
+ (funcall handler 'shell-command command output-buffer)
+ (if (and output-buffer
+ (not (or (bufferp output-buffer) (stringp output-buffer))))
+ (progn (barf-if-buffer-read-only)
+ (push-mark)
+ ;; We do not use -f for csh; we will not support broken use of
+ ;; .cshrcs. Even the BSD csh manual says to use
+ ;; "if ($?prompt) exit" before things which are not useful
+ ;; non-interactively. Besides, if someone wants their other
+ ;; aliases for shell commands then they can still have them.
+ (call-process shell-file-name nil t nil
+ shell-command-switch command)
+ ;; This is like exchange-point-and-mark, but doesn't
+ ;; activate the mark. It is cleaner to avoid activation,
+ ;; even though the command loop would deactivate the mark
+ ;; because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point)
+ (current-buffer)))))
+ ;; Preserve the match data in case called from a program.
+ (save-match-data
(if (string-match "[ \t]*&[ \t]*$" command)
;; Command ending with ampersand means asynchronous.
(let ((buffer (get-buffer-create
- (or output-buffer "*Asynch Shell Command*")))
+ (or output-buffer "*Async Shell Command*")))
(directory default-directory)
proc)
;; Remove the ampersand.
(erase-buffer)
(display-buffer buffer)
(setq default-directory directory)
- (setq proc (start-process "Shell" buffer
- shell-file-name
+ (setq proc (start-process "Shell" buffer shell-file-name
shell-command-switch command))
(setq mode-line-process '(":%s"))
+ (require 'shell) (shell-mode)
(set-process-sentinel proc 'shell-command-sentinel)
- (set-process-filter proc 'shell-command-filter)
))
- (shell-command-on-region (point) (point) command nil))
- (store-match-data data)))))
+ (shell-command-on-region (point) (point) command nil)
+ ))))))
;; We have a sentinel to prevent insertion of a termination message
;; in the buffer itself.
(defun shell-command-sentinel (process signal)
- (if (and (memq (process-status process) '(exit signal))
- (buffer-name (process-buffer process)))
- (progn
- (message "%s: %s."
- (car (cdr (cdr (process-command process))))
- (substring signal 0 -1))
- (save-excursion
- (set-buffer (process-buffer process))
- (setq mode-line-process nil))
- (delete-process process))))
-
-(defun shell-command-filter (proc string)
- ;; Do save-excursion by hand so that we can leave point numerically unchanged
- ;; despite an insertion immediately after it.
- (let* ((obuf (current-buffer))
- (buffer (process-buffer proc))
- opoint
- (window (get-buffer-window buffer))
- (pos (window-start window)))
- (unwind-protect
- (progn
- (set-buffer buffer)
- (or (= (point) (point-max))
- (setq opoint (point)))
- (goto-char (point-max))
- (insert-before-markers string))
- ;; insert-before-markers moved this marker: set it back.
- (set-window-start window pos)
- ;; Finish our save-excursion.
- (if opoint
- (goto-char opoint))
- (set-buffer obuf))))
+ (if (memq (process-status process) '(exit signal))
+ (message "%s: %s."
+ (car (cdr (cdr (process-command process))))
+ (substring signal 0 -1))))
(defun shell-command-on-region (start end command
&optional output-buffer replace)
(read-from-minibuffer "Shell command on region: "
nil nil nil
'shell-command-history)))
+ ;; call-interactively recognizes region-beginning and
+ ;; region-end specially, leaving them in the history.
(list (region-beginning) (region-end)
string
current-prefix-arg
current-prefix-arg)))
(if (or replace
(and output-buffer
- (not (or (bufferp output-buffer) (stringp 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 (< (point) (mark)))))
+ (let ((swap (and replace (< start end))))
;; Don't muck with mark unless REPLACE says we should.
(goto-char start)
(and replace (push-mark))
;; delete everything but the specified region,
;; then replace that region with the output.
(progn (setq buffer-read-only nil)
- (delete-region end (point-max))
- (delete-region (point-min) start)
+ (delete-region (max start end) (point-max))
+ (delete-region (point-min) (min start end))
(call-process-region (point-min) (point-max)
shell-file-name t t nil
shell-command-switch command)
(buffer-substring (point)
(progn (end-of-line) (point))))))
(t
- (set-window-start (display-buffer buffer) 1))))))))
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char (point-min)))
+ (display-buffer buffer))))))))
+\f
+(defconst 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)
+ (define-key map [?\C-u] 'universal-argument-more)
+ (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 [?3] 'digit-argument)
+ (define-key map [?4] 'digit-argument)
+ (define-key map [?5] 'digit-argument)
+ (define-key map [?6] 'digit-argument)
+ (define-key map [?7] 'digit-argument)
+ (define-key map [?8] 'digit-argument)
+ (define-key map [?9] 'digit-argument)
+ 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.")
+
+(defun universal-argument ()
+ "Begin a numeric argument for the following command.
+Digits or minus sign following \\[universal-argument] make up the numeric argument.
+\\[universal-argument] following the digits or minus sign ends the argument.
+\\[universal-argument] without digits or minus sign provides 4 as argument.
+Repeating \\[universal-argument] without digits or minus sign
+ multiplies the argument by 4 each time."
+ (interactive)
+ (setq prefix-arg (list 4))
+ (setq universal-argument-num-events (length (this-command-keys)))
+ (setq overriding-terminal-local-map universal-argument-map))
+
+;; 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)
+ (interactive "P")
+ (if (consp arg)
+ (setq prefix-arg (list (* 4 (car arg))))
+ (setq prefix-arg arg)
+ (setq overriding-terminal-local-map nil))
+ (setq universal-argument-num-events (length (this-command-keys))))
+
+(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)))
+ (setq overriding-terminal-local-map universal-argument-map))
+
+(defun digit-argument (arg)
+ "Part of the numeric argument for the next command.
+\\[universal-argument] following digits or minus sign ends the argument."
+ (interactive "P")
+ (let ((digit (- (logand last-command-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)))
+ (setq overriding-terminal-local-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)
+ (setq overriding-terminal-local-map nil))
\f
(defun forward-to-indentation (arg)
"Move forward ARG lines and position at first nonblank character."
(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
(setq kill-ring-yank-pointer kill-ring)
(if interprogram-cut-function
- (funcall interprogram-cut-function string t)))
+ (funcall interprogram-cut-function string (not replace))))
(defun kill-append (string before-p)
"Append STRING to the end of the latest kill in the kill ring.
(defvar kill-read-only-ok nil
"*Non-nil means don't signal an error for killing read-only text.")
+(put 'text-read-only 'error-conditions
+ '(text-read-only buffer-read-only error))
+(put 'text-read-only 'error-message "Text is read-only")
+
(defun kill-region (beg end)
"Kill between point and mark.
The text is deleted but saved in the kill ring.
(if kill-read-only-ok
(message "Read only text copied to kill ring")
(setq this-command 'kill-region)
- (barf-if-buffer-read-only)))
+ ;; Signal an error if the buffer is read-only.
+ (barf-if-buffer-read-only)
+ ;; If the buffer isn't read-only, the text is.
+ (signal 'text-read-only (list (current-buffer)))))
;; In certain cases, we can arrange for the undo list and the kill
;; ring to share the same string object. This code does that.
(if (not (eq last-command 'yank))
(error "Previous command was not a yank"))
(setq this-command 'yank)
- (let ((before (< (point) (mark t))))
+ (let ((inhibit-read-only t)
+ (before (< (point) (mark t))))
(delete-region (point) (mark t))
(set-marker (mark-marker) (point) (current-buffer))
(insert (current-kill arg))
"Insert after point the contents of BUFFER.
Puts mark after the inserted text.
BUFFER may be a buffer or a buffer name."
- (interactive (list (progn (barf-if-buffer-read-only)
- (read-buffer "Insert buffer: "
- (other-buffer (current-buffer) t)
- t))))
+ (interactive
+ (list
+ (progn
+ (barf-if-buffer-read-only)
+ (read-buffer "Insert buffer: "
+ (if (eq (selected-window) (next-window (selected-window)))
+ (other-buffer (current-buffer))
+ (window-buffer (next-window (selected-window))))
+ t))))
(or (bufferp buffer)
(setq buffer (get-buffer buffer)))
(let (start end newmark)
(save-excursion
(insert-buffer-substring oldbuf start end)))))
\f
-(defvar mark-even-if-inactive nil
- "*Non-nil means you can use the mark even when inactive.
-This option makes a difference in Transient Mark mode.
-When the option is non-nil, deactivation of the mark
-turns off region highlighting, but commands that use the mark
-behave as if the mark were still active.")
-
(put 'mark-inactive 'error-conditions '(mark-inactive error))
(put 'mark-inactive 'error-message "The mark is not active now")
(move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
nil)
(setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
- (or nomsg executing-macro (> (minibuffer-depth) 0)
+ (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
(message "Mark set"))
(if (or activate (not transient-mark-mode))
(set-mark (mark t)))
If there is no line in the buffer after this one, behavior depends on the
value of `next-line-add-newlines'. If non-nil, it inserts a newline character
to create a line, and moves the cursor to that line. Otherwise it moves the
-cursor to the end of the buffer (if already at the end of the buffer, an error
-is signaled).
+cursor to the end of the buffer.
The command \\[set-goal-column] can be used to create
a semipermanent goal column to which this command always moves.
"*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
Outline mode sets this.")
+;; This is the guts of next-line and previous-line.
+;; Arg says how many lines to move.
(defun line-move (arg)
- (if (not (or (eq last-command 'next-line)
- (eq last-command 'previous-line)))
- (setq temporary-goal-column
- (if (and track-eol (eolp)
- ;; Don't count beg of empty line as end of line
- ;; unless we just did explicit end-of-line.
- (or (not (bolp)) (eq last-command 'end-of-line)))
- 9999
- (current-column))))
- (if (and (not (integerp selective-display))
- (not line-move-ignore-invisible))
- ;; Use just newline characters.
- (or (if (> arg 0)
- (progn (if (> arg 1) (forward-line (1- arg)))
- ;; This way of moving forward ARG lines
- ;; verifies that we have a newline after the last one.
- ;; It doesn't get confused by intangible text.
- (end-of-line)
- (zerop (forward-line 1)))
- (and (zerop (forward-line arg))
- (bolp)))
- (signal (if (< arg 0)
- 'beginning-of-buffer
- 'end-of-buffer)
- nil))
- ;; Move by arg lines, but ignore invisible ones.
- (while (> arg 0)
- (end-of-line)
- (and (zerop (vertical-motion 1))
- (signal 'end-of-buffer nil))
- ;; If the following character is currently invisible,
- ;; skip all characters with that same `invisible' property value.
- (while (and (not (eobp))
- (let ((prop
- (get-char-property (point) 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
- (if (get-text-property (point) 'invisible)
- (goto-char (next-single-property-change (point) 'invisible))
- (goto-char (next-overlay-change (point)))))
- (setq arg (1- arg)))
- (while (< arg 0)
- (beginning-of-line)
- (and (zerop (vertical-motion -1))
- (signal 'beginning-of-buffer nil))
- (while (and (not (bobp))
- (let ((prop
- (get-char-property (1- (point)) 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
- (if (get-text-property (1- (point)) 'invisible)
- (goto-char (previous-single-property-change (point) 'invisible))
- (goto-char (previous-overlay-change (point)))))
- (setq arg (1+ arg))))
- (move-to-column (or goal-column temporary-goal-column))
+ ;; Don't run any point-motion hooks, and disregard intangibility,
+ ;; for intermediate positions.
+ (let ((inhibit-point-motion-hooks t)
+ (opoint (point))
+ new)
+ (unwind-protect
+ (progn
+ (if (not (or (eq last-command 'next-line)
+ (eq last-command 'previous-line)))
+ (setq temporary-goal-column
+ (if (and track-eol (eolp)
+ ;; Don't count beg of empty line as end of line
+ ;; unless we just did explicit end-of-line.
+ (or (not (bolp)) (eq last-command 'end-of-line)))
+ 9999
+ (current-column))))
+ (if (and (not (integerp selective-display))
+ (not line-move-ignore-invisible))
+ ;; Use just newline characters.
+ (or (if (> arg 0)
+ (progn (if (> arg 1) (forward-line (1- arg)))
+ ;; This way of moving forward ARG lines
+ ;; verifies that we have a newline after the last one.
+ ;; It doesn't get confused by intangible text.
+ (end-of-line)
+ (zerop (forward-line 1)))
+ (and (zerop (forward-line arg))
+ (bolp)))
+ (signal (if (< arg 0)
+ 'beginning-of-buffer
+ 'end-of-buffer)
+ nil))
+ ;; Move by arg lines, but ignore invisible ones.
+ (while (> arg 0)
+ (end-of-line)
+ (and (zerop (vertical-motion 1))
+ (signal 'end-of-buffer nil))
+ ;; If the following character is currently invisible,
+ ;; skip all characters with that same `invisible' property value.
+ (while (and (not (eobp))
+ (let ((prop
+ (get-char-property (point) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))))
+ (if (get-text-property (point) 'invisible)
+ (goto-char (next-single-property-change (point) 'invisible))
+ (goto-char (next-overlay-change (point)))))
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (beginning-of-line)
+ (and (zerop (vertical-motion -1))
+ (signal 'beginning-of-buffer nil))
+ (while (and (not (bobp))
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))))
+ (if (get-text-property (1- (point)) 'invisible)
+ (goto-char (previous-single-property-change (point) 'invisible))
+ (goto-char (previous-overlay-change (point)))))
+ (setq arg (1+ arg))))
+ (move-to-column (or goal-column temporary-goal-column)))
+ ;; Remember where we moved to, go back home,
+ ;; then do the motion over again
+ ;; in just one step, with intangibility and point-motion hooks
+ ;; enabled this time.
+ (setq new (point))
+ (goto-char opoint)
+ (setq inhibit-point-motion-hooks nil)
+ (goto-char new)))
nil)
;;; Many people have said they rarely use this feature, and often type
;; (hscroll-point-visible))
(defun scroll-other-window-down (lines)
- "Scroll the \"other window\" down."
+ "Scroll the \"other window\" down.
+For more details, see the documentation for `scroll-other-window'."
(interactive "P")
(scroll-other-window
;; Just invert the argument's meaning.
(if (eq lines '-) nil
(if (null lines) '-
(- (prefix-numeric-value lines))))))
+(define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
(defun beginning-of-buffer-other-window (arg)
"Move point to the beginning of the buffer in the other window.
(defun indent-for-comment ()
"Indent this line's comment to comment column, or insert an empty comment."
(interactive "*")
- (beginning-of-line 1)
(let* ((empty (save-excursion (beginning-of-line)
(looking-at "[ \t]*$")))
(starter (or (and empty block-comment-start) comment-start))
(error "No comment syntax defined")
(let* ((eolpos (save-excursion (end-of-line) (point)))
cpos indent begpos)
+ (beginning-of-line)
(if (re-search-forward comment-start-skip eolpos 'move)
(progn (setq cpos (point-marker))
;; Find the start of the comment delimiter.
(defconst auto-fill-inhibit-regexp nil
"*Regexp to match lines which should not be auto-filled.")
+;; This function is the auto-fill-function of a buffer
+;; when Auto-Fill mode is enabled.
+;; It returns t if it really did any work.
(defun do-auto-fill ()
- (let (fc justify bol give-up)
+ (let (fc justify bol give-up
+ (fill-prefix fill-prefix))
(if (or (not (setq justify (current-justification)))
- (and (setq fc (current-fill-column)) ; make sure this gets set
- (eq justify 'left)
- (<= (current-column) (setq fc (current-fill-column))))
+ (null (setq fc (current-fill-column)))
+ (and (eq justify 'left)
+ (<= (current-column) fc))
(save-excursion (beginning-of-line)
(setq bol (point))
(and auto-fill-inhibit-regexp
nil ;; Auto-filling not required
(if (memq justify '(full center right))
(save-excursion (unjustify-current-line)))
+
+ ;; Choose a fill-prefix automatically.
+ (if (and adaptive-fill-mode
+ (or (null fill-prefix) (string= fill-prefix "")))
+ (let ((prefix
+ (fill-context-prefix
+ (save-excursion (backward-paragraph 1) (point))
+ (save-excursion (forward-paragraph 1) (point))
+ ;; Don't accept a non-whitespace fill prefix
+ ;; from the first line of a paragraph.
+ "^[ \t]*$")))
+ (and prefix (not (equal prefix ""))
+ (setq fill-prefix prefix))))
+
(while (and (not give-up) (> (current-column) fc))
- ;; Determine where to split the line.
- (let ((fill-point
- (let ((opoint (point))
- bounce
- (first t))
- (save-excursion
- (move-to-column (1+ fc))
- ;; Move back to a word boundary.
- (while (or first
- ;; If this is after period and a single space,
- ;; move back once more--we don't want to break
- ;; the line there and make it look like a
- ;; sentence end.
- (and (not (bobp))
- (not bounce)
- sentence-end-double-space
- (save-excursion (forward-char -1)
- (and (looking-at "\\. ")
- (not (looking-at "\\. "))))))
- (setq first nil)
- (skip-chars-backward "^ \t\n")
- ;; If we find nowhere on the line to break it,
- ;; break after one word. Set bounce to t
- ;; so we will not keep going in this while loop.
- (if (bolp)
- (progn
- (re-search-forward "[ \t]" opoint t)
- (setq bounce t)))
- (skip-chars-backward " \t"))
- ;; Let fill-point be set to the place where we end up.
- (point)))))
- ;; If that place is not the beginning of the line,
- ;; break the line there.
- (if (save-excursion
- (goto-char fill-point)
- (not (bolp)))
- (let ((prev-column (current-column)))
- ;; If point is at the fill-point, do not `save-excursion'.
- ;; Otherwise, if a comment prefix or fill-prefix is inserted,
- ;; point will end up before it rather than after it.
- (if (save-excursion
- (skip-chars-backward " \t")
- (= (point) fill-point))
- (indent-new-comment-line t)
- (save-excursion
- (goto-char fill-point)
- (indent-new-comment-line t)))
- ;; Now do justification, if required
- (if (not (eq justify 'left))
- (save-excursion
- (end-of-line 0)
- (justify-current-line justify nil t)))
- ;; If making the new line didn't reduce the hpos of
- ;; the end of the line, then give up now;
- ;; trying again will not help.
- (if (>= (current-column) prev-column)
- (setq give-up t)))
- ;; No place to break => stop trying.
- (setq give-up t))))
+ ;; Determine where to split the line.
+ (let ((fill-point
+ (let ((opoint (point))
+ bounce
+ (first t))
+ (save-excursion
+ (move-to-column (1+ fc))
+ ;; Move back to a word boundary.
+ (while (or first
+ ;; If this is after period and a single space,
+ ;; move back once more--we don't want to break
+ ;; the line there and make it look like a
+ ;; sentence end.
+ (and (not (bobp))
+ (not bounce)
+ sentence-end-double-space
+ (save-excursion (forward-char -1)
+ (and (looking-at "\\. ")
+ (not (looking-at "\\. "))))))
+ (setq first nil)
+ (skip-chars-backward "^ \t\n")
+ ;; If we find nowhere on the line to break it,
+ ;; break after one word. Set bounce to t
+ ;; so we will not keep going in this while loop.
+ (if (bolp)
+ (progn
+ (re-search-forward "[ \t]" opoint t)
+ (setq bounce t)))
+ (skip-chars-backward " \t"))
+ ;; Let fill-point be set to the place where we end up.
+ (point)))))
+ ;; If that place is not the beginning of the line,
+ ;; break the line there.
+ (if (save-excursion
+ (goto-char fill-point)
+ (not (bolp)))
+ (let ((prev-column (current-column)))
+ ;; If point is at the fill-point, do not `save-excursion'.
+ ;; Otherwise, if a comment prefix or fill-prefix is inserted,
+ ;; point will end up before it rather than after it.
+ (if (save-excursion
+ (skip-chars-backward " \t")
+ (= (point) fill-point))
+ (indent-new-comment-line t)
+ (save-excursion
+ (goto-char fill-point)
+ (indent-new-comment-line t)))
+ ;; Now do justification, if required
+ (if (not (eq justify 'left))
+ (save-excursion
+ (end-of-line 0)
+ (justify-current-line justify nil t)))
+ ;; If making the new line didn't reduce the hpos of
+ ;; the end of the line, then give up now;
+ ;; trying again will not help.
+ (if (>= (current-column) prev-column)
+ (setq give-up t)))
+ ;; No place to break => stop trying.
+ (setq give-up t))))
;; justify last line
- (justify-current-line justify t t))))
+ (justify-current-line justify t t)
+ t)))
(defun auto-fill-mode (&optional arg)
"Toggle auto-fill mode.
(> (prefix-numeric-value arg) 0))
'do-auto-fill
nil))
- ;; update mode-line
- (set-buffer-modified-p (buffer-modified-p))))
+ (force-mode-line-update)))
;; This holds a document string used to document auto-fill-mode.
(defun auto-fill-function ()
starting a new comment (and terminating it if necessary) on each line.
If you want to continue one comment across several lines, use \\[newline-and-indent].
+If a fill column is specified, it overrides the use of the comment column
+or comment indentation.
+
The inserted newline is marked hard if `use-hard-newlines' is true,
unless optional argument SOFT is non-nil."
(interactive)
(progn (skip-chars-forward " \t")
(point)))
(if soft (insert-and-inherit ?\n) (newline 1))
- (if (not comment-multi-line)
- (save-excursion
- (if (and comment-start-skip
- (let ((opoint (point)))
- (forward-line -1)
- (re-search-forward comment-start-skip opoint t)))
- ;; The old line is a comment.
- ;; Set WIN to the pos of the comment-start.
- ;; But if the comment is empty, look at preceding lines
- ;; to find one that has a nonempty comment.
-
- ;; If comment-start-skip contains a \(...\) pair,
- ;; the real comment delimiter starts at the end of that pair.
- (let ((win (or (match-end 1) (match-beginning 0))))
- (while (and (eolp) (not (bobp))
- (let (opoint)
- (beginning-of-line)
- (setq opoint (point))
- (forward-line -1)
- (re-search-forward comment-start-skip opoint t)))
- (setq win (or (match-end 1) (match-beginning 0))))
- ;; Indent this line like what we found.
- (goto-char win)
- (setq comcol (current-column))
- (setq comstart
- (buffer-substring (point) (match-end 0)))))))
- (if comcol
- (let ((comment-column comcol)
- (comment-start comstart)
- (comment-end comment-end))
- (and comment-end (not (equal comment-end ""))
-; (if (not comment-multi-line)
- (progn
- (forward-char -1)
- (insert comment-end)
- (forward-char 1))
-; (setq comment-column (+ comment-column (length comment-start))
-; comment-start "")
-; )
- )
- (if (not (eolp))
- (setq comment-end ""))
- (insert-and-inherit ?\n)
- (forward-char -1)
- (indent-for-comment)
+ (if fill-prefix
+ (progn
+ (indent-to-left-margin)
+ (insert-and-inherit fill-prefix))
+ (if (not comment-multi-line)
(save-excursion
- ;; Make sure we delete the newline inserted above.
- (end-of-line)
- (delete-char 1)))
- (if (null fill-prefix)
- (indent-according-to-mode)
- (indent-to-left-margin)
- (insert-and-inherit fill-prefix)))))
+ (if (and comment-start-skip
+ (let ((opoint (point)))
+ (forward-line -1)
+ (re-search-forward comment-start-skip opoint t)))
+ ;; The old line is a comment.
+ ;; Set WIN to the pos of the comment-start.
+ ;; But if the comment is empty, look at preceding lines
+ ;; to find one that has a nonempty comment.
+
+ ;; If comment-start-skip contains a \(...\) pair,
+ ;; the real comment delimiter starts at the end of that pair.
+ (let ((win (or (match-end 1) (match-beginning 0))))
+ (while (and (eolp) (not (bobp))
+ (let (opoint)
+ (beginning-of-line)
+ (setq opoint (point))
+ (forward-line -1)
+ (re-search-forward comment-start-skip opoint t)))
+ (setq win (or (match-end 1) (match-beginning 0))))
+ ;; Indent this line like what we found.
+ (goto-char win)
+ (setq comcol (current-column))
+ (setq comstart
+ (buffer-substring (point) (match-end 0)))))))
+ (if comcol
+ (let ((comment-column comcol)
+ (comment-start comstart)
+ (comment-end comment-end))
+ (and comment-end (not (equal comment-end ""))
+ ; (if (not comment-multi-line)
+ (progn
+ (forward-char -1)
+ (insert comment-end)
+ (forward-char 1))
+ ; (setq comment-column (+ comment-column (length comment-start))
+ ; comment-start "")
+ ; )
+ )
+ (if (not (eolp))
+ (setq comment-end ""))
+ (insert-and-inherit ?\n)
+ (forward-char -1)
+ (indent-for-comment)
+ (save-excursion
+ ;; Make sure we delete the newline inserted above.
+ (end-of-line)
+ (delete-char 1)))
+ (indent-according-to-mode)))))
\f
(defun set-selective-display (arg)
"Set `selective-display' to ARG; clear it if no arg.
'overwrite-mode-binary))
(force-mode-line-update))
\f
-(defvar line-number-mode nil
+(defvar line-number-mode t
"*Non-nil means display line number in mode line.")
(defun line-number-mode (arg)
(> (prefix-numeric-value arg) 0)))
(force-mode-line-update))
+(defvar column-number-mode nil
+ "*Non-nil means display column number in mode line.")
+
+(defun column-number-mode (arg)
+ "Toggle Column Number mode.
+With arg, turn Column Number mode on iff arg is positive.
+When Column Number mode is enabled, the column number appears
+in the mode line."
+ (interactive "P")
+ (setq column-number-mode
+ (if (null arg) (not column-number-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (force-mode-line-update))
+
(defvar blink-matching-paren t
"*Non-nil means show matching open-paren when close-paren is inserted.")
+(defvar blink-matching-paren-on-screen t
+ "*Non-nil means show matching open-paren when it is on screen.
+nil means don't show it (but the open-paren can still be shown
+when it is off screen.")
+
(defconst blink-matching-paren-distance 12000
"*If non-nil, is maximum distance to search for matching open-paren.")
(defconst blink-matching-delay 1
"*The number of seconds that `blink-matching-open' will delay at a match.")
+(defconst blink-matching-paren-dont-ignore-comments nil
+ "*Non-nil means `blink-matching-paren' should not ignore comments.")
+
(defun blink-matching-open ()
"Move cursor momentarily to the beginning of the sexp before point."
(interactive)
(- (point) blink-matching-paren-distance))
oldpos))
(condition-case ()
- (setq blinkpos (scan-sexps oldpos -1))
+ (let ((parse-sexp-ignore-comments
+ (and parse-sexp-ignore-comments
+ (not blink-matching-paren-dont-ignore-comments))))
+ (setq blinkpos (scan-sexps oldpos -1)))
(error nil)))
- (and blinkpos (/= (char-syntax (char-after blinkpos))
- ?\$)
+ (and blinkpos
+ (/= (char-syntax (char-after blinkpos))
+ ?\$)
(setq mismatch
- (/= (char-after (1- oldpos))
- (matching-paren (char-after blinkpos)))))
+ (or (null (matching-paren (char-after blinkpos)))
+ (/= (char-after (1- oldpos))
+ (matching-paren (char-after blinkpos))))))
(if mismatch (setq blinkpos nil))
(if blinkpos
(progn
(goto-char blinkpos)
(if (pos-visible-in-window-p)
- (sit-for blink-matching-delay)
+ (and blink-matching-paren-on-screen
+ (sit-for blink-matching-delay))
(goto-char blinkpos)
(message
"Matches %s"
\f
;; Define the major mode for lists of completions.
-(defvar completion-list-mode-map nil)
+(defvar completion-list-mode-map nil
+ "Local map for completion list buffers.")
(or completion-list-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'mouse-choose-completion)
;; Completion mode is suitable only for specially formatted data.
(put 'completion-list-mode 'mode-class 'special)
-;; Record the buffer that was current when the completion list was requested.
-;; Initial value is nil to avoid some compiler warnings.
-(defvar completion-reference-buffer nil)
+(defvar completion-reference-buffer nil
+ "Record the buffer that was current when the completion list was requested.
+This is a local variable in the completion list buffer.
+Initial value is nil to avoid some compiler warnings.")
-;; This records the length of the text at the beginning of the buffer
-;; which was not included in the completion.
-(defvar completion-base-size nil)
+(defvar completion-base-size nil
+ "Number of chars at beginning of minibuffer not involved in completion.
+This is a local variable in the completion list buffer
+but it talks about the buffer in `completion-reference-buffer'.
+If this is nil, it means to compare text to determine which part
+of the tail end of the buffer's text is involved in completion.")
(defun delete-completion-window ()
"Delete the completion list window.
(defun next-completion (n)
"Move to the next item in the completion list.
-WIth prefix argument N, move N items (negative N means move backward)."
+With prefix argument N, move N items (negative N means move backward)."
(interactive "p")
(while (and (> n 0) (not (eobp)))
- (let ((prop (get-text-property (point) 'mouse-face)))
+ (let ((prop (get-text-property (point) 'mouse-face))
+ (end (point-max)))
;; If in a completion, move to the end of it.
(if prop
- (goto-char (next-single-property-change (point) 'mouse-face)))
+ (goto-char (next-single-property-change (point) 'mouse-face nil end)))
;; Move to start of next one.
- (goto-char (next-single-property-change (point) 'mouse-face)))
+ (goto-char (next-single-property-change (point) 'mouse-face nil end)))
(setq n (1- n)))
(while (and (< n 0) (not (bobp)))
- (let ((prop (get-text-property (1- (point)) 'mouse-face)))
+ (let ((prop (get-text-property (1- (point)) 'mouse-face))
+ (end (point-min)))
;; If in a completion, move to the start of it.
(if prop
- (goto-char (previous-single-property-change (point) 'mouse-face)))
+ (goto-char (previous-single-property-change
+ (point) 'mouse-face nil end)))
;; Move to end of the previous completion.
- (goto-char (previous-single-property-change (point) 'mouse-face))
+ (goto-char (previous-single-property-change (point) 'mouse-face nil end))
;; Move to the start of that one.
- (goto-char (previous-single-property-change (point) 'mouse-face)))
+ (goto-char (previous-single-property-change (point) 'mouse-face nil end)))
(setq n (1+ n))))
(defun choose-completion ()
(forward-char 1))
(delete-char len)))
+;; Switch to BUFFER and insert the completion choice CHOICE.
+;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text
+;; to keep. If it is nil, use choose-completion-delete-max-match instead.
(defun choose-completion-string (choice &optional buffer base-size)
(let ((buffer (or buffer completion-reference-buffer)))
;; If BUFFER is a minibuffer, barf unless it's the currently
(setq completion-base-size nil)
(run-hooks 'completion-list-mode-hook))
-(defvar completion-fixup-function nil)
+(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.")
+
+;; This function goes in completion-setup-hook, so that it is called
+;; after the text of the completion list buffer is written.
(defun completion-setup-function ()
(save-excursion
- (let ((mainbuf (current-buffer))
- (base-size (- (point-max) (point-min))))
+ (let ((mainbuf (current-buffer)))
(set-buffer standard-output)
(completion-list-mode)
(make-local-variable 'completion-reference-buffer)
(setq completion-reference-buffer mainbuf)
- (setq completion-base-size base-size)
+;;; The value 0 is right in most cases, but not for file name completion.
+;;; so this has to be turned off.
+;;; (setq completion-base-size 0)
(goto-char (point-min))
(if window-system
(insert (substitute-command-keys
(defun switch-to-completions ()
"Select the completion list window."
(interactive)
+ ;; Make sure we have a completions window.
+ (or (get-buffer-window "*Completions*")
+ (minibuffer-completion-help))
(select-window (get-buffer-window "*Completions*"))
(goto-char (point-min))
(search-forward "\n\n")
PREFIX is the string that represents this modifier in an event type symbol."
(if (numberp event)
(cond ((eq symbol 'control)
- (if (and (< (downcase event) ?z)
- (> (downcase event) ?a))
+ (if (and (<= (downcase event) ?z)
+ (>= (downcase event) ?a))
(- (downcase event) ?a -1)
- (if (and (< (downcase event) ?Z)
- (> (downcase event) ?A))
+ (if (and (<= (downcase event) ?Z)
+ (>= (downcase event) ?A))
(- (downcase event) ?A -1)
(logior (lsh 1 lshiftby) event))))
((eq symbol 'shift)
event-type
(cons event-type (cdr event)))))))
-(define-key function-key-map [?\C-x escape ?h] 'event-apply-hyper-modifier)
-(define-key function-key-map [?\C-x escape ?s] 'event-apply-super-modifier)
-(define-key function-key-map [?\C-x escape ?m] 'event-apply-meta-modifier)
-(define-key function-key-map [?\C-x escape ?a] 'event-apply-alt-modifier)
-(define-key function-key-map [?\C-x escape ?S] 'event-apply-shift-modifier)
-(define-key function-key-map [?\C-x escape ?c] 'event-apply-control-modifier)
-
-(define-key function-key-map [?\C-x ?\e ?h] 'event-apply-hyper-modifier)
-(define-key function-key-map [?\C-x ?\e ?s] 'event-apply-super-modifier)
-(define-key function-key-map [?\C-x ?\e ?m] 'event-apply-meta-modifier)
-(define-key function-key-map [?\C-x ?\e ?a] 'event-apply-alt-modifier)
-(define-key function-key-map [?\C-x ?\e ?S] 'event-apply-shift-modifier)
-(define-key function-key-map [?\C-x ?\e ?c] 'event-apply-control-modifier)
+(define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
+(define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier)
+(define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier)
+(define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
+(define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
+(define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
\f
;;;; Keypad support.