diff options
Diffstat (limited to 'lisp/textmodes')
| -rw-r--r-- | lisp/textmodes/nroff-mode.el | 203 | ||||
| -rw-r--r-- | lisp/textmodes/page.el | 123 | ||||
| -rw-r--r-- | lisp/textmodes/paragraphs.el | 205 | ||||
| -rw-r--r-- | lisp/textmodes/refbib.el | 715 | ||||
| -rw-r--r-- | lisp/textmodes/spell.el | 132 | ||||
| -rw-r--r-- | lisp/textmodes/text-mode.el | 147 | ||||
| -rw-r--r-- | lisp/textmodes/underline.el | 46 |
7 files changed, 1571 insertions, 0 deletions
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el new file mode 100644 index 00000000000..16e1445080b --- /dev/null +++ b/lisp/textmodes/nroff-mode.el @@ -0,0 +1,203 @@ +;; GNU Emacs major mode for editing nroff source +;; 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. + + + +(defvar nroff-mode-abbrev-table nil + "Abbrev table used while in nroff mode.") + +(defvar nroff-mode-map nil + "Major mode keymap for nroff-mode buffers") +(if (not nroff-mode-map) + (progn + (setq nroff-mode-map (make-sparse-keymap)) + (define-key nroff-mode-map "\t" 'tab-to-tab-stop) + (define-key nroff-mode-map "\es" 'center-line) + (define-key nroff-mode-map "\e?" 'count-text-lines) + (define-key nroff-mode-map "\n" 'electric-nroff-newline) + (define-key nroff-mode-map "\en" 'forward-text-line) + (define-key nroff-mode-map "\ep" 'backward-text-line))) + +(defun nroff-mode () + "Major mode for editing text intended for nroff to format. +\\{nroff-mode-map} +Turning on Nroff mode runs text-mode-hook, then nroff-mode-hook. +Also, try nroff-electric-mode, for automatically inserting +closing requests for requests that are used in matched pairs." + (interactive) + (kill-all-local-variables) + (use-local-map nroff-mode-map) + (setq mode-name "Nroff") + (setq major-mode 'nroff-mode) + (set-syntax-table text-mode-syntax-table) + (setq local-abbrev-table nroff-mode-abbrev-table) + (make-local-variable 'nroff-electric-mode) + ;; now define a bunch of variables for use by commands in this mode + (make-local-variable 'page-delimiter) + (setq page-delimiter "^\\.\\(bp\\|SK\\|OP\\)") + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "^[.']\\|" paragraph-start)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate (concat "^[.']\\|" paragraph-separate)) + ;; comment syntax added by mit-erl!gildea 18 Apr 86 + (make-local-variable 'comment-start) + (setq comment-start "\\\" ") + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "\\\\\"[ \t]*") + (make-local-variable 'comment-column) + (setq comment-column 24) + (make-local-variable 'comment-indent-hook) + (setq comment-indent-hook 'nroff-comment-indent) + (run-hooks 'text-mode-hook 'nroff-mode-hook)) + +;;; Compute how much to indent a comment in nroff/troff source. +;;; By mit-erl!gildea April 86 +(defun nroff-comment-indent () + "Compute indent for an nroff/troff comment. +Puts a full-stop before comments on a line by themselves." + (let ((pt (point))) + (unwind-protect + (progn + (skip-chars-backward " \t") + (if (bolp) + (progn + (setq pt (1+ pt)) + (insert ?.) + 1) + (if (save-excursion + (backward-char 1) + (looking-at "^[.']")) + 1 + (max comment-column + (* 8 (/ (+ (current-column) + 9) 8)))))) ; add 9 to ensure at least two blanks + (goto-char pt)))) + +(defun count-text-lines (start end &optional print) + "Count lines in region, except for nroff request lines. +All lines not starting with a period are counted up. +Interactively, print result in echo area. +Noninteractively, return number of non-request lines from START to END." + (interactive "r\np") + (if print + (message "Region has %d text lines" (count-text-lines start end)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (- (buffer-size) (forward-text-line (buffer-size))))))) + +(defun forward-text-line (&optional cnt) + "Go forward one nroff text line, skipping lines of nroff requests. +An argument is a repeat count; if negative, move backward." + (interactive "p") + (if (not cnt) (setq cnt 1)) + (while (and (> cnt 0) (not (eobp))) + (forward-line 1) + (while (and (not (eobp)) (looking-at "[.'].")) + (forward-line 1)) + (setq cnt (- cnt 1))) + (while (and (< cnt 0) (not (bobp))) + (forward-line -1) + (while (and (not (bobp)) + (looking-at "[.'].")) + (forward-line -1)) + (setq cnt (+ cnt 1))) + cnt) + +(defun backward-text-line (&optional cnt) + "Go backward one nroff text line, skipping lines of nroff requests. +An argument is a repeat count; negative means move forward." + (interactive "p") + (forward-text-line (- cnt))) + +(defconst nroff-brace-table + '((".(b" . ".)b") + (".(l" . ".)l") + (".(q" . ".)q") + (".(c" . ".)c") + (".(x" . ".)x") + (".(z" . ".)z") + (".(d" . ".)d") + (".(f" . ".)f") + (".LG" . ".NL") + (".SM" . ".NL") + (".LD" . ".DE") + (".CD" . ".DE") + (".BD" . ".DE") + (".DS" . ".DE") + (".DF" . ".DE") + (".FS" . ".FE") + (".KS" . ".KE") + (".KF" . ".KE") + (".LB" . ".LE") + (".AL" . ".LE") + (".BL" . ".LE") + (".DL" . ".LE") + (".ML" . ".LE") + (".RL" . ".LE") + (".VL" . ".LE") + (".RS" . ".RE") + (".TS" . ".TE") + (".EQ" . ".EN") + (".PS" . ".PE") + (".BS" . ".BE") + (".G1" . ".G2") ; grap + (".na" . ".ad b") + (".nf" . ".fi") + (".de" . ".."))) + +(defun electric-nroff-newline (arg) + "Insert newline for nroff mode; special if electric-nroff mode. +In electric-nroff-mode, if ending a line containing an nroff opening request, +automatically inserts the matching closing request after point." + (interactive "P") + (let ((completion (save-excursion + (beginning-of-line) + (and (null arg) + nroff-electric-mode + (<= (point) (- (point-max) 3)) + (cdr (assoc (buffer-substring (point) + (+ 3 (point))) + nroff-brace-table))))) + (needs-nl (not (looking-at "[ \t]*$")))) + (if (null completion) + (newline (prefix-numeric-value arg)) + (save-excursion + (insert "\n\n" completion) + (if needs-nl (insert "\n"))) + (forward-char 1)))) + +(defun electric-nroff-mode (&optional arg) + "Toggle nroff-electric-newline minor mode +Nroff-electric-newline forces emacs to check for an nroff +request at the beginning of the line, and insert the +matching closing request if necessary. +This command toggles that mode (off->on, on->off), +with an argument, turns it on iff arg is positive, otherwise off." + (interactive "P") + (or (eq major-mode 'nroff-mode) (error "Must be in nroff mode")) + (or (assq 'nroff-electric-mode minor-mode-alist) + (setq minor-mode-alist (append minor-mode-alist + (list '(nroff-electric-mode + " Electric"))))) + (setq nroff-electric-mode + (cond ((null arg) (null nroff-electric-mode)) + (t (> (prefix-numeric-value arg) 0))))) + diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el new file mode 100644 index 00000000000..19b29d02f08 --- /dev/null +++ b/lisp/textmodes/page.el @@ -0,0 +1,123 @@ +;; Page motion commands for emacs. +;; Copyright (C) 1985 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 forward-page (&optional count) + "Move forward to page boundary. With arg, repeat, or go back if negative. +A page boundary is any line whose beginning matches the regexp page-delimiter." + (interactive "p") + (or count (setq count 1)) + (while (and (> count 0) (not (eobp))) + (if (re-search-forward page-delimiter nil t) + nil + (goto-char (point-max))) + (setq count (1- count))) + (while (and (< count 0) (not (bobp))) + (forward-char -1) + (if (re-search-backward page-delimiter nil t) + (goto-char (match-end 0)) + (goto-char (point-min))) + (setq count (1+ count)))) + +(defun backward-page (&optional count) + "Move backward to page boundary. With arg, repeat, or go fwd if negative. +A page boundary is any line whose beginning matches the regexp page-delimiter." + (interactive "p") + (or count (setq count 1)) + (forward-page (- count))) + +(defun mark-page (&optional arg) + "Put mark at end of page, point at beginning. +A numeric arg specifies to move forward or backward by that many pages, +thus marking a page other than the one point was originally in." + (interactive "P") + (setq arg (if arg (prefix-numeric-value arg) 0)) + (if (> arg 0) + (forward-page arg) + (if (< arg 0) + (forward-page (1- arg)))) + (forward-page) + (push-mark nil t) + (forward-page -1)) + +(defun narrow-to-page (&optional arg) + "Make text outside current page invisible. +A numeric arg specifies to move forward or backward by that many pages, +thus showing a page other than the one point was originally in." + (interactive "P") + (setq arg (if arg (prefix-numeric-value arg) 0)) + (save-excursion + (widen) + (if (> arg 0) + (forward-page arg) + (if (< arg 0) + (forward-page (1- arg)))) + ;; Find the end of the page. + (forward-page) + ;; If we stopped due to end of buffer, stay there. + ;; If we stopped after a page delimiter, put end of restriction + ;; at the beginning of that line. + (if (save-excursion (beginning-of-line) + (looking-at page-delimiter)) + (beginning-of-line)) + (narrow-to-region (point) + (progn + ;; Find the top of the page. + (forward-page -1) + ;; If we found beginning of buffer, stay there. + ;; If extra text follows page delimiter on same line, + ;; include it. + ;; Otherwise, show text starting with following line. + (if (and (eolp) (not (bobp))) + (forward-line 1)) + (point))))) + +(defun count-lines-page () + "Report number of lines on current page, and how many are before or after point." + (interactive) + (save-excursion + (let ((opoint (point)) beg end + total before after) + (forward-page) + (beginning-of-line) + (or (looking-at page-delimiter) + (end-of-line)) + (setq end (point)) + (backward-page) + (setq beg (point)) + (setq total (count-lines beg end) + before (count-lines beg opoint) + after (count-lines opoint end)) + (message "Page has %d lines (%d + %d)" total before after)))) + +(defun what-page () + "Print page and line number of point." + (interactive) + (save-restriction + (widen) + (save-excursion + (beginning-of-line) + (let ((count 1) + (opoint (point))) + (goto-char 1) + (while (re-search-forward page-delimiter opoint t) + (setq count (1+ count))) + (message "Page %d, line %d" + count + (1+ (count-lines (point) opoint))))))) diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el new file mode 100644 index 00000000000..c0bd7793a10 --- /dev/null +++ b/lisp/textmodes/paragraphs.el @@ -0,0 +1,205 @@ +;; Paragraph and sentence parsing. +;; Copyright (C) 1985 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. + + +(defvar paragraph-ignore-fill-prefix nil + "Non-nil means the paragraph commands are not affected by fill-prefix. +This is desirable in modes where blank lines are the paragraph delimiters.") + +(defun forward-paragraph (&optional arg) + "Move forward to end of paragraph. +With arg N, do it N times; negative arg -N means move forward N paragraphs. + +A line which `paragraph-start' matches either separates paragraphs +\(if `paragraph-separate' matches it also) or is the first line of a paragraph. +A paragraph end is the beginning of a line which is not part of the paragraph +to which the end of the previous line belongs, or the end of the buffer." + (interactive "p") + (or arg (setq arg 1)) + (let* ((fill-prefix-regexp + (and fill-prefix (not (equal fill-prefix "")) + (not paragraph-ignore-fill-prefix) + (regexp-quote fill-prefix))) + (paragraph-separate + (if fill-prefix-regexp + (concat paragraph-separate "\\|^" + fill-prefix-regexp "[ \t]*$") + paragraph-separate))) + (while (< arg 0) + (if (and (not (looking-at paragraph-separate)) + (re-search-backward "^\n" (max (1- (point)) (point-min)) t)) + nil + (forward-char -1) (beginning-of-line) + (while (and (not (bobp)) (looking-at paragraph-separate)) + (forward-line -1)) + (end-of-line) + ;; Search back for line that starts or separates paragraphs. + (if (if fill-prefix-regexp + ;; There is a fill prefix; it overrides paragraph-start. + (progn + (while (progn (beginning-of-line) + (and (not (bobp)) + (not (looking-at paragraph-separate)) + (looking-at fill-prefix-regexp))) + (forward-line -1)) + (not (bobp))) + (re-search-backward paragraph-start nil t)) + ;; Found one. + (progn + (while (and (not (eobp)) (looking-at paragraph-separate)) + (forward-line 1)) + (if (eq (char-after (- (point) 2)) ?\n) + (forward-line -1))) + ;; No starter or separator line => use buffer beg. + (goto-char (point-min)))) + (setq arg (1+ arg))) + (while (> arg 0) + (beginning-of-line) + (while (prog1 (and (not (eobp)) + (looking-at paragraph-separate)) + (forward-line 1))) + (if fill-prefix-regexp + ;; There is a fill prefix; it overrides paragraph-start. + (while (and (not (eobp)) + (not (looking-at paragraph-separate)) + (looking-at fill-prefix-regexp)) + (forward-line 1)) + (if (re-search-forward paragraph-start nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max)))) + (setq arg (1- arg))))) + +(defun backward-paragraph (&optional arg) + "Move backward to start of paragraph. +With arg N, do it N times; negative arg -N means move forward N paragraphs. + +A paragraph start is the beginning of a line which is a first-line-of-paragraph +or which is ordinary text and follows a paragraph-separating line; except: +if the first real line of a paragraph is preceded by a blank line, +the paragraph starts at that blank line. +See forward-paragraph for more information." + (interactive "p") + (or arg (setq arg 1)) + (forward-paragraph (- arg))) + +(defun mark-paragraph () + "Put point at beginning of this paragraph, mark at end. +The paragraph marked is the one that contains point or follows point." + (interactive) + (forward-paragraph 1) + (push-mark nil t) + (backward-paragraph 1)) + +(defun kill-paragraph (arg) + "Kill forward to end of paragraph. +With arg N, kill forward to Nth end of paragraph; +negative arg -N means kill backward to Nth start of paragraph." + (interactive "*p") + (kill-region (point) (progn (forward-paragraph arg) (point)))) + +(defun backward-kill-paragraph (arg) + "Kill back to start of paragraph. +With arg N, kill back to Nth start of paragraph; +negative arg -N means kill forward to Nth end of paragraph." + (interactive "*p") + (kill-region (point) (progn (backward-paragraph arg) (point)))) + +(defun transpose-paragraphs (arg) + "Interchange this (or next) paragraph with previous one." + (interactive "*p") + (transpose-subr 'forward-paragraph arg)) + +(defun start-of-paragraph-text () + (let ((opoint (point)) npoint) + (forward-paragraph -1) + (setq npoint (point)) + (skip-chars-forward " \t\n") + (if (>= (point) opoint) + (progn + (goto-char npoint) + (if (> npoint (point-min)) + (start-of-paragraph-text)))))) + +(defun end-of-paragraph-text () + (let ((opoint (point))) + (forward-paragraph 1) + (if (eq (preceding-char) ?\n) (forward-char -1)) + (if (<= (point) opoint) + (progn + (forward-char 1) + (if (< (point) (point-max)) + (end-of-paragraph-text)))))) + +(defun forward-sentence (&optional arg) + "Move forward to next sentence-end. With argument, repeat. +With negative argument, move backward repeatedly to sentence-beginning. + +The variable `sentence-end' is a regular expression that matches ends +of sentences. Also, every paragraph boundary terminates sentences as +well." + (interactive "p") + (or arg (setq arg 1)) + (while (< arg 0) + (let ((par-beg (save-excursion (start-of-paragraph-text) (point)))) + (if (re-search-backward (concat sentence-end "[^ \t\n]") par-beg t) + (goto-char (1- (match-end 0))) + (goto-char par-beg))) + (setq arg (1+ arg))) + (while (> arg 0) + (let ((par-end (save-excursion (end-of-paragraph-text) (point)))) + (if (re-search-forward sentence-end par-end t) + (skip-chars-backward " \t\n") + (goto-char par-end))) + (setq arg (1- arg)))) + +(defun backward-sentence (&optional arg) + "Move backward to start of sentence. With arg, do it arg times. +See forward-sentence for more information." + (interactive "p") + (or arg (setq arg 1)) + (forward-sentence (- arg))) + +(defun kill-sentence (&optional arg) + "Kill from point to end of sentence. +With arg, repeat; negative arg -N means kill back to Nth start of sentence." + (interactive "*p") + (let ((beg (point))) + (forward-sentence arg) + (kill-region beg (point)))) + +(defun backward-kill-sentence (&optional arg) + "Kill back from point to start of sentence. +With arg, repeat, or kill forward to Nth end of sentence if negative arg -N." + (interactive "*p") + (let ((beg (point))) + (backward-sentence arg) + (kill-region beg (point)))) + +(defun mark-end-of-sentence (arg) + "Put mark at end of sentence. Arg works as in forward-sentence." + (interactive "p") + (push-mark + (save-excursion + (forward-sentence arg) + (point)))) + +(defun transpose-sentences (arg) + "Interchange this (next) and previous sentence." + (interactive "*p") + (transpose-subr 'forward-sentence arg)) diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el new file mode 100644 index 00000000000..3b376cdd90b --- /dev/null +++ b/lisp/textmodes/refbib.el @@ -0,0 +1,715 @@ +;; Convert refer-style bibliographic entries to ones usable by latex bib +;; Copyright (C) 1989 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. + +;; Use: from a buffer containing the refer-style bibliography, +;; M-x r2b-convert-buffer +;; Program will prompt for an output buffer name, and will log +;; warnings during the conversion process in the buffer *Log*. + +; HISTORY +; 9/88, created +; modified 1/19/89, allow books with editor but no author; +; added %O ordering field; +; appended illegal multiple fields, instead of +; discarding; +; added rule, a tech report whose %R number +; contains "ISBN" is really a book +; added rule, anything with an editor is a book +; or a proceedings +; added 'manual type, for items with institution +; but no author or editor +; fixed bug so trailing blanks are trimmed +; added 'proceedings type +; used "organization" field for proceedings +; modified 2/16/89, updated help messages +; modified 2/23/89, include capitalize stop words in r2b stop words, +; fixed problems with contractions (e.g. it's), +; caught multiple stop words in a row +; modified 3/1/89, fixed capitialize-title for first words all caps +; modified 3/15/89, allow use of " to delimit fields +; modified 4/18/89, properly "quote" special characters on output +(provide 'refer-to-bibtex) +;********************************************************** +; User Parameters + +(defvar r2b-trace-on nil "*trace conversion") + +(defvar r2b-journal-abbrevs + '( + ) + " Abbreviation list for journal names. +If the car of an element matches a journal name exactly, it is replaced by +the cadr when output. Braces must be included if replacement is a +{string}, but not if replacement is a bibtex abbreviation. The cadr +may be eliminated if is exactly the same as the car. + Because titles are capitalized before matching, the abbreviation +for the journal name should be listed as beginning with a capital +letter, even if it really doesn't. + For example, a value of '((\"Aij\" \"{Artificial Intelligence}\") +(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string +\"Artificial Intelligence\", but would replace Ijcai81 with the +BibTeX macro \"ijcai7\".") + +(defvar r2b-booktitle-abbrevs + '( + ) + " Abbreviation list for book and proceedings names. If the car of +an element matches a title or booktitle exactly, it is replaced by +the cadr when output. Braces must be included if replacement is +a {string}, but not if replacement is a bibtex abbreviation. The cadr +may be eliminated if is exactly the same as the car. + Because titles are capitalized before matching, the abbreviated title +should be listed as beginning with a capital letter, even if it doesn't. + For example, a value of '((\"Aij\" \"{Artificial Intelligence}\") +(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string +\"Artificial Intelligence\", but would replace Ijcai81 with the +BibTeX macro \"ijcai7\".") + +(defvar r2b-proceedings-list + '() + " Assoc list of books or journals which are really conference proceedings, +but whose name and whose abbrev expansion (as defined in r2b-journal-abbrevs +and r2b-booktitle-abbrevs) does not contain the words 'conference' or +'proceedings'. (Those cases are handled automatically.) +The entry must match the given data exactly. + Because titles are capitalized before matching, the items in this list +should begin with a capital letter. + For example, suppose the title \"Ijcai81\" is used for the proceedings of +a conference, and it's expansion is the BibTeX macro \"ijcai7\". Then +r2b-proceedings-list should be '((\"Ijcai81\") ...). If instead its +expansion were \"Proceedings of the Seventh International Conference +on Artificial Intelligence\", then you would NOT need to include Ijcai81 +in r2b-proceedings-list (although it wouldn't cause an error).") + +(defvar r2b-additional-stop-words + "Some\\|What" + "Words other than the capitialize-title-stop-words +which are not to be used to build the citation key") + + +(defvar r2b-delimit-with-quote + t + "*If true, then use \" to delimit fields, otherwise use braces") + +;********************************************************** +; Utility Functions + +(defvar capitalize-title-stop-words + (concat + "the\\|and\\|of\\|is\\|a\\|an\\|of\\|for\\|in\\|to\\|in\\|on\\|at\\|" + "by\\|with\\|that\\|its") + "Words not to be capitialized in a title (unless they are the first +word in the title)") + +(defvar capitalize-title-stop-regexp + (concat "\\(" capitalize-title-stop-words "\\)\\(\\b\\|'\\)")) + +(defun capitalize-title-region (begin end) + "Like capitalize-region, but don't capitalize stop words, except the first" + (interactive "r") + (let ((case-fold-search nil) (orig-syntax-table (syntax-table))) + (unwind-protect + (save-restriction + (set-syntax-table text-mode-syntax-table) + (narrow-to-region begin end) + (goto-char (point-min)) + (if (looking-at "[A-Z][a-z]*[A-Z]") + (forward-word 1) + (capitalize-word 1)) + (while (re-search-forward "\\<" nil t) + (if (looking-at "[A-Z][a-z]*[A-Z]") + (forward-word 1) + (if (let ((case-fold-search t)) + (looking-at capitalize-title-stop-regexp)) + (downcase-word 1) + (capitalize-word 1))) + )) + (set-syntax-table orig-syntax-table)))) + + +(defun capitalize-title (s) + "Like capitalize, but don't capitalize stop words, except the first" + (save-excursion + (set-buffer (get-buffer-create "$$$Scratch$$$")) + (erase-buffer) + (insert s) + (capitalize-title-region (point-min) (point-max)) + (buffer-string))) + +;********************************************************* +(defun r2b-reset () + "unbind defvars, for debugging" + (interactive) + (makunbound 'r2b-journal-abbrevs) + (makunbound 'r2b-booktitle-abbrevs) + (makunbound 'r2b-proceedings-list) + (makunbound 'capitalize-title-stop-words) + (makunbound 'capitalize-title-stop-regexp) + (makunbound 'r2b-additional-stop-words) + (makunbound 'r2b-stop-regexp) + ) + +(defvar r2b-stop-regexp + (concat "\\`\\(\\(" + r2b-additional-stop-words "\\|" capitalize-title-stop-words + "\\)\\('\\w*\\)?\\W+\\)*\\([A-Z0-9]+\\)")) + + +(defun r2b-trace (&rest args) + (if r2b-trace-on + (progn + (apply (function message) args) + (sit-for 0) + ))) + +(defun r2b-match (exp) + "returns string matched in current buffer" + (buffer-substring (match-beginning exp) (match-end exp))) + +(defvar r2b-out-buf-name "*Out*" "*output from refer-to-bibtex" ) +(defvar r2b-log-name "*Log*" "*logs errors from refer-to-bibtex" ) +(defvar r2b-in-buf nil) +(defvar r2b-out-buf nil) +(defvar r2b-log nil) + +(defvar r2b-error-found nil) + +(setq r2b-variables '( + r2b-error-found + r2bv-author + r2bv-primary-author + r2bv-date + r2bv-year + r2bv-decade + r2bv-month + r2bv-title + r2bv-title-first-word + r2bv-editor + r2bv-annote + r2bv-tr + r2bv-address + r2bv-institution + r2bv-keywords + r2bv-booktitle + r2bv-journal + r2bv-volume + r2bv-number + r2bv-pages + r2bv-booktitle + r2bv-kn + r2bv-publisher + r2bv-organization + r2bv-school + r2bv-type + r2bv-where + r2bv-note + r2bv-ordering + )) + +(defun r2b-clear-variables () + "set all global vars used by r2b to nil" + (let ((vars r2b-variables)) + (while vars + (set (car vars) nil) + (setq vars (cdr vars))) + )) + +(defun r2b-warning (&rest args) + (setq r2b-error-found t) + (princ (apply (function format) args) r2b-log) + (princ "\n" r2b-log) + (princ "\n" r2b-out-buf) + (princ "% " r2b-out-buf) + (princ (apply (function format) args) r2b-out-buf) + ) + +(defun r2b-get-field (var field &optional unique required capitalize) + "Set VAR to string value of FIELD, if any. If none, VAR is set to +nil. If multiple fields appear, then separate values with the +'\\nand\\t\\t', unless UNIQUE is non-nil, in which case log a warning +and just concatenate the values. Trim off leading blanks and tabs on +first line, and trailing blanks and tabs of every line. Log a warning +and set VAR to the empty string if REQUIRED is true. Capitalize as a +title if CAPITALIZE is true. Returns value of VAR." + (let (item val (not-past-end t)) + (r2b-trace "snarfing %s" field) + (goto-char (point-min)) + (while (and not-past-end + (re-search-forward + (concat "^" field "\\b[ \t]*\\(.*[^ \t\n]\\)[ \t]*") nil t)) + (setq item (r2b-match 1)) + (while (and (setq not-past-end (zerop (forward-line 1))) + (not (looking-at "[ \t]*$\\|%"))) + (looking-at "\\(.*[^ \t\n]\\)[ \t]*$") + (setq item (concat item "\n" (r2b-match 1))) + ) + (if (null val) + (setq val item) + (if unique + (progn + (r2b-warning "*Illegal multiple field %s %s" field item) + (setq val (concat val "\n" item)) + ) + (setq val (concat val "\n\t\tand " item)) + ) + ) + ) + (if (and val capitalize) + (setq val (capitalize-title val))) + (set var val) + (if (and (null val) required) + (r2b-require var)) + )) + +(defun r2b-set-match (var n regexp string ) + "set VAR to the Nth subpattern in REGEXP matched by STRING, or nil if none" + (set var + (if (and (stringp string) (string-match regexp string)) + (substring string (match-beginning n) (match-end n)) + nil) + ) + ) + +(defvar r2b-month-abbrevs + '(("jan") ("feb") ("mar") ("apr") ("may") ("jun") ("jul") ("aug") + ("sep") ("oct") ("nov") ("dec"))) + +(defun r2b-convert-month () + "Try to convert r2bv-month to a standard 3 letter name" + (if r2bv-month + (let ((months r2b-month-abbrevs)) + (if (string-match "[^0-9]" r2bv-month) + (progn + (while (and months (not (string-match (car (car months)) + r2bv-month))) + (setq months (cdr months))) + (if months + (setq r2bv-month (car (car months))))) + (progn + (setq months (car (read-from-string r2bv-month))) + (if (and (numberp months) + (> months 0) + (< months 13)) + (setq r2bv-month (car (nth months r2b-month-abbrevs))) + (progn + (r2b-warning "* Ridiculous month") + (setq r2bv-month nil)) + )) + )) + ) + ) + +(defun r2b-snarf-input () + "parse buffer into global variables" + (let ((case-fold-search t)) + (r2b-trace "snarfing...") + (sit-for 0) + (set-buffer r2b-in-buf) + (goto-char (point-min)) + (princ " " r2b-log) + (princ (buffer-substring (point) (progn (end-of-line) (point))) r2b-log) + (terpri r2b-log) + + (r2b-get-field 'r2bv-author "%A") + (r2b-get-field 'r2bv-editor "%E") + (cond + (r2bv-author + (r2b-set-match 'r2bv-primary-author 1 + "\\b\\(\\w+\\)[ \t]*\\($\\|,\\)" r2bv-author) + ) + (r2bv-editor + (r2b-set-match 'r2bv-primary-author 1 + "\\b\\(\\w+\\)[ \t]*\\($\\|,\\)" r2bv-editor) + ) + (t + (setq r2bv-primary-author "") + ) + ) + + (r2b-get-field 'r2bv-date "%D" t t) + (r2b-set-match 'r2bv-year 0 "[12][0-9][0-9][0-9]" r2bv-date) + (and (null r2bv-year) + (r2b-set-match 'r2bv-year 1 "[^0-9]\\([0-9][0-9]\\)$" r2bv-date) + (setq r2bv-year (concat "19" r2bv-year))) + (r2b-set-match 'r2bv-decade 1 "..\\(..\\)" r2bv-year) + (r2b-set-match 'r2bv-month 0 + "[0-9]+/\\|[a-zA-Z]+" r2bv-date) + (if (and (stringp r2bv-month) (string-match "\\(.*\\)/$" r2bv-month)) + (setq r2bv-month (substring r2bv-month 0 (match-end 1)))) + (r2b-convert-month) + + (r2b-get-field 'r2bv-title "%T" t t t) + (r2b-set-match 'r2bv-title-first-word 4 + r2b-stop-regexp + r2bv-title) + + (r2b-get-field 'r2bv-annote "%X" t ) + (r2b-get-field 'r2bv-tr "%R" t) + (r2b-get-field 'r2bv-address "%C" t) + (r2b-get-field 'r2bv-institution "%I" t) + (r2b-get-field 'r2bv-keywords "%K") + (r2b-get-field 'r2bv-booktitle "%B" t nil t) + (r2b-get-field 'r2bv-journal "%J" t nil t) + (r2b-get-field 'r2bv-volume "%V" t) + (r2b-get-field 'r2bv-number "%N" t) + (r2b-get-field 'r2bv-pages "%P" t) + (r2b-get-field 'r2bv-where "%W" t) + (r2b-get-field 'r2bv-ordering "%O" t) + ) + ) + + +(defun r2b-put-field (field data &optional abbrevs) + "print bibtex FIELD = {DATA} if DATA not null; precede +with a comma and newline; if ABBREVS list is given, then +try to replace the {DATA} with an abbreviation" + (if data + (let (match nodelim multi-line index) + (cond + ((and abbrevs (setq match (assoc data abbrevs))) + (if (null (cdr match)) + (setq data (car match)) + (setq data (car (cdr match)))) + (setq nodelim t)) + ((and (not (equal data "")) + (not (string-match "[^0-9]" data))) + (setq nodelim t)) + (t + (setq index 0) + (while (string-match "[\\~^]" data index) + (setq data (concat (substring data 0 (match-beginning 0)) + "\\verb+" + (substring data (match-beginning 0) (match-end 0)) + "+" + (substring data (match-end 0)))) + (setq index (+ (match-end 0) 7))) + (setq index 0) + (while (string-match "[$&%#_{}]" data index) + (setq data (concat (substring data 0 (match-beginning 0)) + "\\" + (substring data (match-beginning 0)))) + (setq index (+ (match-end 0) 1))) + (setq index 0) + (if r2b-delimit-with-quote + (while (string-match "\"" data index) + (setq data (concat (substring data 0 (match-beginning 0)) + "{\"}" + (substring data (match-end 0)))) + (setq index (+ (match-end 0) 2)))) + )) + (princ ", \n ") + (princ field) + (princ " =\t") + (if (not nodelim) + (if r2b-delimit-with-quote + (princ "\"") + (princ "{"))) + (string-match ".*" data) + (if (> (match-end 0) 59) + (princ "\n")) + (princ data) + (if (not nodelim) + (if r2b-delimit-with-quote + (princ "\"") + (princ "}"))) + ) + )) + + +(defun r2b-require (vars) + "If any of VARS is null, set to empty string and log error" + (cond + ((null vars)) + ((listp vars) (r2b-require (car vars)) (r2b-require (cdr vars))) + (t + (if (null (symbol-value vars)) + (progn + (r2b-warning "*Missing value for field %s" vars) + (set vars "") + ))) + ) + ) + + +(defmacro r2b-moveq (new old) + "set NEW to OLD and set OLD to nil" + (list 'progn (list 'setq new old) (list 'setq old 'nil))) + +(defun r2b-isa-proceedings (name) + "return t if NAME is the name of proceedings" + (and + name + (or + (string-match "proceedings\\|conference" name) + (assoc name r2b-proceedings-list) + (let ((match (assoc name r2b-booktitle-abbrevs))) + (and match + (string-match "proceedings\\|conference" (car (cdr match))))) + ))) + +(defun r2b-isa-university (name) + "return t if NAME is a university or similar organization, +but not a publisher" + (and + name + (string-match "university" name) + (not (string-match "press" name)) + + )) + +(defun r2b-barf-output () + "generate bibtex based on global variables" + (let ((standard-output r2b-out-buf) (case-fold-search t) match) + + (r2b-trace "...barfing") + (sit-for 0) + (set-buffer r2b-out-buf) + + (setq r2bv-kn (concat r2bv-primary-author r2bv-decade + r2bv-title-first-word)) + + (setq r2bv-entry-kind + (cond + ((r2b-isa-proceedings r2bv-journal) + (r2b-moveq r2bv-booktitle r2bv-journal) + (if (r2b-isa-university r2bv-institution) + (r2b-moveq r2bv-organization r2bv-institution) + (r2b-moveq r2bv-publisher r2bv-institution)) + (r2b-moveq r2bv-note r2bv-tr) + (r2b-require 'r2bv-author) + 'inproceedings) + ((r2b-isa-proceedings r2bv-booktitle) + (if (r2b-isa-university r2bv-institution) + (r2b-moveq r2bv-organization r2bv-institution) + (r2b-moveq r2bv-publisher r2bv-institution)) + (r2b-moveq r2bv-note r2bv-tr) + (r2b-require 'r2bv-author) + 'inproceedings) + ((and r2bv-tr (string-match "phd" r2bv-tr)) + (r2b-moveq r2bv-school r2bv-institution) + (r2b-require 'r2bv-school ) + (r2b-require 'r2bv-author) + 'phdthesis) + ((and r2bv-tr (string-match "master" r2bv-tr)) + (r2b-moveq r2bv-school r2bv-institution) + (r2b-require 'r2bv-school ) + (r2b-require 'r2bv-author) + 'mastersthesis) + ((and r2bv-tr (string-match "draft\\|unpublish" r2bv-tr)) + (r2b-moveq r2bv-note r2bv-institution) + (r2b-require 'r2bv-author) + 'unpublished) + (r2bv-journal + (r2b-require 'r2bv-author) + 'article) + (r2bv-booktitle + (r2b-moveq r2bv-publisher r2bv-institution) + (r2b-moveq r2bv-note r2bv-tr) + (r2b-require 'r2bv-publisher) + (r2b-require 'r2bv-author) + 'incollection) + ((and r2bv-author + (null r2bv-editor) + (string-match "\\`personal communication\\'" r2bv-title)) + 'misc) + ((r2b-isa-proceedings r2bv-title) + (if (r2b-isa-university r2bv-institution) + (r2b-moveq r2bv-organization r2bv-institution) + (r2b-moveq r2bv-publisher r2bv-institution)) + (r2b-moveq r2bv-note r2bv-tr) + 'proceedings) + ((or r2bv-editor + (and r2bv-author + (or + (null r2bv-tr) + (string-match "\\bisbn\\b" r2bv-tr)))) + (r2b-moveq r2bv-publisher r2bv-institution) + (r2b-moveq r2bv-note r2bv-tr) + (r2b-require 'r2bv-publisher) + (if (null r2bv-editor) + (r2b-require 'r2bv-author)) + 'book) + (r2bv-tr + (r2b-require 'r2bv-institution) + (if (string-match + "\\`\\(\\(.\\|\n\\)+\\)[ \t\n]+\\([^ \t\n]\\)+\\'" + r2bv-tr) + (progn + (setq r2bv-type (substring r2bv-tr 0 (match-end 1))) + (setq r2bv-number (substring r2bv-tr + (match-beginning 3))) + (setq r2bv-tr nil)) + (r2b-moveq r2bv-number r2bv-tr)) + (r2b-require 'r2bv-author) + 'techreport) + (r2bv-institution + (r2b-moveq r2bv-organization r2bv-institution) + 'manual) + (t + 'misc) + )) + + (r2b-require '( r2bv-year)) + + (if r2b-error-found + (princ "\n% Warning -- Errors During Conversion Next Entry\n")) + + (princ "\n@") + (princ r2bv-entry-kind) + (princ "( ") + (princ r2bv-kn) + + (r2b-put-field "author" r2bv-author ) + (r2b-put-field "title" r2bv-title r2b-booktitle-abbrevs) + (r2b-put-field "year" r2bv-year ) + + (r2b-put-field "month" r2bv-month r2b-month-abbrevs) + (r2b-put-field "journal" r2bv-journal r2b-journal-abbrevs) + (r2b-put-field "volume" r2bv-volume) + (r2b-put-field "type" r2bv-type) + (r2b-put-field "number" r2bv-number) + (r2b-put-field "booktitle" r2bv-booktitle r2b-booktitle-abbrevs) + (r2b-put-field "editor" r2bv-editor) + (r2b-put-field "publisher" r2bv-publisher) + (r2b-put-field "institution" r2bv-institution) + (r2b-put-field "organization" r2bv-organization) + (r2b-put-field "school" r2bv-school) + (r2b-put-field "pages" r2bv-pages) + (r2b-put-field "address" r2bv-address) + (r2b-put-field "note" r2bv-note) + (r2b-put-field "keywords" r2bv-keywords) + (r2b-put-field "where" r2bv-where) + (r2b-put-field "ordering" r2bv-ordering) + (r2b-put-field "annote" r2bv-annote) + + (princ " )\n") + ) + ) + + +(defun r2b-convert-record (output-name) + "transform current bib entry and append to buffer OUTPUT; +do M-x r2b-help for more info" + (interactive + (list (read-string "Output to buffer: " r2b-out-buf-name))) + (let (rec-end rec-begin not-done) + (setq r2b-out-buf-name output-name) + (setq r2b-out-buf (get-buffer-create output-name)) + (setq r2b-in-buf (current-buffer)) + (set-buffer r2b-out-buf) + (goto-char (point-max)) + (setq r2b-log (get-buffer-create r2b-log-name)) + (set-buffer r2b-log) + (goto-char (point-max)) + (set-buffer r2b-in-buf) + (setq not-done (re-search-forward "[^ \t\n]" nil t)) + (if not-done + (progn + (re-search-backward "^[ \t]*$" nil 2) + (re-search-forward "^%") + (beginning-of-line nil) + (setq rec-begin (point)) + (re-search-forward "^[ \t]*$" nil 2) + (setq rec-end (point)) + (narrow-to-region rec-begin rec-end) + (r2b-clear-variables) + (r2b-snarf-input) + (r2b-barf-output) + (set-buffer r2b-in-buf) + (widen) + (goto-char rec-end) + t) + nil + ) + )) + + +(defun r2b-convert-buffer (output-name) + "transform current buffer and append to buffer OUTPUT; +do M-x r2b-help for more info" + (interactive + (list (read-string "Output to buffer: " r2b-out-buf-name))) + (save-excursion + (setq r2b-log (get-buffer-create r2b-log-name)) + (set-buffer r2b-log) + (erase-buffer)) + (widen) + (goto-char (point-min)) + (message "Working, please be patient...") + (sit-for 0) + (while (r2b-convert-record output-name) t) + (message "Done, results in %s, errors in %s" + r2b-out-buf-name r2b-log-name) + ) + +(defvar r2b-load-quietly nil "*Don't print help message when loaded") + +(defvar r2b-help-message +" Refer to Bibtex Bibliography Conversion + +A refer-style database is of the form: + +%A Joe Blow +%T Great Thoughts I've Thought +%D 1977 +etc. + +This utility converts these kind of databases to bibtex form, for +users of TeX and LaTex. Instructions: +1. Visit the file containing the refer-style database. +2. The command + M-x r2b-convert-buffer + converts the entire buffer, appending it's output by default in a + buffer named *Out*, and logging progress and errors in a buffer + named *Log*. The original file is never modified. + Note that results are appended to *Out*, so if that buffer + buffer already exists and contains material you don't want to + save, you should kill it first. +3. Switch to the buffer *Out* and save it as a named file. +4. To convert a single refer-style entry, simply position the cursor + at the entry and enter + M-x r2b-convert-record + Again output is appended to *Out* and errors are logged in *Log*. + +This utility is very robust and pretty smart about determining the +type of the entry. It includes facilities for expanding refer macros +to text, or substituting bibtex macros. Do M-x describe-variable on + r2b-journal-abbrevs + r2b-booktitle-abbrevs + r2b-proceedings-list +for information on these features. + +If you don't want to see this help message when you load this utility, +then include the following line in your .emacs file: + (setq r2b-load-quietly t) +To see this message again, perform + M-x r2b-help") + + +(defun r2b-help () + "print help message" + (interactive) + (with-output-to-temp-buffer "*Help*" + (princ r2b-help-message))) + +(if (not r2b-load-quietly) + (r2b-help)) + +(message "r2b loaded") + diff --git a/lisp/textmodes/spell.el b/lisp/textmodes/spell.el new file mode 100644 index 00000000000..d7cd286141b --- /dev/null +++ b/lisp/textmodes/spell.el @@ -0,0 +1,132 @@ +;; Spelling correction interface for Emacs. +;; Copyright (C) 1985 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. + + +(defvar spell-command "spell" + "*Command to run the spell program.") + +(defvar spell-filter nil + "*Filter function to process text before passing it to spell program. +This function might remove text-processor commands. +nil means don't alter the text before checking it.") + +(defun spell-buffer () + "Check spelling of every word in the buffer. +For each incorrect word, you are asked for the correct spelling +and then put into a query-replace to fix some or all occurrences. +If you do not want to change a word, just give the same word +as its \"correct\" spelling; then the query replace is skipped." + (interactive) + (spell-region (point-min) (point-max) "buffer")) + +(defun spell-word () + "Check spelling of word at or before point. +If it is not correct, ask user for the correct spelling +and query-replace the entire buffer to substitute it." + (interactive) + (let (beg end spell-filter) + (save-excursion + (if (not (looking-at "\\<")) + (forward-word -1)) + (setq beg (point)) + (forward-word 1) + (setq end (point))) + (spell-region beg end (buffer-substring beg end)))) + +(defun spell-region (start end &optional description) + "Like spell-buffer but applies only to region. +Used in a program, applies from START to END. +DESCRIPTION is an optional string naming the unit being checked: +for example, \"word\"." + (interactive "r") + (let ((filter spell-filter) + (buf (get-buffer-create " *temp*"))) + (save-excursion + (set-buffer buf) + (widen) + (erase-buffer)) + (message "Checking spelling of %s..." (or description "region")) + (if (and (null filter) (= ?\n (char-after (1- end)))) + (if (string= "spell" spell-command) + (call-process-region start end "spell" nil buf) + (call-process-region start end shell-file-name + nil buf nil "-c" spell-command)) + (let ((oldbuf (current-buffer))) + (save-excursion + (set-buffer buf) + (insert-buffer-substring oldbuf start end) + (or (bolp) (insert ?\n)) + (if filter (funcall filter)) + (if (string= "spell" spell-command) + (call-process-region (point-min) (point-max) "spell" t buf) + (call-process-region (point-min) (point-max) shell-file-name + t buf nil "-c" spell-command))))) + (message "Checking spelling of %s...%s" + (or description "region") + (if (save-excursion + (set-buffer buf) + (> (buffer-size) 0)) + "not correct" + "correct")) + (let (word newword + (case-fold-search t) + (case-replace t)) + (while (save-excursion + (set-buffer buf) + (> (buffer-size) 0)) + (save-excursion + (set-buffer buf) + (goto-char (point-min)) + (setq word (downcase + (buffer-substring (point) + (progn (end-of-line) (point))))) + (forward-char 1) + (delete-region (point-min) (point)) + (setq newword + (read-input (concat "`" word + "' not recognized; edit a replacement: ") + word)) + (flush-lines (concat "^" (regexp-quote word) "$"))) + (if (not (equal word newword)) + (progn + (goto-char (point-min)) + (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b") + newword))))))) + + +(defun spell-string (string) + "Check spelling of string supplied as argument." + (interactive "sSpell string: ") + (let ((buf (get-buffer-create " *temp*"))) + (save-excursion + (set-buffer buf) + (widen) + (erase-buffer) + (insert string "\n") + (if (string= "spell" spell-command) + (call-process-region (point-min) (point-max) "spell" + t t) + (call-process-region (point-min) (point-max) shell-file-name + t t nil "-c" spell-command)) + (if (= 0 (buffer-size)) + (message "%s is correct" string) + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (replace-match " ")) + (message "%sincorrect" (buffer-substring 1 (point-max))))))) diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el new file mode 100644 index 00000000000..ba54cb845f6 --- /dev/null +++ b/lisp/textmodes/text-mode.el @@ -0,0 +1,147 @@ +;; Text mode, and its ideosyncratic commands. +;; Copyright (C) 1985 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. + + +(defvar text-mode-syntax-table nil + "Syntax table used while in text mode.") + +(defvar text-mode-abbrev-table nil + "Abbrev table used while in text mode.") +(define-abbrev-table 'text-mode-abbrev-table ()) + +(if text-mode-syntax-table + () + (setq text-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?\" ". " text-mode-syntax-table) + (modify-syntax-entry ?\\ ". " text-mode-syntax-table) + (modify-syntax-entry ?' "w " text-mode-syntax-table)) + +(defvar text-mode-map nil + "Keymap for Text mode. +Many other modes, such as Mail mode, Outline mode and Indented Text mode, +inherit all the commands defined in this map.") + +(if text-mode-map + () + (setq text-mode-map (make-sparse-keymap)) + (define-key text-mode-map "\t" 'tab-to-tab-stop) + (define-key text-mode-map "\es" 'center-line) + (define-key text-mode-map "\eS" 'center-paragraph)) + + +;(defun non-saved-text-mode () +; "Like text-mode, but delete auto save file when file is saved for real." +; (text-mode) +; (make-local-variable 'delete-auto-save-files) +; (setq delete-auto-save-files t)) + +(defun text-mode () + "Major mode for editing text intended for humans to read. Special commands:\\{text-mode-map} +Turning on text-mode calls the value of the variable `text-mode-hook', +if that value is non-nil." + (interactive) + (kill-all-local-variables) + (use-local-map text-mode-map) + (setq mode-name "Text") + (setq major-mode 'text-mode) + (setq local-abbrev-table text-mode-abbrev-table) + (set-syntax-table text-mode-syntax-table) + (run-hooks 'text-mode-hook)) + +(defvar indented-text-mode-map () + "Keymap for Indented Text mode. +All the commands defined in Text mode are inherited unless overridden.") + +(if indented-text-mode-map + () + (setq indented-text-mode-map (nconc (make-sparse-keymap) text-mode-map)) + (define-key indented-text-mode-map "\t" 'indent-relative)) + +(defun indented-text-mode () + "Major mode for editing indented text intended for humans to read.\\{indented-text-mode-map} +Turning on indented-text-mode calls the value of the variable `text-mode-hook', +if that value is non-nil." + (interactive) + (kill-all-local-variables) + (use-local-map text-mode-map) + (define-abbrev-table 'text-mode-abbrev-table ()) + (setq local-abbrev-table text-mode-abbrev-table) + (set-syntax-table text-mode-syntax-table) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'indent-relative-maybe) + (use-local-map indented-text-mode-map) + (setq mode-name "Indented Text") + (setq major-mode 'indented-text-mode) + (run-hooks 'text-mode-hook)) + +(defun change-log-mode () + "Major mode for editing ChangeLog files. See M-x add-change-log-entry. +Almost the same as Indented Text mode, but prevents numeric backups +and sets `left-margin' to 8 and `fill-column' to 74." + (interactive) + (indented-text-mode) + (setq left-margin 8) + (setq fill-column 74) + (make-local-variable 'version-control) + (setq version-control 'never) + (run-hooks 'change-log-mode-hook)) + +(defun center-paragraph () + "Center each nonblank line in the paragraph at or after point. +See center-line for more info." + (interactive) + (save-excursion + (forward-paragraph) + (or (bolp) (newline 1)) + (let ((end (point))) + (backward-paragraph) + (center-region (point) end)))) + +(defun center-region (from to) + "Center each nonblank line starting in the region. +See center-line for more info." + (interactive "r") + (if (> from to) + (let ((tem to)) + (setq to from from tem))) + (save-excursion + (save-restriction + (narrow-to-region from to) + (goto-char from) + (while (not (eobp)) + (or (save-excursion (skip-chars-forward " \t") (eolp)) + (center-line)) + (forward-line 1))))) + +(defun center-line () + "Center the line point is on, within the width specified by `fill-column'. +This means adjusting the indentation so that it equals +the distance between the end of the text and `fill-column'." + (interactive) + (save-excursion + (let (line-length) + (beginning-of-line) + (delete-horizontal-space) + (end-of-line) + (delete-horizontal-space) + (setq line-length (current-column)) + (beginning-of-line) + (indent-to + (+ left-margin + (/ (- fill-column left-margin line-length) 2)))))) diff --git a/lisp/textmodes/underline.el b/lisp/textmodes/underline.el new file mode 100644 index 00000000000..4a9f3dfa823 --- /dev/null +++ b/lisp/textmodes/underline.el @@ -0,0 +1,46 @@ +;; Insert or remove underlining (done by overstriking) in Emacs. +;; Copyright (C) 1985 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 underline-region (start end) + "Underline all nonblank characters in the region. +Works by overstriking underscores. +Called from program, takes two arguments START and END +which specify the range to operate on." + (interactive "r") + (save-excursion + (let ((end1 (make-marker))) + (move-marker end1 (max start end)) + (goto-char (min start end)) + (while (< (point) end1) + (or (looking-at "[_\^@- ]") + (insert "_")) + (forward-char 1))))) + +(defun ununderline-region (start end) + "Remove all underlining (overstruck underscores) in the region. +Called from program, takes two arguments START and END +which specify the range to operate on." + (interactive "r") + (save-excursion + (let ((end1 (make-marker))) + (move-marker end1 (max start end)) + (goto-char (min start end)) + (while (re-search-forward "_\\|_" end1 t) + (delete-char -2))))) |