Want more features on Pastebin? Sign Up, it's FREE!
Guest

eLisp functions for advanced padding

By: a guest on Sep 26th, 2012  |  syntax: Lisp  |  size: 5.99 KB  |  views: 35  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. (defvar haxe-folding-delimiters '(?\ ?\t ?\n)
  2.   "Characters used to delimit the words when padding a region")
  3.  
  4. (defvar haxe-folding-terminators '(?\- ?\. ?\, ?\? ?\! ?\; ?\: ?\) ?\] ?\")
  5.   "Characters that terminate words when padding a region")
  6.  
  7. (defvar haxe-folding-exceptions
  8.   '((?\. . ?\)) (?\. . ?\") (?\. . ?\') (?\. . ?\]) (?\. . ?\.)
  9.    (?\! . ?\)) (?\! . ?\") (?\! . ?\') (?\! . ?\]) (?\! . ?\.)
  10.    (?\! . ?\!) (?\! . ?\?) (?\? . ?\)) (?\? . ?\") (?\? . ?\')
  11.    (?\? . ?\]) (?\? . ?\.) (?\? . ?\!) (?\? . ?\?))
  12.  "Character pairs that should not be split, when word-wrapping a region,
  13. unless there is only one word in the line")
  14.  
  15. (defun exception-p (first-char second-char exceptions)
  16.  "Werifies whether the EXCEPTIONS contains a pair (FIRST-CHAR SECOND-CHAR)"
  17.  (dolist (i exceptions)
  18.    (when (and (char-equal (car i) first-char)
  19.               (char-equal (cdr i) second-char))
  20.      (return t))))
  21.  
  22. (defun read-word (input position delimiters ends exceptions)
  23.  "Reads the first word from the INPUT, starting from position. The word
  24. is a substring that may be terminated by any of the ENDS characters, or
  25. before any of DELIMITERS characters. However, if the last character of
  26. the word is the `car' of any of EXCEPTION pairs and the character that follows
  27. that character is that same pairs `cdr', then the word is not terminated
  28. and the process is repeated until the next DELIMITER or END is encountered."
  29.  (let (word char)
  30.    (catch 't
  31.      (while (< position (length input))
  32.        (setq char (aref input position))
  33.        (cond
  34.         ((member char delimiters)
  35.          (if (and (< position (1- (length input)))
  36.                   (exception-p char (aref input (1+ position)) exceptions))
  37.              (setq word (cons char word))
  38.            (throw 't t)))
  39.         ((member char ends)
  40.          (setq word (cons char word))
  41.          (unless (and (< position (1- (length input)))
  42.                       (exception-p char (aref input (1+ position)) exceptions))
  43.            (throw 't t)))
  44.         (t (setq word (cons char word))))
  45.        (incf position)))
  46.    (coerce (reverse word) 'string)))
  47.  
  48. (defun fold-string-words
  49.  (input max-length &optional pad-left pad-right delimiters ends exceptions)
  50.  "Creates a block of text which has no more than MAX-LENGTH characters
  51. in one line, is padded by PAD-LEFT characters on the left and PAD-RIGHT
  52. characters on the right. The text will break words only when the word is
  53. longer then MAX-LENGTH.
  54. DELIMITERS are the characters which cannot be part of the word.
  55. ENDS are the characters that end a word.
  56. EXCEPTIONS are the pairs of characters (an assoc list) that should never be
  57. split, unless it is the only word on the line."
  58.  (let* ((delimiters (or delimiters haxe-folding-delimiters))
  59.         (ends (or ends haxe-folding-terminators))
  60.         (exceptions
  61.          (or exceptions haxe-folding-exceptions))
  62.         (tab-delimiter-p (member ?\t delimiters))
  63.         (pad-left (or pad-left 0))
  64.         (pad-right (or pad-right 0))
  65.         (pos 0) (line-built 0) word line-has-words next-char)
  66.    (when (> (+ pad-right pad-left) max-length)
  67.      (error "The sum of paddings must be smaller then the line length."))
  68.    (with-output-to-string
  69.      (while (< pos (length input))
  70.        (dotimes (i pad-left)
  71.          (princ " ")
  72.          (incf line-built))
  73.        (setq word (read-word input pos delimiters ends exceptions))
  74.        (if (<= (+ line-built (length word)) (- max-length pad-right))
  75.            (progn
  76.              (princ word)
  77.              (setq line-has-words t)
  78.              (incf line-built (length word))
  79.              (incf pos (length word))
  80.              (when (and (< pos (1- (length input)))
  81.                         (member (aref input pos) delimiters))
  82.                (setq next-char (aref input pos))
  83.                (cond
  84.                 ((char-equal ?\t next-char)
  85.                  (incf pos tab-width)
  86.                  (incf line-built tab-width))
  87.                 ((char-equal ?\n next-char)
  88.                  (incf pos)
  89.                  (dotimes (i (- max-length line-built))
  90.                    (princ " "))
  91.                  (setq line-built 0 line-has-words nil)
  92.                  (terpri))
  93.                 (t (incf pos)
  94.                    (incf line-built)))
  95.                (princ (char-to-string next-char))))
  96.          (progn
  97.            (if line-has-words
  98.                (dotimes (i (- max-length line-built))
  99.                    (princ " "))
  100.              (progn
  101.                (princ (subseq word 0 (- max-length pad-right line-built)))
  102.                (incf pos (- max-length pad-right line-built))
  103.                (dotimes (i pad-right)
  104.                  (princ " "))))
  105.            (terpri)
  106.            (setq line-built 0 line-has-words nil)))))))
  107.  
  108. (defun haxe-pad-region (start end width &optional prefix pad-left pad-right)
  109.  "Creates a column from the seclected region between START and END of the
  110. width WIDTH.
  111. PREFIX argument is populated when this function is called interactively.
  112. With default prefix argument, the column will be padded by 1 character on the
  113. right and on the left. If you provide numberical argument other than default,
  114. then you will be prompted to provide the padding for left and right sides.
  115. Non-interactive callers must not provide PREFIX argument if they wish to
  116. specify paddings other then 0.
  117.  
  118. See also `haxe-folding-delimiters', `haxe-folding-terminators',
  119. `haxe-folding-exceptions' and `fold-string-words'"
  120.  (interactive "r\nnHow wide should the created columnbe? \nP")
  121.  (if prefix
  122.      (if (equal prefix 4)
  123.          (setq pad-left (read-string "Columns to pad on the left: " prefix)
  124.                pad-right (read-string "Columns to pad on the right: " prefix))
  125.        (setq pad-left prefix pad-right prefix))
  126.    (setq pad-left (or pad-left 0) pad-right (or pad-right 0)))
  127.  (let ((input (fold-string-words
  128.                (buffer-substring start end) width pad-left pad-right)))
  129.    (kill-region start end)
  130.    (insert input)))
clone this paste RAW Paste Data