;; -*- lexical-binding: t -*-

(defconst rcrlib-version "1.0")
(defconst rcrlib-license "CC BY-NC-ND 4.0, https://creativecommons.org/licenses/by-nc-nd/4.0/")
(defconst rcrlib-copyright "(c) 2026 Claude Diderich, https://rcrlib.cdsp.photo/")
(defconst rcrlib-doc "https://rcrlib.cdsp.photo/")

(defconst rcrlib-revision "rev. 6, 2026-04-03")

;; Configuration (CRC, CRP, and CRA must be replace by single characters before first use)
;; --
(defconst rcrlib-cnf-cr-code "\\CRC")    ;; Code replacement prefix, e.g., $
(defconst rcrlib-cnf-prefix "CRP")       ;; Prefix for extended codes, e.g., +
(defconst rcrlib-cnf-alt-prefix "CRA")   ;; Alternate prefix for exended codes (without team identifier), e.g., -

;; Word to remove when generating numberised prefixed, e.g.
;;     xx01 \t Goalkeeper Toto -> xx01 \t Toto \n -xx01 \t Goalkeeper Toto #1
;; ..
(defconst rcrlib-words-to-remove
  '("goalkeeper" "head coach" "coach" "umpire" "linesman"))

;; Nobiliary prefixes
;; ...
(defconst rcrlib-nobiliary-prefixes
  '("von und zu" "von der" "von" "van" "de" "du" "del" "della" "di" "da" "le" "la" "les" 
    "los" "las" "der" "den" "ter" "te" "op" "zu" "zum" "zur")
  "List of nobiliary particles/prefixes used in surnames.")

;; De-accent translation table
;; ..
(defconst rcrlib-cte-deaccent-table
  '(;; a
    (?à . ?a) (?á . ?a) (?â . ?a) (?ã . ?a) (?ä . "ae") (?å . ?a)
    (?À . ?A) (?Á . ?A) (? . ?A) (?à . ?A) (?Ä . "Ae") (?Å . ?A)
    ;; ae / oe
    (?æ . "ae") (?Æ . "AE")
    (?œ . "oe") (?Œ . "OE")
    ;; c
    (?ç . ?c) (?Ç . ?C)
    ;; e
    (?è . ?e) (?é . ?e) (?ê . ?e) (?ë . ?e)
    (?È . ?E) (?É . ?E) (?Ê . ?E) (?Ë . ?E)
    ;; i
    (?ì . ?i) (?í . ?i) (?î . ?i) (?ï . ?i)
    (?Ì . ?I) (?Í . ?I) (?Î . ?I) (?Ï . ?I)
    ;; n
    (?ñ . ?n) (?Ñ . ?N)
    ;; o
    (?ò . ?o) (?ó . ?o) (?ô . ?o) (?õ . ?o) (?ö . "oe") (?ø . ?o)
    (?Ò . ?O) (?Ó . ?O) (?Ô . ?O) (?Õ . ?O) (?Ö . "Oe") (?Ø . ?O)
    ;; ss
    (?ß . "ss")
    ;; u
    (?ù . ?u) (?ú . ?u) (?û . ?u) (?ü . "ue")
    (?Ù . ?U) (?Ú . ?U) (?Û . ?U) (?Ü . "Ue")
    ;; y
    (?ý . ?y) (?ÿ . ?y)
    (?Ý . ?Y))
  "Mapping of accented characters to their ASCII equivalents.")



