(progn
(skip-chars-forward " \t")
(constrain-to-field nil orig-pos t)))))
-
+\f
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer; leave mark at previous position.
With arg N, put point N/10 of the way from the beginning.
(push-mark (point))
(push-mark (point-max) nil t)
(goto-char (point-min)))
-
+\f
;; Counting lines, one way or another.
(single-key-description char)
(buffer-substring-no-properties (point) (1+ (point))))
encoding-msg pos total percent col hscroll))))))
-
+\f
(defvar read-expression-map
(let ((m (make-sparse-keymap)))
(define-key m "\M-\t" 'lisp-complete-symbol)
(setq command-history (cons newcmd command-history)))
(eval newcmd))
(ding))))
-
+\f
(defvar minibuffer-history nil
"Default minibuffer history list.
This is used for all minibuffer input
;; Return the width of everything before the field at the end of
;; the buffer; this should be 0 for normal buffers.
(1- (minibuffer-prompt-end)))
-
+\f
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(defalias 'advertised-undo 'undo)
(with-current-buffer
standard-output
(call-process shell-file-name nil t nil shell-command-switch command))))
-
+\f
(defvar universal-argument-map
(let ((map (make-sparse-keymap)))
(define-key map [t] 'universal-argument-other-key)
unread-command-events)))
(reset-this-command-lengths)
(setq overriding-terminal-local-map nil))
-
+\f
;;;; Window system cut and paste hooks.
(defvar interprogram-cut-function nil
difficult to tell whether Emacs or some other program provided the
current string, it is probably good enough to return nil if the string
is equal (according to `string=') to the last text Emacs provided.")
-
+\f
;;;; The kill ring data structure.
(defun kill-new (string &optional replace)
"Make STRING the latest kill in the kill ring.
-Set the kill-ring-yank pointer to point to it.
+Set `kill-ring-yank-pointer' to point to it.
If `interprogram-cut-function' is non-nil, apply it to STRING.
Optional second argument REPLACE non-nil means that STRING will replace
the front of the kill ring, rather than being added to the list."
With argument, rotate that many kills forward (or backward, if negative)."
(interactive "p")
(current-kill arg))
-
+\f
;; Some kill commands.
;; Internal subroutine of delete-char
(goto-char (next-single-property-change (point) 'invisible))
(goto-char (next-overlay-change (point))))
(end-of-line)))
-
+\f
(defun insert-buffer (buffer)
"Insert after point the contents of BUFFER.
Puts mark after the inserted text.
(erase-buffer)
(save-excursion
(insert-buffer-substring oldbuf start end)))))
-
+\f
(put 'mark-inactive 'error-conditions '(mark-inactive error))
(put 'mark-inactive 'error-message "The mark is not active now")
(widen))
(goto-char position)
(switch-to-buffer buffer)))
-
+\f
(defcustom next-line-add-newlines nil
"*If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
:type 'boolean
new line-end line-beg)
(unwind-protect
(progn
- (if (not (or (eq last-command 'next-line)
- (eq last-command 'previous-line)))
+ (if (not (memq last-command '(next-line previous-line)))
(setq temporary-goal-column
(if (and track-eol (eolp)
;; Don't count beg of empty line as end of line
This function works only in certain cases,
because what we really need is for `move-to-column'
and `current-column' to be able to ignore invisible text."
- (move-to-column col)
+ (if (zerop col)
+ (beginning-of-line)
+ (move-to-column col))
(when (and line-move-ignore-invisible
(not (bolp)) (line-move-invisible (1- (point))))
"Goal column %d (use \\[set-goal-column] with an arg to unset it)")
goal-column))
nil)
-
+\f
(defun scroll-other-window-down (lines)
"Scroll the \"other window\" down.
(end-of-buffer arg)
(recenter '(t)))
(select-window orig-window))))
-
+\f
(defun transpose-chars (arg)
"Interchange characters around point, moving forward one character.
With prefix arg ARG, effect is to take character before point
and drag it forward past ARG other words (backward if ARG negative).
If ARG is zero, the words around or after point and around or after mark
are interchanged."
+ ;; FIXME: `foo a!nd bar' should transpose into `bar and foo'.
(interactive "*p")
(transpose-subr 'forward-word arg))
Does not work on a sexp that point is in the middle of
if it is a list or string."
(interactive "*p")
- (transpose-subr 'forward-sexp arg))
+ (transpose-subr
+ (lambda (arg)
+ ;; Here we should try to simulate the behavior of
+ ;; (cons (progn (forward-sexp x) (point))
+ ;; (progn (forward-sexp (- x)) (point)))
+ ;; Except that we don't want to rely on the second forward-sexp
+ ;; putting us back to where we want to be, since forward-sexp-function
+ ;; might do funny things like infix-precedence.
+ (if (if (> arg 0)
+ (looking-at "\\sw\\|\\s_")
+ (and (not (bobp))
+ (save-excursion (forward-char -1) (looking-at "\\sw\\|\\s_"))))
+ ;; Jumping over a symbol. We might be inside it, mind you.
+ (progn (funcall (if (> arg 0)
+ 'skip-syntax-backward 'skip-syntax-forward)
+ "w_")
+ (cons (save-excursion (forward-sexp arg) (point)) (point)))
+ ;; Otherwise, we're between sexps. Take a step back before jumping
+ ;; to make sure we'll obey the same precedence no matter which direction
+ ;; we're going.
+ (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) " .")
+ (cons (save-excursion (forward-sexp arg) (point))
+ (progn (while (or (forward-comment (if (> arg 0) 1 -1))
+ (not (zerop (funcall (if (> arg 0)
+ 'skip-syntax-forward
+ 'skip-syntax-backward)
+ ".")))))
+ (point)))))
+ arg 'special))
(defun transpose-lines (arg)
"Exchange current line and previous line, leaving point after both.
(insert (delete-and-extract-region (car pos1) (cdr pos1)))
(goto-char (car pos1))
(insert word2))))
-
+\f
(defun backward-word (arg)
"Move backward until encountering the beginning of a word.
With argument, do this that many times."
(setq start (point)))
(buffer-substring-no-properties start end)))
(buffer-substring-no-properties start end)))))
-
+\f
(defcustom fill-prefix nil
"*String for filling to insert at front of new line, or nil for none."
:type '(choice (const :tag "None" nil)
;; Determine where to split the line.
(let* (after-prefix
(fill-point
- (let ((opoint (point))
- bounce
- (first t))
+ (let ((opoint (point)))
(save-excursion
(beginning-of-line)
(setq after-prefix (point))
(looking-at (regexp-quote fill-prefix))
(setq after-prefix (match-end 0)))
(move-to-column (1+ fc))
- ;; Move back to the point where we can break the line.
- ;; We break the line between word or
- ;; after/before the character which has character
- ;; category `|'. We search space, \c| followed by
- ;; a character, or \c| following a character. If
- ;; not found, place the point at beginning of line.
- (while (or first
- (and (not (bobp))
- (not bounce)
- (fill-nobreak-p)))
- (setq first nil)
- (re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
- ;; 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 (<= (point) after-prefix)
- (progn
- (goto-char after-prefix)
- (re-search-forward "[ \t]" opoint t)
- (setq bounce t))
- (if (looking-at "[ \t]")
- ;; Break the line at word boundary.
- (skip-chars-backward " \t")
- ;; Break the line after/before \c|.
- (forward-char 1))))
- (if enable-multibyte-characters
- ;; If we are going to break the line after or
- ;; before a non-ascii character, we may have
- ;; to run a special function for the charset
- ;; of the character to find the correct break
- ;; point.
- (if (not (and (eq (charset-after (1- (point))) 'ascii)
- (eq (charset-after (point)) 'ascii)))
- (fill-find-break-point after-prefix)))
-
- ;; Let fill-point be set to the place where we end up.
- ;; But move back before any whitespace here.
- (skip-chars-backward " \t")
+ (fill-move-to-break-point after-prefix)
(point)))))
;; See whether the place we found is any good.
(if (save-excursion
(goto-char fill-point)
- (and (not (bolp))
- ;; There is no use breaking at end of line.
- (not (save-excursion (skip-chars-forward " ") (eolp)))
- ;; It is futile to split at the end of the prefix
- ;; since we would just insert the prefix again.
- (not (and after-prefix (<= (point) after-prefix)))
- ;; Don't split right after a comment starter
- ;; since we would just make another comment starter.
- (not (and comment-start-skip
- (let ((limit (point)))
- (beginning-of-line)
- (and (re-search-forward comment-start-skip
- limit t)
- (eq (point) limit)))))))
- ;; Ok, we have a useful place to break the line. Do it.
- (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))
- (funcall comment-line-break-function t)
+ (or (bolp)
+ ;; There is no use breaking at end of line.
+ (save-excursion (skip-chars-forward " ") (eolp))
+ ;; It is futile to split at the end of the prefix
+ ;; since we would just insert the prefix again.
+ (and after-prefix (<= (point) after-prefix))
+ ;; Don't split right after a comment starter
+ ;; since we would just make another comment starter.
+ (and comment-start-skip
+ (let ((limit (point)))
+ (beginning-of-line)
+ (and (re-search-forward comment-start-skip
+ limit t)
+ (eq (point) limit))))))
+ ;; No good place to break => stop trying.
+ (setq give-up t)
+ ;; Ok, we have a useful place to break the line. Do it.
+ (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))
+ (funcall comment-line-break-function t)
+ (save-excursion
+ (goto-char fill-point)
+ (funcall comment-line-break-function t)))
+ ;; Now do justification, if required
+ (if (not (eq justify 'left))
(save-excursion
- (goto-char fill-point)
- (funcall comment-line-break-function 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 good place to break => stop trying.
- (setq give-up 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))))))
;; Justify last line.
(justify-current-line justify t t)
t)))
(error "set-fill-column requires an explicit argument")
(message "Fill column set to %d (was %d)" arg fill-column)
(setq fill-column arg)))
-
+\f
(defun set-selective-display (arg)
"Set `selective-display' to ARG; clear it if no arg.
When the value of `selective-display' is a number > 0,
(if (null arg) (not column-number-mode)
(> (prefix-numeric-value arg) 0)))
(force-mode-line-update))
-
+\f
(defgroup paren-blinking nil
"Blinking matching of parens and expressions."
:prefix "blink-matching-"
;Turned off because it makes dbx bomb out.
(setq blink-paren-function 'blink-matching-open)
-
+\f
;; This executes C-g typed while Emacs is waiting for a command.
;; Quitting out of a program does not go through here;
;; that happens in the QUIT macro at the C code level.
((string-match "^ \\*" (buffer-name (current-buffer)))
(bury-buffer))))
+(defun play-sound-file (file &optional volume device)
+ "Play sound stored in FILE.
+VOLUME and DEVICE correspond to the keywords of the sound
+specification for `play-sound'."
+ (interactive "fPlay sound file: ")
+ (let ((sound (list :file file)))
+ (if volume
+ (plist-put sound :volume volume))
+ (if device
+ (plist-put sound :device device))
+ (push 'sound sound)
+ (play-sound sound)))
+
(define-key global-map "\e\e\e" 'keyboard-escape-quit)
(defcustom read-mail-command 'rmail
(define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window)
-;;; Syntax stuff.
-
-(defconst syntax-code-table
- '((?\ 0 "whitespace")
- (?- 0 "whitespace")
- (?. 1 "punctuation")
- (?w 2 "word")
- (?_ 3 "symbol")
- (?\( 4 "open parenthesis")
- (?\) 5 "close parenthesis")
- (?\' 6 "expression prefix")
- (?\" 7 "string quote")
- (?$ 8 "paired delimiter")
- (?\\ 9 "escape")
- (?/ 10 "character quote")
- (?< 11 "comment start")
- (?> 12 "comment end")
- (?@ 13 "inherit")
- (nil 14 "comment fence")
- (nil 15 "string fence"))
- "Alist of forms (CHAR CODE DESCRIPTION) mapping characters to syntax info.
-CHAR is a character that is allowed as first char in the string
-specifying the syntax when calling `modify-syntax-entry'. CODE is the
-corresponing syntax code as it is stored in a syntax cell, and
-can be used as value of a `syntax-table' property.
-DESCRIPTION is the descriptive string for the syntax.")
-
-
;;; Handling of Backspace and Delete keys.
(defcustom normal-erase-is-backspace nil