;-*- coding: utf-8 -*-
; Xah Lee's emacs customization related to google earth, and also a Geogebra function that work similarly.
; 2007-10
; Xah Lee
; ∑ http://xahlee.org/
;-----------------------------------
(defun grab-lines (n)
"Delete the next n lines and return a list
where each element is a line."
(interactive)
(move-beginning-of-line 1)
(let (t1 t2 cl (lines '()))
(dotimes (x n)
(progn
(setq t1 (point))
(move-end-of-line nil)
(setq t2 (point))
(setq cl (buffer-substring-no-properties t1 t2))
(delete-region t1 t2)
(delete-char 1)
(push cl lines)
)
)
(setq lines (reverse lines))
; (prin1 lines (current-buffer))
))
(defun insert-google-map-link (&optional title latlon)
"Insert HTML link to Google Map.
Takes 2 optional parameters: title and latlon.
Here's a outline of inserted text:
"
(interactive)
(let (title2 latlon2)
(if title
(progn (setq title2 title) (setq latlon2 latlon))
(progn (setq title2 "ttt") (setq latlon2 "ttt")))
(insert "\n")))
(defun insert-google-earth-link (&optional title file-path)
"Insert a HTML markup for link to local Goole Earth file.
It takes a title and file-path option.
Here's a sample inserted text:
⊕
Note: older version inserts this text:
"
(interactive)
(let (title2 file-path2)
(if title
(progn (setq title2 title) (setq file-path2 file-path))
(progn (setq title2 "ttt") (setq file-path2 "ttt")))
(insert "⊕\n")))
(defun insert-kml (&optional title latti longi sourceFilePath)
"Insert a simple Google Earth KML markup template."
(interactive)
(let (title2 latti2 longi2)
(if title
(progn
(setq title2 title)
(setq latti2 latti)
(setq longi2 longi))
(progn
(setq title2 "ttt")
(setq latti2 "ttt")
(setq longi2 "ttt")))
(insert "
" title2 "
Good for a visit.
This file is from: http://xahlee.org/" sourceFilePath "
" longi2 "," latti2 "
" longi2 "
" latti2 "
0
10000
0
0
\n")))
(defun make-google-earth ()
"Create a Google Earth file, and insert a link to it.\n
The cursor must be on 2 lines separated by empty lines.
The lines are:
‹Name›
‹latitude›,‹longitude›
For Example:
Altamount Pass Wind Farm
37.7497,-121.6832
make-google-earth will create the kml file and with proper html link
to it in the current file.
The kml file will be created in this dir: “/Users/xah/web/kml/”
The title will be used to make the file name, so it shouldn't
contain chars like slash or other weird ones."
(interactive)
(search-backward "\n\n")
(search-forward "\n\n")
(let (title latlon kmlFilePath sl vl latti longi sourceFilePath doit-p kmlDirRoot)
(setq kmlDirRoot "~/web/kml/")
(setq sl '(title latlon))
(setq vl (grab-lines 2))
(while sl (set (pop sl) (pop vl) ) )
(setq sl '(latti longi))
(setq vl (split-string latlon ","))
(while sl (set (pop sl) (pop vl) ) )
(setq sourceFilePath buffer-file-name)
(setq kmlFilePath (concat (file-relative-name kmlDirRoot )
(replace-regexp-in-string " " "_" title) ".kml"))
(setq doit-p t)
(when (file-exists-p kmlFilePath)
(setq doit-p nil)
(setq doit-p (y-or-n-p (format "File exist at %s\nDo you want to replace it?" kmlFilePath)))
)
(when doit-p
(progn
; (insert-google-map-link title latlon)
(insert-google-earth-link title kmlFilePath)
(find-file kmlFilePath)
(erase-buffer)
(insert-kml title latti longi sourceFilePath)
(search-backward "") (forward-char 14)
(nxml-mode)
(save-buffer)))
))
;;;;-----------------------------------------
(defun insert-ggb-link (fileCoreName fileTitle)
"Insert HTML link to GeoGebra (“.ggb”) file."
(interactive)
(insert "" fileTitle ""))
(defun make-ggb ()
"Create a Geogebra file set and link.
This function will take 2 lines the cursor is on as input,
create a Geogebra file (.ggb),
create a HTML file that embed the ggb applet,
and insert a link to the html file in the current buffer.
The cursor must be on 2 lines separated by empty lines.
The lines are:
fileCoreName
fileTitle
For Example:
ellipse_trace
Ellisp Tracing
make-ggb will then create the files at:
~/web/SpecialPlaneCurves_dir/ggb/ellipse_trace.html
~/web/SpecialPlaneCurves_dir/ggb/ellipse_trace.ggb
and the html file's tag content will be “Ellisp Tracing”.
The ggb file is copied from a template file at
~/web/SpecialPlaneCurves_dir/ggb/x-template.ggb
The html file is copied from a template file at
~/web/SpecialPlaneCurves_dir/ggb/x-template.html
Finally, the 2 input lines will be replaced by this link:
Ellisp Tracing
"
(interactive)
(let (fileCoreName fileTitle sl vl ggbFileName htmlFileName dirPath linkBackRelativePath linkBackTitle)
(search-backward "\n\n")
(search-forward "\n\n")
(setq sl '(fileCoreName fileTitle)) ;; sl = symbol list; vl = value list
(setq vl (grab-lines 2))
(while sl (set (pop sl) (pop vl)))
;; returns this "../Ellipse_dir/ellipse.html"
(setq linkBackRelativePath (concat ".." (substring (buffer-file-name) 37)))
(setq linkBackTitle (get-html-file-title (buffer-file-name)))
(setq dirPath "~/web/SpecialPlaneCurves_dir/ggb/")
(setq ggbFileName (concat dirPath fileCoreName ".ggb"))
(setq htmlFileName (concat dirPath fileCoreName ".html"))
(insert-ggb-link fileCoreName fileTitle)
(insert "\n")
(copy-file (concat dirPath "x-template.ggb") ggbFileName)
(copy-file (concat dirPath "x-template.html") htmlFileName)
(let (mybuff (case-replace nil) (case-fold-search nil))
(setq mybuff (find-file htmlFileName))
(goto-char (point-min))
(while (search-forward "「fileTitle」" nil t) (replace-match fileTitle nil t))
(goto-char (point-min))
(while (search-forward "「fileCoreName」" nil t) (replace-match fileCoreName nil t))
(goto-char (point-min))
(while (search-forward "「linkBackRelativePath」" nil t) (replace-match linkBackRelativePath nil t))
(goto-char (point-min))
(while (search-forward "「linkBackTitle」" nil t) (replace-match linkBackTitle nil t))
(save-buffer)
(kill-buffer mybuff)
)
(shell-command (concat "open " ggbFileName))
))
(defun get-html-file-title (fname)
"Return FNAME tag's text.
Assumes that the file contains the string
“...”."
(let (x1 x2 linkText)
(with-temp-buffer
(goto-char (point-min))
(insert-file-contents fname nil nil nil t)
(setq x1 (search-forward ""))
(search-forward "")
(setq x2 (search-backward "<"))
(buffer-substring-no-properties x1 x2)
)
))