;; -*- coding: utf-8 -*-
;; some custome string functions for working with HTML
;; 2007-06
;;   Xah Lee
;; ∑ http://xahlee.org/

(defun forward-html-end-tag ()
  "Move cursor to the next html tag's content."
  (interactive)
  (forward-char 1)
  (search-forward "</")
  (backward-char 2)
  )

(defun backward-html-end-tag ()
  "Move cursor to the previous html tag's content."
  (interactive)
  (search-backward "</")
  ;; (forward-char-char 2)
  )


;; § ----------------------------------------
(defun compact-css-region (p1 p2)
  "Remove unnecessary whitespaces of CSS source code in region.
CSS is Cascading Style Sheet.
WARNING: not robust. Designed for my personal use only."
  (interactive "r")
  (let ()
    (save-restriction
      (narrow-to-region p1 p2)
      (replace-regexp-pairs-region (point-min) (point-max) '(["  +" " "]))
      (replace-pairs-region (point-min) (point-max)
'(
  ["\n" ""]
  [" /* " "/*"]
  [" */ " "*/"]
  [" {" "{"]
  ["{ " "{"]
  ["; " ";"]
  [": " ":"]

  [";}" "}"]
  ["}" "}\n"]
 )) ) ) )


;; § ----------------------------------------

(defun insert-tag ()
  "Insert a HTML tag based on the current line.

If current line is empty, then insert “<p></p>”.
If current line is a single word, use that word as tag name.
If current line has 2 words, use first word as tag name,
second word as value for attribute “class”.

For example,

pre poem

will become

<pre class=\"poem\"></pre>."
  (interactive)
  (let (bds p1 p2 myline goodies tagname classVal insStr)

    (setq bds (get-selection-or-unit 'line))
    (setq myline (elt bds 0) )
    (setq p1 (elt bds 1) )
    (setq p2 (elt bds 2) )

    (setq goodies (split-string myline " +" t))

    (cond
     ((equal (length goodies) 1) (progn (setq tagname "div") (setq classVal (nth 0 goodies))))
     ((equal (length goodies) 2) (progn (setq tagname (nth 0 goodies)) (setq classVal (nth 1 goodies)))))
    (delete-region p1 p2)

    (cond
     ((equal (length goodies) 0) (insert "<p>\n</p>") )
     ((and t) (insert (concat "<" tagname " class=\"" classVal "\">\n</" tagname ">")))
)
    (search-backward "<")
    (backward-char 1)
))


;; § ----------------------------------------

(defun insert-div-x-note ()
  "Insert a HTML markup."
  (interactive)
  (insert "<div class=\"x-note\"></div>\n")
  (backward-char 7)
  )


(defun xah-annotate ()
  "Create a annotation in HTML.
Wrap HTML “span” tag around current word or text selection, then
insert a div tag above the current paragraph."
  (interactive)
  (let (bds inputText)

    (setq bds (get-selection-or-unit 'word))
    (setq inputText (elt bds 0) )

    (wrap-html-tag "span" "xnt")
    (search-backward "<p")
    (insert "\n")
    (backward-char 1)
    (insert-div-x-note)
    (insert inputText " ⇒ ")
    )
  )

;; (defun wrap-span (class-name)
;;   "Insert “<span class=\"CLASS-NAME\">” and “</span>”
;; around current word or text selection."
;;   (interactive "sClass code: ")
;;   (let (bds p1 p2)

;;     (setq bds (get-selection-or-unit 'word))
;;     (setq p1 (elt bds 1) )
;;     (setq p2 (elt bds 2) )

;;     (goto-char p2)
;;     (insert "</span>")
;;     (goto-char p1)
;;     (insert (concat "<span class=\"" class-name "\">"))
;;     )
;;   )

(defun wrap-html-tag (tagName &optional className ξid)
  "Add a HTML tag to beginning and ending of current word or text selection.

If tagName is empty or nil, use “span”.
If className is empty or nil, don't add any class attribute.
If ξid is empty or nil, don't add id attribute."
  (interactive "sEnter tag name:
sEnter class:")
  (let (bds p1 p2 inputText outputText)
    (setq bds (get-selection-or-unit 'word))
    (setq inputText (elt bds 0) )
    (setq p1 (elt bds 1) )
    (setq p2 (elt bds 2) )

    (setq
     outputText
     (concat
      "<"
      (if (or (equal tagName nil) (string= tagName "")) "span" tagName)
      (if (or (equal ξid nil) (string= ξid "")) "" (concat " id=\"" ξid "\""))
      (if (or (equal className nil) (string-equal className "")) "" (concat " class=\"" className "\""))
      ">"
      inputText
      "</"
      (if (or (equal tagName nil) (string= tagName "")) "span" tagName)
      ">" ) )

    (delete-region p1 p2)
    (goto-char p1)
    (insert outputText) ) )

(defun mark-unicode (p1)
  "Wrap 「<b class=\"u\"></span>」 around current character.

When called in elisp program, wrap the tag at point P1."
  (interactive (list (point)))
    (goto-char p1)
    (insert "<b class=\"u\">")
    (forward-char 1)
    (insert "</b>"))


;; § ----------------------------------------

(defun add-paragraph-tag ()
  "Add <p>…</p> tag to current paragraph or text selection."
  (interactive)
  (let (bds p1 p2 inputText)

    (setq bds (get-selection-or-unit 'block))
    (setq inputText (elt bds 0) )
    (setq p1 (elt bds 1) )
    (setq p2 (elt bds 2) )

    (delete-region p1 p2 )
    (insert "<p>" (replace-regexp-in-string "\n\n+" "</p>\n\n<p>" (trim-string inputText)) "</p>")
    )
)

(defun make-citation ()
  "Reformat current text block or selection into a canonical citation format.

For example, place cursor somewhere in the following block:

Circus Maximalist
By PAUL GRAY
Monday, Sep. 12, 1994
http://www.time.com/time/magazine/article/0,9171,981408,00.html

After execution, the lines will become

<cite>Circus Maximalist</cite> (1994-09-12) By Paul Gray. @ <a href=\"http://www.time.com/time/magazine/article/0,9171,981408,00.html\">Source www.time.com</a>

If there's a text selection, use it for input, otherwise the input is a text block between empty lines."
  (interactive)
  (let (bds p1 p2 inputText myList ξtitle ξauthor ξdate ξurl )

    (setq bds (get-selection-or-unit 'block))
    (setq inputText (elt bds 0) )
    (setq p1 (elt bds 1) )
    (setq p2 (elt bds 2) )

    (setq inputText (replace-regexp-in-string "^[[:space:]]*" "" inputText)) ; remove white space in front

    (setq myList (split-string inputText "[[:space:]]*\n[[:space:]]*" t) )

    (setq ξtitle (trim-string (elt myList 0)))
    (setq ξauthor (trim-string (elt myList 1)))
    (setq ξdate (trim-string (elt myList 2)))
    (setq ξurl (trim-string (elt myList 3)))

    (setq ξauthor (replace-regexp-in-string "\\. " " " ξauthor)) ; remove period in Initals
    (setq ξauthor (replace-regexp-in-string "By +" "" ξauthor))
    (setq ξauthor (upcase-initials (downcase ξauthor)))
    (setq ξdate (fix-timestamp ξdate))

    (setq ξurl (with-temp-buffer (insert ξurl) (source-linkify) (buffer-string)))

    (delete-region p1 p2 )
    (insert (concat "<cite>" ξtitle "</cite>") " " "<time>" ξdate "</time>"  " By " ξauthor ". @ " ξurl)
    ))

(defun htmlize-keyboard-shortcut-notation ()
  "Wrap a “kbd” tag around keyboard keys on current text inside 【】, or text selection.
e.g.
 【ctrl+w】
becomes
 【<kbd>Ctrl</kbd>+<kbd>w</kbd>】
Same for Alt, Shift, Cmd, Win, Enter, Return, Home… and other strings."
  (interactive)

  (let (p1 p2 inputStr resultStr replaceList)
    (if (region-active-p)
        (progn
          (setq p1 (region-beginning))
          (setq p2 (region-end))
          )
      (save-excursion
        (progn
          (if (search-backward "【" nil t)
              (progn (forward-char)
                     (setq p1 (point) ) )
            (setq p1 (line-beginning-position) )
            )

          (if (search-forward "】" nil t)
              (progn (backward-char)
                     (setq p2 (point) ))
            (setq p2 (line-end-position) ) ) )) )
    (setq inputStr (buffer-substring-no-properties p1 p2))

(setq replaceList [

 ["Ctrl" "<kbd>Ctrl</kbd>"]
 ["Alt" "<kbd>Alt</kbd>"]
 ["Shift" "<kbd>Shift</kbd>"]
 ["Cmd" "<kbd>⌘ Cmd</kbd>"]
 ["Option" "<kbd>⌥ Opt</kbd>"]
 ["Opt" "<kbd>⌥ Opt</kbd>"]
 ["Win" "<kbd>Win</kbd>"]
 ["App" "<kbd>App</kbd>"]
 ["Meta" "<kbd>Meta</kbd>"]

 ["Return" "<kbd>Return</kbd>"]
 ["Enter" "<kbd>Enter</kbd>"]
 ["Backspace" "<kbd>⌫ Backspace</kbd>"]
 ["Del" "<kbd>⌦ Delete</kbd>"]
 ["Space" "<kbd>Space</kbd>"]
 ["Caps Lock" "<kbd>Caps Lock</kbd>"]
 ["Tab" "<kbd>Tab</kbd>"]
 ["Esc" "<kbd>Esc</kbd>"]

 ["F10" "<kbd>F10</kbd>"]
 ["F11" "<kbd>F11</kbd>"]
 ["F12" "<kbd>F12</kbd>"]
 ["F1" "<kbd>F1</kbd>"]
 ["F2" "<kbd>F2</kbd>"]
 ["F3" "<kbd>F3</kbd>"]
 ["F4" "<kbd>F4</kbd>"]
 ["F5" "<kbd>F5</kbd>"]
 ["F6" "<kbd>F6</kbd>"]
 ["F7" "<kbd>F7</kbd>"]
 ["F8" "<kbd>F8</kbd>"]
 ["F9" "<kbd>F9</kbd>"]
 ["Fn" "<kbd>Fn</kbd>"]

 ["←" "<kbd>←</kbd>"]
 ["→" "<kbd>→</kbd>"]
 ["↑" "<kbd>↑</kbd>"]
 ["↓" "<kbd>↓</kbd>"]
 ["Home" "<kbd>Home</kbd>"]
 ["End" "<kbd>End</kbd>"]
 ["PageUp" "<kbd>PageUp</kbd>"]
 ["PageDown" "<kbd>PageDown</kbd>"]
 ["delete" "<kbd>Delete</kbd>"]
 ["del" "<kbd>Delete</kbd>"]

 ["pgdn" "<kbd>PageDown</kbd>"]
 ["pgup" "<kbd>PageUp</kbd>"]

 ["‹key›" "<kbd>‹key›</kbd>"]
])

(let ((case-fold-search t) (case-replace nil)
 )
(setq resultStr (replace-pairs-in-string inputStr replaceList))
  )

(setq resultStr (replace-regexp-pairs-in-string resultStr [
["\+\\([^<]\\) \\(.\\) \\(.\\)\\'" "+<kbd>\\1</kbd> <kbd>\\2</kbd> <kbd>\\3</kbd>"]
["\+\\([^<]\\) \\([A-Za-z]\\)\\'" "+<kbd>\\1</kbd> <kbd>\\2</kbd>"]
["\+\\([^<]\\)" "+<kbd>\\1</kbd>"]
]))

(delete-region p1 p2)
(insert resultStr)
    )

;; test cases
;; 【Ctrl+x a】
;; 【Ctrl+x a b】
;; 【Ctrl+x Ctrl+j】
  )

(defun emacs-to-windows-kbd-notation (p1 p2)
  "Change emacs keyboard-shortcut notation to Windows's notation.

When called interactively, work on text enclosed in 【…】, or text selection.

For example:
 「【C-h f】」⇒ 「【Ctrl+h f】」
 「【M-a】」⇒ 「【Meta+a】」

This command is just for convenient, not 100% correct translation.

Partly because the Windows key notation isn't exactly standardized. e.g. up arrow key may be ↑ or UpArrow.
"
  (interactive
   (let ((bds (get-selection-or-unit ["^【" "^】"])) )
     (list (elt bds 1) (elt bds 2)) ) )

  (let (  (case-fold-search nil))
    (replace-pairs-region p1 p2
                          '(
                            ["C-" "Ctrl+"]
                            ["M-" "Meta+"]
                            ["S-" "Shift+"]

                            ["s-" "Super+"]
                            ["H-" "Hyper+"]

                            ["<prior>" "PageUp"]
                            ["<next>" "PageDown"]
                            ["<home>" "Home"]
                            ["<end>" "End"]

                            ["RET" "Enter"]
                            ["<return>" "Enter"]
                            ["TAB" "Tab"]
                            ["<tab>" "Tab"]

                            ["<right>" "→"]
                            ["<left>" "←"]
                            ["<up>" "↑"]
                            ["<down>" "↓"]

                            ["<insert>" "Insert"]
                            ["<delete>" "Delete"]

                            ["<backspace>" "Backspace"]
                            ["DEL" "Delete"]
                            ))
    )
  )

(defun xah-update-page-tag-old (p1 p2)
  "Update html page navigation tags.

The input is a text selection.
Each line should a file name
Update each file's page navigation tag.

Each file name is a file path without dir, and relative to current dir.
Sample text selection for input:
“combowords.html
combowords-2.html
combowords-3.html
combowords-4.html”"
  (interactive "r")
  (let (filez pageNavStr (i 1))
    (setq filez
          (split-string (buffer-substring-no-properties p1 p2) "\n" t)
          )

    (delete-region p1 p2)

    ;; generate the page nav string
    (setq pageNavStr "<div class=\"pgs\">")

    (while (<= i (length filez))
      (setq pageNavStr
            (concat pageNavStr
                    "<a href=\""
                    (nth (- i 1) filez)
                    "\">"
                    (number-to-string i)
                    "</a>, ")
            )
      (setq i (1+ i))
      )

    (setq pageNavStr (substring pageNavStr 0 -2) ) ; remove the last ", "
    (setq pageNavStr (concat pageNavStr "</div>"))

    ;; open each file, insert the page nav string, remove link in the
    ;; nav string that's the current page
    (mapc
     (lambda (thisFile)
       (message "%s" thisFile)
       (find-file thisFile)
       (goto-char (point-min))
       (search-forward "<div class=\"pgs\">")
       (beginning-of-line)
       (kill-line 1)
       (insert pageNavStr "\n")
       (search-backward (file-name-nondirectory buffer-file-name))

       (require 'sgml-mode)
       (sgml-delete-tag 1)
;;        (save-buffer)
;;        (kill-buffer)
       )
     filez)
))

(defun xah-update-page-tag ()
  "Update html page navigation tags.

The input is a block or text selection.
Each line should a file name
Update each file's page navigation tag.

Each file name is a file path without dir, and relative to current dir.
Sample text selection for input:

combowords.html
combowords-2.html
combowords-3.html
combowords-4.html
"
  (interactive)
  (require 'sgml-mode)
  (let (bds p1 p2 inputStr fileList pageNavStr )
    (setq bds (get-selection-or-unit 'block))
    (setq inputStr (elt bds 0) p1 (elt bds 1) p2 (elt bds 2)  )
    (setq fileList (split-string (buffer-substring-no-properties p1 p2) "\n" t) )

    (delete-region p1 p2)

    ;; generate the page nav string
    (setq pageNavStr "<div id=\"pnavbar\">\n")
    (let (linkPath fTitle (ξi 0) )
      (while (< ξi (length fileList))
        (setq linkPath (elt fileList ξi) )
        (setq fTitle (get-html-file-title linkPath) )
        (setq pageNavStr (concat pageNavStr "<a href=\"" linkPath "\" title=\"" fTitle "\">" (number-to-string (1+ ξi)) "</a>\n") )
        (setq ξi (1+ ξi))
        )
      )
    (setq pageNavStr (concat pageNavStr "</div>"))

    ;; open each file, insert the page nav string
    (mapc
     (lambda (thisFile)
       (message "%s" thisFile)
       (find-file thisFile)
       (goto-char (point-min))

       (if (search-forward "<div id=\"pnavbar\">" nil t)
           (let (p3 p4 )
             (backward-char 18)
             (setq p3 (point))
             (sgml-skip-tag-forward 1)
             (setq p4 (point))
             (delete-region p3 p4)
             (insert pageNavStr)
             )
         (progn
           (search-forward "<script><!--
amazon_ad_tag")
           (progn
             (backward-char 26)
             (insert pageNavStr "\n\n")
             ) ) )

       )
     fileList)
     ))

(defun extract-url (p1 p2)
  "Print all URLs in from a HTML text in region P1 P2.

When called interactively, use text selection as input, or
current text block between empty lines.

Output in a buffer named 「*extract URL output*」.

This function assumes the input is HTML text.  WARNING: this
function extract all text of the form 「href=\"…\"」 only. It
does not extract {「href='…'」, 「src='…'」} or consider whether
that's plain text or proper tag."
  (interactive
   (let ((bds (get-selection-or-unit 'block)))
     (list (elt bds 1) (elt bds 2) ) ) )
  (let (p3 p4 urlStr)
    (with-output-to-temp-buffer "*extract URL output*"
      (save-excursion
        (save-restriction
          (narrow-to-region p1 p2)
          (goto-char (point-min))
          (while
              (re-search-forward "href" nil t)
            (search-forward "=" nil t)
            (search-forward "\"" nil t)
            (setq p3 (point))
            (search-forward "\"" nil t)
            (setq p4 (- (point) 1))
            (setq urlStr (buffer-substring-no-properties p3 p4))
            (princ urlStr)
            (terpri) ) ) ) ) ))