;;; Code:
(eval-when-compile
+ (autoload 'widget-convert "wid-edit")
+ (autoload 'shell-mode "shell")
(require 'cl))
(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.
+With ARG, insert that many newlines.
In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
(interactive "*P")
(barf-if-buffer-read-only)
(buffer-substring-no-properties (point) (1+ (point))))
encoding-msg pos total percent col hscroll))))))
\f
-(defvar read-expression-map (cons 'keymap minibuffer-local-map)
+(defvar read-expression-map
+ (let ((m (make-sparse-keymap)))
+ (define-key m "\M-\t" 'lisp-complete-symbol)
+ (set-keymap-parent m minibuffer-local-map)
+ m)
"Minibuffer keymap used for reading Lisp expressions.")
-(define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
(defvar read-expression-history nil)
(defcustom eval-expression-print-length 12
"*Value to use for `print-length' when printing value in `eval-expression'."
:group 'lisp
- :type 'integer
+ :type '(choice (const nil) integer)
:version "21.1")
(defcustom eval-expression-debug-on-error t
(error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
- (if (and (zerop minibuffer-history-position)
- (null minibuffer-text-before-history))
- (setq minibuffer-text-before-history (field-string (point-max))))
- (let ((history (symbol-value minibuffer-history-variable))
- (case-fold-search
- (if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
- ;; On some systems, ignore case for file names.
- (if (memq minibuffer-history-variable
- minibuffer-history-case-insensitive-variables)
- t
- ;; Respect the user's setting for case-fold-search:
- case-fold-search)
- nil))
- prevpos
- (pos minibuffer-history-position))
- (while (/= n 0)
- (setq prevpos pos)
- (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
- (if (= pos prevpos)
+ (unless (zerop n)
+ (if (and (zerop minibuffer-history-position)
+ (null minibuffer-text-before-history))
+ (setq minibuffer-text-before-history (field-string (point-max))))
+ (let ((history (symbol-value minibuffer-history-variable))
+ (case-fold-search
+ (if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
+ ;; On some systems, ignore case for file names.
+ (if (memq minibuffer-history-variable
+ minibuffer-history-case-insensitive-variables)
+ t
+ ;; Respect the user's setting for case-fold-search:
+ case-fold-search)
+ nil))
+ prevpos
+ match-string
+ match-offset
+ (pos minibuffer-history-position))
+ (while (/= n 0)
+ (setq prevpos pos)
+ (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
+ (when (= pos prevpos)
(error (if (= pos 1)
"No later matching history item"
"No earlier matching history item")))
- (if (string-match regexp
- (if (eq minibuffer-history-sexp-flag
- (minibuffer-depth))
- (let ((print-level nil))
- (prin1-to-string (nth (1- pos) history)))
- (nth (1- pos) history)))
- (setq n (+ n (if (< n 0) 1 -1)))))
- (setq minibuffer-history-position pos)
- (goto-char (point-max))
- (delete-field)
- (let ((elt (nth (1- pos) history)))
- (insert (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
+ (setq match-string
+ (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
(let ((print-level nil))
- (prin1-to-string elt))
- elt)))
- (goto-char (field-beginning)))
+ (prin1-to-string (nth (1- pos) history)))
+ (nth (1- pos) history)))
+ (setq match-offset
+ (if (< n 0)
+ (and (string-match regexp match-string)
+ (match-end 0))
+ (and (string-match (concat ".*\\(" regexp "\\)") match-string)
+ (match-beginning 1))))
+ (when match-offset
+ (setq n (+ n (if (< n 0) 1 -1)))))
+ (setq minibuffer-history-position pos)
+ (goto-char (point-max))
+ (delete-field)
+ (insert match-string)
+ (goto-char (+ (field-beginning) match-offset))))
(if (or (eq (car (car command-history)) 'previous-matching-history-element)
(eq (car (car command-history)) 'next-matching-history-element))
(setq command-history (cdr command-history))))
(prefix-numeric-value current-prefix-arg))))
(previous-matching-history-element regexp (- n)))
+(defvar minibuffer-temporary-goal-position nil)
+
(defun next-history-element (n)
"Insert the next element of the minibuffer history into the minibuffer."
(interactive "p")
(error "End of history; no default available")))
(if (> narg (length (symbol-value minibuffer-history-variable)))
(error "Beginning of history; no preceding item"))
+ (unless (or (eq last-command 'next-history-element)
+ (eq last-command 'previous-history-element))
+ (let ((prompt-end (field-beginning (point-max))))
+ (set (make-local-variable 'minibuffer-temporary-goal-position)
+ (cond ((<= (point) prompt-end) prompt-end)
+ ((eobp) nil)
+ (t (point))))))
(goto-char (point-max))
(delete-field)
(setq minibuffer-history-position narg)
(let ((print-level nil))
(prin1-to-string elt))
elt))
- (goto-char (field-beginning)))))
+ (goto-char (or minibuffer-temporary-goal-position (point-max))))))
(defun previous-history-element (n)
"Inserts the previous element of the minibuffer history into the minibuffer."
Repeat this command to undo more changes.
A numeric argument serves as a repeat count.
-Just C-u as argument requests selective undo,
-limited to changes within the current region.
-Likewise in Transient Mark mode when the mark is active."
+In Transient Mark mode when the mark is active, only undo changes within
+the current region. Similarly, when not in Transient Mark mode, just C-u
+as an argument limits undo to changes within the current region."
(interactive "*P")
;; If we don't get all the way thru, make last-command indicate that
;; for the following command.
(recent-save (recent-auto-save-p)))
(or (eq (selected-window) (minibuffer-window))
(message "Undo!"))
- (or (eq last-command 'undo)
- (progn (if (or arg (and transient-mark-mode mark-active))
- (undo-start (region-beginning) (region-end))
- (undo-start))
- (undo-more 1)))
- (undo-more (if arg (prefix-numeric-value arg) 1))
+ (unless (eq last-command 'undo)
+ (if (if transient-mark-mode mark-active (and arg (not (numberp arg))))
+ (undo-start (region-beginning) (region-end))
+ (undo-start))
+ ;; get rid of initial undo boundary
+ (undo-more 1))
+ (undo-more
+ (if (or transient-mark-mode (numberp arg))
+ (prefix-numeric-value arg)
+ 1))
;; Don't specify a position in the undo record for the undo command.
;; Instead, undoing this should move point to where the change is.
(let ((tail buffer-undo-list)
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.
+buffer `*Shell Command Output*'. If the output is short enough to
+display in the echo area (which is determined by the variable
+`max-mini-window-height'), it is shown there, 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.
To specify a coding system for converting non-ASCII characters
in the shell command output, use \\[universal-coding-system-argument]
(shell-command-on-region (point) (point) command
output-buffer nil error-buffer)))))))
\f
+(defun display-message-or-buffer (message
+ &optional buffer-name not-this-window frame)
+ "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
+MESSAGE may be either a string or a buffer.
+
+A buffer is displayed using `display-buffer' if MESSAGE is too long for
+the maximum height of the echo area, as defined by `max-mini-window-height'.
+
+Returns either the string shown in the echo area, or when a pop-up
+buffer is used, the window used to display it.
+
+If MESSAGE is a string, then the optional argument BUFFER-NAME is the
+name of the buffer used to display it in the case where a pop-up buffer
+is used, defaulting to `*Message*'. In the case where MESSAGE is a
+string and it is displayed in the echo area, it is not specified whether
+the contents are inserted into the buffer anyway.
+
+Optional arguments NOT-THIS-WINDOW and FRAME are as for `display-buffer',
+and only used if a buffer is displayed."
+ (cond ((and (stringp message) (not (string-match "\n" message)))
+ ;; Trivial case where we can use the echo area
+ (message "%s" message))
+ ((and (stringp message)
+ (= (string-match "\n" message) (1- (length message))))
+ ;; Trivial case where we can just remove single trailing newline
+ (message "%s" (substring message 0 (1- (length message)))))
+ (t
+ ;; General case
+ (with-current-buffer
+ (if (bufferp message)
+ message
+ (get-buffer-create (or buffer-name "*Message*")))
+
+ (unless (bufferp message)
+ (erase-buffer)
+ (insert message))
+
+ (let ((lines
+ (if (= (buffer-size) 0)
+ 0
+ (count-lines (point-min) (point-max)))))
+ (cond ((or (<= lines 1)
+ (<= lines
+ (cond ((floatp max-mini-window-height)
+ (* (frame-height) max-mini-window-height))
+ ((integerp max-mini-window-height)
+ max-mini-window-height)
+ (t
+ 1))))
+ ;; Echo area
+ (goto-char (point-max))
+ (when (bolp)
+ (backward-char 1))
+ (message "%s" (buffer-substring (point-min) (point))))
+ (t
+ ;; Buffer
+ (goto-char (point-min))
+ (display-buffer message not-this-window frame))))))))
+
+
;; We have a sentinel to prevent insertion of a termination message
;; in the buffer itself.
(defun shell-command-sentinel (process signal)
systems by binding `coding-system-for-read' and
`coding-system-for-write'.
-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 if output is inserted in the current buffer,
-then `*Shell Command Output*' is deleted.
+If the output is short enough to display in the echo area (which is
+determined by the variable `max-mini-window-height'), it is shown there,
+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.
If the optional fourth argument OUTPUT-BUFFER is non-nil,
that says to put the output in some other buffer.
nil shell-command-switch command)))
(setq success (and exit-status (equal 0 exit-status)))
;; Report the amount of output.
- (let ((lines (save-excursion
- (set-buffer buffer)
- (if (= (buffer-size) 0)
- 0
- (count-lines (point-min) (point-max))))))
- (cond ((= lines 0)
- (if (and error-file
- (< 0 (nth 7 (file-attributes error-file))))
- (message "(Shell command %sed with some error output)"
- (if (equal 0 exit-status)
- "succeed"
- "fail"))
- (message "(Shell command %sed with no output)"
- (if (equal 0 exit-status)
- "succeed"
- "fail")))
- (kill-buffer buffer))
- ((= lines 1)
- (message "%s"
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min))
- (buffer-substring (point)
- (progn (end-of-line) (point))))))
- (t
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min)))
- (display-buffer buffer)))))))
+ (if (with-current-buffer buffer (> (point-max) (point-min)))
+ ;; There's some output, display it
+ (display-message-or-buffer buffer)
+ ;; No output; error?
+ (message (if (and error-file
+ (< 0 (nth 7 (file-attributes error-file))))
+ "(Shell command %sed with some error output)"
+ "(Shell command %sed with no output)")
+ (if (equal 0 exit-status) "succeed" "fail"))
+ (kill-buffer buffer)))))
+
(when (and error-file (file-exists-p error-file))
(if (< 0 (nth 7 (file-attributes error-file)))
(with-current-buffer (get-buffer-create error-buffer)
(define-key map [?7] 'digit-argument)
(define-key map [?8] 'digit-argument)
(define-key map [?9] 'digit-argument)
+ (define-key map [kp-0] 'digit-argument)
+ (define-key map [kp-1] 'digit-argument)
+ (define-key map [kp-2] 'digit-argument)
+ (define-key map [kp-3] 'digit-argument)
+ (define-key map [kp-4] 'digit-argument)
+ (define-key map [kp-5] 'digit-argument)
+ (define-key map [kp-6] 'digit-argument)
+ (define-key map [kp-7] 'digit-argument)
+ (define-key map [kp-8] 'digit-argument)
+ (define-key map [kp-9] 'digit-argument)
+ (define-key map [kp-subtract] 'universal-argument-minus)
map)
"Keymap used while processing \\[universal-argument].")
"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)))
+ (let* ((char (if (integerp last-command-char)
+ last-command-char
+ (get last-command-char 'ascii-character)))
+ (digit (- (logand char ?\177) ?0)))
(cond ((integerp arg)
(setq prefix-arg (+ (* arg 10)
(if (< arg 0) (- digit) digit))))
"Kill the rest of the current line; if no nonblanks there, kill thru newline.
With prefix argument, kill that many lines from point.
Negative arguments kill lines backward.
+With zero argument, kills the text before point on the current line.
When calling from a program, nil means \"no arg\",
a number counts as a prefix arg.
;; with intangibility and point-motion hooks enabled this time.
(goto-char opoint)
(setq inhibit-point-motion-hooks nil)
- (goto-char (constrain-to-field new opoint t t))
+ (goto-char (constrain-to-field new opoint nil t
+ 'inhibit-line-move-field-capture))
;; If intangibility processing moved us to a different line,
;; readjust the horizontal position within the line we ended up at.
(when (or (< (point) line-beg) (> (point) line-end))
(setq new (point)))
(goto-char (point-min))
(setq inhibit-point-motion-hooks nil)
- (goto-char (constrain-to-field new opoint t t))
+ (goto-char (constrain-to-field new opoint nil t
+ 'inhibit-line-move-field-capture))
)))
nil)
(delete-region (point) (+ (point) len1))
(insert word2)))
\f
-(defvar comment-indent-hook nil
- "Obsolete variable for function to compute desired indentation for a comment.
-This function is called with no args with point at the beginning of
-the comment's starting delimiter.")
-\f
(defun backward-word (arg)
"Move backward until encountering the end of a word.
-With argument, do this that many times.
-In programs, it is faster to call `forward-word' with negative arg."
+With argument, do this that many times."
(interactive "p")
(forward-word (- arg)))
(defun turn-on-auto-fill ()
"Unconditionally turn on Auto Fill mode."
(auto-fill-mode 1))
+
+(defun turn-off-auto-fill ()
+ "Unconditionally turn off Auto Fill mode."
+ (auto-fill-mode -1))
+
(custom-add-option 'text-mode-hook 'turn-on-auto-fill)
(defun set-fill-column (arg)
\f
(defcustom read-mail-command 'rmail
"*Your preference for a mail reading package.
-This is used by some keybindings which support reading mail."
+This is used by some keybindings which support reading mail.
+See also `mail-user-agent' concerning sending mail."
:type '(choice (function-item rmail)
(function-item gnus)
(function-item mh-rmail)
(defcustom mail-user-agent 'sendmail-user-agent
"*Your preference for a mail composition package.
-Various Emacs Lisp packages (e.g. reporter) require you to compose an
+Various Emacs Lisp packages (e.g. Reporter) require you to compose an
outgoing email message. This variable lets you specify which
mail-sending package you prefer.
Valid values include:
- `sendmail-user-agent' -- use the default Emacs Mail package
- `mh-e-user-agent' -- use the Emacs interface to the MH mail system
- `message-user-agent' -- use the GNUS mail sending package
+ `sendmail-user-agent' -- use the default Emacs Mail package.
+ See Info node `(emacs)Sending Mail'.
+ `mh-e-user-agent' -- use the Emacs interface to the MH mail system.
+ See Info node `(mh-e)'.
+ `message-user-agent' -- use the Gnus Message package.
+ See Info node `(message)'.
+ `gnus-user-agent' -- like `message-user-agent', but with Gnus
+ paraphernalia, particularly the Gcc: header for
+ archiving.
Additional valid symbols may be available; check with the author of
-your package for details."
+your package for details.
+
+See also `read-mail-command' concerning reading mail."
:type '(radio (function-item :tag "Default Emacs mail"
:format "%t\n"
sendmail-user-agent)
(function-item :tag "Emacs interface to MH"
:format "%t\n"
mh-e-user-agent)
- (function-item :tag "Gnus mail sending package"
+ (function-item :tag "Gnus Message package"
:format "%t\n"
message-user-agent)
+ (function-item :tag "Gnus Message with full Gnus features"
+ :format "%t\n"
+ gnus-user-agent)
(function :tag "Other"))
:group 'mail)
can be used as value of a `syntax-table' property.
DESCRIPTION is the descriptive string for the syntax.")
-(defconst syntax-flag-table
- '((?1 . #b10000000000000000)
- (?2 . #b100000000000000000)
- (?3 . #b1000000000000000000)
- (?4 . #b10000000000000000000)
- (?p . #b100000000000000000000)
- (?b . #b1000000000000000000000)
- (?n . #b10000000000000000000000))
- "Alist of pairs (CHAR . FLAG) mapping characters to syntax flags.
-CHAR is a character that is allowed as second or following character
-in the string argument to `modify-syntax-entry' specifying the syntax.
-FLAG is the corresponding syntax flag value that is stored in a
-syntax table.")
-
-(defun string-to-syntax (string)
- "Convert a syntax specification STRING into syntax cell form.
-STRING should be a string as it is allowed as argument of
-`modify-syntax-entry'. Value is the equivalent cons cell
-\(CODE . MATCHING-CHAR) that can be used as value of a `syntax-table'
-text property."
- (let* ((first-char (aref string 0))
- (code (or (nth 1 (assq first-char syntax-code-table))
- (error "Invalid syntax specification `%s'" string)))
- (length (length string))
- (i 1)
- matching-char)
- ;; Determine the matching character, if any.
- (when (and (> length 1)
- (memq first-char '(?\( ?\))))
- (setq matching-char (aref string i)
- i (1+ i)))
- ;; Add any flags to the syntax code.
- (while (< i length)
- (let ((flag (or (assq (aref string i) syntax-flag-table)
- (error "Invalid syntax flag in `%s'" string))))
- (setq code (logior flag code))
- (setq i (1+ i))))
-
- (cons code matching-char)))
-
;;; simple.el ends here
HCoop / bpt / emacs.git / blobdiff