eLisp functions for advanced padding

(defvar haxe-folding-delimiters '(?\ ?\t ?\n)
  "Characters used to delimit the words when padding a region")

(defvar haxe-folding-terminators '(?\- ?\. ?\, ?\? ?\! ?\; ?\: ?\) ?\] ?\")
  "Characters that terminate words when padding a region")

(defvar haxe-folding-exceptions
  '((?\. . ?\)) (?\. . ?\") (?\. . ?\') (?\. . ?\]) (?\. . ?\.)
    (?\! . ?\)) (?\! . ?\") (?\! . ?\') (?\! . ?\]) (?\! . ?\.)
    (?\! . ?\!) (?\! . ?\?) (?\? . ?\)) (?\? . ?\") (?\? . ?\')
    (?\? . ?\]) (?\? . ?\.) (?\? . ?\!) (?\? . ?\?))
  "Character pairs that should not be split, when word-wrapping a region,
unless there is only one word in the line")

(defun exception-p (first-char second-char exceptions)
  "Werifies whether the EXCEPTIONS contains a pair (FIRST-CHAR SECOND-CHAR)"
  (dolist (i exceptions)
    (when (and (char-equal (car i) first-char)
               (char-equal (cdr i) second-char))
      (return t))))

(defun read-word (input position delimiters ends exceptions)
  "Reads the first word from the INPUT, starting from position. The word
is a substring that may be terminated by any of the ENDS characters, or
before any of DELIMITERS characters. However, if the last character of
the word is the `car' of any of EXCEPTION pairs and the character that follows
that character is that same pairs `cdr', then the word is not terminated
and the process is repeated until the next DELIMITER or END is encountered."
  (let (word char)
    (catch 't
      (while (< position (length input))
        (setq char (aref input position))
        (cond
         ((member char delimiters)
          (if (and (< position (1- (length input)))
                   (exception-p char (aref input (1+ position)) exceptions))
              (setq word (cons char word))
            (throw 't t)))
         ((member char ends)
          (setq word (cons char word))
          (unless (and (< position (1- (length input)))
                       (exception-p char (aref input (1+ position)) exceptions))
            (throw 't t)))
         (t (setq word (cons char word))))
        (incf position)))
    (coerce (reverse word) 'string)))

(defun fold-string-words
  (input max-length &optional pad-left pad-right delimiters ends exceptions)
  "Creates a block of text which has no more than MAX-LENGTH characters
in one line, is padded by PAD-LEFT characters on the left and PAD-RIGHT
characters on the right. The text will break words only when the word is
longer then MAX-LENGTH.
DELIMITERS are the characters which cannot be part of the word.
ENDS are the characters that end a word.
EXCEPTIONS are the pairs of characters (an assoc list) that should never be
split, unless it is the only word on the line."
  (let* ((delimiters (or delimiters haxe-folding-delimiters))
         (ends (or ends haxe-folding-terminators))
         (exceptions
          (or exceptions haxe-folding-exceptions))
         (tab-delimiter-p (member ?\t delimiters))
         (pad-left (or pad-left 0))
         (pad-right (or pad-right 0))
         (pos 0) (line-built 0) word line-has-words next-char)
    (when (> (+ pad-right pad-left) max-length)
      (error "The sum of paddings must be smaller then the line length."))
    (with-output-to-string
      (while (< pos (length input))
        (dotimes (i pad-left)
          (princ " ")
          (incf line-built))
        (setq word (read-word input pos delimiters ends exceptions))
        (if (<= (+ line-built (length word)) (- max-length pad-right))
            (progn
              (princ word)
              (setq line-has-words t)
              (incf line-built (length word))
              (incf pos (length word))
              (when (and (< pos (1- (length input)))
                         (member (aref input pos) delimiters))
                (setq next-char (aref input pos))
                (cond
                 ((char-equal ?\t next-char)
                  (incf pos tab-width)
                  (incf line-built tab-width))
                 ((char-equal ?\n next-char)
                  (incf pos)
                  (dotimes (i (- max-length line-built))
                    (princ " "))
                  (setq line-built 0 line-has-words nil)
                  (terpri))
                 (t (incf pos)
                    (incf line-built)))
                (princ (char-to-string next-char))))
          (progn
            (if line-has-words
                (dotimes (i (- max-length line-built))
                    (princ " "))
              (progn
                (princ (subseq word 0 (- max-length pad-right line-built)))
                (incf pos (- max-length pad-right line-built))
                (dotimes (i pad-right)
                  (princ " "))))
            (terpri)
            (setq line-built 0 line-has-words nil)))))))

(defun haxe-pad-region (start end width &optional prefix pad-left pad-right)
  "Creates a column from the seclected region between START and END of the
width WIDTH.
PREFIX argument is populated when this function is called interactively.
With default prefix argument, the column will be padded by 1 character on the
right and on the left. If you provide numberical argument other than default,
then you will be prompted to provide the padding for left and right sides.
Non-interactive callers must not provide PREFIX argument if they wish to
specify paddings other then 0.

See also `haxe-folding-delimiters', `haxe-folding-terminators',
`haxe-folding-exceptions' and `fold-string-words'"
  (interactive "r\nnHow wide should the created columnbe? \nP")
  (if prefix
      (if (equal prefix 4)
          (setq pad-left (read-string "Columns to pad on the left: " prefix)
                pad-right (read-string "Columns to pad on the right: " prefix))
        (setq pad-left prefix pad-right prefix))
    (setq pad-left (or pad-left 0) pad-right (or pad-right 0)))
  (let ((input (fold-string-words
                (buffer-substring start end) width pad-left pad-right)))
    (kill-region start end)
    (insert input)))