;;; text-conf.el --- My configurations about plain text files. -*- lexical-binding: t; -*-

(require 'text-mode)
(require 'rx)

;; (declare-function #'center-buffer-on "center-buffer" nil)
;; (declare-function #'center-buffer-off "center-buffer" nil)
;; (declare-function #'center-buffer-toggle "center-buffer" nil)

;; (define-key text-mode-map (vector 'f8) nil)

;;; Insert section heading

;;;###autoload
(defvar insert-section-heading-history nil
  "The history of inserted section heading strings")

;;;###autoload
(defun insert-section-heading (custom-heading)
  "Insert a heading line below.

If CUSTOM-HEADING is non-nil, then use a custom heading.

The user can input any string as a basic constituent of a
heading. The inputed string will be repeated (floor N M) times,
where N is the length of the current line and M is the lenght of
the input string. After this repeat the first (remainder N M)
characters of the input string will be inserted as well to cover
exactly the current ilne."
  (interactive "P")
  (let* ((current-length (- (point-at-eol)
                            (point-at-bol)))
         (heading (cond
                   ((null custom-heading) "-")
                   (t (read-string "Enter a custom heading: "
                                   nil insert-section-heading-history
                                   "-" t))))
         (floor-length (floor current-length (length heading)))
         (remainder (% current-length (length heading)))
         (remainder-string (substring heading 0 remainder))
         (index 0))
    (save-excursion
      (goto-char (line-end-position))
      (newline)
      (while (< index floor-length)
        (insert heading)
        (setq index (1+ index)))
      (insert remainder-string))))

;;; Make a centered string

;;;###autoload
(defun correct-length (str)
  "Return the length of STR.
Characters that take up more than one column will be counted with
1.7 columns."
  (declare (side-effect-free t) (pure t)
           (obsolete string-width "2021-12-21 20:56:10.928712"))
  (let ((len 0))
    (mapc (lambda (char)
            (let ((name (get-char-code-property char 'name))
                  (decomposition (get-char-code-property char 'decomposition)))
              (cond
               ((or (and
                     (stringp name)
                     (string-match (rx-to-string '(seq bos "CJK"))
                                   name))
                    (eq (car decomposition) 'wide))
                (setq len (+ len 1.7)))
               ((setq len (1+ len))))))
          str)
    (floor len)))

;;;###autoload
(defun center-string-in-width (str width)
  "Add spaces to STR so that it is centered in a box which is WIDTH \
wide."
  (let* ((space-width (string-pixel-width (string 32)))
         (width (* width space-width))
         (len (string-pixel-width str)))
    (cond
     ((> len width)
      (error "String %s longer than %d" str width))
     (t (concat
         (make-string
          (round  (- width len) (* space-width 2))
          32)
         str)))))

;;; Center the string

(defun make-center-line (&optional nlines)
  "Center the line point is on, within the width specified by
`fill-column'.

This means adjusting the indentation so that it equals the
distance between the end of the text and `fill-column'.  The
argument NLINES says how many lines to center.

This is adapted from the function `center-line' by Durand at
2024-02-20 23:27:43.839601."
  (interactive "P")
  (if nlines (setq nlines (prefix-numeric-value nlines)))
  (while (not (eq nlines 0))
    (save-excursion
      (let ((lm (current-left-margin))
            space)
	(beginning-of-line)
	(delete-horizontal-space)
	(end-of-line)
	(delete-horizontal-space)
        (setq space (- fill-column
                       lm
                       (round
                        (car
                         (window-text-pixel-size
                          nil (pos-bol) (point)))
                        (string-pixel-width (string 32)))))
        (if (> space 0)
            (indent-line-to (+ lm (/ space 2))))))
    (cond ((null nlines)
	   (setq nlines 0))
	  ((> nlines 0)
	   (setq nlines (1- nlines))
	   (forward-line 1))
	  ((< nlines 0)
	   (setq nlines (1+ nlines))
	   (forward-line -1)))))

;;; Make a block

;;;###autoload
(defvar make-block-history nil
  "The history of block quote descriptions.")

;;;###autoload
(defun make-block (&optional description)
  "Surround the current line or the region in a block.

If DESCRIPTION is non-nil, ask for a description and put the
DESCRIPTION above the block."
  (interactive "P")
  (let* ((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)))
         (fill-line (make-string fill-column ?=))
         (header (cond
                  (description
                   (list fill-line
                         "\n"
                         (center-string-in-width
                          (read-string "Description of the block: "
                                       nil make-block-history nil t)
                          fill-column)
                         "\n"
                         fill-line))
                  (t (list fill-line)))))
    (save-excursion
      (goto-char beg)
      (while (<= (point) (1- (marker-position end-marker)))
        (make-center-line)
        (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))))

;;; 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
(defun durand-next-page (&optional arg)
  "Move forward ARG pages and narrow to page.
The only differences with `narrow-to-page' are that a nil
argument means 1, and that after narrowing this moves the cursor
to the beginning."
  (interactive "p")
  (narrow-to-page arg)
  (goto-char (point-min)))

;;;###autoload
(defun durand-previous-page (&optional arg)
  "Move backward ARG pages and narrow to page.
Pass (- (prefix-numeric-value arg)) to `durand-next-page'."
  (interactive "p")
  (durand-next-page (- (prefix-numeric-value arg))))

(define-key text-mode-map (vector ?\s-m) #'durand-previous-page)
(define-key text-mode-map (vector ?\s-ù) #'durand-next-page)

;;; Insert time stamps

;;;###autoload
(defun durand-insert-timestamp (&optional arg)
  "Insert the time stamp for now.
If ARG is non-nil, use a more verbose format."
  (interactive "P")
  (let ((time-format (cond (arg "%F %T.%6N")
                           ("%F"))))
    (insert (format-time-string time-format))))

(define-key global-map (vector ?\H-=) #'durand-insert-timestamp)

;;; a diff-dwim

(autoload 'vc-diff "vc.el")

;;;###autoload
(defun durand-diff-dwim (&optional arg)
  "Run `diff-buffer-with-file' or `vc-diff'."
  (interactive "P")
  (cond
   ((and (or (not (buffer-modified-p))
             (equal arg (list 16)))
         (vc-registered (buffer-file-name)))
    (vc-diff arg t))
   ((buffer-modified-p)
    (diff-buffer-with-file
     (cond
      (arg (read-buffer "Choose a buffer to diff: "
                        (current-buffer) t))
      ((current-buffer)))))
   ((user-error "No reasonable way to diff"))))

(define-key global-map (vector ?\C-\M-=) #'durand-diff-dwim)

;;; Eliding a region of text

(defun durand-elide-region (beg end ignore-invisible-lines)
  "Elide a region of text delimited by BEG and END.
If IGNORE-INVISIBLE-LINES is non-nil, the line count will not
include invisible lines."
  (interactive
   (cond
    ((use-region-p) (list (region-beginning) (region-end)
                          current-prefix-arg))
    ((user-error "First select a region to elide"))))
  (cond
   ((> beg end)
    (let ((temp beg))
      (setq beg end) (setq end temp))))
  (setq beg (save-excursion
              (goto-char beg)
              (line-beginning-position)))
  (setq end (save-excursion
              (goto-char end)
              (line-end-position)))
  (let ((n (count-lines beg end ignore-invisible-lines)))
    (save-excursion
      (delete-region beg end)
      (insert (format "    >> [ %d lines elided ... ]" n)))))

(define-key text-mode-map (vector ?\M-\s-\=) #'durand-elide-region)

(provide 'text-conf)
;;; text-conf.el ends here.