home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / functions / fill-para.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  4.6 KB  |  125 lines
  1. ;From utkcs2!emory!samsung!uunet!mcsun!ukc!edcastle!aipna!rjc Thu Jun 21 11:36:02 EDT 1990
  2. ;Article 3027 of gnu.emacs:
  3. ;Path: utkcs2!emory!samsung!uunet!mcsun!ukc!edcastle!aipna!rjc
  4. ;>From: rjc@uk.ac.ed.cstr (Richard Caley)
  5. ;Newsgroups: gnu.emacs
  6. ;Subject: syntax tables (was: regexp question: search for words)
  7. ;Message-ID: <RJC.90Jun20040929@brodie.uk.ac.ed.cstr>
  8. ;Date: 20 Jun 90 04:09:29 GMT
  9. ;References: <3017@isaak.isa.de> <1990Jun19.143251.28944@talos.pm.com>
  10. ;Sender: news@aipna.ed.ac.uk
  11. ;Organization: Center for Speech Technology Research
  12. ;Lines: 108
  13. ;In-reply-to: kjones@talos.pm.com's message of 19 Jun 90 14:32:51 GMT
  14. ;
  15. ;
  16. ;To go off at something of a tangent...
  17. ;
  18. ;I've been thinking for a while that emacs underuses the ysntax tables.
  19. ;The specific example which brought it to mind was my wanting to use
  20. ;M-q to format a paragraph of text which was written in a strange mode
  21. ;where word boundries are indicated by `|` ( don't ask ). I declared
  22. ;`|' as a space and ` ' as a word character which got forward/backward
  23. ;word working, but M-q still broke lines at spaces.
  24. ;
  25. ;Anyway, enough motivation, now onto the soapbox--
  26. ;
  27. ;    Any elisp code which looks for a space should look for a
  28. ;    character with syntax class ` ' rather than for a literal
  29. ;    space. By extension, the same holds for looking for
  30. ;    alphanumerics. 
  31. ;
  32. ;Discuss; use both sides of the paper.
  33. ;
  34. ;-----------    
  35. ;
  36. ;Appendix A: Code for filling based on syntax class.
  37. ;
  38. ;This seems to work, but I have not leant on it very hard. Certainly it
  39. ;is almost always in my emacs and M-q still works fine in text mode
  40. ;etc. 
  41.  
  42.  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43.  ;;                                                                  ;;
  44.  ;; A version of fill-region-as-paragraph which uses some syntax     ;;
  45.  ;; information. It should be upward compatable with the standard    ;;
  46.  ;; one. We define this here so that M-q can be used to justify      ;;
  47.  ;; transcription files.                                             ;;
  48.  ;;                                                                  ;;
  49.  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  50.  
  51. (defun fill-region-as-paragraph (from to &optional justify-flag)
  52.   "Fill region as one paragraph: break lines to fit fill-column.
  53. Prefix arg means justify too.
  54. From program, pass args FROM, TO and JUSTIFY-FLAG."
  55.   (interactive "r\nP")
  56.   (save-restriction
  57.     (narrow-to-region from to)
  58.     (goto-char (point-min))
  59.     (skip-chars-forward "\n")
  60.     (narrow-to-region (point) (point-max))
  61.     (setq from (point))
  62.     (let ((fpre (and fill-prefix (not (equal fill-prefix ""))
  63.              (regexp-quote fill-prefix))))
  64.       ;; Delete the fill prefix from every line except the first.
  65.       ;; The first line may not even have a fill prefix.
  66.       (and fpre
  67.        (progn
  68.          (if (>= (length fill-prefix) fill-column)
  69.          (error "fill-prefix too long for specified width"))
  70.          (goto-char (point-min))
  71.          (forward-line 1)
  72.          (while (not (eobp))
  73.            (if (looking-at fpre)
  74.            (delete-region (point) (match-end 0)))
  75.            (forward-line 1))
  76.          (goto-char (point-min))
  77.          (and (looking-at fpre) (forward-char (length fill-prefix)))
  78.          (setq from (point)))))
  79.     ;; from is now before the text to fill,
  80.     ;; but after any fill prefix on the first line.
  81.  
  82.     ;; Make sure sentences ending at end of line get an extra space.
  83.     (goto-char from)
  84.     (while (re-search-forward "[.?!][])""']*$" nil t)
  85.       (insert ? ))
  86.     ;; The change all newlines to spaces.
  87.     (subst-char-in-region from (point-max) ?\n ?\ )
  88.     ;; Flush excess spaces, except in the paragraph indentation.
  89.     (goto-char from)
  90.     (skip-chars-forward " \t")
  91.     (while (re-search-forward "   *" nil t)
  92.       (delete-region
  93.        (+ (match-beginning 0)
  94.       (if (save-excursion
  95.            (skip-chars-backward " ])\"'")
  96.            (memq (preceding-char) '(?. ?? ?!)))
  97.           2 1))
  98.        (match-end 0)))
  99.     (goto-char (point-max))
  100.     (delete-horizontal-space)
  101.     (insert "  ")
  102.     (goto-char (point-min))
  103.     (let ((prefixcol 0))
  104.       (while (not (eobp))
  105.     (move-to-column (1+ fill-column))
  106.     (if (eobp)
  107.         nil
  108.         (re-search-backward "\\s \\|\\s(\\|\\s)\\|\\s$" )
  109.       (if (if (zerop prefixcol) (bolp) (>= prefixcol (current-column)))
  110.           (re-search-forward "\\s \\|\\s(\\|\\s)\\|\\s$" )
  111.         (forward-char 1)))
  112.     (delete-horizontal-space)
  113.     (insert ?\n)
  114.     (and (not (eobp)) fill-prefix (not (equal fill-prefix ""))
  115.          (progn
  116.            (insert fill-prefix)
  117.            (setq prefixcol (current-column))))
  118.     (and justify-flag (not (eobp))
  119.          (progn
  120.            (forward-line -1)
  121.            (justify-current-line)
  122.            (forward-line 1)))))))
  123.  
  124.  
  125.