home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d5xx / d551 / cweb.lha / CWeb / cweb2.lzh / cweb / cweb.el < prev    next >
Lisp/Scheme  |  1990-12-14  |  12KB  |  304 lines
  1. ;; This file contains extensions to GNU-Emacs, to wit:
  2. ; (1) some WEB-oriented functions that are also of general use
  3. ; (2) changes to the GNU-distributed TeX mode
  4. ; (3) definitions of simple WEB and CWEB modes
  5. ; (4) changes to the GNU-distributed spell interface, slightly better for TeX
  6.  
  7. ; To use: Put this in your EMACS-lisp library and say (load-library "cweb")
  8. ; in your .emacs init file.
  9.  
  10. ; Contributed by Don Knuth, July 1990
  11.  
  12. ;; OK, here's part (1): some WEB-oriented functions whose main purpose is
  13. ; to maintain a stack of module names that are "pending" as you are writing
  14. ; a program. When you first think of a module that needs to be written later,
  15. ; put it into the pending list (by typing CTL-Z instead of @> after the
  16. ; name). Later you can say CTL-\ to retrieve a pending name (and if
  17. ; you want to cycle through the pending names, ESC-y after CTL-\ will
  18. ; do it, just as ESC-y works after a yank).
  19. ; The following code binds the new commands to CTL-Z, CTL-\, and ESC-\
  20. ; in all modes. You may prefer other bindings, of course.
  21. ; CTL-Z is normally "suspend emacs", but it is best not used when emacs
  22. ; has its own window as it usually does nowadays; if you need the
  23. ; old CTL-Z, you might rather bind it to CTL-X CTL-Z.
  24. ; CTL-\ is normally undefined.
  25. ; ESC-\ is normally "delete space", but ESC-space DEL does that easily too.
  26.  
  27. (defvar pending-list nil
  28.  "List of strings (usually WEB module names) still pending.")
  29. (defun into-pending-list (beg end)
  30.  "Copy region into pending-list."
  31.  (interactive "r")
  32.  (indicate-region)
  33.  (setq pending-list (cons (buffer-substring beg end) pending-list)))
  34. (defun new-module-name-pending ()
  35.  "Insert @> to complete a module name, then put it into pending-list."
  36.  (interactive)
  37.  (insert "@>")
  38.  (push-mark)
  39.  (if (search-backward "@<" nil t)
  40.      (progn
  41.        (exchange-point-and-mark)
  42.        (into-pending-list (point) (mark))
  43.        )
  44.    (message "There's no @< to begin the module name!")))
  45. (global-set-key "\C-z" 'new-module-name-pending)
  46. (defun pop-pending-list (arg)
  47.  "Remove first element of pending-list and insert it as current region.
  48. With argument, put point at left; otherwise point will follow the insertion.
  49. Say \\[new-yank-pop] to replace this by another element of the list.
  50. Say \\[into-pending-list] to put it back in the list."
  51.  (interactive "*P")
  52.  (if (consp pending-list)
  53.      (progn
  54.        (push-mark (point))
  55.        (insert (car pending-list))
  56.        (setq pending-list (cdr pending-list))
  57.        (if arg
  58.            (exchange-point-and-mark)))
  59.    (message "Nothing is pending.")
  60.    (setq this-command nil)))
  61. (global-set-key "\C-\\" 'pop-pending-list)
  62. (global-set-key "\M-\\" 'into-pending-list)
  63.  
  64. (defun new-yank-pop (arg)
  65.  "If previous command was \\[pop-pending-list], pop a different string;
  66. otherwise do an ordinary Meta-y."
  67.  (interactive "*p")
  68.  (if (eq last-command 'pop-pending-list)
  69.      (let (xch)
  70.        (setq xch (< (point) (mark)))
  71.        (setq pending-list (append pending-list
  72.                                  (list (buffer-substring (point) (mark)))))
  73.        (delete-region (point) (mark))
  74.        (setq this-command 'pop-pending-list)
  75.        (pop-pending-list xch))
  76.    (yank-pop arg)))
  77. (global-set-key "\M-y" 'new-yank-pop)
  78.  
  79. (defun indicate-region ()
  80.   "Bounce cursor to mark and back again"
  81.   (let ((point-save (point)))
  82.     (unwind-protect
  83.         (progn (goto-char (mark))
  84. ; The next two lines of code are controversial ---
  85. ; they seem to be the best way to do a short wait and redraw the screen with
  86. ; standard emacs primitives --- but the short wait is a "busy wait".
  87. ; On a faster machine, it would be better to install the function
  88. ; sit-for-millisecs found in sunfns.c (if not already installed)
  89. ; and to say (sit-for-millisecs 100) instead.
  90. ; On a slower machine, do the call-process only once.
  91. ; On a still slower machine, (sit-for 1) is probably best.
  92.                (call-process "echo" nil nil t)
  93.                (call-process "echo" nil nil t))
  94.       (goto-char point-save))))
  95.  
  96. ; I prefer to change the standard copy-region command to the following,
  97. ; which gives me visual feedback about what I've copied to the kill ring:
  98. (defun indicate-and-copy-region (beg end)
  99.   "Indicate current region, then copy it to the kill ring."
  100.   (interactive "r")(indicate-region)(copy-region-as-kill beg end))
  101. (global-set-key "\M-w" 'indicate-and-copy-region)
  102.  
  103. ; Here's another convenient command, bound to the usually unused ESC-".
  104. (defun ditto (arg)
  105.   "Copy ARG characters from the line above."
  106.   (interactive "*p")
  107.   (let (ch)
  108.     (while (> arg 0)
  109.       (setq temporary-goal-column (current-column))
  110.       (save-excursion
  111.         (line-move -1)
  112.         (setq ch (following-char)))
  113.       (insert ch)
  114.       (setq arg (1- arg)))))
  115. (global-set-key "\M-\"" 'ditto)
  116.  
  117. ;; OK, here's part (2): Changes to TeX mode.
  118. ; The WEB modes below are very much like TeX mode, but some improvements were
  119. ; desirable in TeX mode:
  120. ; I made newline act as it does in indented-text mode, since this
  121. ; works nicely for both TeX and WEB (Pascal or C code).
  122. ; I made RET check for unmatched delimiters if it ends a paragraph.
  123. ; Otherwise TeX mode remains as it was before.
  124.  
  125. (setq TeX-mode-map (make-sparse-keymap))
  126. (define-key TeX-mode-map "\C-c\C-k" 'TeX-kill-job)
  127. (define-key TeX-mode-map "\C-c\C-l" 'TeX-recenter-output-buffer)
  128. (define-key TeX-mode-map "\C-c\C-q" 'TeX-show-print-queue)
  129. (define-key TeX-mode-map "\C-c\C-p" 'TeX-print)
  130. (define-key TeX-mode-map "\"" 'TeX-insert-quote)
  131. (define-key TeX-mode-map "\e}" 'up-list)
  132. (define-key TeX-mode-map "\e{" 'TeX-insert-braces)
  133. (define-key TeX-mode-map "\C-c\C-r" 'TeX-region)
  134. (define-key TeX-mode-map "\C-c\C-b" 'TeX-buffer)
  135. (define-key TeX-mode-map "\C-c\C-f" 'TeX-close-LaTeX-block)
  136. (define-key TeX-mode-map "\r" 'TeX-newline)
  137. (define-key TeX-mode-map "\t" 'indent-relative)
  138. (setq TeX-mode-hook '(lambda ()
  139.   (make-local-variable 'indent-line-function)
  140.   (setq indent-line-function 'indent-relative-maybe)))
  141.  
  142. (defun TeX-newline (arg)
  143. "If previous character is newline and no ARG, check for unbalanced braces
  144. and/or dollar signs in previous paragraph. If ARG is \\[universal-argument],
  145. do a single newline; otherwise do ordinary newline."
  146.  (interactive "*P")
  147.  (if (and (eq (preceding-char) ?\n) (not arg))
  148.      (TeX-check-paragraph)
  149.    (if (listp arg)
  150.        (newline)
  151.      (newline arg))))
  152.  
  153. (defun TeX-check-paragraph ()
  154. "Insert a newline following a newline, breaking a paragraph for TeX.
  155. Check for mismatched delimiters in paragraph being terminated."
  156.   (interactive)
  157.   (if (TeX-validate-paragraph
  158.            (save-excursion
  159.              (search-backward "\n\n" nil 'move)
  160.              (point))
  161.            (point))
  162.       (insert ?\n)
  163.     (insert ?\n)
  164.     (error "Mismatched delimiters in that paragraph?")))
  165.  
  166. ;; and now, part (3): WEB and CWEB modes.
  167. ; These are like plain TeX mode except that the automatic conversion of
  168. ; " to `` or '' is disabled. (Personally I never liked that feature anyway,
  169. ; since it's easy to get used to typing `` and ''. In WEB modes, the
  170. ; feature soon becomes intolerable, unless you never use string constants!)
  171. ; Another thing distinguishing WEB mode from TeX is ESC-p and ESC-n, to
  172. ; move to previous or next module. These keys are usually unbound, except
  173. ; when processing email.
  174.  
  175. (defun forward-module (arg)
  176. "Advance past next WEB module beginning; with ARG, repeat ARG times."
  177.  (interactive "p")
  178.  (move-to-module arg))
  179. (defun backward-module (arg)
  180. "Advance to previous WEB module beginning; with ARG, repeat ARG times."
  181.  (interactive "p")
  182.  (move-to-module (- arg)))
  183. (defun move-to-module (arg)
  184.  (while (> arg 0)
  185.    (re-search-forward "@ \\|@\\*\\|@\n")
  186.    (setq arg (1- arg)))
  187.  (while (< arg 0)
  188.    (re-search-backward "@ \\|@\\*\\|@\n")
  189.    (setq arg (1+ arg))))
  190.  
  191. (defun web-mode ()
  192.   "Major mode like TeX mode plus \\[forward-module] and \\[backward-module]
  193. for relative module movement. The automatic \" feature is disabled."
  194.   (interactive)
  195.   (plain-tex-mode)
  196.   (local-set-key "\M-n" 'forward-module)
  197.   (local-set-key "\M-p" 'backward-module)
  198.   (local-set-key "\"" 'self-insert-command)
  199.   (setq mode-name "WEB")
  200.   (setq major-mode 'web-mode))
  201. (setq auto-mode-alist (cons '("\\.web$" . web-mode) auto-mode-alist))
  202.  
  203. (defun cweb-mode ()
  204.   "Major mode like TeX mode plus \\[forward-module] and \\[backward-module]
  205. for relative module movement. The automatic \" feature is disabled."
  206.   (interactive)
  207.   (plain-tex-mode)
  208.   (local-set-key "\M-n" 'forward-module)
  209.   (local-set-key "\M-p" 'backward-module)
  210.   (local-set-key "\"" 'self-insert-command)
  211.   (setq mode-name "CWEB")
  212.   (setq major-mode 'cweb-mode))
  213. (setq auto-mode-alist (cons '("\\.w$" . cweb-mode) auto-mode-alist))
  214.  
  215. ;; (4) Finally, some revisions to GNU's spell interface. The main change is
  216. ; to avoid asking you to correct words that query-replace won't find anyway.
  217. ; (These happen when the UNIX spell program truncates \foobar to oobar;
  218. ; now you won't be asked to correct the spelling of oobar, because
  219. ; the word oobar isn't in the file.)
  220.  
  221.  
  222. (defvar spell-command "spell"
  223.   "*Command to run the spell program.")
  224.  
  225. (defun spell-buffer ()
  226.   "Check spelling of every word in the buffer.
  227. For each incorrect word, you are asked for the correct spelling
  228. and then put into a query-replace to fix some or all occurrences.
  229. If you do not want to change a word, just give the same word
  230. as its \"correct\" spelling; then the query replace is skipped."
  231.   (interactive)
  232.   (spell-region (point-min) (point-max) "buffer"))
  233.  
  234. (defun spell-word ()
  235.   "Check spelling of word at or before point.
  236. If it is not correct, ask user for the correct spelling
  237. and query-replace the entire buffer to substitute it."
  238.   (interactive)
  239.   (let (beg end)
  240.     (save-excursion
  241.      (if (not (looking-at "\\<"))
  242.      (forward-word -1))
  243.      (setq beg (point))
  244.      (forward-word 1)
  245.      (setq end (point)))
  246.     (spell-region beg end (buffer-substring beg end))))
  247.  
  248. (defun spell-region (start end &optional description)
  249.   "Like spell-buffer but applies only to region.
  250. From program, applies from START to END."
  251.   (interactive "r")
  252.   (let ((buf (get-buffer-create " *temp*")))
  253.     (save-excursion
  254.      (set-buffer buf)
  255.      (widen)
  256.      (erase-buffer))
  257.     (message "Checking spelling of %s..." (or description "region"))
  258.     (if (= ?\n (char-after (1- end)))
  259.     (if (string= "spell" spell-command)
  260.         (call-process-region start end "spell" nil buf)
  261.       (call-process-region start end shell-file-name
  262.                    nil buf nil "-c" spell-command))
  263.       (let ((oldbuf (current-buffer)))
  264.     (save-excursion
  265.      (set-buffer buf)
  266.      (insert-buffer-substring oldbuf start end)
  267.      (insert ?\n)
  268.      (if (string= "spell" spell-command)
  269.          (call-process-region (point-min) (point-max) "spell" t buf)
  270.        (call-process-region (point-min) (point-max) shell-file-name
  271.                 t buf nil "-c" spell-command)))))
  272.     (message "Checking spelling of %s...%s"
  273.          (or description "region")
  274.          (if (save-excursion
  275.           (set-buffer buf)
  276.           (> (buffer-size) 0))
  277.          "not correct"
  278.            "correct"))
  279.     (let (word newword qtext
  280.       (case-fold-search t)
  281.       (case-replace t))
  282.       (while (save-excursion
  283.           (set-buffer buf)
  284.           (> (buffer-size) 0))
  285.     (save-excursion
  286.      (set-buffer buf)
  287.      (goto-char (point-min))
  288.      (setq word (buffer-substring (point)
  289.                       (progn (end-of-line) (point))))
  290.      (forward-char 1)
  291.      (delete-region (point-min) (point))
  292.          (setq qtext (concat "\\b" (regexp-quote word) "\\b"))
  293.      (flush-lines (concat "^" (regexp-quote word) "$")))
  294.         (if (save-excursion (re-search-forward qtext nil t))
  295.             (progn
  296.               (setq newword (read-input (concat "Replacement for " word ": ")
  297.                    word))
  298.               (if (not (equal word newword))
  299.                   (progn
  300.                     (goto-char (point-min))
  301.                     (query-replace-regexp qtext newword)))))))))
  302.  
  303.  
  304.