;;; 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.
+ "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."
(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."
'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))
(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] 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
+ (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."
(interactive "p")
(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")
"*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
(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.
(defun do-auto-fill ()
(let (fc justify bol give-up)
(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
(> (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 ()
\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.
(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
- (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")
(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