text: `make-center-block`

* text-conf.el (make-center-block): Make a "centered" block
  surrounding the selected region or line.  This seems similar to the
  so-called source blocks in "Org-mode" , at least in my eyes.

  (find-max-nonblank-len-in-region): A helper function to calculate
  the maximal length of non-blank lines within a region.  Here the
  length refers to the length of the non-blank portions of the lines.

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