;-*- coding: utf-8 -*-
; part of Xah Lee's emacs init file.
; 2007-06
; Xah Lee,
; ∑ http://xahlee.org/



; some functions personal to working on XahLee.org's website
; many of these opens a particular file and insert a string

(defun yellowMe ()
  "temp function. change background color of current frame to light yellow.."
  (interactive)
  (set-background-color "cornsilk")
  )

(defun list-matching-lines2 ()
  "Show lines in the current buffer matching current word or text selection. 
This command is the similar to `list-matching-lines'.
The differences are:
• The input of this command is the current word.
• If there is a text selection, that is used as input.
• The input is plain text, not regex."
  (interactive)
  (let (meat pos1 pos2 bds)
    (if (and transient-mark-mode
             mark-active)
        (setq pos1 (region-beginning) pos2 (region-end))
      (progn
        (setq bds (bounds-of-thing-at-point 'symbol))
        (setq pos1 (car bds) pos2 (cdr bds))))
    (setq meat (buffer-substring-no-properties pos1 pos2))
    (list-matching-lines (regexp-quote meat))
    )
  )

(defun delete-secondlife-cache ()
  "Delete Second Life's cache directory."
  (interactive)
  (shell-command "rm -R c:/Users/xah/AppData/Local/SecondLife/ &")
 )

(defun create-atom-id-tag (&optional domainName)
  "Returns a string for ATOM webfeed's <id> tag's value.
Example of return value:
tag:xahlee.org,2010-03-31:022128

If DOMAINNAME is given, use that for the domain name.
Else, use “xahlee.org”."
  (interactive)
  (let (returnStr domain)
    (if domainName
        (setq domain domainName)
      (setq domain "xahlee.org")
      )
    (setq returnStr
          (concat (format-time-string
                   (concat "tag:" domain ",%Y-%m-%d:%H%M%S") (current-time) 1)
                  )
          )
    returnStr
    )
  )


(defun insert-atom-entry (&optional link-url)
  "Insert a blank Atom webfeed entry template,
 in the current buffer's cursor position.

If LINK-URL is given, it is used in the link tag, e.g.
  <link rel=\"alternate\" href=\"http://xahlee.org/emacs/blog.html\"/>
otherwise the alt link used is:
  <link rel=\"alternate\" href=\"http://xahlee.org/Periodic_dosage_dir/pd.html\"/>"
  (interactive)
(let (textToInsert domainName)

  (setq domainName 
        (if link-url
            (cond 
             ((string-match "xahporn.org" currentFileDir) "xahporn.org")
             ((string-match "xahlee.org" currentFileDir) "xahlee.org")
             "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbad"
             )
          "xahlee.org"
          )
        )

(setq textToInsert
(concat " <entry>\n   <title>ttt</title>\n   <id>"
           (create-atom-id-tag domainName)
           "</id>\n   <updated>"
           (concat
            (format-time-string "%Y-%m-%dT%T")
            ((lambda (x)
               (concat (substring x 0 3) ":"
                       (substring x 3 5))) (format-time-string "%z")))
           "</updated>
   <summary>ttt</summary>
   <content type=\"xhtml\">
<div xmlns=\"http://www.w3.org/1999/xhtml\">
</div>
   </content>
  <link rel=\"alternate\" href=\"" 
  (if link-url
    link-url
"http://xahlee.org/Periodic_dosage_dir/pd.html"
)
  "\"/>
 </entry>\n\n")
)
(insert textToInsert)

)
  )



(defun update-blog-date (fpath)
  "Update the Atom RSS updated tag in a Atom file at FPATH.

That is, the first occurance of: <updated>2006-10-10T22:58:42-07:00</updated>"
  (interactive)
  (find-file fpath)
  (goto-char 1)
  (let (x1)
    (setq x1 (re-search-forward "<updated>" nil t))
    (delete-region x1 (+ x1 25))
    (insert-date-time)))

(defun xah-make-atom-entry (begin end)
  "Create a Atom (RSS) entry of the current blog file,
using selected text as content,
and update the Atom file's overall updated” tag.

Note: this command is customized for xah lee's file
structures. Much of things are implicit.

If the current file is
~/web/xahlee_org/emacs/blog.html
Then the blog will be blog.xml

other files paths for blogs are:
~/web/xahlee_org/Periodic_dosage_dir/pd.html
~/web/xahlee_org/arts/blog.html
~/web/xahlee_org/blender/blog.html
~/web/xahlee_org/comp/blog.html
~/web/xahlee_org/emacs/blog.html
~/web/xahlee_org/js/blog.html
~/web/xahlee_org/math/blog.html
~/web/xahlee_org/piano/blog.html
~/web/xahlee_org/sex/blog.html
~/web/xahlee_org/sl/blog.html

the Atom files names will be same as blog file name but with
suffix “.xml”."
  (interactive "r")
  (let (meat currentFileDir currentFileName blogFileName blogFilePath altUrl)

    (setq meat (buffer-substring-no-properties begin end))
    (setq currentFileName (file-name-nondirectory (buffer-file-name)))
    (setq currentFileDir (file-name-directory (buffer-file-name))) ; ends in slash
    (setq blogFileName (concat (file-name-sans-extension (file-name-nondirectory currentFileName)) ".xml"))
    (setq blogFilePath (concat currentFileDir blogFileName))
    (setq altUrl (concat
                  (cond 
                   ((string-match "xahporn_org/" currentFileDir) "http://xahporn.org/")
                   ((string-match "xahlee_org/" currentFileDir) "http://xahlee.org/")
                   "fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffucked"
                   )

                  (cond 
                   ((string-match "arts/$" currentFileDir) "arts/blog.html")
                   ((string-match "blender/$" currentFileDir) "blender/blog.html")
                   ((string-match "comp/$" currentFileDir) "comp/blog.html")
                   ((string-match "emacs/$" currentFileDir) "emacs/blog.html")
                   ((string-match "js/$" currentFileDir) "js/blog.html")
                   ((string-match "math/$" currentFileDir) "math/blog.html")
                   ((string-match "piano/$" currentFileDir) "piano/blog.html")
                   ((string-match "sex/$" currentFileDir) "sex/blog.html")
                   ((string-match "sl/$" currentFileDir) "sl/blog.html")
                   ((string-match "xahporn_org/porn/$" currentFileDir) "porn/blog.html")
                   ((string-match "Periodic_dosage_dir/$" currentFileDir) "Periodic_dosage_dir/pd.html")
                   ) 
                  ))

    (find-file blogFilePath)
    (goto-char (point-min))
    (re-search-forward "<entry>" nil t)
    (move-beginning-of-line 1)
    (insert-atom-entry altUrl)
    (re-search-backward "<div xmlns=\"http://www.w3.org/1999/xhtml\">" nil t)
    (re-search-forward ">" nil t)
    (insert "\n" meat)
    (update-blog-date blogFilePath)
    (find-file blogFilePath)
    (goto-char (point-min))
    (re-search-forward ">ttt" nil t)
)
)

(defun make-word-entry ()
  "Insert a blank a-word-a-day html template in a paritcular file."
  (interactive)
  (find-file "~/web/xahlee_org/PageTwo_dir/Vocabulary_dir/new.html")
  (goto-char (point-min))
  (re-search-forward "<!--t-->\n" nil t)
  (insert-word-entry)
  (re-search-backward "\"ex\">" nil t)
  (re-search-forward ">ttt" nil t))

(defun insert-word-entry ()
  "Insert a blank a-word-a-day html template."
  (interactive)
  (insert (concat "<div class=\"date\">" (format-time-string "%Y-%m-%d")
"</div>
<div class=\"ent\">
<p class=\"wd\">ttt</p>
<div class=\"ex\">
<div class=\"bdy\">ttt</div>
<div class=\"src\">ttt</div>
</div>\n</div>\n\n"))
  (re-search-backward "\"ex\">" nil t)
  (re-search-forward ">ttt" nil t))

(defun make-definition-entry ()
  "Insert a word definition entry template.
Using current word or current text selection."
  (interactive)
  (require 'dictionary)
  (let (meat)
    (setq meat
          (if (and transient-mark-mode mark-active)
              (buffer-substring-no-properties (region-beginning) (region-end))
            (let ((bdr (get-english-word-boundary) ))
              (buffer-substring-no-properties (car bdr) (cdr bdr)))))
    (search-forward "\n\n" nil t)
    (search-backward "</div>")
    (insert "<div class=\"def\"></div>\n")
    (search-backward "</div>")
    (insert meat)
    (insert " = ")
    (lookup-word-def meat)
    ;; (dictionary-new-search (cons meat dictionary-default-dictionary))
    ))

(defun xah-search-next-unbold ()
  "search the next word block that isn't bolded.
Used for the files in
~/web/PageTwo_dir/Vocabulary_dir/
."
  (interactive)

  (let ( wd egText p1 p2 p3 p4 notBolded-p)
    ;; grab the word
    (search-forward "<p class=\"wd\">")
    (setq p1 (point))
    (search-forward "</p>")
    (backward-char 4)
    (setq p2 (point))
    (setq wd (buffer-substring-no-properties p1 p2))

    ;; grab the example text
    (search-forward "<div class=\"bdy\">")
    (setq p3 (point))
    (search-forward "</div>")
    (backward-char 6)
    (setq p4 (point))
    (setq egText (buffer-substring-no-properties p3 p4))

    ;; check if word is bolded in example text
    (setq notBolded-p (not (string-match (concat ">" wd) egText)) )
;;     (setq notBolded-p (string-match ">harrowing" egText) )

    (if notBolded-p
        (progn (goto-char p3)
               (search-forward wd p4))
      (xah-search-next-unbold)
      ;; (when (y-or-n-p "Do you want to bold it?")
      ;;         (goto-char p3)
      ;;         (search-forward wd p4)
      ;;         (search-backward wd p3)
      ;;         (insert "<span class=\"w\">")
      ;;         (search-forward wd p4)
      ;;         (insert "</span>")
      ;;         )
      )))


(defun make-lojban-entry ()
  "Insert a blank a-lojban-a-day html template in a paritcular file."
  (interactive)
(find-file "~/web/lojban/valsi_dikni/valsi_dikni.html")
(goto-char (point-min))
(re-search-forward "<!--t-->\n" nil t)
(insert (concat
"<div class=\"date\">"
(format-time-string "%Y-%m-%d")
"</div>
<p><b>renro</b> = throw = 丢 diu1</p>
<div class=\"def\">
renro:=x1 throws/launches/casts/hurls x2 to/at/in direction x3 (propulsion derives internally to x1)
</div>
<div class=\"ex\">
mi renro (le bolci ku) do = i throw ball to you = 我 丢 球qiu2 给gei3 你
</div>
<p>bolci = ball = 球. 给 = give.</p>
<pre class=\"linsi\">
• <a href=\"http://en.wiktionary.org/wiki/丢\">http://en.wiktionary.org/wiki/丢</a>
• <a href=\"http://en.wiktionary.org/wiki/给\">http://en.wiktionary.org/wiki/给</a>
</pre>
"))
(re-search-backward "<p><b>" nil t)
(re-search-forward "<p><b>" nil t))

(defun make-wiki-entry ()
  "Open pd.html, and at the right place, paste (a Wikipedia link), and save."
  (interactive)
(find-file "~/web/Periodic_dosage_dir/pd.html")
(goto-char (point-min))
(re-search-forward "wikime\n" nil t)
(yank)
(insert "\n")
(save-buffer))

(defun xah-find-file-at-point ()
 "Open the file path under cursor.

If there's no current text selection, this command uses current
word as input. If there is a text selection, it uses the text
selection for path. (convenient if the file path contains space)

This is similar to `find-file-at-point' but
customized for Xah Lee.
URL that starts with
“file:///xahdomain/” or “http://xahdomain/”
will also changed to local path.
The following path all works:

/Users/xah/web/xahlee_org/emacs/emacs.html
c:/Users/xah/web/xahlee_org/emacs/emacs.html
~/web/xahlee_org/emacs/emacs.html
file:///C:/Users/xah/web/xahlee_org/emacs/emacs.html
http://xahlee.org/emacs/emacs.html"
 (interactive)
 (let (ff)
   (if (and transient-mark-mode mark-active)
       (progn 
         (setq ff (buffer-substring-no-properties (region-beginning) (region-end) ) )
         )
     (setq ff (thing-at-point 'filename)))

   (setq ff (xahlee-site-url-to-fpath ff))
   (setq ff (local-url-to-file-path ff))
;; ;    (setq ff (windows-style-path-to-unix ff))

   ;; change /cygdrive/c/Users/xah/ to just ~/
   (setq ff (replace-regexp-in-string "/cygdrive/c/Users/xah/" "~/" ff))

   ;; make some path starting with “/” to be “~/web/xahlee_org”
   (when (and
          (string-equal "/" (substring ff 0 1))
          (not (string-equal "/Deskto" (substring ff 0 7)))
          (not (string-equal "/Developer" (substring ff 0 10)))
          (not (string-equal "/Library" (substring ff 0 8)))
          (not (string-equal "/Network" (substring ff 0 8)))
          (not (string-equal "/System" (substring ff 0 7)))
          (not (string-equal "/TheVol" (substring ff 0 7)))
          (not (string-equal "/Volumes" (substring ff 0 8)))
          (not (string-equal "/bin" (substring ff 0 4)))
          (not (string-equal "/cores" (substring ff 0 6)))
          (not (string-equal "/dev" (substring ff 0 4)))
          (not (string-equal "/opt" (substring ff 0 4)))
          (not (string-equal "/private" (substring ff 0 8)))
          (not (string-equal "/sbin" (substring ff 0 5)))
          (not (string-equal "/sw" (substring ff 0 3)))
          (not (string-equal "/usr" (substring ff 0 4)))
          (not (string-equal "/var" (substring ff 0 4)))
          (not (string-equal "/Users/" (substring ff 0 7))))
     (setq ff (concat "~/web/xahlee_org/" ff)))

    (if (not (file-exists-p ff))
        (if (file-exists-p (concat ff ".el"))
            (find-file-at-point (concat ff ".el"))
            (find-file-at-point ff)
            )
      (find-file-at-point ff)
      )
))

(defun xah-browse-url-at-point ()
"Switch to web browser and load the URL at point.
This code is designed to work on Mac OS X only.

If the cursor is on a url, visit it
http://mathforum.org/library/topics/conic_g/
for certain domain, use particular browser.

If the cursor is on like one of the following
 /somedir/somefile.html or
~/web/somedir/somefile.html
use FireFox to visit it as local file (construct the proper url)."
 (interactive)
 (let (posOrig pos1 pos2 myurl)

   (setq myurl
         (if (and transient-mark-mode mark-active)
             (buffer-substring-no-properties (region-beginning) (region-end))
           (progn ;; not using thing-at-point because the thing i need to grab may be symbol, url, file. The thing-at-point will actually transform the thing grabbed. e.g. if the thing is url, it'll add http prefix or such.
             (setq posOrig (point))
             (skip-chars-backward "^\n\t\" ")
             (setq pos1 (point))
             (skip-chars-forward "^\n\t\" ")
             (setq pos2 (point))
             (goto-char posOrig)
             (buffer-substring-no-properties pos1 pos2))))

   (setq myurl (replace-regexp-in-string "&amp;" "&" myurl))

   ;; on Mac, map specific links to particular browser
   ;; (cond
   ;;  ((string-match "flickr.com/" myurl) (shell-command (concat "open -a safari " "\"" myurl "\"")))
   ;;  ((string-match "blogspot.com/" myurl) (shell-command (concat "open -a safari " "\"" myurl "\"")))
   ;;  ((string-match "livejournal.com/" myurl) (shell-command (concat "open -a safari " "\"" myurl "\"")))
   ;;  ((string-match "yahoo.com/" myurl) (shell-command (concat "open -a safari " "\"" myurl "\"")))
   ;;  (t (browse-url myurl)))

   (browse-url myurl)
   ))

(defun xah-find-word-usage (myword)
  "Grep a dir for a word's usage."
  (interactive "sWord to search: ")
  (require 'grep)
  (grep-compute-defaults)
  (rgrep myword "*html" "~/web/p")
;; ~/web/p
;; ~/web/flatland/
;; ~/web/Periodic_dosage_dir/_p2/russell-lecture.html
;; ~/web/Periodic_dosage_dir/_p2/why_not_christian.html
)


(defun xah-web-path-to-url (webpath)
  "Turn a web path WEBPATH to url.
For example, the following webpath:
 C:/Users/xah/web/emacs/emacs.html
or
 /Users/xah/web/emacs/emacs.html
will become:
 http://xahlee.org/emacs/emacs.html"
  (let ((ff webpath))
    (setq ff (replace-regexp-in-string "^C:" "" ff))
    (setq ff (replace-regexp-in-string "^/Users/xah/web/xahlee_org/" "http://xahlee.org/" ff))
    ff
    )
  )

(defun xah-cite ()
"Change the file path under cursor into title and path.

For example, this line
 /Users/xah/web/xahlee_org/emacs/emacs.html
becomes
• Xah's Emacs Tutorial
  http://xahlee.org/emacs/emacs.html

The title came from HTML file's title tag.
File path must be a url scheme, full path, or relative path.

Example url schemes among browsers and OSes

 C:\\Users\\xah\\web\\xahlee_org\\emacs\\emacs.html ; ie
 file:///C:/Users/xah/web/xahlee_org/emacs/emacs.html ; firefox
 file:///C:/Users/xah/web/xahlee_org/emacs/emacs.html ; google chrom
 file:///C:/Users/xah/web/xahlee_org/emacs/emacs.html ; safari
 file://localhost/C:/Users/xah/web/xahlee_org/emacs/emacs.html ; opera
 file:///Users/xah/web/xahlee_org/emacs/emacs.html ; safari
 file:///Users/xah/web/xahlee_org/emacs/emacs.html ; firefox
 file://localhost/Users/xah/web/xahlee_org/emacs/emacs.html ; opera

Example full path variations
 c:/Users/xah/web/xahlee_org/emacs/emacs.html
 /Users/xah/web/xahlee_org/emacs/emacs.html

This is Xah Lee's personal command assuming a particular dir structure."
  (interactive)
  (let (bds ff title)
    (setq bds (bounds-of-thing-at-point 'filename))
    (setq ff
          (buffer-substring-no-properties
           (car bds)
           (cdr bds)))

    ;; change file path to full path
    (setq ff (replace-regexp-in-string "^http://www\\." "http://" ff))
    (setq ff 
          (cond
           ((string-equal system-type "windows-nt") ; Windows
            (replace-regexp-in-string "^http://xahlee\\.org/" "c:/Users/xah/web/xahlee_org/" ff)
            )
           ((string-equal system-type "darwin") ; Mac
            (replace-regexp-in-string "^http://xahlee\\.org/" "/Users/xah/web/xahlee_org/" ff)
            )
           )
          )

    (setq ff (local-url-to-file-path ff))
    (setq ff (expand-file-name ff ))

    (setq title
          (if (string-match ".+html\\'" ff)
              (get-html-file-title ff)
            (file-name-nondirectory ff)))
    (delete-region (car bds)
                   (cdr bds))
    (insert "• " title "\n")
    (insert (concat "  " (xah-web-path-to-url ff)) )
    ))

(defun xah-insert-dstp ()
  "Insert the file creation date in this format:
“<div class=\"dstp\">2008-12</div>”
at cursor position.

This command requires the GetFileInfo command line util in OS X."
  (interactive)
  (let (cmdStr resultStr mydate)
    (setq cmdStr (concat "GetFileInfo -d " (buffer-file-name)))
    (setq resultStr (shell-command-to-string cmdStr))
    (setq mydate (replace-regexp-in-string "\\([0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9][0-9][0-9]\\) .+\n" "\\3-\\1" resultStr))
    (insert "<div class=\"dstp\">" mydate "</div>")))

(defun xah-put-dstp ()
  "Insert a file creation date like
“<div class=\"dstp\">2008-12.</div>”
in the appropriate footer location of the current XahLee.org html file.

This command requires the GetFileInfo command line util in OS X."
  (interactive)
  (let (cmdStr resultStr mydate)
    (setq cmdStr (concat "GetFileInfo -d " (buffer-file-name)))
    (setq resultStr (shell-command-to-string cmdStr))
    (setq mydate (replace-regexp-in-string "\\([0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9][0-9][0-9]\\) .+\n" "\\3-\\1" resultStr))
    (goto-char (point-max))
    (search-backward "<div class=\"cpr\">")
    (insert "<div class=\"dstp\">" mydate "</div>\n")))

(defun xah-fix-dstp (fpath)
  "Insert a file creation date like
“<div class=\"dstp\">2008-12.</div>”
to file at FPATH."
(let (mybuffer)
    (setq mybuffer (find-file fpath))

    (xah-put-dstp)

;;     (goto-char (point-max))
;;     (search-backward "<div class=\"cpr\">")
;;     (insert "<div class=\"dstp\">1997</div>\n")

;;    (save-buffer)
;;    (kill-buffer mybuffer)
))


(defun to-unix-eol (fpath)
  "Change file's line ending to unix convention."
  (let (mybuffer)
    (setq mybuffer (find-file fpath))
    (set-buffer-file-coding-system 'unix) ; or 'mac or 'dos
    (save-buffer)
    (kill-buffer mybuffer)))

(defun dired-2unix-marked-files ()
  "Change to unix line ending for marked (or next arg) files."
  (interactive)
  (mapcar 'to-unix-eol (dired-get-marked-files)))

(defun make-blogger-entry ()
  "Make a blogger entry.

Copy the current buffer.
create a new buffer. Make it html-mode.
paste it in.
remove the header and footer.
fix all relative links to http://xahlee.org/ links.
add a “perm url with updates ‹link›” sentence at top.

This new content is ready to be posted to blogger."
  (interactive)
  (let (meattext thisFilePath currentDir newbuf link)

    (setq meattext
          (if (and transient-mark-mode mark-active)
              (buffer-substring-no-properties (region-beginning)
                                              (region-end))
            (save-excursion
              (widen)     
              (buffer-string)
              )
            ))

    (setq thisFilePath (buffer-file-name))
    (setq currentDir (file-name-directory thisFilePath))

    (setq newbuf (generate-new-buffer "*blogger temp*"))
    (switch-to-buffer newbuf)
    (html-mode)

    (insert meattext)

    ;; remove header
    (beginning-of-buffer)
    (when (search-forward "<div class=\"nav\">Back to" nil t)
      (search-forward "</div>")
      (delete-region (point) (point-min) )
      )

    ;; remove footer
    (when (progn (end-of-buffer) (search-backward "<div class=\"ftr\">" nil t))
      (delete-region (point) (point-max) )
      )
    
    ;; change href links from relative to http://xahlee.org/ url
    (goto-char 1)
    (while (search-forward "href=\"" nil t)
      (when (not (looking-at "http"))
        (let (bds link fPath)
          (setq bds (bounds-of-thing-at-point 'filename))
          (setq link (buffer-substring-no-properties (car bds) (cdr bds)))
          (setq fPath (expand-file-name (concat currentDir link)) )
          (delete-region (car bds) (cdr bds))
          (insert (xah-web-path-to-url fPath))
          ) ))

    ;; fix inline image links from relative to http://xahlee.org/ url
    (goto-char 1)
    (while (search-forward "src=\"" nil t) 
      (when (not (looking-at "http"))
        (let (bds link fPath)
          (setq bds (bounds-of-thing-at-point 'filename))
          (setq link (buffer-substring-no-properties (car bds) (cdr bds)))
          (setq fPath (expand-file-name (concat currentDir link)) )
          (delete-region (car bds) (cdr bds))
          (insert (xah-web-path-to-url fPath))
          ) ) )

    ;; (compute-url-from-relative-link thisFilePath)

    ;; insert perm link at top
    (goto-char 1)
    (setq link (xah-web-path-to-url thisFilePath))
    (insert "<p>Perm url with updates: " "<a href=\"" link "\">" link "</a>" "</p>")

    ))