;-*- coding: utf-8 -*-
; some elisp string replacement functions

; 2007-06
;   Xah Lee
; ∑ http://xahlee.org/

(defun count-block ()
"Return a list “(start end num-of-lines)” of the current text block,
where “start” is the starting position of the block, etc.
A text block is defined as surrounded by two empty lines (on each end)."
(interactive)
(save-excursion
  (let (t1 t2 n)
    (search-backward "\n\n")
    (search-forward "\n\n")
    (setq t1 (point))
    (search-forward "\n\n")
    (search-backward "\n\n")
    (setq t2 (+ (point) 1))
    (setq n (count-lines t1 t2))
    ;(prin1 (list t1 t2 n) (current-buffer))
    (list t1 t2 n)
)))

(defun fold (f x li)
  "Recursively evaluate (F X i), where i is the ith element in the list LI.\n
For example, “(fold f x '(1 2))” is equivalent to “(f (f x 1) 2)”"
  (let ((li2 li) (ele) (x2 x))
    (while (setq ele (pop li2))
      (setq x2 (funcall f x2 ele))
      )
    x2
    )
  )

(defun replace-in-string-pairs (str pairs)
"Replace string STR repeatedy by the list pairs.\n
Example:
\(replace-string-pairs \"lambda and Infinity\" 
  (list (\"lambda\" \"λ\") (\"Infinity\" \"∞\") ) )

 ⇒  \"λ or ∞\".

The replacement is done sequentially after each find/replace pair.
Earlier replaced value may be replaced again.
The replacement are literal and case sensitive.
"
(fold (lambda (x y) ""
        (replace-regexp-in-string
         (nth 0 y) (nth 1 y) x t t) ) str pairs) )

(defun replace-string-pairs-region1 (start end mylist)
  "Replace string pairs in region.
Example syntax:
 (replace-string-pairs-region START END '((\"alpha\" \"α\") (\"beta\" \"β\")))
The search string and replace string are all literal and case sensitive.
"
  (save-restriction 
    (narrow-to-region start end)
    (mapc
      (lambda (arg)
        (goto-char (point-min)) 
        (while (search-forward (car arg) nil t) (replace-match (cadr arg) t t) )) 
      mylist)))

(defun replace-string-pairs-region2 (start end mylist)
  "Replace string pairs in region.
Example syntax:
 (replace-string-pairs-region START END '((\"alpha\" \"α\") (\"beta\" \"β\")))
The search string and replace string are all literal and case sensitive.
"
  (let (mystr)
    (setq mystr (buffer-substring start end))
    (mapc
     (lambda (x) (setq mystr (replace-regexp-in-string (car x) (cadr x) mystr t t))) 
     mylist)
    (delete-region start end)
    (insert mystr)
    )
)

(defun replace-string-pairs-region3 (start end mylist)
  "Replace string pairs in region.
Example syntax:
 (replace-string-pairs-region START END '((\"alpha\" \"α\") (\"beta\" \"β\")))
The search string and replace string are all literal and case sensitive.
"
  (let (mystr)
    (setq mystr (buffer-substring start end))

    (setq mystr
          (with-temp-buffer
            (insert mystr)
            (mapc
             (lambda (arg)
               (goto-char (point-min))
               (while (search-forward (car arg) nil t) (replace-match (cadr arg) t t) )) 
             mylist)
            (buffer-string)
            ))
    (delete-region start end)
    (insert mystr)))

(defun replace-mma-symbols-region (start end)
  "Replace Mathematica's special char encoding to unicode of the same semantics.
For example:
\[Infinity] ⇒ ∞
\[Equal] ⇒ ==
"
  (interactive "r")
  (replace-string-pairs-region3 start end
                                '(
                                  ("\\[Infinity]" "∞")
                                  ("\\[Equal]" "==")
                                  )
                                )
  )


(defun space2underscore-region (start end)
  "Replace space by underscore in region."
  (interactive "r")
(replace-string-pairs-region3 start end '(
(" " "_")
    )
  )
)

(defun underscore2space-region (start end)
  "Replace underscore by space in region."
  (interactive "r")
(replace-string-pairs-region3 start end '(
("_" " ")
    )
  )
)

(defun replace-underscore-space-toggle ()
  "Replace underscore/space in the current region or line.
If the current line contains more “_” char than space,
then replace them to space, else replace space to _.
If region is active, work on region instead."
  (interactive)
  (let (li bds)
    (setq bds
          (if (and transient-mark-mode mark-active)
              (cons (region-beginning) (region-end))
            (bounds-of-thing-at-point 'line)
            ))
    (setq li (buffer-substring-no-properties (car bds) (cdr bds)))
    (if (> (count 32 li) (count 95 li))
        (progn (replace-string " " "_" nil (car bds) (cdr bds)))
      (progn (replace-string "_" " " nil (car bds) (cdr bds)))
      )))

(defun replace-greek-region (start end)
  "Replace math symbols. e.g. alpha to α."
  (interactive "r")
(replace-string-pairs-region3 start end '(
("alpha" "α")
("beta" "β")
("gamma" "γ")
("theta" "θ")
("lambda" "λ")
("delta" "δ")
("epsilon" "ε")
("omega" "ω")
("Pi" "π")
    )
  )
)

(defun replace-html-chars-region (start end)
  "Replace < to &lt; and other similar HTML chars that needs to be encoded."
  (interactive "r")
(replace-string-pairs-region3 start end '(
("&" "&amp;")
("<" "&lt;")
(">" "&gt;")
    )
  )
)


(defun replace-straight-quotes-region (p1 p2)
  "Replace straight double quotes to curly ones
Also replace “--” by “—”."
  (interactive "r")
  (let (quoteReplaceMap)
    ;; a map that helps converting straight quotes to double quotes in texts (e.g. novels). Note: order is important since this is huristic.
    (setq quoteReplaceMap
          '(
            (">\"" ">“")
            ("(\"" "(“")
            (" \"" " “")
            ("\" " "” ")
            ("\"," "”,")
            ("\"." "”.")
            ("\"?" "”?")
            ("\";" "”;")
            ("\":" "”:")
            ("\")" "”)")
            ("\"]" "”]")
            (".\"" ".”")
            (",\"" ",”")
            ("!\"" "!”")
            ("?\"" "?”")
            ;; ";
            ("\n\"" "\n“")
            (">\'" ">‘")
            (" \'" " ‘")
            ("\' " "’ ")
            ("\'," "’,")
            (".\'" ".’")
            ("!\'" "!’")
            ("?\'" "?’")
            ("(\'" "(‘")
            ("\')" "’)")
            ("\']" "’]")
            )
          )

    (replace-string-pairs-region3 p1 p2 quoteReplaceMap)
    (replace-string-pairs-region3 p1 p2 '(("--" " — ") ("  —  " " — ")))
    )
  )

(defun escape-quotes-region (start end)
  (interactive "r")
  "Replace \" by \\\"."
  (replace-string-pairs-region3 start end '(("\"" "\\\"")))
)

(defun replace-curly-apostrophe-region (start end)
  "Replace some single curly quotes ‘ or ’ to '."
  (interactive "r")
(replace-string-pairs-region3 start end '(
("‘tis" "'tis")
("’s" "'s")
("’d" "'d")
("n’t" "n't")
("’ve" "'ve")
("’ll" "'ll")
("’m" "'m")
("’re" "'re")
("s’ " "s' ")
    )
  )
)

;;;--------------------------------------------------
(defun replace-tex-region (start end)
  "Replace some math function names or symbols by their LaTeX markup."
  (interactive "r")
(replace-string-pairs-region3 start end '(
("*" "\\ ")
("cos(" "\\cos(")
("sin(" "\\sin(")
("tan(" "\\tan(")
(" pi" "\\!\\pi")
("R^2" "\\mathbb{R}^2")
("R^3" "\\mathbb{R}^3")
    )
  )
)

(defun mathematica-to-lsl-region (start end)
  "Change Mathematica syntax to LSL syntax on region.

LSL is Linden Scripting Language.
This command does simple string replacement only."
  (interactive "r")
(replace-string-pairs-region3 start end '(
("Cos[" "llCos(")
("Sin[" "llSin(")
("Tan[" "llTan(")
("Pi" "PI")
("π" "PI")

("{" "<")
("}" ">")
    )
  )
)

;;;--------------------------------------------------

(defun replace-eols-to-p (start end)
  "Replaces “\n\n” by “</p>\n\n<p>” in region.
As a first step of changing ascii paragraphs into html markuped paragraphs."
  (interactive "r")
  (save-restriction 
    (narrow-to-region start end)
    (goto-char (point-min))
    (while (search-forward "\n\n" nil t) (replace-match "</p>\n\n<p>" nil t))
    )
  )

(defun clean-mgs-buffer ()
  "Reduce size of a mgs file by removing whitespace and truncating numbers.
This function does several find and replace on the current buffer.
Removing spaces, removing new lines, truncate numbers to 3 decimals, etc.
The goal of these replacement is to reduce the file size of a Mathematica Graphics file (.mgs) that are read over the net by JavaView."
  (interactive)
    (goto-char (point-min))
    (while (search-forward "\n" nil t) (replace-match "" nil t))
    (goto-char (point-min))
    (while (search-forward-regexp "  +" nil t) (replace-match " " nil t))
    (goto-char (point-min))
    (while (search-forward ", " nil t) (replace-match "," nil t))
    (goto-char (point-min))
    (while (search-forward-regexp "\\([0-9]\\)\\.\\([0-9][0-9][0-9]\\)[0-9]+" nil t) (replace-match "\\1.\\2" t nil))
)