JUSTIFY COMMENT BLOCK elisp function

[David McCracken]

I'm not sure how to share this but I have written an elisp function that 
justifies a marked region while inserting a user-defined string at the 
beginning of each line as would be typically found in a comment block. 
The function, justify-region, takes one interactive argument, which 
defines the line prefix. This may be empty or comprise one or more 
characters, including space, for example "#" or "//     " or "rem ". Any 
existing instances of this string that appear at the beginning of lines 
are removed (elsewhere in the line, they are considered part of the 
text) and they are (re)inserted at the beginning of each line 
reformatted to wrap at the fill-column point (typically 80). The 
function is generally language-agnostic but aware of common conventions. 
For example, it splits A-B between - and B but it does not split -B.

;----------------------------- justify-region 
--------------------------------
; Purpose: word-wrap the marked region at the fill-column point (e.g. 
80) with
; the given prefix string on the left edge. This is typically used to 
justify a
; comment block. The prefix comprises 0 or more characters, for example 
;,;;,
; or ;;; for lisp, // for C++, rem for Windows batch, # for sh and make.
;
; Input: this may be called non-interactively with the prefix string 
argument
; pfstring. Interactively, the user is asked for pfstring. This is used
; exactly. If it contains no trailing space, there will be no space 
between it
; and the text. Typically, pfstring is the language's comment character or
; string followed by one space. Instances of pfstring that appear at the
; beginning of a line are considered to be discardable. Any that appear
; elsewhere are considered part of the text and are not disturbed.
;............................... notes 
.........................................
; Operation: this comprises two loops, reduction and expansion, applied 
to each
; line from top to bottom of the region. The reduction loop merges the next
; line with the current one by removing the newline and pfstring (if 
any) at
; the beginning of the next line. This continues until it produces a 
line that
; crosses the fill column point. Then the expansion loop traverses this 
line
; from the end until it finds a whole word that does not cross the 
fill-column.
; The line is split between this and the next word after accounting for 
certain
; character combinations that belong with the next word. For example, 
word-word
; splits to word- and word, but -word cannot split to - and word.
;...............................................................................
(defun justify-region( pfstring )
   "Word-wrap region at fill-column, applying optional prefix at left. 
The prefix
may be nothing or one or more characters.Existing instances of the 
prefix on
the left edge are removed before formatting."
   (interactive "sPrefix string: " )
   (let ((length (string-width pfstring)) count)
   (if mark-active
       (if (> (point) (mark))
       (exchange-point-and-mark))
           ; Else no region marked. Treat cursor line as region.
       (end-of-line)
       (set-mark (point))
       (beginning-of-line))

   ;; If the first line doesn't have the prefix string then insert it now.
   (if (not (looking-at pfstring))
       (insert pfstring))
  
   (catch 'end
       (while t
       (end-of-line)
;; Reduction loop deletes newlines while EOL < fill-column. At each 
reduction,
;; if we see the prefix string, it is removed because it was at the 
beginning
;; of the line before the newline was deleted.
       (while (< (current-column) (1- fill-column)) ; Reduction loop.
           (if (>= (point) (- (mark) 2))
           (progn
               (forward-char 1) ;Leave point at beginning of next line.
               (pop-mark) ; Unmarks region for the few cases that don't.
               (throw 'end 1))
           (delete-char 1)
           (if (looking-at pfstring)
               (delete-char length)) ;kill-word goes too far if 
pfstring length = 1.
           (fixup-whitespace)      ; Normalize to one space.
           (end-of-line)))          ; Close reduction loop.

;; Expansion loop steps back from EOL one word at a time until the point 
is on
;; a word that doesn't cross over the fill-column and breaks the line after
;; that by inserting newline (unless starting point was already less 
than fill-
;; column). The prefix string is inserted on next line if not already there.
       (setq count 0)
       (while (> (current-column) fill-column) ; Expansion loop.
           (backward-word 1)
           (setq count (1+ count)))

;; If the word we intend to move down to the next line is immediately 
preceded
;; by ", ', `, (, or < then bring that along as well. If preceded by - 
itself
;; preceded by space then bring the - character along. This represents 
-word as
;; opposed to word-word. If preceded by the combination </ then bring that.
;; This is for HTML but shouldn't be a problem for other languages.
       (cond
           ((looking-back "</")
           (backward-char 2))
           ((looking-back "[\"\'\`(<]")
           (backward-char 1))
           ((looking-back "[ \t]-")
           (backward-char 1)))

       (if ( > count 0)
           (insert ?\n)
           (forward-char 1))
       (if (not (looking-at pfstring))
           (insert pfstring))))))