--- /dev/null
+;; Perl code editing commands for GNU Emacs
+;; Copyright (C) 1990 William F. Mann
+;; Adapted from C code editing commands 'c-mode.el', Copyright 1987 by the
+;; Free Software Foundation, under terms of its General Public License.
+
+;; This file may be made part of GNU Emacs at the option of the FSF, or
+;; of the perl distribution at the option of Larry Wall.
+
+;; This code is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY. No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing. Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; this code, but only under the conditions described in the
+;; GNU Emacs General Public License. A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities. It should be in a
+;; file named COPYING. Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode")
+;; to your .emacs file and change the first line of your perl script to:
+;; #!/usr/bin/perl -- # -*-Perl-*-
+;; With argments to perl:
+;; #!/usr/bin/perl -P- # -*-Perl-*-
+;; To handle files included with do 'filename.pl';, add something like
+;; (setq auto-mode-alist (append (list (cons "\\.pl$" 'perl-mode))
+;; auto-mode-alist))
+;; to your .emacs file; otherwise the .pl suffix defaults to prolog-mode.
+
+;; This code is based on the 18.53 version c-mode.el, with extensive
+;; rewriting. Most of the features of c-mode survived intact.
+
+;; I added a new feature which adds functionality to TAB; it is controlled
+;; by the variable perl-tab-to-comment. With it enabled, TAB does the
+;; first thing it can from the following list: change the indentation;
+;; move past leading white space; delete an empty comment; reindent a
+;; comment; move to end of line; create an empty comment; tell you that
+;; the line ends in a quoted string, or has a # which should be a \#.
+
+;; If your machine is slow, you may want to remove some of the bindings
+;; to electric-perl-terminator. I changed the indenting defaults to be
+;; what Larry Wall uses in perl/lib, but left in all the options.
+
+;; I also tuned a few things: comments and labels starting in column
+;; zero are left there by indent-perl-exp; perl-beginning-of-function
+;; goes back to the first open brace/paren in column zero, the open brace
+;; in 'sub ... {', or the equal sign in 'format ... ='; indent-perl-exp
+;; (meta-^q) indents from the current line through the close of the next
+;; brace/paren, so you don't need to start exactly at a brace or paren.
+
+;; It may be good style to put a set of redundant braces around your
+;; main program. This will let you reindent it with meta-^q.
+
+;; Known problems (these are all caused by limitations in the elisp
+;; parsing routine (parse-partial-sexp), which was not designed for such
+;; a rich language; writing a more suitable parser would be a big job):
+;; 1) Regular expression delimitors do not act as quotes, so special
+;; characters such as `'"#:;[](){} may need to be backslashed
+;; in regular expressions and in both parts of s/// and tr///.
+;; 2) The globbing syntax <pattern> is not recognized, so special
+;; characters in the pattern string must be backslashed.
+;; 3) The q, qq, and << quoting operators are not recognized; see below.
+;; 4) \ (backslash) always quotes the next character, so '\' is
+;; treated as the start of a string. Use "\\" as a work-around.
+;; 5) To make variables such a $' and $#array work, perl-mode treats
+;; $ just like backslash, so '$' is the same as problem 5.
+;; 6) Unfortunately, treating $ like \ makes ${var} be treated as an
+;; unmatched }. See below.
+;; 7) When ' (quote) is used as a package name separator, perl-mode
+;; doesn't understand, and thinks it is seeing a quoted string.
+
+;; Here are some ugly tricks to bypass some of these problems: the perl
+;; expression /`/ (that's a back-tick) usually evaluates harmlessly,
+;; but will trick perl-mode into starting a quoted string, which
+;; can be ended with another /`/. Assuming you have no embedded
+;; back-ticks, this can used to help solve problem 3:
+;;
+;; /`/; $ugly = q?"'$?; /`/;
+;;
+;; To solve problem 6, add a /{/; before each use of ${var}:
+;; /{/; while (<${glob_me}>) ...
+;;
+;; Problem 7 is even worse, but this 'fix' does work :-(
+;; $DB'stop#'
+;; [$DB'line#'
+;; ] =~ s/;9$//;
+
+
+(defvar perl-mode-abbrev-table nil
+ "Abbrev table in use in perl-mode buffers.")
+(define-abbrev-table 'perl-mode-abbrev-table ())
+
+(defvar perl-mode-map ()
+ "Keymap used in Perl mode.")
+(if perl-mode-map
+ ()
+ (setq perl-mode-map (make-sparse-keymap))
+ (define-key perl-mode-map "{" 'electric-perl-terminator)
+ (define-key perl-mode-map "}" 'electric-perl-terminator)
+ (define-key perl-mode-map ";" 'electric-perl-terminator)
+ (define-key perl-mode-map ":" 'electric-perl-terminator)
+ (define-key perl-mode-map "\e\C-a" 'perl-beginning-of-function)
+ (define-key perl-mode-map "\e\C-e" 'perl-end-of-function)
+ (define-key perl-mode-map "\e\C-h" 'mark-perl-function)
+ (define-key perl-mode-map "\e\C-q" 'indent-perl-exp)
+ (define-key perl-mode-map "\177" 'backward-delete-char-untabify)
+ (define-key perl-mode-map "\t" 'perl-indent-command))
+
+(autoload 'c-macro-expand "cmacexp"
+ "Display the result of expanding all C macros occurring in the region.
+The expansion is entirely correct because it uses the C preprocessor."
+ t)
+
+(defvar perl-mode-syntax-table nil
+ "Syntax table in use in perl-mode buffers.")
+
+(if perl-mode-syntax-table
+ ()
+ (setq perl-mode-syntax-table (make-syntax-table (standard-syntax-table)))
+ (modify-syntax-entry ?\n ">" perl-mode-syntax-table)
+ (modify-syntax-entry ?# "<" perl-mode-syntax-table)
+ (modify-syntax-entry ?$ "/" perl-mode-syntax-table)
+ (modify-syntax-entry ?% "." perl-mode-syntax-table)
+ (modify-syntax-entry ?& "." perl-mode-syntax-table)
+ (modify-syntax-entry ?\' "\"" perl-mode-syntax-table)
+ (modify-syntax-entry ?* "." perl-mode-syntax-table)
+ (modify-syntax-entry ?+ "." perl-mode-syntax-table)
+ (modify-syntax-entry ?- "." perl-mode-syntax-table)
+ (modify-syntax-entry ?/ "." perl-mode-syntax-table)
+ (modify-syntax-entry ?< "." perl-mode-syntax-table)
+ (modify-syntax-entry ?= "." perl-mode-syntax-table)
+ (modify-syntax-entry ?> "." perl-mode-syntax-table)
+ (modify-syntax-entry ?\\ "\\" perl-mode-syntax-table)
+ (modify-syntax-entry ?` "\"" perl-mode-syntax-table)
+ (modify-syntax-entry ?| "." perl-mode-syntax-table)
+)
+
+(defconst perl-indent-level 4
+ "*Indentation of Perl statements with respect to containing block.")
+(defconst perl-continued-statement-offset 4
+ "*Extra indent for lines not starting new statements.")
+(defconst perl-continued-brace-offset -4
+ "*Extra indent for substatements that start with open-braces.
+This is in addition to perl-continued-statement-offset.")
+(defconst perl-brace-offset 0
+ "*Extra indentation for braces, compared with other text in same context.")
+(defconst perl-brace-imaginary-offset 0
+ "*Imagined indentation of an open brace that actually follows a statement.")
+(defconst perl-label-offset -2
+ "*Offset of Perl label lines relative to usual indentation.")
+
+(defconst perl-tab-always-indent t
+ "*Non-nil means TAB in Perl mode should always indent the current line,
+regardless of where in the line point is when the TAB command is used.")
+
+(defconst perl-tab-to-comment t
+ "*Non-nil means that for lines which don't need indenting, TAB will
+either indent an existing comment, move to end-of-line, or if at end-of-line
+already, create a new comment.")
+
+(defconst perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:"
+ "*Lines starting with this regular expression will not be auto-indented.")
+\f
+(defun perl-mode ()
+ "Major mode for editing Perl code.
+Expression and list commands understand all Perl brackets.
+Tab indents for Perl code.
+Comments are delimited with # ... \\n.
+Paragraphs are separated by blank lines only.
+Delete converts tabs to spaces as it moves back.
+\\{perl-mode-map}
+Variables controlling indentation style:
+ perl-tab-always-indent
+ Non-nil means TAB in Perl mode should always indent the current line,
+ regardless of where in the line point is when the TAB command is used.
+ perl-tab-to-comment
+ Non-nil means that for lines which don't need indenting, TAB will
+ either delete an empty comment, indent an existing comment, move
+ to end-of-line, or if at end-of-line already, create a new comment.
+ perl-nochange
+ Lines starting with this regular expression will not be auto-indented.
+ perl-indent-level
+ Indentation of Perl statements within surrounding block.
+ The surrounding block's indentation is the indentation
+ of the line on which the open-brace appears.
+ perl-continued-statement-offset
+ Extra indentation given to a substatement, such as the
+ then-clause of an if or body of a while.
+ perl-continued-brace-offset
+ Extra indentation given to a brace that starts a substatement.
+ This is in addition to perl-continued-statement-offset.
+ perl-brace-offset
+ Extra indentation for line if it starts with an open brace.
+ perl-brace-imaginary-offset
+ An open brace following other text is treated as if it were
+ this far to the right of the start of its line.
+ perl-label-offset
+ Extra indentation for line that is a label.
+
+Various indentation styles: K&R BSD BLK GNU LW
+ perl-indent-level 5 8 0 2 4
+ perl-continued-statement-offset 5 8 4 2 4
+ perl-continued-brace-offset 0 0 0 0 -4
+ perl-brace-offset -5 -8 0 0 0
+ perl-brace-imaginary-offset 0 0 4 0 0
+ perl-label-offset -5 -8 -2 -2 -2
+
+Turning on Perl mode calls the value of the variable perl-mode-hook with no
+args, if that value is non-nil."
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map perl-mode-map)
+ (setq major-mode 'perl-mode)
+ (setq mode-name "Perl")
+ (setq local-abbrev-table perl-mode-abbrev-table)
+ (set-syntax-table perl-mode-syntax-table)
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start (concat "^$\\|" page-delimiter))
+ (make-local-variable 'paragraph-separate)
+ (setq paragraph-separate paragraph-start)
+ (make-local-variable 'paragraph-ignore-fill-prefix)
+ (setq paragraph-ignore-fill-prefix t)
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'perl-indent-line)
+ (make-local-variable 'require-final-newline)
+ (setq require-final-newline t)
+ (make-local-variable 'comment-start)
+ (setq comment-start "# ")
+ (make-local-variable 'comment-end)
+ (setq comment-end "")
+ (make-local-variable 'comment-column)
+ (setq comment-column 32)
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start-skip "\\(^\\|\\s-\\);?#+ *")
+ (make-local-variable 'comment-indent-hook)
+ (setq comment-indent-hook 'perl-comment-indent)
+ (make-local-variable 'parse-sexp-ignore-comments)
+ (setq parse-sexp-ignore-comments nil)
+ (run-hooks 'perl-mode-hook))
+\f
+;; This is used by indent-for-comment
+;; to decide how much to indent a comment in Perl code
+;; based on its context.
+(defun perl-comment-indent ()
+ (if (and (bolp) (not (eolp)))
+ 0 ;Existing comment at bol stays there.
+ (save-excursion
+ (skip-chars-backward " \t")
+ (max (1+ (current-column)) ;Else indent at comment column
+ comment-column)))) ; except leave at least one space.
+
+(defun electric-perl-terminator (arg)
+ "Insert character. If at end-of-line, and not in a comment or a quote,
+correct the line's indentation."
+ (interactive "P")
+ (let ((insertpos (point)))
+ (and (not arg) ; decide whether to indent
+ (eolp)
+ (save-excursion
+ (beginning-of-line)
+ (and (not ; eliminate comments quickly
+ (re-search-forward comment-start-skip insertpos t))
+ (or (/= last-command-char ?:)
+ ;; Colon is special only after a label ....
+ (looking-at "\\s-*\\(\\w\\|\\s_\\)+$"))
+ (let ((pps (parse-partial-sexp
+ (perl-beginning-of-function) insertpos)))
+ (not (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))
+ (progn ; must insert, indent, delete
+ (insert-char last-command-char 1)
+ (perl-indent-line)
+ (delete-char -1))))
+ (self-insert-command (prefix-numeric-value arg)))
+
+;; not used anymore, but may be useful someday:
+;;(defun perl-inside-parens-p ()
+;; (condition-case ()
+;; (save-excursion
+;; (save-restriction
+;; (narrow-to-region (point)
+;; (perl-beginning-of-function))
+;; (goto-char (point-max))
+;; (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
+;; (error nil)))
+\f
+(defun perl-indent-command (&optional arg)
+ "Indent current line as Perl code, or optionally, insert a tab character.
+
+With an argument, indent the current line, regardless of other options.
+
+If perl-tab-always-indent is nil and point is not in the indentation
+area at the beginning of the line, simply insert a tab.
+
+Otherwise, indent the current line. If point was within the indentation
+area it is moved to the end of the indentation area. If the line was
+already indented properly and point was not within the indentation area,
+and if perl-tab-to-comment is non-nil (the default), then do the first
+possible action from the following list:
+
+ 1) delete an empty comment
+ 2) move forward to start of comment, indenting if necessary
+ 3) move forward to end of line
+ 4) create an empty comment
+ 5) move backward to start of comment, indenting if necessary."
+ (interactive "P")
+ (if arg ; If arg, just indent this line
+ (perl-indent-line "\f")
+ (if (and (not perl-tab-always-indent)
+ (<= (current-column) (current-indentation)))
+ (insert-tab)
+ (let (bof lsexp delta (oldpnt (point)))
+ (beginning-of-line)
+ (setq lsexp (point))
+ (setq bof (perl-beginning-of-function))
+ (goto-char oldpnt)
+ (setq delta (perl-indent-line "\f\\|;?#" bof))
+ (and perl-tab-to-comment
+ (= oldpnt (point)) ; done if point moved
+ (if (listp delta) ; if line starts in a quoted string
+ (setq lsexp (or (nth 2 delta) bof))
+ (= delta 0)) ; done if indenting occurred
+ (let (eol state)
+ (end-of-line)
+ (setq eol (point))
+ (if (= (char-after bof) ?=)
+ (if (= oldpnt eol)
+ (message "In a format statement"))
+ (setq state (parse-partial-sexp lsexp eol))
+ (if (nth 3 state)
+ (if (= oldpnt eol) ; already at eol in a string
+ (message "In a string which starts with a %c."
+ (nth 3 state)))
+ (if (not (nth 4 state))
+ (if (= oldpnt eol) ; no comment, create one?
+ (indent-for-comment))
+ (beginning-of-line)
+ (if (re-search-forward comment-start-skip eol 'move)
+ (if (eolp)
+ (progn ; kill existing comment
+ (goto-char (match-beginning 0))
+ (skip-chars-backward " \t")
+ (kill-region (point) eol))
+ (if (or (< oldpnt (point)) (= oldpnt eol))
+ (indent-for-comment) ; indent existing comment
+ (end-of-line)))
+ (if (/= oldpnt eol)
+ (end-of-line)
+ (message "Use backslash to quote # characters.")
+ (ding t))))))))))))
+
+(defun perl-indent-line (&optional nochange parse-start)
+ "Indent current line as Perl code. Return the amount the indentation
+changed by, or (parse-state) if line starts in a quoted string."
+ (let ((case-fold-search nil)
+ (pos (- (point-max) (point)))
+ (bof (or parse-start (save-excursion (perl-beginning-of-function))))
+ beg indent shift-amt)
+ (beginning-of-line)
+ (setq beg (point))
+ (setq shift-amt
+ (cond ((= (char-after bof) ?=) 0)
+ ((listp (setq indent (calculate-perl-indent bof))) indent)
+ ((looking-at (or nochange perl-nochange)) 0)
+ (t
+ (skip-chars-forward " \t\f")
+ (cond ((looking-at "\\(\\w\\|\\s_\\)+:")
+ (setq indent (max 1 (+ indent perl-label-offset))))
+ ((= (following-char) ?})
+ (setq indent (- indent perl-indent-level)))
+ ((= (following-char) ?{)
+ (setq indent (+ indent perl-brace-offset))))
+ (- indent (current-column)))))
+ (skip-chars-forward " \t\f")
+ (if (and (numberp shift-amt) (/= 0 shift-amt))
+ (progn (delete-region beg (point))
+ (indent-to indent)))
+ ;; If initial point was within line's indentation,
+ ;; position after the indentation. Else stay at same point in text.
+ (if (> (- (point-max) pos) (point))
+ (goto-char (- (point-max) pos)))
+ shift-amt))
+
+(defun calculate-perl-indent (&optional parse-start)
+ "Return appropriate indentation for current line as Perl code.
+In usual case returns an integer: the column to indent to.
+Returns (parse-state) if line starts inside a string."
+ (save-excursion
+ (beginning-of-line)
+ (let ((indent-point (point))
+ (case-fold-search nil)
+ (colon-line-end 0)
+ state containing-sexp)
+ (if parse-start ;used to avoid searching
+ (goto-char parse-start)
+ (perl-beginning-of-function))
+ (while (< (point) indent-point) ;repeat until right sexp
+ (setq parse-start (point))
+ (setq state (parse-partial-sexp (point) indent-point 0))
+; state = (depth_in_parens innermost_containing_list last_complete_sexp
+; string_terminator_or_nil inside_commentp following_quotep
+; minimum_paren-depth_this_scan)
+; Parsing stops if depth in parentheses becomes equal to third arg.
+ (setq containing-sexp (nth 1 state)))
+ (cond ((nth 3 state) state) ; In a quoted string?
+ ((null containing-sexp) ; Line is at top level.
+ (skip-chars-forward " \t\f")
+ (if (= (following-char) ?{)
+ 0 ; move to beginning of line if it starts a function body
+ ;; indent a little if this is a continuation line
+ (perl-backward-to-noncomment)
+ (if (or (bobp)
+ (memq (preceding-char) '(?\; ?\})))
+ 0 perl-continued-statement-offset)))
+ ((/= (char-after containing-sexp) ?{)
+ ;; line is expression, not statement:
+ ;; indent to just after the surrounding open.
+ (goto-char (1+ containing-sexp))
+ (current-column))
+ (t
+ ;; Statement level. Is it a continuation or a new statement?
+ ;; Find previous non-comment character.
+ (perl-backward-to-noncomment)
+ ;; Back up over label lines, since they don't
+ ;; affect whether our line is a continuation.
+ (while (or (eq (preceding-char) ?\,)
+ (and (eq (preceding-char) ?:)
+ (memq (char-syntax (char-after (- (point) 2)))
+ '(?w ?_))))
+ (if (eq (preceding-char) ?\,)
+ (perl-backward-to-start-of-continued-exp containing-sexp))
+ (beginning-of-line)
+ (perl-backward-to-noncomment))
+ ;; Now we get the answer.
+ (if (not (memq (preceding-char) '(?\; ?\} ?\{)))
+ ;; This line is continuation of preceding line's statement;
+ ;; indent perl-continued-statement-offset more than the
+ ;; previous line of the statement.
+ (progn
+ (perl-backward-to-start-of-continued-exp containing-sexp)
+ (+ perl-continued-statement-offset (current-column)
+ (if (save-excursion (goto-char indent-point)
+ (looking-at "[ \t]*{"))
+ perl-continued-brace-offset 0)))
+ ;; This line starts a new statement.
+ ;; Position at last unclosed open.
+ (goto-char containing-sexp)
+ (or
+ ;; If open paren is in col 0, close brace is special
+ (and (bolp)
+ (save-excursion (goto-char indent-point)
+ (looking-at "[ \t]*}"))
+ perl-indent-level)
+ ;; Is line first statement after an open-brace?
+ ;; If no, find that first statement and indent like it.
+ (save-excursion
+ (forward-char 1)
+ ;; Skip over comments and labels following openbrace.
+ (while (progn
+ (skip-chars-forward " \t\f\n")
+ (cond ((looking-at ";?#")
+ (forward-line 1) t)
+ ((looking-at "\\(\\w\\|\\s_\\)+:")
+ (save-excursion
+ (end-of-line)
+ (setq colon-line-end (point)))
+ (search-forward ":")))))
+ ;; The first following code counts
+ ;; if it is before the line we want to indent.
+ (and (< (point) indent-point)
+ (if (> colon-line-end (point))
+ (- (current-indentation) perl-label-offset)
+ (current-column))))
+ ;; If no previous statement,
+ ;; indent it relative to line brace is on.
+ ;; For open paren in column zero, don't let statement
+ ;; start there too. If perl-indent-level is zero,
+ ;; use perl-brace-offset + perl-continued-statement-offset
+ ;; For open-braces not the first thing in a line,
+ ;; add in perl-brace-imaginary-offset.
+ (+ (if (and (bolp) (zerop perl-indent-level))
+ (+ perl-brace-offset perl-continued-statement-offset)
+ perl-indent-level)
+ ;; Move back over whitespace before the openbrace.
+ ;; If openbrace is not first nonwhite thing on the line,
+ ;; add the perl-brace-imaginary-offset.
+ (progn (skip-chars-backward " \t")
+ (if (bolp) 0 perl-brace-imaginary-offset))
+ ;; If the openbrace is preceded by a parenthesized exp,
+ ;; move to the beginning of that;
+ ;; possibly a different line
+ (progn
+ (if (eq (preceding-char) ?\))
+ (forward-sexp -1))
+ ;; Get initial indentation of the line we are on.
+ (current-indentation))))))))))
+
+(defun perl-backward-to-noncomment ()
+ "Move point backward to after the first non-white-space, skipping comments."
+ (interactive)
+ (let (opoint stop)
+ (while (not stop)
+ (setq opoint (point))
+ (beginning-of-line)
+ (if (re-search-forward comment-start-skip opoint 'move 1)
+ (progn (goto-char (match-end 1))
+ (skip-chars-forward ";")))
+ (skip-chars-backward " \t\f")
+ (setq stop (or (bobp)
+ (not (bolp))
+ (forward-char -1))))))
+
+(defun perl-backward-to-start-of-continued-exp (lim)
+ (if (= (preceding-char) ?\))
+ (forward-sexp -1))
+ (beginning-of-line)
+ (if (<= (point) lim)
+ (goto-char (1+ lim)))
+ (skip-chars-forward " \t\f"))
+\f
+;; note: this may be slower than the c-mode version, but I can understand it.
+(defun indent-perl-exp ()
+ "Indent each line of the Perl grouping following point."
+ (interactive)
+ (let* ((case-fold-search nil)
+ (oldpnt (point-marker))
+ (bof-mark (save-excursion
+ (end-of-line 2)
+ (perl-beginning-of-function)
+ (point-marker)))
+ eol last-mark lsexp-mark delta)
+ (if (= (char-after (marker-position bof-mark)) ?=)
+ (message "Can't indent a format statement")
+ (message "Indenting Perl expression...")
+ (save-excursion (end-of-line) (setq eol (point)))
+ (save-excursion ; locate matching close paren
+ (while (and (not (eobp)) (<= (point) eol))
+ (parse-partial-sexp (point) (point-max) 0))
+ (setq last-mark (point-marker)))
+ (setq lsexp-mark bof-mark)
+ (beginning-of-line)
+ (while (< (point) (marker-position last-mark))
+ (setq delta (perl-indent-line nil (marker-position bof-mark)))
+ (if (numberp delta) ; unquoted start-of-line?
+ (progn
+ (if (eolp)
+ (delete-horizontal-space))
+ (setq lsexp-mark (point-marker))))
+ (end-of-line)
+ (setq eol (point))
+ (if (nth 4 (parse-partial-sexp (marker-position lsexp-mark) eol))
+ (progn ; line ends in a comment
+ (beginning-of-line)
+ (if (or (not (looking-at "\\s-*;?#"))
+ (listp delta)
+ (and (/= 0 delta)
+ (= (- (current-indentation) delta) comment-column)))
+ (if (re-search-forward comment-start-skip eol t)
+ (indent-for-comment))))) ; indent existing comment
+ (forward-line 1))
+ (goto-char (marker-position oldpnt))
+ (message "Indenting Perl expression...done"))))
+\f
+(defun perl-beginning-of-function (&optional arg)
+ "Move backward to next beginning-of-function, or as far as possible.
+With argument, repeat that many times; negative args move forward.
+Returns new value of point in all cases."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (if (< arg 0) (forward-char 1))
+ (and (/= arg 0)
+ (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*=\\|^\\."
+ nil 'move arg)
+ (goto-char (1- (match-end 0))))
+ (point))
+
+;; note: this routine is adapted directly from emacs lisp.el, end-of-defun;
+;; no bugs have been removed :-)
+(defun perl-end-of-function (&optional arg)
+ "Move forward to next end-of-function.
+The end of a function is found by moving forward from the beginning of one.
+With argument, repeat that many times; negative args move backward."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (let ((first t))
+ (while (and (> arg 0) (< (point) (point-max)))
+ (let ((pos (point)) npos)
+ (while (progn
+ (if (and first
+ (progn
+ (forward-char 1)
+ (perl-beginning-of-function 1)
+ (not (bobp))))
+ nil
+ (or (bobp) (forward-char -1))
+ (perl-beginning-of-function -1))
+ (setq first nil)
+ (forward-list 1)
+ (skip-chars-forward " \t")
+ (if (looking-at "[#\n]")
+ (forward-line 1))
+ (<= (point) pos))))
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (let ((pos (point)))
+ (perl-beginning-of-function 1)
+ (forward-sexp 1)
+ (forward-line 1)
+ (if (>= (point) pos)
+ (if (progn (perl-beginning-of-function 2) (not (bobp)))
+ (progn
+ (forward-list 1)
+ (skip-chars-forward " \t")
+ (if (looking-at "[#\n]")
+ (forward-line 1)))
+ (goto-char (point-min)))))
+ (setq arg (1+ arg)))))
+
+(defun mark-perl-function ()
+ "Put mark at end of Perl function, point at beginning."
+ (interactive)
+ (push-mark (point))
+ (perl-end-of-function)
+ (push-mark (point))
+ (perl-beginning-of-function)
+ (backward-paragraph))
+
+;;;;;;;; That's all, folks! ;;;;;;;;;
--- /dev/null
+;; Basic editing commands for Emacs
+;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun open-line (arg)
+ "Insert a newline and leave point before it. If there is a fill
+prefix, inserts the fill prefix after the newline that it inserts.
+With arg, inserts that many newlines."
+ (interactive "*p")
+ (let ((flag (and (bolp) (not (bobp)))))
+ (if flag (forward-char -1))
+ (while (> arg 0)
+ (save-excursion
+ (insert ?\n)
+ (if fill-prefix (insert fill-prefix)))
+ (setq arg (1- arg)))
+ (if flag (forward-char 1))))
+
+(defun split-line ()
+ "Split current line, moving portion beyond point vertically down."
+ (interactive "*")
+ (skip-chars-forward " \t")
+ (let ((col (current-column))
+ (pos (point)))
+ (insert ?\n)
+ (indent-to col 0)
+ (goto-char pos)))
+
+(defun quoted-insert (arg)
+ "Read next input character and insert it.
+Useful for inserting control characters.
+You may also type up to 3 octal digits, to insert a character with that code"
+ (interactive "*p")
+ (let ((char (read-quoted-char)))
+ (while (> arg 0)
+ (insert char)
+ (setq arg (1- arg)))))
+
+(defun delete-indentation (&optional arg)
+ "Join this line to previous and fix up whitespace at join.
+With argument, join this line to following line."
+ (interactive "*P")
+ (beginning-of-line)
+ (if arg (forward-line 1))
+ (if (eq (preceding-char) ?\n)
+ (progn
+ (delete-region (point) (1- (point)))
+ (fixup-whitespace))))
+
+(defun fixup-whitespace ()
+ "Fixup white space between objects around point.
+Leave one space or none, according to the context."
+ (interactive "*")
+ (save-excursion
+ (delete-horizontal-space)
+ (if (or (looking-at "^\\|\\s)")
+ (save-excursion (forward-char -1)
+ (looking-at "$\\|\\s(\\|\\s'")))
+ nil
+ (insert ?\ ))))
+
+(defun delete-horizontal-space ()
+ "Delete all spaces and tabs around point."
+ (interactive "*")
+ (skip-chars-backward " \t")
+ (delete-region (point) (progn (skip-chars-forward " \t") (point))))
+
+(defun just-one-space ()
+ "Delete all spaces and tabs around point, leaving one space."
+ (interactive "*")
+ (skip-chars-backward " \t")
+ (if (= (following-char) ? )
+ (forward-char 1)
+ (insert ? ))
+ (delete-region (point) (progn (skip-chars-forward " \t") (point))))
+
+(defun delete-blank-lines ()
+ "On blank line, delete all surrounding blank lines, leaving just one.
+On isolated blank line, delete that one.
+On nonblank line, delete all blank lines that follow it."
+ (interactive "*")
+ (let (thisblank singleblank)
+ (save-excursion
+ (beginning-of-line)
+ (setq thisblank (looking-at "[ \t]*$"))
+ (setq singleblank
+ (and thisblank
+ (not (looking-at "[ \t]*\n[ \t]*$"))
+ (or (bobp)
+ (progn (forward-line -1)
+ (not (looking-at "[ \t]*$")))))))
+ (if thisblank
+ (progn
+ (beginning-of-line)
+ (if singleblank (forward-line 1))
+ (delete-region (point)
+ (if (re-search-backward "[^ \t\n]" nil t)
+ (progn (forward-line 1) (point))
+ (point-min)))))
+ (if (not (and thisblank singleblank))
+ (save-excursion
+ (end-of-line)
+ (forward-line 1)
+ (delete-region (point)
+ (if (re-search-forward "[^ \t\n]" nil t)
+ (progn (beginning-of-line) (point))
+ (point-max)))))))
+
+(defun back-to-indentation ()
+ "Move point to the first non-whitespace character on this line."
+ (interactive)
+ (beginning-of-line 1)
+ (skip-chars-forward " \t"))
+
+(defun newline-and-indent ()
+ "Insert a newline, then indent according to major mode.
+Indentation is done using the current indent-line-function.
+In programming language modes, this is the same as TAB.
+In some text modes, where TAB inserts a tab, this indents to the
+specified left-margin column."
+ (interactive "*")
+ (delete-region (point) (progn (skip-chars-backward " \t") (point)))
+ (insert ?\n)
+ (indent-according-to-mode))
+
+(defun reindent-then-newline-and-indent ()
+ "Reindent current line, insert newline, then indent the new line.
+Indentation of both lines is done according to the current major mode,
+which means that the current value of indent-line-function is called.
+In programming language modes, this is the same as TAB.
+In some text modes, where TAB inserts a tab, this indents to the
+specified left-margin column."
+ (interactive "*")
+ (save-excursion
+ (delete-region (point) (progn (skip-chars-backward " \t") (point)))
+ (indent-according-to-mode))
+ (insert ?\n)
+ (indent-according-to-mode))
+
+;; Internal subroutine of delete-char
+(defun kill-forward-chars (arg)
+ (if (listp arg) (setq arg (car arg)))
+ (if (eq arg '-) (setq arg -1))
+ (kill-region (point) (+ (point) arg)))
+
+;; Internal subroutine of backward-delete-char
+(defun kill-backward-chars (arg)
+ (if (listp arg) (setq arg (car arg)))
+ (if (eq arg '-) (setq arg -1))
+ (kill-region (point) (- (point) arg)))
+
+(defun backward-delete-char-untabify (arg &optional killp)
+ "Delete characters backward, changing tabs into spaces.
+Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
+Interactively, ARG is the prefix arg (default 1)
+and KILLP is t if prefix arg is was specified."
+ (interactive "*p\nP")
+ (let ((count arg))
+ (save-excursion
+ (while (and (> count 0) (not (bobp)))
+ (if (= (preceding-char) ?\t)
+ (let ((col (current-column)))
+ (forward-char -1)
+ (setq col (- col (current-column)))
+ (insert-char ?\ col)
+ (delete-char 1)))
+ (forward-char -1)
+ (setq count (1- count)))))
+ (delete-backward-char arg killp)
+ ;; In overwrite mode, back over columns while clearing them out,
+ ;; unless at end of line.
+ (and overwrite-mode (not (eolp))
+ (save-excursion (insert-char ?\ arg))))
+
+(defun zap-to-char (arg char)
+ "Kill up to and including ARG'th occurrence of CHAR.
+Goes backward if ARG is negative; error if CHAR not found."
+ (interactive "p\ncZap to char: ")
+ (kill-region (point) (progn
+ (search-forward (char-to-string char) nil nil arg)
+; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
+ (point))))
+
+(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 true beginning.
+Don't use this in Lisp programs!
+\(goto-char (point-min)) is faster and avoids clobbering the mark."
+ (interactive "P")
+ (push-mark)
+ (goto-char (if arg
+ (if (> (buffer-size) 10000)
+ ;; Avoid overflow for large buffer sizes!
+ (* (prefix-numeric-value arg)
+ (/ (buffer-size) 10))
+ (/ (+ 10 (* (buffer-size) (prefix-numeric-value arg))) 10))
+ (point-min)))
+ (if arg (forward-line 1)))
+
+(defun end-of-buffer (&optional arg)
+ "Move point to the end of the buffer; leave mark at previous position.
+With arg N, put point N/10 of the way from the true end.
+Don't use this in Lisp programs!
+\(goto-char (point-max)) is faster and avoids clobbering the mark."
+ (interactive "P")
+ (push-mark)
+ (goto-char (if arg
+ (- (1+ (buffer-size))
+ (if (> (buffer-size) 10000)
+ ;; Avoid overflow for large buffer sizes!
+ (* (prefix-numeric-value arg)
+ (/ (buffer-size) 10))
+ (/ (* (buffer-size) (prefix-numeric-value arg)) 10)))
+ (point-max)))
+ (if arg (forward-line 1)
+ ;; Scroll to put point near bottom--show nearly maximum amount of text,
+ ;; but leave room to add something.
+ (recenter -3)))
+
+(defun mark-whole-buffer ()
+ "Put point at beginning and mark at end of buffer."
+ (interactive)
+ (push-mark (point))
+ (push-mark (point-max))
+ (goto-char (point-min)))
+
+(defun count-lines-region (start end)
+ "Print number of lines and charcters in the region."
+ (interactive "r")
+ (message "Region has %d lines, %d characters"
+ (count-lines start end) (- end start)))
+
+(defun what-line ()
+ "Print the current line number (in the buffer) of point."
+ (interactive)
+ (save-restriction
+ (widen)
+ (save-excursion
+ (beginning-of-line)
+ (message "Line %d"
+ (1+ (count-lines 1 (point)))))))
+
+(defun count-lines (start end)
+ "Return number of lines between START and END.
+This is usually the number of newlines between them,
+but will be one more if START is not equal to END
+and the greater of them is not at the start of a line."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (if (eq selective-display t)
+ (let ((done 0))
+ (while (re-search-forward "[\n\C-m]" nil t 40)
+ (setq done (+ 40 done)))
+ (while (re-search-forward "[\n\C-m]" nil t 1)
+ (setq done (+ 1 done)))
+ done)
+ (- (buffer-size) (forward-line (buffer-size)))))))
+
+(defun what-cursor-position ()
+ "Print info on cursor position (on screen and within buffer)."
+ (interactive)
+ (let* ((char (following-char))
+ (beg (point-min))
+ (end (point-max))
+ (pos (point))
+ (total (buffer-size))
+ (percent (if (> total 50000)
+ ;; Avoid overflow from multiplying by 100!
+ (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
+ (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
+ (hscroll (if (= (window-hscroll) 0)
+ ""
+ (format " Hscroll=%d" (window-hscroll))))
+ (col (current-column)))
+ (if (= pos end)
+ (if (or (/= beg 1) (/= end (1+ total)))
+ (message "point=%d of %d(%d%%) <%d - %d> column %d %s"
+ pos total percent beg end col hscroll)
+ (message "point=%d of %d(%d%%) column %d %s"
+ pos total percent col hscroll))
+ (if (or (/= beg 1) (/= end (1+ total)))
+ (message "Char: %s (0%o) point=%d of %d(%d%%) <%d - %d> column %d %s"
+ (single-key-description char) char pos total percent beg end col hscroll)
+ (message "Char: %s (0%o) point=%d of %d(%d%%) column %d %s"
+ (single-key-description char) char pos total percent col hscroll)))))
+
+(defun fundamental-mode ()
+ "Major mode not specialized for anything in particular.
+Other major modes are defined by comparison with this one."
+ (interactive)
+ (kill-all-local-variables))
+
+(put 'eval-expression 'disabled t)
+
+;; 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 variable values 's value."
+ (interactive "xEval: ")
+ (setq values (cons (eval expression) values))
+ (prin1 (car values) t))
+
+(defun edit-and-eval-command (prompt command)
+ "Prompting with PROMPT, let user edit COMMAND and eval result.
+COMMAND is a Lisp expression. Let user edit that expression in
+the minibuffer, then read and evaluate the result."
+ (let ((command (read-minibuffer prompt
+ (prin1-to-string command))))
+ ;; Add edited command to command history, unless redundant.
+ (or (equal command (car command-history))
+ (setq command-history (cons command command-history)))
+ (eval command)))
+
+;; (defvar repeat-complex-command nil)
+
+(defvar repeat-complex-command-map (copy-keymap minibuffer-local-map))
+(define-key repeat-complex-command-map "\ep" 'previous-complex-command)
+(define-key repeat-complex-command-map "\en" 'next-complex-command)
+(defun repeat-complex-command (repeat-complex-command-arg)
+ "Edit and re-evaluate last complex command, or ARGth from last.
+A complex command is one which used the minibuffer.
+The command is placed in the minibuffer as a Lisp form for editing.
+The result is executed, repeating the command as changed.
+If the command has been changed or is not the most recent previous command
+it is added to the front of the command history.
+Whilst editing the command, the following commands are available:
+\\{repeat-complex-command-map}"
+ (interactive "p")
+ (let ((elt (nth (1- repeat-complex-command-arg) command-history))
+ (repeat-complex-command-flag t)
+ newcmd)
+ (if elt
+ (progn
+ (setq newcmd (read-from-minibuffer "Redo: "
+ (prin1-to-string elt)
+ repeat-complex-command-map
+ t))
+ ;; If command to be redone does not match front of history,
+ ;; add it to the history.
+ (or (equal newcmd (car command-history))
+ (setq command-history (cons newcmd command-history)))
+ (eval newcmd))
+ (ding))))
+
+(defun next-complex-command (n)
+ "Inserts the next element of `command-history' into the minibuffer."
+ (interactive "p")
+ (let ((narg (min (max 1 (- repeat-complex-command-arg n))
+ (length command-history))))
+ (if (= repeat-complex-command-arg narg)
+ (error (if (= repeat-complex-command-arg 1)
+ "No following item in command history"
+ "No preceding item in command history"))
+ (erase-buffer)
+ (setq repeat-complex-command-arg narg)
+ (insert (prin1-to-string (nth (1- repeat-complex-command-arg)
+ command-history)))
+ (goto-char (point-min)))))
+
+(defun previous-complex-command (n)
+ "Inserts the previous element of `command-history' into the minibuffer."
+ (interactive "p")
+ (if repeat-complex-command-flag
+ (next-complex-command (- n))
+ (repeat-complex-command 1)))
+
+(defun goto-line (arg)
+ "Goto line ARG, counting from line 1 at beginning of buffer."
+ (interactive "NGoto line: ")
+ (save-restriction
+ (widen)
+ (goto-char 1)
+ (if (eq selective-display t)
+ (re-search-forward "[\n\C-m]" nil 'end (1- arg))
+ (forward-line (1- arg)))))
+
+;Put this on C-x u, so we can force that rather than C-_ into startup msg
+(fset 'advertised-undo 'undo)
+
+(defun undo (&optional arg)
+ "Undo some previous changes.
+Repeat this command to undo more changes.
+A numeric argument serves as a repeat count."
+ (interactive "*p")
+ (let ((modified (buffer-modified-p)))
+ (message "Undo!")
+ (or (eq last-command 'undo)
+ (progn (undo-start)
+ (undo-more 1)))
+ (setq this-command 'undo)
+ (undo-more (or arg 1))
+ (and modified (not (buffer-modified-p))
+ (delete-auto-save-file-if-necessary))))
+
+(defun undo-start ()
+ "Move pending-undo-list to front of undo records.
+The next call to undo-more will undo the most recently made change."
+ (if (eq buffer-undo-list t)
+ (error "No undo information in this buffer"))
+ (setq pending-undo-list buffer-undo-list))
+
+(defun undo-more (count)
+ "Undo back N undo-boundaries beyond what was already undone recently.
+Call undo-start to get ready to undo recent changes,
+then call undo-more one or more times to undo them."
+ (or pending-undo-list
+ (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 "")
+
+(defun shell-command (command &optional flag)
+ "Execute string COMMAND in inferior shell; display output, if any.
+If COMMAND ends in ampersand, execute it asynchronously.
+
+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)
+ current-prefix-arg))
+ (if flag
+ (progn (barf-if-buffer-read-only)
+ (push-mark)
+ ;; We do not use -f for csh; we will not support broken use of
+ ;; .cshrcs. Even the BSD csh manual says to use
+ ;; "if ($?prompt) exit" before things which are not useful
+ ;; non-interactively. Besides, if someone wants their other
+ ;; aliases for shell commands then they can still have them.
+ (call-process shell-file-name nil t nil
+ "-c" command)
+ (exchange-point-and-mark))
+ ;; Preserve the match data in case called from a program.
+ (let ((data (match-data)))
+ (unwind-protect
+ (if (string-match "[ \t]*&[ \t]*$" command)
+ ;; Command ending with ampersand means asynchronous.
+ (let ((buffer (get-buffer-create "*shell-command*"))
+ (directory default-directory)
+ proc)
+ ;; Remove the ampersand.
+ (setq command (substring command 0 (match-beginning 0)))
+ ;; If will kill a process, query first.
+ (setq proc (get-buffer-process buffer))
+ (if proc
+ (if (yes-or-no-p "A command is running. Kill it? ")
+ (kill-process proc)
+ (error "Shell command in progress")))
+ (save-excursion
+ (set-buffer buffer)
+ (erase-buffer)
+ (display-buffer buffer)
+ (setq default-directory directory)
+ (setq proc (start-process "Shell" buffer
+ shell-file-name "-c" command))
+ (setq mode-line-process '(": %s"))
+ (set-process-sentinel proc 'shell-command-sentinel)
+ (set-process-filter proc 'shell-command-filter)
+ ))
+ (shell-command-on-region (point) (point) command nil))
+ (store-match-data data)))))
+
+;; We have a sentinel to prevent insertion of a termination message
+;; in the buffer itself.
+(defun shell-command-sentinel (process signal)
+ (if (memq (process-status process) '(exit signal))
+ (progn
+ (message "%s: %s."
+ (car (cdr (cdr (process-command process))))
+ (substring signal 0 -1))
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (setq mode-line-process nil))
+ (delete-process process))))
+
+(defun shell-command-filter (proc string)
+ ;; Do save-excursion by hand so that we can leave point numerically unchanged
+ ;; despite an insertion immediately after it.
+ (let* ((obuf (current-buffer))
+ (buffer (process-buffer proc))
+ opoint
+ (window (get-buffer-window buffer))
+ (pos (window-start window)))
+ (unwind-protect
+ (progn
+ (set-buffer buffer)
+ (setq opoint (point))
+ (goto-char (point-max))
+ (insert-before-markers string))
+ ;; insert-before-markers moved this marker: set it back.
+ (set-window-start window pos)
+ ;; Finish our save-excursion.
+ (goto-char opoint)
+ (set-buffer obuf))))
+
+(defun shell-command-on-region (start end command &optional flag interactive)
+ "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.
+
+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."
+ (interactive (list (min (point) (mark)) (max (point) (mark))
+ (read-string "Shell command on region: "
+ last-shell-command-on-region)
+ current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)))
+ (if flag
+ ;; 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))
+ (call-process-region start end shell-file-name t t nil
+ "-c" command)
+ (if (get-buffer "*Shell Command Output*")
+ (kill-buffer "*Shell Command Output*"))
+ (and interactive swap (exchange-point-and-mark)))
+ ;; No prefix argument: put the output in a temp buffer,
+ ;; replacing its entire contents.
+ (let ((buffer (get-buffer-create "*Shell Command Output*")))
+ (if (eq buffer (current-buffer))
+ ;; If the input is the same buffer as the output,
+ ;; delete everything but the specified region,
+ ;; then replace that region with the output.
+ (progn (delete-region end (point-max))
+ (delete-region (point-min) start)
+ (call-process-region (point-min) (point-max)
+ shell-file-name t t nil
+ "-c" command))
+ ;; Clear the output buffer, then run the command with output there.
+ (save-excursion
+ (set-buffer buffer)
+ (erase-buffer))
+ (call-process-region start end shell-file-name
+ nil buffer nil
+ "-c" command))
+ ;; 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)
+ (message "(Shell command completed with no output)")
+ (kill-buffer "*Shell Command Output*"))
+ ((= lines 1)
+ (message "%s"
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char (point-min))
+ (buffer-substring (point)
+ (progn (end-of-line) (point))))))
+ (t
+ (set-window-start (display-buffer buffer) 1)))))))
+\f
+(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 nil)
+ (let ((c-u 4) (argstartchar last-command-char)
+ char)
+; (describe-arg (list c-u) 1)
+ (setq char (read-char))
+ (while (= char argstartchar)
+ (setq c-u (* 4 c-u))
+; (describe-arg (list c-u) 1)
+ (setq char (read-char)))
+ (prefix-arg-internal char c-u nil)))
+
+(defun prefix-arg-internal (char c-u 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 (= ?- char)
+ (setq sign (- sign) c-u nil)
+; (describe-arg value sign)
+ (setq char (read-char)))
+ (while (and (>= char ?0) (<= char ?9))
+ (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)) c-u nil)
+; (describe-arg value sign)
+ (setq char (read-char)))
+ ;; Repeating the arg-start char after digits
+ ;; terminates the argument but is ignored.
+ (if (eq (lookup-key global-map (make-string 1 char)) 'universal-argument)
+ (setq char (read-char)))
+ (setq prefix-arg
+ (cond (c-u (list c-u))
+ ((numberp value) (* value sign))
+ ((= sign -1) '-)))
+ (setq unread-command-char char)))
+
+;(defun describe-arg (value sign)
+; (cond ((numberp value)
+; (message "Arg: %d" (* value sign)))
+; ((consp value)
+; (message "Arg: C-u factor %d" (car value)))
+; ((< sign 0)
+; (message "Arg: -"))))
+
+(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")
+ (prefix-arg-internal last-command-char nil arg))
+
+(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))
+\f
+(defun forward-to-indentation (arg)
+ "Move forward ARG lines and position at first nonblank character."
+ (interactive "p")
+ (forward-line arg)
+ (skip-chars-forward " \t"))
+
+(defun backward-to-indentation (arg)
+ "Move backward ARG lines and position at first nonblank character."
+ (interactive "p")
+ (forward-line (- arg))
+ (skip-chars-forward " \t"))
+
+(defun kill-line (&optional arg)
+ "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.
+
+When calling from a program, nil means \"no arg\",
+a number counts as a prefix arg."
+ (interactive "P")
+ (kill-region (point)
+ (progn
+ (if arg
+ (forward-line (prefix-numeric-value arg))
+ (if (eobp)
+ (signal 'end-of-buffer nil))
+ (if (looking-at "[ \t]*$")
+ (forward-line 1)
+ (end-of-line)))
+ (point))))
+\f
+;;;; The kill ring
+
+(defvar kill-ring nil
+ "List of killed text sequences.")
+
+(defconst kill-ring-max 30
+ "*Maximum length of kill ring before oldest elements are thrown away.")
+
+(defvar kill-ring-yank-pointer nil
+ "The tail of the kill ring whose car is the last thing yanked.")
+
+(defun kill-append (string before-p)
+ (setcar kill-ring
+ (if before-p
+ (concat string (car kill-ring))
+ (concat (car kill-ring) string))))
+
+(defun kill-region (beg end)
+ "Kill between point and mark.
+The text is deleted but saved in the kill ring.
+The command \\[yank] can retrieve it from there.
+\(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
+
+This is the primitive for programs to kill text (as opposed to deleting it).
+Supply two arguments, character numbers indicating the stretch of text
+ to be killed.
+Any command that calls this function is a \"kill command\".
+If the previous command was also a kill command,
+the text killed this time appends to the text killed last time
+to make one entry in the kill ring."
+ (interactive "r")
+ (if (and (not (eq buffer-undo-list t))
+ (not (eq last-command 'kill-region))
+ (not (eq beg end))
+ (not buffer-read-only))
+ ;; Don't let the undo list be truncated before we can even access it.
+ (let ((undo-high-threshold (+ (- (max beg end) (min beg end)) 100)))
+ (delete-region beg end)
+ ;; Take the same string recorded for undo
+ ;; and put it in the kill-ring.
+ (setq kill-ring (cons (car (car buffer-undo-list)) kill-ring))
+ (if (> (length kill-ring) kill-ring-max)
+ (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
+ (setq this-command 'kill-region)
+ (setq kill-ring-yank-pointer kill-ring))
+ (copy-region-as-kill beg end)
+ (or buffer-read-only (delete-region beg end))))
+
+(defvar x-select-kill nil)
+
+(defun copy-region-as-kill (beg end)
+ "Save the region as if killed, but don't kill it.
+If `x-select-kill' is non-nil, also save the text for X cut and paste."
+ (interactive "r")
+ (if (eq last-command 'kill-region)
+ (kill-append (buffer-substring beg end) (< end beg))
+ (setq kill-ring (cons (buffer-substring beg end) kill-ring))
+ (if (> (length kill-ring) kill-ring-max)
+ (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
+ (if (and (eq window-system 'x) x-select-kill)
+ (x-own-selection (car kill-ring) (selected-screen)))
+ (setq this-command 'kill-region
+ kill-ring-yank-pointer kill-ring)
+ nil)
+
+(defun kill-ring-save (beg end)
+ "Save the region as if killed, but don't kill it."
+ (interactive "r")
+ (copy-region-as-kill beg end)
+ (message "%d characters copied to kill ring"
+ (- (max beg end) (min beg end))))
+
+(defun append-next-kill ()
+ "Cause following command, if kill, to append to previous kill."
+ (interactive)
+ (if (interactive-p)
+ (progn
+ (setq this-command 'kill-region)
+ (message "If the next command is a kill, it will append"))
+ (setq last-command 'kill-region)))
+
+(defun rotate-yank-pointer (arg)
+ "Rotate the yanking point in the kill ring."
+ (interactive "p")
+ (let ((length (length kill-ring)))
+ (if (zerop length)
+ (error "Kill ring is empty")
+ (setq kill-ring-yank-pointer
+ (nthcdr (% (+ arg (- length (length kill-ring-yank-pointer)))
+ length)
+ kill-ring)))))
+
+(defun yank-pop (arg)
+ "Replace just-yanked stretch of killed-text with a different stretch.
+This command is allowed only immediately after a yank or a yank-pop.
+At such a time, the region contains a stretch of reinserted
+previously-killed text. yank-pop deletes that text and inserts in its
+place a different stretch of killed text.
+
+With no argument, the previous kill is inserted.
+With argument n, the n'th previous kill is inserted.
+If n is negative, this is a more recent kill.
+
+The sequence of kills wraps around, so that after the oldest one
+comes the newest one."
+ (interactive "*p")
+ (if (not (eq last-command 'yank))
+ (error "Previous command was not a yank"))
+ (setq this-command 'yank)
+ (let ((before (< (point) (mark))))
+ (delete-region (point) (mark))
+ (rotate-yank-pointer arg)
+ (set-mark (point))
+ (insert (car kill-ring-yank-pointer))
+ (if before (exchange-point-and-mark))))
+
+(defun yank (&optional arg)
+ "Reinsert the last stretch of killed text.
+More precisely, reinsert the stretch of killed text most recently
+killed OR yanked.
+With just C-U as argument, same but put point in front (and mark at end).
+With argument n, reinsert the nth most recently killed stretch of killed
+text.
+See also the command \\[yank-pop]."
+ (interactive "*P")
+ (rotate-yank-pointer (if (listp arg) 0
+ (if (eq arg '-) -1
+ (1- arg))))
+ (push-mark (point))
+ (insert (car kill-ring-yank-pointer))
+ (if (consp arg)
+ (exchange-point-and-mark)))
+\f
+(defun insert-buffer (buffer)
+ "Insert after point the contents of BUFFER.
+Puts mark after the inserted text.
+BUFFER may be a buffer or a buffer name."
+ (interactive (list (read-buffer "Insert buffer: " (other-buffer) t)))
+ (or (bufferp buffer)
+ (setq buffer (get-buffer buffer)))
+ (let (start end newmark)
+ (save-excursion
+ (save-excursion
+ (set-buffer buffer)
+ (setq start (point-min) end (point-max)))
+ (insert-buffer-substring buffer start end)
+ (setq newmark (point)))
+ (push-mark newmark)))
+
+(defun append-to-buffer (buffer start end)
+ "Append to specified buffer the text of the region.
+It is inserted into that buffer before its point.
+
+When calling from a program, give three arguments:
+BUFFER (or buffer name), START and END.
+START and END specify the portion of the current buffer to be copied."
+ (interactive "BAppend to buffer: \nr")
+ (let ((oldbuf (current-buffer)))
+ (save-excursion
+ (set-buffer (get-buffer-create buffer))
+ (insert-buffer-substring oldbuf start end))))
+
+(defun prepend-to-buffer (buffer start end)
+ "Prepend to specified buffer the text of the region.
+It is inserted into that buffer after its point.
+
+When calling from a program, give three arguments:
+BUFFER (or buffer name), START and END.
+START and END specify the portion of the current buffer to be copied."
+ (interactive "BPrepend to buffer: \nr")
+ (let ((oldbuf (current-buffer)))
+ (save-excursion
+ (set-buffer (get-buffer-create buffer))
+ (save-excursion
+ (insert-buffer-substring oldbuf start end)))))
+
+(defun copy-to-buffer (buffer start end)
+ "Copy to specified buffer the text of the region.
+It is inserted into that buffer, replacing existing text there.
+
+When calling from a program, give three arguments:
+BUFFER (or buffer name), START and END.
+START and END specify the portion of the current buffer to be copied."
+ (interactive "BCopy to buffer: \nr")
+ (let ((oldbuf (current-buffer)))
+ (save-excursion
+ (set-buffer (get-buffer-create buffer))
+ (erase-buffer)
+ (save-excursion
+ (insert-buffer-substring oldbuf start end)))))
+\f
+(defun mark ()
+ "Return this buffer's mark value as integer, or nil if no mark.
+If you are using this in an editing command, you are most likely making
+a mistake; see the documentation of `set-mark'."
+ (marker-position (mark-marker)))
+
+(defun set-mark (pos)
+ "Set this buffer's mark to POS. Don't use this function!
+That is to say, don't use this function unless you want
+the user to see that the mark has moved, and you want the previous
+mark position to be lost.
+
+Normally, when a new mark is set, the old one should go on the stack.
+This is why most applications should use push-mark, not set-mark.
+
+Novice emacs-lisp programmers often try to use the mark for the wrong
+purposes. The mark saves a location for the user's convenience.
+Most editing commands should not alter the mark.
+To remember a location for internal use in the Lisp program,
+store it in a Lisp variable. Example:
+
+ (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
+
+ (set-marker (mark-marker) pos (current-buffer)))
+
+(defvar mark-ring nil
+ "The list of saved former marks of the current buffer,
+most recent first.")
+(make-variable-buffer-local 'mark-ring)
+
+(defconst mark-ring-max 16
+ "*Maximum size of mark ring. Start discarding off end if gets this big.")
+
+(defun set-mark-command (arg)
+ "Set mark at where point is, or jump to mark.
+With no prefix argument, set mark, and push previous mark on mark ring.
+With argument, jump to mark, and pop into mark off the mark ring.
+
+Novice emacs-lisp programmers often try to use the mark for the wrong
+purposes. See the documentation of `set-mark' for more information."
+ (interactive "P")
+ (if (null arg)
+ (push-mark)
+ (if (null (mark))
+ (error "No mark set in this buffer")
+ (goto-char (mark))
+ (pop-mark))))
+
+(defun push-mark (&optional location nomsg)
+ "Set mark at LOCATION (point, by default) and push old mark on mark ring.
+Displays \"Mark set\" unless the optional second arg NOMSG is non-nil.
+
+Novice emacs-lisp programmers often try to use the mark for the wrong
+purposes. See the documentation of `set-mark' for more information."
+ (if (null (mark))
+ nil
+ (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
+ (if (> (length mark-ring) mark-ring-max)
+ (progn
+ (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
+ (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
+ (set-mark (or location (point)))
+ (or nomsg executing-macro (> (minibuffer-depth) 0)
+ (message "Mark set"))
+ nil)
+
+(defun pop-mark ()
+ "Pop off mark ring into the buffer's actual mark.
+Does not set point. Does nothing if mark ring is empty."
+ (if mark-ring
+ (progn
+ (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
+ (set-mark (+ 0 (car mark-ring)))
+ (move-marker (car mark-ring) nil)
+ (if (null (mark)) (ding))
+ (setq mark-ring (cdr mark-ring)))))
+
+(fset 'exchange-dot-and-mark 'exchange-point-and-mark)
+(defun exchange-point-and-mark ()
+ "Put the mark where point is now, and point where the mark is now."
+ (interactive nil)
+ (let ((omark (mark)))
+ (if (null omark)
+ (error "No mark set in this buffer"))
+ (set-mark (point))
+ (goto-char omark)
+ nil))
+\f
+(defun next-line (arg)
+ "Move cursor vertically down ARG lines.
+If there is no character in the target line exactly under the current column,
+the cursor is positioned after the character in that line which spans this
+column, or at the end of the line if it is not long enough.
+If there is no line in the buffer after this one,
+a newline character is inserted to create a line
+and the cursor moves to that line.
+
+The command \\[set-goal-column] can be used to create
+a semipermanent goal column to which this command always moves.
+Then it does not try to move vertically. This goal column is stored
+in `goal-column', which is nil when there is none.
+
+If you are thinking of using this in a Lisp program, consider
+using `forward-line' instead. It is usually easier to use
+and more reliable (no dependence on goal column, etc.)."
+ (interactive "p")
+ (if (= arg 1)
+ (let ((opoint (point)))
+ (forward-line 1)
+ (if (or (= opoint (point))
+ (not (eq (preceding-char) ?\n)))
+ (insert ?\n)
+ (goto-char opoint)
+ (line-move arg)))
+ (line-move arg))
+ nil)
+
+(defun previous-line (arg)
+ "Move cursor vertically up ARG lines.
+If there is no character in the target line exactly over the current column,
+the cursor is positioned after the character in that line which spans this
+column, or at the end of the line if it is not long enough.
+
+The command \\[set-goal-column] can be used to create
+a semipermanent goal column to which this command always moves.
+Then it does not try to move vertically.
+
+If you are thinking of using this in a Lisp program, consider using
+`forward-line' with negative argument instead.. It is usually easier
+to use and more reliable (no dependence on goal column, etc.)."
+ (interactive "p")
+ (line-move (- arg))
+ nil)
+
+(defconst track-eol nil
+ "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
+This means moving to the end of each line moved onto.
+The beginning of a blank line does not count as the end of a line.")
+
+(make-variable-buffer-local
+ (defvar goal-column nil
+ "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil."))
+
+(defvar temporary-goal-column 0
+ "Current goal column for vertical motion.
+It is the column where point was
+at the start of current run of vertical motion commands.
+When the `track-eol' feature is doing its job, the value is 9999."
+
+(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))
+ (forward-line arg)
+ ;; Move by arg lines, but ignore invisible ones.
+ (while (> arg 0)
+ (vertical-motion 1)
+ (forward-char -1)
+ (forward-line 1)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (vertical-motion -1)
+ (beginning-of-line)
+ (setq arg (1+ arg))))
+ (move-to-column (or goal-column temporary-goal-column))
+ nil)
+
+
+(defun set-goal-column (arg)
+ "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
+Those commands will move to this position in the line moved to
+rather than trying to keep the same horizontal position.
+With a non-nil argument, clears out the goal column
+so that \\[next-line] and \\[previous-line] resume vertical motion."
+ (interactive "P")
+ (if arg
+ (progn
+ (setq goal-column nil)
+ (message "No goal column"))
+ (setq goal-column (current-column))
+ (message (substitute-command-keys
+ "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
+ goal-column))
+ nil)
+\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 characters (backward if ARG negative).
+If no argument and at end of line, the previous two chars are exchanged."
+ (interactive "*P")
+ (and (null arg) (eolp) (forward-char -1))
+ (transpose-subr 'forward-char (prefix-numeric-value arg)))
+
+(defun transpose-words (arg)
+ "Interchange words around point, leaving point at end of them.
+With prefix arg ARG, effect is to take word before or around 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."
+ (interactive "*p")
+ (transpose-subr 'forward-word arg))
+
+(defun transpose-sexps (arg)
+ "Like \\[transpose-words] but applies to sexps.
+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))
+
+(defun transpose-lines (arg)
+ "Exchange current line and previous line, leaving point after both.
+With argument ARG, takes previous line and moves it past ARG lines.
+With argument 0, interchanges line point is in with line mark is in."
+ (interactive "*p")
+ (transpose-subr (function
+ (lambda (arg)
+ (if (= arg 1)
+ (progn
+ ;; Move forward over a line,
+ ;; but create a newline if none exists yet.
+ (end-of-line)
+ (if (eobp)
+ (newline)
+ (forward-char 1)))
+ (forward-line arg))))
+ arg))
+
+(defun transpose-subr (mover arg)
+ (let (start1 end1 start2 end2)
+ (if (= arg 0)
+ (progn
+ (save-excursion
+ (funcall mover 1)
+ (setq end2 (point))
+ (funcall mover -1)
+ (setq start2 (point))
+ (goto-char (mark))
+ (funcall mover 1)
+ (setq end1 (point))
+ (funcall mover -1)
+ (setq start1 (point))
+ (transpose-subr-1))
+ (exchange-point-and-mark)))
+ (while (> arg 0)
+ (funcall mover -1)
+ (setq start1 (point))
+ (funcall mover 1)
+ (setq end1 (point))
+ (funcall mover 1)
+ (setq end2 (point))
+ (funcall mover -1)
+ (setq start2 (point))
+ (transpose-subr-1)
+ (goto-char end2)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (funcall mover -1)
+ (setq start2 (point))
+ (funcall mover -1)
+ (setq start1 (point))
+ (funcall mover 1)
+ (setq end1 (point))
+ (funcall mover 1)
+ (setq end2 (point))
+ (transpose-subr-1)
+ (setq arg (1+ arg)))))
+
+(defun transpose-subr-1 ()
+ (if (> (min end1 end2) (max start1 start2))
+ (error "Don't have two things to transpose"))
+ (let ((word1 (buffer-substring start1 end1))
+ (word2 (buffer-substring start2 end2)))
+ (delete-region start2 end2)
+ (goto-char start2)
+ (insert word1)
+ (goto-char (if (< start1 start2) start1
+ (+ start1 (- (length word1) (length word2)))))
+ (delete-char (length word1))
+ (insert word2)))
+\f
+(defconst comment-column 32
+ "*Column to indent right-margin comments to.
+Setting this variable automatically makes it local to the current buffer.")
+(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.")
+
+(defconst comment-start-skip nil
+ "*Regexp to match the start of a comment plus everything up to its body.
+If there are any \\(...\\) pairs, the comment delimiter text is held to begin
+at the place matched by the close of the first pair.")
+
+(defconst comment-end ""
+ "*String to insert to end a new comment.
+Should be an empty string if comments are terminated by end-of-line.")
+
+(defconst comment-indent-hook
+ '(lambda () comment-column)
+ "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.")
+
+(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-chars-backward " \t" (match-beginning 0))
+ (skip-chars-backward "^ \t" (match-beginning 0)))))
+ (setq begpos (point))
+ ;; Compute desired indent.
+ (if (= (current-column)
+ (setq indent (funcall comment-indent-hook)))
+ (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))))))
+
+(defun set-comment-column (arg)
+ "Set the comment column based on point.
+With no arg, set the comment column to the current column.
+With just minus as arg, kill any comment on this line.
+With any other arg, set comment column to indentation of the previous comment
+ and then align or create a comment on this line at that column."
+ (interactive "P")
+ (if (eq arg '-)
+ (kill-comment nil)
+ (if arg
+ (progn
+ (save-excursion
+ (beginning-of-line)
+ (re-search-backward comment-start-skip)
+ (beginning-of-line)
+ (re-search-forward comment-start-skip)
+ (goto-char (match-beginning 0))
+ (setq comment-column (current-column))
+ (message "Comment column set to %d" comment-column))
+ (indent-for-comment))
+ (setq comment-column (current-column))
+ (message "Comment column set to %d" comment-column))))
+
+(defun kill-comment (arg)
+ "Kill the comment on this line, if any.
+With argument, kill comments on that many lines starting with this one."
+ ;; this function loses in a lot of situations. it incorrectly recognises
+ ;; comment delimiters sometimes (ergo, inside a string), doesn't work
+ ;; with multi-line comments, can kill extra whitespace if comment wasn't
+ ;; through end-of-line, et cetera.
+ (interactive "P")
+ (or comment-start-skip (error "No comment syntax defined"))
+ (let ((count (prefix-numeric-value arg)) endc)
+ (while (> count 0)
+ (save-excursion
+ (end-of-line)
+ (setq endc (point))
+ (beginning-of-line)
+ (and (string< "" comment-end)
+ (setq endc
+ (progn
+ (re-search-forward (regexp-quote comment-end) endc 'move)
+ (skip-chars-forward " \t")
+ (point))))
+ (beginning-of-line)
+ (if (re-search-forward comment-start-skip endc t)
+ (progn
+ (goto-char (match-beginning 0))
+ (skip-chars-backward " \t")
+ (kill-region (point) endc)
+ ;; to catch comments a line beginnings
+ (indent-according-to-mode))))
+ (if arg (forward-line 1))
+ (setq count (1- count)))))
+
+(defun comment-region (beg end &optional arg)
+ "Comment the region; third arg numeric means use ARG comment characters.
+If ARG is negative, delete that many comment characters instead.
+Comments are terminated on each line, even for syntax in which newline does
+not end the comment. Blank lines do not get comments."
+ ;; if someone wants it to only put a comment-start at the beginning and
+ ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x
+ ;; is easy enough. No option is made here for other than commenting
+ ;; every line.
+ (interactive "r\np")
+ (or comment-start (error "No comment syntax is defined"))
+ (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
+ (save-excursion
+ (save-restriction
+ (let ((cs comment-start) (ce comment-end))
+ (cond ((not arg) (setq arg 1))
+ ((> arg 1)
+ (while (> (setq arg (1- arg)) 0)
+ (setq cs (concat cs comment-start)
+ ce (concat ce comment-end)))))
+ (narrow-to-region beg end)
+ (goto-char beg)
+ (while (not (eobp))
+ (if (< arg 0)
+ (let ((count arg))
+ (while (and (> 1 (setq count (1+ count)))
+ (looking-at (regexp-quote cs)))
+ (delete-char (length cs)))
+ (if (string= "" ce) ()
+ (setq count arg)
+ (while (> 1 (setq count (1+ count)))
+ (end-of-line)
+ ;; this is questionable if comment-end ends in whitespace
+ ;; that is pretty brain-damaged though
+ (skip-chars-backward " \t")
+ (backward-char (length ce))
+ (if (looking-at (regexp-quote ce))
+ (delete-char (length ce))))))
+ (if (looking-at "[ \t]*$") ()
+ (insert cs)
+ (if (string= "" ce) ()
+ (end-of-line)
+ (insert ce)))
+ (search-forward "\n" nil 'move)))))))
+\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."
+ (interactive "p")
+ (forward-word (- arg)))
+
+(defun mark-word (arg)
+ "Set mark arg words away from point."
+ (interactive "p")
+ (push-mark
+ (save-excursion
+ (forward-word arg)
+ (point))))
+
+(defun kill-word (arg)
+ "Kill characters forward until encountering the end of a word.
+With argument, do this that many times."
+ (interactive "p")
+ (kill-region (point) (progn (forward-word arg) (point))))
+
+(defun backward-kill-word (arg)
+ "Kill characters backward until encountering the end of a word.
+With argument, do this that many times."
+ (interactive "p")
+ (kill-word (- arg)))
+\f
+(defconst fill-prefix nil
+ "*String for filling to insert at front of new line, or nil for none.
+Setting this variable automatically makes it local to the current buffer.")
+(make-variable-buffer-local 'fill-prefix)
+
+(defconst auto-fill-inhibit-regexp nil
+ "*Regexp to match lines which should not be auto-filled.")
+
+(defun do-auto-fill ()
+ (let (give-up)
+ (or (and auto-fill-inhibit-regexp
+ (save-excursion (beginning-of-line)
+ (looking-at auto-fill-inhibit-regexp)))
+ (while (and (not give-up) (> (current-column) fill-column))
+ (let ((fill-point
+ (let ((opoint (point)))
+ (save-excursion
+ (move-to-column (1+ fill-column))
+ (skip-chars-backward "^ \t\n")
+ (if (bolp)
+ (re-search-forward "[ \t]" opoint t))
+ (skip-chars-backward " \t")
+ (point)))))
+ ;; If there is a space on the line before fill-point,
+ ;; and nonspaces precede it, break the line there.
+ (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)))
+ ;; No place to break => stop trying.
+ (setq give-up t)))))))
+
+(defconst comment-multi-line nil
+ "*Non-nil means \\[indent-new-comment-line] should continue same comment
+on new line, with no new terminator or starter.")
+
+(defun indent-new-comment-line ()
+ "Break line at point and indent, continuing comment if presently within one.
+The body of the continued comment is indented under the previous comment line."
+ (interactive "*")
+ (let (comcol comstart)
+ (skip-chars-backward " \t")
+ (delete-region (point)
+ (progn (skip-chars-forward " \t")
+ (point)))
+ (insert ?\n)
+ (save-excursion
+ (if (and comment-start-skip
+ (let ((opoint (point)))
+ (forward-line -1)
+ (re-search-forward comment-start-skip opoint t)))
+ ;; The old line is a comment.
+ ;; 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)))
+ (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)))
+ ;; Indent this line like what we found.
+ (goto-char win)
+ (setq comcol (current-column))
+ (setq comstart (buffer-substring (point) (match-end 0))))))
+ (if comcol
+ (let ((comment-column comcol)
+ (comment-start comstart)
+ (comment-end comment-end))
+ (and comment-end (not (equal comment-end ""))
+ (if (not comment-multi-line)
+ (progn
+ (forward-char -1)
+ (insert comment-end)
+ (forward-char 1))
+ (setq comment-column (+ comment-column (length comment-start))
+ comment-start "")))
+ (if (not (eolp))
+ (setq comment-end ""))
+ (insert ?\n)
+ (forward-char -1)
+ (indent-for-comment)
+ (save-excursion
+ ;; Make sure we delete the newline inserted above.
+ (end-of-line)
+ (delete-char 1)))
+ (if fill-prefix
+ (insert fill-prefix)
+ (indent-according-to-mode)))))
+
+(defun auto-fill-mode (&optional arg)
+ "Toggle auto-fill mode.
+With arg, turn auto-fill mode on if and only if arg is positive.
+In auto-fill mode, inserting a space at a column beyond fill-column
+automatically breaks the line at a previous space."
+ (interactive "P")
+ (prog1 (setq auto-fill-function
+ (if (if (null arg)
+ (not auto-fill-function)
+ (> (prefix-numeric-value arg) 0))
+ 'do-auto-fill
+ nil))
+ ;; update mode-line
+ (set-buffer-modified-p (buffer-modified-p))))
+
+(defun turn-on-auto-fill ()
+ "Unconditionally turn on Auto Fill mode."
+ (auto-fill-mode 1))
+
+(defun set-fill-column (arg)
+ "Set fill-column to current column, or to argument if given.
+fill-column's value is separate for each buffer."
+ (interactive "P")
+ (setq fill-column (if (integerp arg) arg (current-column)))
+ (message "fill-column set to %d" fill-column))
+\f
+(defun set-selective-display (arg)
+ "Set selective-display to ARG; clear it if no arg.
+When selective-display is a number > 0,
+lines whose indentation is >= selective-display are not displayed.
+selective-display's value is separate for each buffer."
+ (interactive "P")
+ (if (eq selective-display t)
+ (error "selective-display already in use for marked lines"))
+ (setq selective-display
+ (and arg (prefix-numeric-value arg)))
+ (set-window-start (selected-window) (window-start (selected-window)))
+ (princ "selective-display set to " t)
+ (prin1 selective-display t)
+ (princ "." t))
+
+(defun overwrite-mode (arg)
+ "Toggle overwrite mode.
+With arg, turn overwrite mode on iff arg is positive.
+In overwrite mode, printing characters typed in replace existing text
+on a one-for-one basis, rather than pushing it to the right."
+ (interactive "P")
+ (setq overwrite-mode
+ (if (null arg) (not overwrite-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (set-buffer-modified-p (buffer-modified-p))) ;No-op, but updates mode line.
+\f
+(defvar blink-matching-paren t
+ "*Non-nil means show matching open-paren when close-paren is inserted.")
+
+(defconst blink-matching-paren-distance 4000
+ "*If non-nil, is maximum distance to search for matching open-paren
+when close-paren is inserted.")
+
+(defun blink-matching-open ()
+ "Move cursor momentarily to the beginning of the sexp before point."
+ (interactive)
+ (and (> (point) (1+ (point-min)))
+ (/= (char-syntax (char-after (- (point) 2))) ?\\ )
+ blink-matching-paren
+ (let* ((oldpos (point))
+ (blinkpos)
+ (mismatch))
+ (save-excursion
+ (save-restriction
+ (if blink-matching-paren-distance
+ (narrow-to-region (max (point-min)
+ (- (point) blink-matching-paren-distance))
+ oldpos))
+ (condition-case ()
+ (setq blinkpos (scan-sexps oldpos -1))
+ (error nil)))
+ (and blinkpos (/= (char-syntax (char-after blinkpos))
+ ?\$)
+ (setq mismatch
+ (/= (char-after (1- oldpos))
+ (logand (lsh (aref (syntax-table)
+ (char-after blinkpos))
+ -8)
+ 255))))
+ (if mismatch (setq blinkpos nil))
+ (if blinkpos
+ (progn
+ (goto-char blinkpos)
+ (if (pos-visible-in-window-p)
+ (sit-for 1)
+ (goto-char blinkpos)
+ (message
+ "Matches %s"
+ (if (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp)))
+ (buffer-substring (progn (beginning-of-line) (point))
+ (1+ blinkpos))
+ (buffer-substring blinkpos
+ (progn
+ (forward-char 1)
+ (skip-chars-forward "\n \t")
+ (end-of-line)
+ (point)))))))
+ (cond (mismatch
+ (message "Mismatched parentheses"))
+ ((not blink-matching-paren-distance)
+ (message "Unmatched parenthesis"))))))))
+
+;Turned off because it makes dbx bomb out.
+(setq blink-paren-function 'blink-matching-open)
+
+; this is just something for the luser to see in a keymap -- this is not
+; how quitting works normally!
+(defun keyboard-quit ()
+ "Signal a quit condition."
+ (interactive)
+ (signal 'quit nil))
+
+(define-key global-map "\C-g" 'keyboard-quit)
+\f
+(defun set-variable (var val)
+ "Set VARIABLE to VALUE. VALUE is a Lisp object.
+When using this interactively, supply a Lisp expression for VALUE.
+If you want VALUE to be a string, you must surround it with doublequotes."
+ (interactive
+ (let* ((var (read-variable "Set variable: "))
+ (minibuffer-help-form
+ '(funcall myhelp))
+ (myhelp
+ (function
+ (lambda ()
+ (with-output-to-temp-buffer "*Help*"
+ (prin1 var)
+ (princ "\nDocumentation:\n")
+ (princ (substring (documentation-property var 'variable-documentation)
+ 1))
+ (if (boundp var)
+ (let ((print-length 20))
+ (princ "\n\nCurrent value: ")
+ (prin1 (symbol-value var))))
+ nil)))))
+ (list var
+ (eval-minibuffer (format "Set %s to value: " var)))))
+ (set var val))
+\f
+;These commands are defined in editfns.c
+;but they are not assigned to keys there.
+(put 'narrow-to-region 'disabled t)
+(define-key ctl-x-map "n" 'narrow-to-region)
+(define-key ctl-x-map "w" 'widen)
+
+(define-key global-map "\C-j" 'newline-and-indent)
+(define-key global-map "\C-m" 'newline)
+(define-key global-map "\C-o" 'open-line)
+(define-key esc-map "\C-o" 'split-line)
+(define-key global-map "\C-q" 'quoted-insert)
+(define-key esc-map "^" 'delete-indentation)
+(define-key esc-map "\\" 'delete-horizontal-space)
+(define-key esc-map "m" 'back-to-indentation)
+(define-key ctl-x-map "\C-o" 'delete-blank-lines)
+(define-key esc-map " " 'just-one-space)
+(define-key esc-map "z" 'zap-to-char)
+(define-key esc-map "=" 'count-lines-region)
+(define-key ctl-x-map "=" 'what-cursor-position)
+(define-key esc-map "\e" 'eval-expression)
+(define-key ctl-x-map "\e" 'repeat-complex-command)
+(define-key ctl-x-map "u" 'advertised-undo)
+(define-key global-map "\C-_" 'undo)
+(define-key esc-map "!" 'shell-command)
+(define-key esc-map "|" 'shell-command-on-region)
+
+(define-key global-map "\C-u" 'universal-argument)
+(let ((i ?0))
+ (while (<= i ?9)
+ (define-key esc-map (char-to-string i) 'digit-argument)
+ (setq i (1+ i))))
+(define-key esc-map "-" 'negative-argument)
+
+(define-key global-map "\C-k" 'kill-line)
+(define-key global-map "\C-w" 'kill-region)
+(define-key esc-map "w" 'kill-ring-save)
+(define-key esc-map "\C-w" 'append-next-kill)
+(define-key global-map "\C-y" 'yank)
+(define-key esc-map "y" 'yank-pop)
+
+(define-key ctl-x-map "a" 'append-to-buffer)
+
+(define-key global-map "\C-@" 'set-mark-command)
+(define-key ctl-x-map "\C-x" 'exchange-point-and-mark)
+
+(define-key global-map "\C-n" 'next-line)
+(define-key global-map "\C-p" 'previous-line)
+(define-key ctl-x-map "\C-n" 'set-goal-column)
+
+(define-key global-map "\C-t" 'transpose-chars)
+(define-key esc-map "t" 'transpose-words)
+(define-key esc-map "\C-t" 'transpose-sexps)
+(define-key ctl-x-map "\C-t" 'transpose-lines)
+
+(define-key esc-map ";" 'indent-for-comment)
+(define-key esc-map "j" 'indent-new-comment-line)
+(define-key esc-map "\C-j" 'indent-new-comment-line)
+(define-key ctl-x-map ";" 'set-comment-column)
+(define-key ctl-x-map "f" 'set-fill-column)
+(define-key ctl-x-map "$" 'set-selective-display)
+
+(define-key esc-map "@" 'mark-word)
+(define-key esc-map "f" 'forward-word)
+(define-key esc-map "b" 'backward-word)
+(define-key esc-map "d" 'kill-word)
+(define-key esc-map "\177" 'backward-kill-word)
+
+(define-key esc-map "<" 'beginning-of-buffer)
+(define-key esc-map ">" 'end-of-buffer)
+(define-key ctl-x-map "h" 'mark-whole-buffer)
+(define-key esc-map "\\" 'delete-horizontal-space)
+
+(fset 'mode-specific-command-prefix (make-sparse-keymap))
+(defconst mode-specific-map (symbol-function 'mode-specific-command-prefix)
+ "Keymap for characters following C-c.")
+(define-key global-map "\C-c" 'mode-specific-command-prefix)
HCoop / bpt / emacs.git / commitdiff