;; Faces
;; --
(defface rcrlib-mode-comment-face '((t :inherit font-lock-comment-face))
  "Face for // comments" :group 'rcrlib-mode)

(defface rcrlib-mode-code-face '((t :foreground "blue"))
  "Face for the first word on a line" :group 'rcrlib-mode)

(defface rcrlib-mode-rcr-face '((t :inherit font-lock-keyword-face))
  "Face for recursive code replacement codes" :group 'rcrlib-mode)

(defface rcrlib-mode-variable-face '((t :foreground "dark green"))
  "Face for variables" :group 'rcrlib-mode)

(defface rcrlib-mode-tab-face '((t :background "#FFFF90"))
  "Face for tab characters" :group 'rcrlib-mode)

(defface rcrlib-mode-double-tab-face '((t :background "#FF9900"))
  "Face for tab characters" :group 'rcrlib-mode)

;; Colouring of code replacement code
;; --
(defconst rcrlib-mode-font-lock
  `(
    ;; 1a. Comments: from // to end of line (override flag `t' ensures full priority on comment lines)
    ("//.*$" (0 'rcrlib-mode-comment-face t))
    ;; 1b. Double Tabs: background colour
    ("\t\t" (0 'rcrlib-mode-double-tab-face))
    ;; 1c. Tabs: background colour
    ("\t" (0 'rcrlib-mode-tab-face))

    ;; 2. Replacement code: First word on a line
    ("^[^ \t]+" (0 'rcrlib-mode-code-face))
    ;; 3a. Recursive codes: $[^ \t]*$  — dollar-prefix and suffix
    (,(concat rcrlib-cnf-cr-code "[^ \t]*" rcrlib-cnf-cr-code) (0 'rcrlib-mode-rcr-face))
    ;; 3b. Recursive codes: $[^ \t]+<space>  — dollar-prefix, space-terminated
    (,(concat rcrlib-cnf-cr-code "[^ \t]+[ \t]") (0 'rcrlib-mode-rcr-face))

    ;; 4. Variables: {[^ \t]*}
    ("{[^ \t]*}" (0 'rcrlib-mode-variable-face))

    )
  "Font-lock colours for `rcrlib-mode'.")

;; Key mapping
;; --
(defvar rcrlib-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "C-r C-r") #'isearch-backward)
    (define-key map (kbd "C-r C-a") #'rcrlib-asciify)
    (define-key map (kbd "C-r C-d") #'rcrlib-append-asciified-name)
    (define-key map (kbd "C-r C-t") #'rcrlib-transpose-last-first-name)
    (define-key map (kbd "C-r C-n") #'rcrlib-normalise-numbering)
    (define-key map (kbd "C-r C-c") #'rcrlib-numberised-codes)
    map)
  "Keymap for rcrlib-mode.")

;; rcrlib-mode definition
;; ==
(define-derived-mode rcrlib-mode
  text-mode "rcrlib"
  "Recursive Code Replacement Library"

  ;; Colour code buffer
  ;; ..
  (setq-local font-lock-defaults
              '(rcrlib-mode-font-lock
                nil   ; perform syntactic fontification
                nil   ; keywords are case-sensitive
                nil   ; no extra syntax-alist entries
                nil)) ; no syntax-begin-function
  (font-lock-mode 1)
  (setq-default ident-tabs-mode t)
  (setq-default tab-width 4)
  
  ;; Modify definition of a word
  ;; ..
  (let ((st (copy-syntax-table (syntax-table))))
    ;; Set the entire character range to word constituents in one call
    (modify-syntax-entry '(#x0 . #x10FFFF) "w" st)
    ;; Carve out whitespace exceptions
    (modify-syntax-entry ?\s " " st)
    (modify-syntax-entry ?\t " " st)
    (modify-syntax-entry ?\n " " st)
    (set-syntax-table st))

  ;; Assign specific CTRL+R keys (overwriting reverse search normally bound to CTRL+R)
  (use-local-map rcrlib-mode-map)
  )

;; Define .rcr as the extension of a code replacement file
;; --
(add-to-list 'auto-mode-alist '("\\.rcr\\'" . rcrlib-mode))


;; rcrlib functions
;; ==

;; rcrlib-remove-words: Remove words from a text
;; ..
(defun rcrlib-remove-words-from-string (str words)
  "Remove all words in WORDS list from string STR
   (with surrounding whitespace cleaned up)"
   (let ((result str)
        (case-fold-search t))  ;; makes regexp matching case-insensitive
    (dolist (word words result)
      (setq result (replace-regexp-in-string
                    (concat "\\b" (regexp-quote (downcase (concat word " "))) "\\b") ""
                    result)))
    (string-trim result)))

;; rcrlib-apply-to-lines: Generic function to apply a function to all lines in a region
;; ..
(defun rcrlib-apply-to-lines (fnc beg end)
  "Apply the function TOTO to each line in the selected region."
  (interactive "r")
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      (while (not (eobp))
        (let* ((line-beg (line-beginning-position))
               (line-end (line-end-position))
               (line-text (buffer-substring-no-properties line-beg line-end))
               (result (funcall fnc line-text)))
          (delete-region line-beg line-end)
          (insert result))
        (forward-line 1)))))

;; rcr-capitalise-custom: Custom capitalisation function
;; ..
(defun rcrlib-capitalise (str)
  "Capitalize all words in STR matching [^][[:space:][:punct:]]+"
  (replace-regexp-in-string
   "[^][[:space:][:punct:]]+"
   (lambda (word)
	 (if (member (downcase word) rcrlib-nobiliary-prefixes)
		 (concat word)
       (concat (upcase (substring word 0 1)) (downcase (substring word 1)))))
   str t t))

;; rcrlib-asciify: Asciify line/selection
;; --
(defun rcrlib-asciify-line (line)
  "Replace all accented characters in LINE with their ASCII equivalents."
  (mapconcat
   (lambda (ch)
     (let ((replacement (alist-get ch rcrlib-cte-deaccent-table)))
       (cond
        ((stringp replacement) replacement)          ; multi-char (æ→ae, ß→ss)
        ((characterp replacement) (char-to-string replacement)) ; single char
        (t (char-to-string ch)))))                   ; no mapping, keep as-is
   line
   "")
  )

(defun rcrlib-asciify (beg end) (interactive "r") (rcrlib-apply-to-lines 'rcrlib-asciify-line beg end))

;; rcrlib-append-asciified-name: add de-ascified name to line/selection
;; --
(defun rcrlib-append-asciified-name-line (line)
 "Append a de-ascified version of the NAME to the line."
 (let ((tab-pos (string-search "\t" line)))
   (if (null tab-pos)
       line
     (let* ((after-tab (substring line (1+ tab-pos)))
            (transformed (rcrlib-asciify-line after-tab)))
       (concat line "\t" transformed)))))

(defun rcrlib-append-asciified-name (beg end)
  (interactive "r") (rcrlib-apply-to-lines 'rcrlib-append-asciified-name-line beg end))

;; rcrlib-transpose-last-first-name: transpose last and first name
;; --
(defun rcrlib-de-nobiliary (str)
  "Replace the space in and after any nobiliary prefix in STR with an underscore."
  (dolist (nobi-prefix rcrlib-nobiliary-prefixes str)
	(setq str (replace-regexp-in-string (regexp-quote (concat nobi-prefix " "))
										(concat (replace-regexp-in-string (regexp-quote " ") "_" nobi-prefix t t) "_")
										str t t))))
(defun rcrlib-en-nobiliary (str)
  "Remove underscores from a name"
  (replace-regexp-in-string (regexp-quote "_") " " str))
(defun rcrlib-transpose-last-first-name-string (str)
  "Capitalize the first word of STR, move it to the end, and return the result."
  (let* ((capped (mapconcat #'rcrlib-capitalise (split-string str) " "))
         (dened (rcrlib-de-nobiliary capped))
         (words (split-string dened))
         (rotated (mapconcat #'identity (append (cdr words) (list (car words))) " ")))
    (rcrlib-en-nobiliary rotated)))

(defun rcrlib-transpose-last-first-name-line (line)
  "Transpose first and last name"
  (if (not (string-match "\t" line))
      line
    (let* ((tab1      (match-end 0))
           (region-end (or (string-match "\t\\| #\\| (\\| of" line tab1)
                           (length line)))
           (before    (substring line 0 tab1))
           (text      (substring line tab1 region-end))
           (after     (substring line region-end)))
      (concat before (rcrlib-transpose-last-first-name-string text) after))))

(defun rcrlib-transpose-last-first-name (beg end)
  (interactive "r") (rcrlib-apply-to-lines 'rcrlib-transpose-last-first-name-line beg end))

;; rcrlib-numberise: add number and (optionally) team
;; --
(defun rcrlib-numberise-line (line prefix append-team)
  ""
   (let* ((first-word (car (split-string line)))
         (result (if (and first-word (string-match "[0-9]+" first-word))
                     (concat line " #" (number-to-string (string-to-number (match-string 0 first-word))))
                   line)))
    (if (and append-team (not (string-empty-p append-team)))
        (concat prefix result " " append-team)
      (concat prefix result))))

(defun rcrlib-numberise (beg end)
  "Prompt for a string X and append it to each line in the selected region."
  (interactive "r")
  (let ((rcrlib-team (read-string "Team/Country: ")))
    (rcrlib-apply-to-lines (lambda (line) (concat (rcrlib-numberise-line line rcrlib-cnf-prefix rcrlib-team)))
						   beg end)))

;; rcrlib-normalise-numbering: Normalise numbering so that they are always at least two digits
;; --
(defun rcrlib-normalise-numbering-line (line nb-prefixes)
  "Replace the number in the first word of LINE with a zero-padded number."
  (if (string-match "\\([0-9]+\\)" line)
      (let* ((num (match-string 1 line))
             (padded (format (concat "%0000000000" nb-prefixes "d") (string-to-number num))))
        (replace-match padded t t line 1))
    line))
(defun rcrlib-normalise-numbering (beg end)
  (interactive "r")
  (let* ((input (read-string "Number length [2]: "))
		(input-trimmed (string-trim input))
		(input-parsed (if (string= input-trimmed "") "2" input-trimmed)))
	(rcrlib-apply-to-lines (lambda (line) (rcrlib-normalise-numbering-line line input-parsed)) beg end)
  ))

;; rcr-numberised-codes: generate numberised codes prefixed with a +
;; --
(defun rcrlib-numberised-codes (beg end)
  "Insert a copy of the selected region and apply rcrlib-numberise to the copy."
  (interactive "r")
  (let* ((rcrlib-team (read-string "Team/Country: "))
		 ;; Number
		 (rcrlib-num-len (read-string "Number length [2]: "))
		 (rcrlib-num-len-trimmed (string-trim rcrlib-num-len))
		 (rcrlib-num-len-parsed (if (string= rcrlib-num-len-trimmed "") "2" rcrlib-num-len-trimmed))
		 ;; Selection
		 (text (buffer-substring-no-properties beg end))
		 (lines (split-string text "\n"))
		 (filtered-lines (seq-filter (lambda (line)
									   (and (not (string-empty-p line)) (string-match-p "\t" line)))
									 lines))
		 (numbered-lines (mapcar (lambda (line) (rcrlib-normalise-numbering-line line rcrlib-num-len-parsed))
								 filtered-lines))
		 (numbered (mapconcat #'identity numbered-lines "\n"))
		 (copy-lines (mapcar (lambda (line) (rcrlib-numberise-line line rcrlib-cnf-prefix rcrlib-team))
							 numbered-lines))
		 (copy (mapconcat #'identity copy-lines "\n"))
		 (alt-copy-lines (mapcar (lambda (line) (rcrlib-numberise-line line rcrlib-cnf-alt-prefix ""))
								 numbered-lines))
		 (alt-copy (mapconcat #'identity alt-copy-lines "\n")))
	(delete-region beg end)
	(insert (rcrlib-remove-words-from-string numbered rcrlib-words-to-remove))
	(insert "\n")
	(insert "\n")
	(insert copy)
	(insert "\n")
	(insert "\n")
	(when (not (string-empty-p rcrlib-team)) (insert (concat alt-copy "\n")))
	)
  )