diff options
| -rw-r--r-- | text-conf.el | 104 |
1 files changed, 104 insertions, 0 deletions
diff --git a/text-conf.el b/text-conf.el index 5bf2218..c8bc566 100644 --- a/text-conf.el +++ b/text-conf.el @@ -131,6 +131,110 @@ DESCRIPTION above the block." (newline) (insert fill-line)))) +;;; Make a center block + +(defun find-max-nonblank-len-in-region (beg end) + "Find the maximum length of non-blank lines in the region \ +delimited by BEG and END." + (let ((result 0) line-beg line-end temp) + (save-excursion + (goto-char beg) + (while (<= (point) end) + (forward-line 0) + (setq + line-beg + (re-search-forward + (rx-to-string + '(seq bol (zero-or-more space)) + t) + end t)) + (goto-char (line-end-position)) + (setq + temp + (re-search-backward + (rx-to-string + '(seq (not space) (zero-or-more space) eol) + t) + line-beg t)) + (setq line-end (cond (temp (1+ temp)) (line-beg))) + (setq result (max result (- line-end line-beg))) + (forward-line 1))) + result)) + +;;;###autoload +(defun make-center-block (&optional description) + "Surround the current line or the region in a centered block. + +If DESCRIPTION is non-nil, ask for a description and put the +DESCRIPTION above the block." + (interactive "P") + (let* ((description + (cond + (description + (read-string "Description of the block: " + nil make-block-history nil t)))) + (description-len (length description)) + (beg (cond + ((use-region-p) + (region-beginning)) + ((line-beginning-position)))) + (end (cond + ((use-region-p) + (region-end)) + ((line-end-position)))) + (end-marker (set-marker (make-marker) (1+ end))) + (max-len (max (find-max-nonblank-len-in-region beg end) + description-len)) + (spaces-before + (make-string (/ (- fill-column max-len 4) 2) 32)) + (fill-line + (concat spaces-before (make-string (+ max-len 4) ?-))) + (header (cond + (description + (list fill-line + "\n" + (center-string-in-width + description fill-column) + "\n" + fill-line)) + ((list fill-line)))) + line-beg line-end line-str) + (save-excursion + (goto-char beg) + (while (<= (point) (1- (marker-position end-marker))) + (goto-char (line-end-position)) + (re-search-backward + (rx-to-string + '(seq (not space) (zero-or-more space) eol) + t) + (line-beginning-position) t) + (setq line-end (min (line-end-position) (1+ (point)))) + (forward-line 0) + (re-search-forward + (rx-to-string + '(seq bol (zero-or-more space)) + t) + (line-end-position) t) + (setq line-beg (point)) + (setq line-str (buffer-substring line-beg line-end)) + (delete-region (line-beginning-position) + (line-end-position)) + (insert spaces-before + ?| 32 + line-str + (make-string + (- (1+ max-len) (length line-str)) + 32) + ?|) + (forward-line 1)) + (goto-char beg) + (mapc #'insert header) + (newline) + (goto-char (1- (marker-position end-marker))) + (set-marker end-marker nil) + (newline) + (insert fill-line)))) + ;;; Moving between pages ;;;###autoload |