;;; 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)))
+ (self-insert-command (prefix-numeric-value arg)))
+ ;; 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, insert the fill prefix on the new line
-if the line would have been empty.
+If there is a fill prefix and/or a left-margin, insert them on the new line
+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-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."
(eq overwrite-mode 'overwrite-mode-binary))
(read-quoted-char)
(read-char))))
- (if (eq overwrite-mode 'overwrite-mode-binary)
- (delete-char arg))
- (insert-char char arg)))
+ (if (> arg 0)
+ (if (eq overwrite-mode 'overwrite-mode-binary)
+ (delete-char arg)))
+ (while (> arg 0)
+ (insert-and-inherit char)
+ (setq arg (1- arg)))))
(defun delete-indentation (&optional arg)
"Join this line to previous and fix up whitespace at join.
'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 next-history-element (n)
"Insert the next element of the minibuffer history into the minibuffer."
(interactive "p")
- (let ((narg (min (max 1 (- minibuffer-history-position n))
- (length (symbol-value minibuffer-history-variable)))))
- (if (= minibuffer-history-position narg)
- (error (if (= minibuffer-history-position 1)
- "End of history; no next item"
- "Beginning of history; no preceding item"))
- (erase-buffer)
- (setq minibuffer-history-position narg)
- (let ((elt (nth (1- minibuffer-history-position)
- (symbol-value minibuffer-history-variable))))
- (insert
- (if minibuffer-history-sexp-flag
- (let ((print-level nil))
- (prin1-to-string elt))
- elt)))
- (goto-char (point-min)))))
+ (or (zerop n)
+ (let ((narg (min (max 1 (- minibuffer-history-position n))
+ (length (symbol-value minibuffer-history-variable)))))
+ (if (or (zerop narg)
+ (= minibuffer-history-position narg))
+ (error (if (if (zerop narg)
+ (> n 0)
+ (= minibuffer-history-position 1))
+ "End of history; no next item"
+ "Beginning of history; no preceding item"))
+ (erase-buffer)
+ (setq minibuffer-history-position narg)
+ (let ((elt (nth (1- minibuffer-history-position)
+ (symbol-value minibuffer-history-variable))))
+ (insert
+ (if minibuffer-history-sexp-flag
+ (let ((print-level nil))
+ (prin1-to-string elt))
+ elt)))
+ (goto-char (point-min))))))
(defun previous-history-element (n)
"Inserts the previous element of the minibuffer history into the minibuffer."
(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*'.
+
+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.
(if (string-match "[ \t]*&[ \t]*$" command)
;; Command ending with ampersand means asynchronous.
(let ((buffer (get-buffer-create
- (or output-buffer "*Shell-Command*")))
+ (or output-buffer "*Asynch Shell Command*")))
(directory default-directory)
proc)
;; Remove the ampersand.
(set-buffer obuf))))
(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.
In either case, the output is inserted after point (leaving mark after it)."
- (interactive (list (region-beginning) (region-end)
- (read-from-minibuffer "Shell command on region: "
- nil nil nil 'shell-command-history)
- current-prefix-arg
- (prefix-numeric-value current-prefix-arg)))
- (if (and output-buffer
- (not (or (bufferp output-buffer) (stringp output-buffer))))
+ (interactive (let ((string
+ ;; Do this before calling region-beginning
+ ;; and region-end, in case subprocess output
+ ;; relocates them while we are in the minibuffer.
+ (read-from-minibuffer "Shell command on region: "
+ nil nil nil
+ 'shell-command-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)))))
;; 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 (< (point) (mark)))))
+ ;; 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
(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."
(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")
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
(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.
(and auto-fill-inhibit-regexp
(looking-at auto-fill-inhibit-regexp))))
nil ;; Auto-filling not required
- ;; Remove justification-introduced whitespace before filling
- (cond ((eq 'left justify) nil)
- ((eq 'full justify) ; full justify: remove extra spaces
- (canonically-space-region
- (point) (save-excursion (end-of-line) (point))))
- ;; right or center justify: remove extra indentation.
- (t (save-excursion (indent-according-to-mode))))
+ (if (memq justify '(full center right))
+ (save-excursion (unjustify-current-line)))
(while (and (not give-up) (> (current-column) fc))
;; Determine where to split the line.
(let ((fill-point
(> (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 ()
;; 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)))
+
+ ;; 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 (match-beginning 0)))
+ (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)))))))
+ (setq comstart
+ (buffer-substring (point) (match-end 0)))))))
(if comcol
(let ((comment-column comcol)
(comment-start comstart)
;; Make sure we delete the newline inserted above.
(end-of-line)
(delete-char 1)))
- (if fill-prefix
- (insert-and-inherit fill-prefix)
- (indent-according-to-mode)))))
+ (if (null fill-prefix)
+ (indent-according-to-mode)
+ (indent-to-left-margin)
+ (insert-and-inherit fill-prefix)))))
\f
(defun set-selective-display (arg)
"Set `selective-display' to ARG; clear it if no arg.
\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
(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