(if (and buffer-undo-list (not (eq buffer-undo-list t)))
(setq buffer-undo-list (cons (point) buffer-undo-list)))
(forward-char -1)))
- (while (> arg 0)
- (save-excursion
- (insert ?\n))
- (if do-fill-prefix (insert fill-prefix))
- (setq arg (1- arg)))
+ (save-excursion
+ (while (> arg 0)
+ (if do-fill-prefix (insert fill-prefix))
+ (insert ?\n)
+ (setq arg (1- arg))))
+ (end-of-line)
(if flag (forward-char 1))))
(defun split-line ()
(goto-char (point-min)))
(defun count-lines-region (start end)
- "Print number of lines and charcters in the region."
+ "Print number of lines and characters in the region."
(interactive "r")
(message "Region has %d lines, %d characters"
(count-lines start end) (- end start)))
(setq done (+ 40 done)))
(while (re-search-forward "[\n\C-m]" nil t 1)
(setq done (+ 1 done)))
- done)
+ (goto-char (point-max))
+ (if (and (/= start end)
+ (not (bolp)))
+ (1+ done)
+ done))
(- (buffer-size) (forward-line (buffer-size))))))))
(defun what-cursor-position ()
(interactive)
(kill-all-local-variables))
-(defvar read-expression-map (copy-keymap minibuffer-local-map)
+(defvar read-expression-map (cons 'keymap minibuffer-local-map)
"Minibuffer keymap used for reading Lisp expressions.")
(define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
(put 'eval-expression 'disabled t)
-;; We define this, rather than making eval interactive,
+(defvar read-expression-history nil)
+
+;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-current-buffer.
(defun eval-expression (expression)
"Evaluate EXPRESSION and print value in minibuffer.
Value is also consed on to front of the variable `values'."
- (interactive (list (read-from-minibuffer "Eval: "
- nil read-expression-map t)))
+ (interactive
+ (list (read-from-minibuffer "Eval: "
+ nil read-expression-map t
+ 'read-expression-history)))
(setq values (cons (eval expression) values))
(prin1 (car values) t))
the minibuffer, then read and evaluate the result."
(let ((command (read-from-minibuffer prompt
(prin1-to-string command)
- read-expression-map t)))
- ;; Add edited command to command history, unless redundant.
- (or (equal command (car command-history))
- (setq command-history (cons command command-history)))
+ read-expression-map t
+ '(command-history . 1))))
(eval command)))
(defun repeat-complex-command (arg)
newcmd)
(if elt
(progn
- (setq newcmd (read-from-minibuffer "Redo: "
- (prin1-to-string elt)
- read-expression-map
- t
- (cons 'command-history
- arg)))
+ (setq newcmd
+ (read-from-minibuffer
+ "Redo: " (prin1-to-string elt) read-expression-map t
+ (cons 'command-history arg)))
+
;; If command was added to command-history as a string,
;; get rid of that. We want only evallable expressions there.
(if (stringp (car command-history))
(setq command-history (cdr command-history)))
+
;; If command to be redone does not match front of history,
;; add it to the history.
(or (equal newcmd (car command-history))
(next-history-element (- n)))
(defun next-complete-history-element (n)
- "\
-Get previous element of history which is a completion of minibuffer contents."
+ "Get next element of history which is a completion of minibuffer contents."
(interactive "p")
(let ((point-at-start (point)))
(next-matching-history-element
(goto-char point-at-start)))
(defun previous-complete-history-element (n)
- "Get next element of history which is a completion of minibuffer contents."
+ "\
+Get previous element of history which is a completion of minibuffer contents."
(interactive "p")
(next-complete-history-element (- n)))
\f
(error "No further undo information"))
(setq pending-undo-list (primitive-undo count pending-undo-list)))
-(defvar last-shell-command "")
-(defvar last-shell-command-on-region "")
+(defvar shell-command-history nil
+ "History list for some commands that read shell commands.")
(defun shell-command (command &optional flag)
"Execute string COMMAND in inferior shell; display output, if any.
Optional second arg non-nil (prefix arg, if interactive)
means insert output in current buffer after point (leave mark after it).
This cannot be done asynchronously."
- (interactive (list (read-string "Shell command: " last-shell-command)
+ (interactive (list (read-from-minibuffer "Shell command: "
+ nil nil nil 'shell-command-history)
current-prefix-arg))
(if flag
(progn (barf-if-buffer-read-only)
or output is inserted in the current buffer then `*Shell Command Output*' is
deleted."
(interactive (list (region-beginning) (region-end)
- (read-string "Shell command on region: "
- last-shell-command-on-region)
+ (read-from-minibuffer "Shell command on region: "
+ nil nil nil 'shell-command-history)
current-prefix-arg
(prefix-numeric-value current-prefix-arg)))
(if flag
(kill-new interprogram-paste))
interprogram-paste)
(or kill-ring (error "Kill ring is empty"))
- (let* ((length (length kill-ring))
- (ARGth-kill-element
- (nthcdr (% (+ n (- length (length kill-ring-yank-pointer)))
- length)
- kill-ring)))
+ (let ((ARGth-kill-element
+ (nthcdr (mod (- n (length kill-ring-yank-pointer))
+ (length kill-ring))
+ kill-ring)))
(or do-not-move
(setq kill-ring-yank-pointer ARGth-kill-element))
(car ARGth-kill-element)))))
;; ring to share the same string object. This code does that.
((not (or (eq buffer-undo-list t)
(eq last-command 'kill-region)
- (eq beg end)))
+ (equal beg end)))
;; Don't let the undo list be truncated before we can even access it.
- (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100)))
+ (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100))
+ (old-list buffer-undo-list)
+ tail)
(delete-region beg end)
+ ;; Search back in buffer-undo-list for this string,
+ ;; in case a change hook made property changes.
+ (setq tail buffer-undo-list)
+ (while (not (stringp (car (car tail))))
+ (setq tail (cdr tail)))
;; Take the same string recorded for undo
;; and put it in the kill-ring.
- (kill-new (car (car buffer-undo-list)))
+ (kill-new (car (car tail)))
(setq this-command 'kill-region)))
(t
(goto-char opoint)
;; If user quit, deactivate the mark
;; as C-g would as a command.
- (and quit-flag transient-mark-mode mark-active
- (progn
- (message "foo")
- (setq mark-active nil)
- (run-hooks 'deactivate-mark-hook))))
+ (and quit-flag mark-active
+ (deactivate-mark)))
(let* ((killed-text (current-kill 0))
(message-len (min (length killed-text) 40)))
(if (= (point) beg)
BUFFER (or buffer name), START and END.
START and END specify the portion of the current buffer to be copied."
(interactive
- (list (read-buffer "Append to buffer: " (other-buffer nil t) t)))
+ (list (read-buffer "Append to buffer: " (other-buffer nil t))
+ (region-beginning) (region-end)))
(let ((oldbuf (current-buffer)))
(save-excursion
(set-buffer (get-buffer-create buffer))
(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")
+
(defun mark (&optional force)
- "Return this buffer's mark value as integer, or nil if no active mark now.
+ "Return this buffer's mark value as integer; error if mark inactive.
If optional argument FORCE is non-nil, access the mark value
-even if the mark is not currently active.
+even if the mark is not currently active, and return nil
+if there is no mark at all.
If you are using this in an editing command, you are most likely making
a mistake; see the documentation of `set-mark'."
- (if (or force mark-active)
+ (if (or force mark-active mark-even-if-inactive)
(marker-position (mark-marker))
- (error "The mark is not currently active")))
+ (signal 'mark-inactive nil)))
+
+;; Many places set mark-active directly, and several of them failed to also
+;; run deactivate-mark-hook. This shorthand should simplify.
+(defsubst deactivate-mark ()
+ "Deactivate the mark by setting `mark-active' to nil.
+\(That makes a difference only in Transient Mark mode.)
+Also runs the hook `deactivate-mark-hook'."
+ (setq mark-active nil)
+ (run-hooks 'deactivate-mark-hook))
(defun set-mark (pos)
"Set this buffer's mark to POS. Don't use this function!
(let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
- (setq mark-active t)
- (run-hooks 'activate-mark-hook)
- (set-marker (mark-marker) pos (current-buffer)))
+ (if pos
+ (progn
+ (setq mark-active t)
+ (run-hooks 'activate-mark-hook)
+ (set-marker (mark-marker) pos (current-buffer)))
+ (deactivate-mark)
+ (set-marker (mark-marker) pos (current-buffer))))
(defvar mark-ring nil
"The list of saved former marks of the current buffer,
(progn
(setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
(set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
- (if transient-mark-mode
- (setq mark-active nil))
+ (deactivate-mark)
(move-marker (car mark-ring) nil)
(if (null (mark t)) (ding))
(setq mark-ring (cdr mark-ring)))))
"Toggle Transient Mark mode.
With arg, turn Transient Mark mode on if arg is positive, off otherwise.
-In Transient Mark mode, changing the buffer \"deactivates\" the mark.
-While the mark is active, the region is highlighted."
+In Transient Mark mode, when the mark is active, the region is highlighted.
+Changing the buffer \"deactivates\" the mark.
+So do certain other operations that set the mark
+but whose main purpose is something else--for example,
+incremental search, \\[beginning-of-buffer], and \\[end-of-buffer]."
(interactive "P")
(setq transient-mark-mode
(if (null arg)
(defun hscroll-point-visible ()
"Scrolls the window horizontally to make point visible."
- (let* ((min (window-hscroll))
- (max (- (+ min (window-width)) 2))
- (here (current-column))
- (delta (if (zerop hscroll-step) (/ (window-width) 2) hscroll-step))
- )
- (if (< here min)
- (scroll-right (max 0 (+ (- min here) delta)))
- (if (>= here max)
- (scroll-left (- (- here min) delta))
- ))))
+ (let* ((here (current-column))
+ (left (window-hscroll))
+ (right (- (+ left (window-width)) 3)))
+ (cond
+ ;; Should we recenter?
+ ((or (< here (- left hscroll-step))
+ (> here (+ right hscroll-step)))
+ (set-window-hscroll
+ (selected-window)
+ ;; Recenter, but don't show too much white space off the end of
+ ;; the line.
+ (max 0
+ (min (- (save-excursion (end-of-line) (current-column))
+ (window-width)
+ -5)
+ (- here (/ (window-width) 2))))))
+ ;; Should we scroll left?
+ ((> here right)
+ (scroll-left hscroll-step))
+ ;; Or right?
+ ((< here left)
+ (scroll-right hscroll-step)))))
;; rms: (1) The definitions of arrow keys should not simply restate
;; what keys they are. The arrow keys should run the ordinary commands.
(if (save-excursion
(goto-char fill-point)
(not (bolp)))
- ;; 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)
- (save-excursion
- (goto-char fill-point)
- (indent-new-comment-line)))
+ (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)
+ (save-excursion
+ (goto-char fill-point)
+ (indent-new-comment-line)))
+ ;; 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)))))))
"Move cursor momentarily to the beginning of the sexp before point."
(interactive)
(and (> (point) (1+ (point-min)))
- (/= (char-syntax (char-after (- (point) 2))) ?\\ )
+ (not (memq (char-syntax (char-after (- (point) 2))) '(?/ ?\\ )))
blink-matching-paren
(let* ((oldpos (point))
(blinkpos)
During execution of Lisp code, this character causes a quit directly.
At top-level, as an editor command, this simply beeps."
(interactive)
- (and transient-mark-mode mark-active
- (progn
- (setq mark-active nil)
- (run-hooks 'deactivate-mark-hook)))
+ (deactivate-mark)
(signal 'quit nil))
(define-key global-map "\C-g" 'keyboard-quit)
'arg))
(eval-minibuffer (format "Set %s to value: " var)))))))
(set var val))
+\f
+;; Define the major mode for lists of completions.
+
+(defvar completion-list-mode-map nil)
+(or completion-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'mouse-choose-completion)
+ (setq completion-list-mode-map map)))
+
+;; Completion mode is suitable only for specially formatted data.
+(put 'completion-list-mode 'mode-class 'special)
+
+(defun completion-list-mode ()
+ "Major mode for buffers showing lists of possible completions.
+Type \\<completion-list-mode-map>\\[mouse-choose-completion] to select
+a completion with the mouse."
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map completion-list-mode-map)
+ (setq mode-name "Completion List")
+ (setq major-mode 'completion-list-mode)
+ (run-hooks 'completion-list-mode-hook))
+
+(defun completion-setup-function ()
+ (save-excursion
+ (completion-list-mode)
+ (goto-char (point-min))
+ (if window-system
+ (insert (substitute-command-keys
+ "Click \\[mouse-choose-completion] on a completion to select it.\n\n")))))
+
+(add-hook 'completion-setup-hook 'completion-setup-function)
+\f
+;;;; Keypad support.
+
+;;; Make the keypad keys act like ordinary typing keys. If people add
+;;; bindings for the function key symbols, then those bindings will
+;;; override these, so this shouldn't interfere with any existing
+;;; bindings.
+
+;; Also tell read-char how to handle these keys.
+(mapcar
+ (lambda (keypad-normal)
+ (let ((keypad (nth 0 keypad-normal))
+ (normal (nth 1 keypad-normal)))
+ (put keypad 'ascii-character normal)
+ (define-key function-key-map (vector keypad) (vector normal))))
+ '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
+ (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
+ (kp-space ?\ )
+ (kp-tab ?\t)
+ (kp-enter ?\r)
+ (kp-multiply ?*)
+ (kp-add ?+)
+ (kp-separator ?,)
+ (kp-subtract ?-)
+ (kp-decimal ?.)
+ (kp-divide ?/)
+ (kp-equal ?=)))
;;; simple.el ends here
HCoop / bpt / emacs.git / blobdiff