;;; 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.
;;; Code:
+(defun newline (&optional arg)
+ "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")
+ ;; 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
+ ;; the end of the previous line.
+ (let ((flag (and (not (bobp))
+ (bolp)
+ (< (or (previous-property-change (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.
+ ;; 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)))
+ (sticky (get-text-property from 'rear-nonsticky)))
+ (put-text-property from (point) 'hard 't)
+ ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
+ (if (and (listp sticky) (not (memq 'hard sticky)))
+ (put-text-property from (point) 'rear-nonsticky
+ (cons 'hard sticky)))))
+ ;; 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."
(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.
'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))
(defun shell-command (command &optional output-buffer)
"Execute string COMMAND in inferior shell; display output, if any.
+
If COMMAND ends in ampersand, execute it asynchronously.
-The output appears in the buffer `*Shell Command*'.
+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*'.
+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.
+If there is no output, or if output is inserted in the current buffer,
+then `*Shell Command Output*' is deleted.
The optional second argument OUTPUT-BUFFER, if non-nil,
says to put the output in some other buffer.
;; 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.
+ ;; 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
- (if (string-match "[ \t]*&[ \t]*$" command)
- ;; Command ending with ampersand means asynchronous.
- (let ((buffer (get-buffer-create
- (or output-buffer "*Shell-Command*")))
- (directory default-directory)
- proc)
- ;; Remove the ampersand.
- (setq command (substring command 0 (match-beginning 0)))
- ;; If will kill a process, query first.
- (setq proc (get-buffer-process buffer))
- (if proc
- (if (yes-or-no-p "A command is running. Kill it? ")
- (kill-process proc)
- (error "Shell command in progress")))
- (save-excursion
- (set-buffer buffer)
- (setq buffer-read-only nil)
- (erase-buffer)
- (display-buffer buffer)
- (setq default-directory directory)
- (setq proc (start-process "Shell" buffer
- shell-file-name
- shell-command-switch command))
- (setq mode-line-process '(":%s"))
- (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)))))
+ (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*")))
+ (directory default-directory)
+ proc)
+ ;; Remove the ampersand.
+ (setq command (substring command 0 (match-beginning 0)))
+ ;; If will kill a process, query first.
+ (setq proc (get-buffer-process buffer))
+ (if proc
+ (if (yes-or-no-p "A command is running. Kill it? ")
+ (kill-process proc)
+ (error "Shell command in progress")))
+ (save-excursion
+ (set-buffer buffer)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (display-buffer buffer)
+ (setq default-directory directory)
+ (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)
+ ))
+ (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 interactive)
+ &optional output-buffer replace)
"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.
-Noninteractive args are START, END, COMMAND, FLAG.
-Noninteractively FLAG means insert output in place of text from START to END,
-and put point at the end, but don't alter the mark.
+
+The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE.
+If REPLACE is non-nil, that means insert the output
+in place of text from START to END, putting point and mark around it.
If the output is one line, it is displayed in the echo area,
but it is nonetheless available in buffer `*Shell Command Output*'
-even though that buffer is not automatically displayed. If there is no output
-or output is inserted in the current buffer then `*Shell Command Output*' is
-deleted.
+even though that buffer is not automatically displayed.
+If there is no output, or if output is inserted in the current buffer,
+then `*Shell Command Output*' is deleted.
-The optional second argument OUTPUT-BUFFER, if non-nil,
-says to put the output in some other buffer.
+If the optional fourth argument OUTPUT-BUFFER is non-nil,
+that says to put the output in some other buffer.
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
If OUTPUT-BUFFER is not a buffer and not nil,
insert output in the current buffer.
(read-from-minibuffer "Shell command on region: "
nil nil nil
'shell-command-history)))
- (list (region-beginning) (region-end)
+ (list (point) (mark)
string
current-prefix-arg
- (prefix-numeric-value current-prefix-arg))))
- (if (and output-buffer
- (not (or (bufferp output-buffer) (stringp output-buffer))))
+ current-prefix-arg)))
+ (if (or replace
+ (and output-buffer
+ (not (or (bufferp output-buffer) (stringp output-buffer)))))
;; Replace specified region with output from command.
- (let ((swap (and interactive (< (point) (mark)))))
- ;; Don't muck with mark
- ;; unless called interactively.
- (and interactive (push-mark))
+ (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 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)))
- (and interactive swap (exchange-point-and-mark)))
+ ;; 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
;; 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) (max start end))
(call-process-region (point-min) (point-max)
shell-file-name t t nil
shell-command-switch command)
(t
(set-window-start (display-buffer buffer) 1))))))))
\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] 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 nil)
- (let ((factor 4)
- key)
-;; (describe-arg (list factor) 1)
- (setq key (read-key-sequence nil t))
- (while (equal (key-binding key) 'universal-argument)
- (setq factor (* 4 factor))
-;; (describe-arg (list factor) 1)
- (setq key (read-key-sequence nil t)))
- (prefix-arg-internal key factor nil)))
-
-(defun prefix-arg-internal (key factor value)
- (let ((sign 1))
- (if (and (numberp value) (< value 0))
- (setq sign -1 value (- value)))
- (if (eq value '-)
- (setq sign -1 value nil))
-;; (describe-arg value sign)
- (while (equal key "-")
- (setq sign (- sign) factor nil)
-;; (describe-arg value sign)
- (setq key (read-key-sequence nil t)))
- (while (and (stringp key)
- (= (length key) 1)
- (not (string< key "0"))
- (not (string< "9" key)))
- (setq value (+ (* (if (numberp value) value 0) 10)
- (- (aref key 0) ?0))
- factor nil)
-;; (describe-arg value sign)
- (setq key (read-key-sequence nil t)))
- (setq prefix-arg
- (cond (factor (list factor))
- ((numberp value) (* value sign))
- ((= sign -1) '-)))
- ;; Calling universal-argument after digits
- ;; terminates the argument but is ignored.
- (if (eq (key-binding key) 'universal-argument)
- (progn
- (describe-arg value sign)
- (setq key (read-key-sequence nil t))))
- (setq unread-command-events (listify-key-sequence key))))
-
-(defun describe-arg (value sign)
- (cond ((numberp value)
- (message "Arg: %d" (* value sign)))
- ((consp value)
- (message "Arg: [%d]" (car value)))
- ((< sign 0)
- (message "Arg: -"))))
+ (interactive)
+ (setq prefix-arg (list 4))
+ (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."
+;; 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")
- (prefix-arg-internal (char-to-string (logand last-command-char ?\177))
- nil arg))
+ (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")
- (prefix-arg-internal "-" nil arg))
+ (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
+ (nthcdr universal-argument-num-events keylist)))
+ (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.
(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")
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.
at the start of current run of vertical motion commands.
When the `track-eol' feature is doing its job, the value is 9999.")
+(defvar line-move-ignore-invisible nil
+ "*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 (not (integerp selective-display))
- (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))
- (setq arg (1- arg)))
- (while (< arg 0)
- (beginning-of-line)
- (and (zerop (vertical-motion -1))
- (signal 'beginning-of-buffer nil))
- (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.
(make-variable-buffer-local 'comment-column)
(defconst comment-start nil
- "*String to insert to start a new comment, or nil if no comment syntax defined.")
+ "*String to insert to start a new comment, or nil if no comment syntax.")
(defconst comment-start-skip nil
"*Regexp to match the start of a comment plus everything up to its body.
This function is called with no args with point at the beginning of
the comment's starting delimiter.")
+(defconst block-comment-start nil
+ "*String to insert to start a new comment on a line by itself.
+If nil, use `comment-start' instead.
+Note that the regular expression `comment-start-skip' should skip this string
+as well as the `comment-start' string.")
+
+(defconst block-comment-end nil
+ "*String to insert to end a new comment on a line by itself.
+Should be an empty string if comments are terminated by end-of-line.
+If nil, use `comment-end' instead.")
+
(defun indent-for-comment ()
"Indent this line's comment to comment column, or insert an empty comment."
(interactive "*")
- (beginning-of-line 1)
- (if (null comment-start)
- (error "No comment syntax defined")
- (let* ((eolpos (save-excursion (end-of-line) (point)))
- cpos indent begpos)
- (if (re-search-forward comment-start-skip eolpos 'move)
- (progn (setq cpos (point-marker))
- ;; Find the start of the comment delimiter.
- ;; If there were paren-pairs in comment-start-skip,
- ;; position at the end of the first pair.
- (if (match-end 1)
- (goto-char (match-end 1))
- ;; If comment-start-skip matched a string with
- ;; internal whitespace (not final whitespace) then
- ;; the delimiter start at the end of that
- ;; whitespace. Otherwise, it starts at the
- ;; beginning of what was matched.
- (skip-syntax-backward " " (match-beginning 0))
- (skip-syntax-backward "^ " (match-beginning 0)))))
- (setq begpos (point))
- ;; Compute desired indent.
- (if (= (current-column)
- (setq indent (if comment-indent-hook
- (funcall comment-indent-hook)
- (funcall comment-indent-function))))
- (goto-char begpos)
- ;; If that's different from current, change it.
- (skip-chars-backward " \t")
- (delete-region (point) begpos)
- (indent-to indent))
- ;; An existing comment?
- (if cpos
- (progn (goto-char cpos)
- (set-marker cpos nil))
- ;; No, insert one.
- (insert comment-start)
- (save-excursion
- (insert comment-end))))))
+ (let* ((empty (save-excursion (beginning-of-line)
+ (looking-at "[ \t]*$")))
+ (starter (or (and empty block-comment-start) comment-start))
+ (ender (or (and empty block-comment-end) comment-end)))
+ (if (null starter)
+ (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.
+ ;; If there were paren-pairs in comment-start-skip,
+ ;; position at the end of the first pair.
+ (if (match-end 1)
+ (goto-char (match-end 1))
+ ;; If comment-start-skip matched a string with
+ ;; internal whitespace (not final whitespace) then
+ ;; the delimiter start at the end of that
+ ;; whitespace. Otherwise, it starts at the
+ ;; beginning of what was matched.
+ (skip-syntax-backward " " (match-beginning 0))
+ (skip-syntax-backward "^ " (match-beginning 0)))))
+ (setq begpos (point))
+ ;; Compute desired indent.
+ (if (= (current-column)
+ (setq indent (if comment-indent-hook
+ (funcall comment-indent-hook)
+ (funcall comment-indent-function))))
+ (goto-char begpos)
+ ;; If that's different from current, change it.
+ (skip-chars-backward " \t")
+ (delete-region (point) begpos)
+ (indent-to indent))
+ ;; An existing comment?
+ (if cpos
+ (progn (goto-char cpos)
+ (set-marker cpos nil))
+ ;; No, insert one.
+ (insert starter)
+ (save-excursion
+ (insert ender)))))))
(defun set-comment-column (arg)
"Set the comment column based on point.
"*Regexp to match lines which should not be auto-filled.")
(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 (start end temp)
+ (save-excursion
+ (end-of-line)
+ (setq end (point))
+ (beginning-of-line)
+ (setq start (point))
+ (move-to-left-margin)
+ ;; Don't do it if this line is a paragraph-starter line
+ ;; because then the next line will probably also become one.
+ ;; In text mode, when the user indents the first line of a
+ ;; paragraph, we don't want all the lines to be indented.
+ (if (not (looking-at paragraph-start))
+ (cond ((re-search-forward adaptive-fill-regexp end t)
+ (setq fill-prefix
+ (buffer-substring-no-properties start (point))))
+ ((setq temp (funcall adaptive-fill-function))
+ (setq fill-prefix temp)))))))
+
(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))))
(> (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.
- (let ((win (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 (match-beginning 0)))
- ;; Indent this line like what we found.
- (goto-char win)
+ (if fill-prefix
+ (progn
+ (indent-to-left-margin)
+ (insert-and-inherit fill-prefix))
+ (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.
- (if (match-end 1)
- (goto-char (match-end 1)))
- (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)))
- (if (null fill-prefix)
- (indent-according-to-mode)
- (indent-to-left-margin)
- (insert-and-inherit fill-prefix)))))
+ (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 t
+ "*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.")
(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
\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.
(if (and (not (eobp)) (get-text-property (point) 'mouse-face))
(setq end (point) beg (1+ (point))))
(if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
- (setq end (1- (point)) beg(point)))
+ (setq end (1- (point)) beg (point)))
(if (null beg)
(error "No completion here"))
(setq beg (previous-single-property-change beg 'mouse-face))
(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
;; active minibuffer.
(if (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))
- (or (not (minibuffer-window-active-p (minibuffer-window)))
- (not (equal buffer (window-buffer (minibuffer-window))))))
+ (or (not (active-minibuffer-window))
+ (not (equal buffer
+ (window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion")
;; Insert the completion into the buffer where completion was requested.
(set-buffer buffer)
(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
(completion-list-mode)
(make-local-variable 'completion-reference-buffer)
(setq completion-reference-buffer mainbuf)
+;;; 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")
(forward-line 1))
\f
+;; Support keyboard commands to turn on various modifiers.
+
+;; These functions -- which are not commands -- each add one modifier
+;; to the following event.
+
+(defun event-apply-alt-modifier (ignore-prompt)
+ (vector (event-apply-modifier (read-event) 'alt 22 "A-")))
+(defun event-apply-super-modifier (ignore-prompt)
+ (vector (event-apply-modifier (read-event) 'super 23 "s-")))
+(defun event-apply-hyper-modifier (ignore-prompt)
+ (vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
+(defun event-apply-shift-modifier (ignore-prompt)
+ (vector (event-apply-modifier (read-event) 'shift 25 "S-")))
+(defun event-apply-control-modifier (ignore-prompt)
+ (vector (event-apply-modifier (read-event) 'control 26 "C-")))
+(defun event-apply-meta-modifier (ignore-prompt)
+ (vector (event-apply-modifier (read-event) 'meta 27 "M-")))
+
+(defun event-apply-modifier (event symbol lshiftby prefix)
+ "Apply a modifier flag to event EVENT.
+SYMBOL is the name of this modifier, as a symbol.
+LSHIFTBY is the numeric value of this modifier, in keyboard events.
+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))
+ (- (downcase event) ?a -1)
+ (if (and (<= (downcase event) ?Z)
+ (>= (downcase event) ?A))
+ (- (downcase event) ?A -1)
+ (logior (lsh 1 lshiftby) event))))
+ ((eq symbol 'shift)
+ (if (and (<= (downcase event) ?z)
+ (>= (downcase event) ?a))
+ (upcase event)
+ (logior (lsh 1 lshiftby) event)))
+ (t
+ (logior (lsh 1 lshiftby) event)))
+ (if (memq symbol (event-modifiers event))
+ event
+ (let ((event-type (if (symbolp event) event (car event))))
+ (setq event-type (intern (concat prefix (symbol-name event-type))))
+ (if (symbolp event)
+ event-type
+ (cons event-type (cdr event)))))))
+
+(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.
;;; Make the keypad keys act like ordinary typing keys. If people add
HCoop / bpt / emacs.git / blobdiff