diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ebuff-menu.el | 241 | ||||
| -rw-r--r-- | lisp/progmodes/perl-mode.el | 631 | ||||
| -rw-r--r-- | lisp/simple.el | 1667 |
3 files changed, 2539 insertions, 0 deletions
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el new file mode 100644 index 00000000000..f3fab00a19e --- /dev/null +++ b/lisp/ebuff-menu.el @@ -0,0 +1,241 @@ +; buggestions to mly@ai.mit.edu + +;; who says one can't have typeout windows in gnu emacs? +;; like ^r select buffer from its emacs lunar or tmacs libraries. + +;; Copyright (C) 1985, 1986 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. + + +(require 'electric) + +;; this depends on the format of list-buffers (from src/buffer.c) and +;; on stuff in lisp/buff-menu.el + +(defvar electric-buffer-menu-mode-map nil) + +;;;###autoload +(defun electric-buffer-list (arg) + "Pops up a buffer describing the set of Emacs buffers. +Vaguely like ITS lunar select buffer; combining typeoutoid buffer +listing with menuoid buffer selection. + +If the very next character typed is a space then the buffer list +window disappears. Otherwise, one may move around in the buffer list +window, marking buffers to be selected, saved or deleted. + +To exit and select a new buffer, type a space when the cursor is on +the appropriate line of the buffer-list window. Other commands are +much like those of buffer-menu-mode. + +Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil. + +\\{electric-buffer-menu-mode-map}" + (interactive "P") + (let (select buffer) + (save-window-excursion + (save-window-excursion (list-buffers arg)) + (setq buffer (window-buffer (Electric-pop-up-window "*Buffer List*"))) + (unwind-protect + (progn + (set-buffer buffer) + (Electric-buffer-menu-mode) + (setq select + (catch 'electric-buffer-menu-select + (message "<<< Press Space to bury the buffer list >>>") + (if (= (setq unread-command-char (read-char)) ?\ ) + (progn (setq unread-command-char -1) + (throw 'electric-buffer-menu-select nil))) + (let ((first (progn (goto-char (point-min)) + (forward-line 2) + (point))) + (last (progn (goto-char (point-max)) + (forward-line -1) + (point))) + (goal-column 0)) + (goto-char first) + (Electric-command-loop 'electric-buffer-menu-select + nil + t + 'electric-buffer-menu-looper + (cons first last)))))) + (set-buffer buffer) + (Buffer-menu-mode) + (bury-buffer buffer) + (message ""))) + (if select + (progn (set-buffer buffer) + (let ((opoint (point-marker))) + (Buffer-menu-execute) + (goto-char (point-min)) + (if (prog1 (search-forward "\n>" nil t) + (goto-char opoint) (set-marker opoint nil)) + (Buffer-menu-select) + (switch-to-buffer (Buffer-menu-buffer t)))))))) + +(defun electric-buffer-menu-looper (state condition) + (cond ((and condition + (not (memq (car condition) '(buffer-read-only + end-of-buffer + beginning-of-buffer)))) + (signal (car condition) (cdr condition))) + ((< (point) (car state)) + (goto-char (point-min)) + (forward-line 2)) + ((> (point) (cdr state)) + (goto-char (point-max)) + (forward-line -1) + (if (pos-visible-in-window-p (point-max)) + (recenter -1))))) + +(put 'Electric-buffer-menu-mode 'mode-class 'special) +(defun Electric-buffer-menu-mode () + "Major mode for editing a list of buffers. +Each line describes one of the buffers in Emacs. +Letters do not insert themselves; instead, they are commands. +\\<electric-buffer-menu-mode-map> +\\[keyboard-quit] or \\[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer + configuration. If the very first character typed is a space, it + also has this effect. +\\[Electric-buffer-menu-select] -- select buffer of line point is on. + Also show buffers marked with m in other windows, + deletes buffers marked with \"D\", and saves those marked with \"S\". +\\[Buffer-menu-mark] -- mark buffer to be displayed. +\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer. +\\[Buffer-menu-save] -- mark that buffer to be saved. +\\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted. +\\[Buffer-menu-unmark] -- remove all kinds of marks from current line. +\\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done. +\\[Buffer-menu-backup-unmark] -- back up a line and remove marks. + +\\{electric-buffer-menu-mode-map} + +Entry to this mode via command electric-buffer-list calls the value of +electric-buffer-menu-mode-hook if it is non-nil." + (kill-all-local-variables) + (use-local-map electric-buffer-menu-mode-map) + (setq mode-name "Electric Buffer Menu") + (setq mode-line-buffer-identification "Electric Buffer List") + (make-local-variable 'Helper-return-blurb) + (setq Helper-return-blurb "return to buffer editing") + (setq truncate-lines t) + (setq buffer-read-only t) + (setq major-mode 'Electric-buffer-menu-mode) + (goto-char (point-min)) + (if (search-forward "\n." nil t) (forward-char -1)) + (run-hooks 'electric-buffer-menu-mode-hook)) + +;; generally the same as Buffer-menu-mode-map +;; (except we don't indirect to global-map) +(put 'Electric-buffer-menu-undefined 'suppress-keymap t) +(if electric-buffer-menu-mode-map + nil + (let ((map (make-keymap))) + (fillarray map 'Electric-buffer-menu-undefined) + (define-key map "\e" (make-keymap)) + (fillarray (lookup-key map "\e") 'Electric-buffer-menu-undefined) + (define-key map "\C-z" 'suspend-emacs) + (define-key map "v" 'Electric-buffer-menu-mode-view-buffer) + (define-key map "\C-h" 'Helper-help) + (define-key map "?" 'Helper-describe-bindings) + (define-key map "\C-c" nil) + (define-key map "\C-c\C-c" 'Electric-buffer-menu-quit) + (define-key map "\C-]" 'Electric-buffer-menu-quit) + (define-key map "q" 'Electric-buffer-menu-quit) + (define-key map " " 'Electric-buffer-menu-select) + (define-key map "\C-l" 'recenter) + (define-key map "s" 'Buffer-menu-save) + (define-key map "d" 'Buffer-menu-delete) + (define-key map "k" 'Buffer-menu-delete) + (define-key map "\C-d" 'Buffer-menu-delete-backwards) + ;(define-key map "\C-k" 'Buffer-menu-delete) + (define-key map "\177" 'Buffer-menu-backup-unmark) + (define-key map "~" 'Buffer-menu-not-modified) + (define-key map "u" 'Buffer-menu-unmark) + (let ((i ?0)) + (while (<= i ?9) + (define-key map (char-to-string i) 'digit-argument) + (define-key map (concat "\e" (char-to-string i)) 'digit-argument) + (setq i (1+ i)))) + (define-key map "-" 'negative-argument) + (define-key map "\e-" 'negative-argument) + (define-key map "m" 'Buffer-menu-mark) + (define-key map "\C-u" 'universal-argument) + (define-key map "\C-p" 'previous-line) + (define-key map "\C-n" 'next-line) + (define-key map "p" 'previous-line) + (define-key map "n" 'next-line) + (define-key map "\C-v" 'scroll-up) + (define-key map "\ev" 'scroll-down) + (define-key map ">" 'scroll-right) + (define-key map "<" 'scroll-left) + (define-key map "\e\C-v" 'scroll-other-window) + (define-key map "\e>" 'end-of-buffer) + (define-key map "\e<" 'beginning-of-buffer) + (setq electric-buffer-menu-mode-map map))) + +(defun Electric-buffer-menu-exit () + (interactive) + (setq unread-command-char last-input-char) + ;; for robustness + (condition-case () + (throw 'electric-buffer-menu-select nil) + (error (Buffer-menu-mode) + (other-buffer)))) + +(defun Electric-buffer-menu-select () + "Leave Electric Buffer Menu, selecting buffers and executing changes. +Saves buffers marked \"S\". Deletes buffers marked \"K\". +Selects buffer at point and displays buffers marked \">\" in other windows." + (interactive) + (throw 'electric-buffer-menu-select (point))) + +(defun Electric-buffer-menu-quit () + "Leave Electric Buffer Menu, restoring previous window configuration. +Does not execute select, save, or delete commands." + (interactive) + (throw 'electric-buffer-menu-select nil)) + +(defun Electric-buffer-menu-undefined () + (interactive) + (ding) + (message (if (and (eq (key-binding "\C-c\C-c") 'Electric-buffer-menu-quit) + (eq (key-binding " ") 'Electric-buffer-menu-select) + (eq (key-binding "\C-h") 'Helper-help) + (eq (key-binding "?") 'Helper-describe-bindings)) + "Type C-c C-c to exit, Space to select, C-h for help, ? for commands" + (substitute-command-keys "\ +Type \\[Electric-buffer-menu-quit] to exit, \ +\\[Electric-buffer-menu-select] to select, \ +\\[Helper-help] for help, \\[Helper-describe-bindings] for commands."))) + (sit-for 4)) + +(defun Electric-buffer-menu-mode-view-buffer () + "View buffer on current line in Electric Buffer Menu. +Returns to Electric Buffer Menu when done." + (interactive) + (let ((bufnam (Buffer-menu-buffer nil))) + (if bufnam + (view-buffer bufnam) + (ding) + (message "Buffer %s does not exist!" bufnam) + (sit-for 4)))) + + + + diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el new file mode 100644 index 00000000000..cb6195dec3b --- /dev/null +++ b/lisp/progmodes/perl-mode.el @@ -0,0 +1,631 @@ +;; 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.") + +(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)) + +;; 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))) + +(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")) + +;; 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")))) + +(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! ;;;;;;;;; diff --git a/lisp/simple.el b/lisp/simple.el new file mode 100644 index 00000000000..0d4ca3fda7b --- /dev/null +++ b/lisp/simple.el @@ -0,0 +1,1667 @@ +;; 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))))))) + +(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)) + +(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)))) + +;;;; 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))) + +(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))))) + +(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)) + +(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) + +(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))) + +(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))))))) + +(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))) + +(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)) + +(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. + +(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) + +(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)) + +;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) |