;-*- coding: utf-8 -*-
; some general command definitions
; general in the sense they can be useful for anyone

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun copy-all ()
  "Put the whole buffer content into the kill-ring.
If narrow-to-region is in effect, then just copy that region."
  (interactive)
  (kill-ring-save (point-min) (point-max))
  (message "Buffer content copied")
  )

(defun cut-all ()
  "Cut the whole buffer content into the kill-ring.
If narrow-to-region is in effect, then just copy that region."
  (interactive)
  (kill-region (point-min) (point-max))
  (message "Buffer content cut")
  )

;; (defun goto-point-min ()
;;   "Goto the beginning of buffer.
;; This is different from beginning-of-buffer
;; because that marks the previous position."
;;   (interactive)
;;   (goto-char (point-min))
;; )

;; (defun goto-point-max ()
;;   "Goto the end of buffer.
;; This is different from end-of-buffer
;; because that marks the previous position."
;;   (interactive)
;;   (goto-char (point-max))
;; )

;-----------
;; (defun my-delete-word (arg)
;;   "Delete characters forward until encountering the end of a word.
;; With argument, do this that many times.
;; This command does not push erased text to kill-ring."
;;   (interactive "p")
;;   (delete-region (point) (progn (forward-word arg) (point))))

;; (defun my-backward-delete-word (arg)
;;   "Delete characters backward until encountering the beginning of a word.
;; With argument, do this that many times.
;; This command does not push erased text to kill-ring."
;;   (interactive "p")
;;   (my-delete-word (- arg)))

;; (defun my-delete-line ()
;;   "Delete text from current position to end of line char."
;;   (interactive)
;;   (delete-region
;;    (point)
;;    (save-excursion (move-end-of-line 1) (point)))
;;   (delete-char 1)
;; )

(defun forward-block ()
  "Move cursor forward to first occurrence of double newline char."
  (interactive)
  (search-forward "\n\n")
  )

(defun backward-block ()
  "Move cursor backward to first occurrence of double newline chars."
  (interactive)
  (search-backward "\n\n")
  )

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

(defun toggle-line-spacing ()
"Toggle line spacing between 1 and 5 pixels."
(interactive)
(if (eq line-spacing 1)
    (setq-default line-spacing 5)
  (setq-default line-spacing 1))
)

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

(defun lookup-word-def (&optional arg)
  "Look up the word's definition in WordNet, Webster 1913, Moby Thesaurus. 
If there is a text selection (a phrase), lookup that phrase.
This command needs “dictionary.el” installed."
  (interactive)
  (require 'dictionary)
  (let (myurl meat navigText pos)
    (setq myword
          (if arg
              arg
            (if (and transient-mark-mode mark-active)
                (buffer-substring-no-properties (region-beginning) (region-end))
              (thing-at-point 'symbol))
            )
          )
   (setq myword (replace-regexp-in-string "á\\|à\\|â\\|ä" "a" myword))
   (setq myword (replace-regexp-in-string "é\\|è\\|ê\\|ë" "e" myword))
   (setq myword (replace-regexp-in-string "í\\|ì\\|î\\|ï" "i" myword))
   (setq myword (replace-regexp-in-string "ó\\|ò\\|ô\\|ö" "o" myword))
   (setq myword (replace-regexp-in-string "ú\\|ù\\|û\\|ü" "u" myword))

   (setq meat "")
   ;; (dictionary-do-search "fancy" "web1913" 'dictionary-display-search-result)

;   (dictionary-do-search myword "wn" 'dictionary-display-search-result t)
   (dictionary-new-search (cons myword "wn"))
   (setq meat (concat meat (buffer-substring (point-min) (point-max))))

;   (dictionary-do-search myword "web1913" 'dictionary-display-search-result t)
   (dictionary-new-search (cons myword "web1913"))
   (setq meat (concat meat (buffer-substring (point-min) (point-max))))

;   (dictionary-do-search myword "moby-thes" 'dictionary-display-search-result t)
   (dictionary-new-search (cons myword "moby-thes"))
   (setq meat (concat meat (buffer-substring (point-min) (point-max))))

   (switch-to-buffer "*my dict results*")
   (erase-buffer)
   (dictionary-mode)
   (insert meat)
   (goto-char 1) (next-line 2)
   (setq pos (point))

   (setq navigText (buffer-substring 1 pos))

   (goto-char 1)
   ;; remove navigation text
   (while 
       (search-forward
        "[Back] [Search Definition]         [Matching words]        [Quit]
       [Select Dictionary]         [Select Match Strategy]
" nil t
        )
     (replace-match "-----------------------------------------------------------------" t t))

   ;; remove message about how many def found. e.g. “1 definition found”.
   (goto-char 1)
   (while 
       (search-forward-regexp "[0-9]+ definitions* found\n\n" nil t)
     (replace-match "" t t))

   (goto-char (point-max))
   (insert navigText)
   (goto-char 1)
   (other-window 1)
   ))

(defun lookup-word-definition ()
  "Look up the current word's definition in a browser.
If a region is active (a phrase), lookup that phrase."
 (interactive)
 (let (myword myurl)
   (setq myword
         (if (and transient-mark-mode mark-active)
             (buffer-substring-no-properties (region-beginning) (region-end))
           (thing-at-point 'symbol)))

  (setq myword (replace-regexp-in-string " " "%20" myword))
  (setq myurl (concat "http://www.answers.com/main/ntquery?s=" myword))
  (w3m-browse-url myurl)
  ;; (browse-url myurl)
  ;; (shell-command (concat "open -a opera " myurl))

  ;; alternative ref site url
  ;; http://en.wiktionary.org/wiki/
  ;; http://dictionary.reference.com/browse/
   ))

(defun lookup-google ()
  "Look up the current word or region in google in browser.
Removes all html span tags first, and transform those & > < chars."
 (interactive)
 (let (myphrase myurl)
   (setq myphrase
         (if (and transient-mark-mode mark-active)
             (buffer-substring-no-properties (region-beginning) (region-end))
           (thing-at-point 'symbol)))
   
   (setq myphrase
         (with-temp-buffer
           (insert myphrase)
            
           (goto-char (point-min))
           (while (search-forward-regexp "<span class=\"[^\"]+\">" nil t) (replace-match ""))

           (goto-char (point-min))
           (while (search-forward "</span>" nil t) (replace-match ""))

           (goto-char (point-min))
           (while (search-forward "&amp;" nil t) (replace-match "&"))

           (goto-char (point-min))
           (while (search-forward "&lt;" nil t) (replace-match "<"))

           (goto-char (point-min))
           (while (search-forward "&gt;" nil t) (replace-match ">"))

           (goto-char (point-min))
           (while (search-forward " " nil t) (replace-match "%20"))

           (buffer-string)
           ))

  (setq myurl (concat "http://www.google.com/search?q=%22" myphrase "%22"))
  (w3m-browse-url myurl)
  (browse-url myurl)
  ))

(defun lookup-wikipedia ()
  "Look up the word's in Wikipedia.
If there is a text selection (a phrase), lookup that phrase.
This command generates a url for Wikipedia.com and switches you
to browser."
 (interactive)
 (let (myword myurl)
   (setq myword
         (if (and transient-mark-mode mark-active)
             (buffer-substring-no-properties (region-beginning) (region-end))
           (thing-at-point 'symbol)))

  (setq myword (replace-regexp-in-string " " "_" myword))
  (setq myurl (concat "http://en.wikipedia.org/wiki/" myword))
  (browse-url myurl)
   ))

(defun lookup-php-ref ()
  "Look up current word in PHP ref site in a browser.
If a there is a text selection (a phrase), lookup that phrase."
  (interactive)
  (let (myword myurl)
    (setq myword
          (if (and transient-mark-mode mark-active)
              (buffer-substring-no-properties (region-beginning) (region-end))
            (thing-at-point 'symbol)))
    (setq myurl
          (concat "http://us.php.net/" myword))
    (browse-url myurl)))

(defun run-current-file ()
  "Execute or compile the current file.
For example, if the current buffer is the file x.pl,
then it'll call “perl x.pl” in a shell.
The file can be php, perl, python, bash, java, POV-Ray.
File suffix is used to determine what program to run."
(interactive)
  (let (ext-map fname suffix progName cmdStr)
; get the file name
; get the program name
; run it
    (setq ext-map ; a keyed list of file suffix to comand-line program to run
          '(
            ("php" . "php")
            ("pl" . "perl")
            ("py" . "python")
            ("rb" . "ruby")
            ("js" . "js")
            ("sh" . "bash")
            ("lsl" . "lslint")
            ("java" . "javac")
;            ("pov" . "/usr/local/bin/povray +R2 +A0.1 +J1.2 +Am2 +Q9 +H480 +W640")
            )
          )
    (setq fname (buffer-file-name))
    (setq suffix (file-name-extension fname))
    (setq progName (cdr (assoc suffix ext-map)))
    (setq cmdStr (concat progName " \""   fname "\""))

    (if (string-equal suffix "el")
        (load-file fname)
      (progn
        (message "Running...")
        (shell-command cmdStr)))
;;    ;; if file is povray, open the generated image; refresh from disk
;;    (when (equal suffix "pov")
;;      (let ((revert-without-query (list "\\.png$")))
;;        (find-file-other-window
;;         (concat (file-name-sans-extension fname) ".png"))
;;        (redraw-display)
;;        ;; (revert-buffer t t)
;;        )
;;
;;;;       (let ((povImgFile (concat (file-name-sans-extension fname) ".png")))
;;;;         (find-file povImgFile)
;;;;         (redraw-display)
;;;;         ;; (revert-buffer t t)
;;;;         )
;;)
))

(defun run-current-java-file ()
  "Execute the current file's class with Java.
For example, if the current buffer is the file x.java,
then it'll call “java x” in a shell."
(interactive)
  (let (fnm prog-name cmd-str)
    (setq fnm (file-name-sans-extension (file-name-nondirectory (buffer-file-name))))
    (setq prog-name "java")
    (setq cmd-str (concat prog-name " " fnm " &"))
    (shell-command cmd-str))
)

(defun make-backup ()
  "Make a backup copy of current buffer as ~ file.
Creates a copy of the current file with name “file~”.
Overwrites existing backup."
  (interactive)
  (let (cfile bfilename)
    (setq cfile (buffer-file-name))
    (setq bfilename (concat cfile "~"))
    (copy-file cfile bfilename t) ;; override existing
    (message "backup done.")
    )
  )

; the following 2 about dired are for opening all marked files. They are pulled from dired-x.
(defun dired-do-find-marked-files (&optional noselect)
  "Find all marked files displaying all of them simultaneously.
With optional NOSELECT just find files but do not select them.

The current window is split across all files marked, as evenly as possible.
Remaining lines go to bottom-most window.  The number of files that can be
displayed this way is restricted by the height of the current window and
`window-min-height'.

To keep dired buffer displayed, type \\[split-window-vertically] first.
To display just marked files, type \\[delete-other-windows] first."
  (interactive "P")
  (dired-simultaneous-find-file (dired-get-marked-files) noselect))

(defun dired-simultaneous-find-file (file-list noselect)
  "Visit all files in FILE-LIST and display them simultaneously.
The current window is split across all files in FILE-LIST, as evenly as
possible.  Remaining lines go to the bottom-most window.  The number of
files that can be displayed this way is restricted by the height of the
current window and the variable `window-min-height'.  With non-nil
NOSELECT the files are merely found but not selected."

  ;; We don't make this function interactive because it is usually too clumsy
  ;; to specify FILE-LIST interactively unless via dired.

  (let (size)

    (if noselect
        ;; Do not select the buffer.
        (find-file-noselect (car file-list))

      ;; We will have to select the buffer.  Calculate and check window size.
      (setq size (/ (window-height) (length file-list)))
      (or (<= window-min-height size)
          (error "Too many files to visit simultaneously.  Try C-u prefix"))
      (find-file (car file-list)))

    ;; Decrement.
    (setq file-list (cdr file-list))

    (while file-list

      (if noselect
          ;; Do not select the buffer.
          (find-file-noselect (car file-list))

        ;; Vertically split off a window of desired size.  Upper window will
        ;; have SIZE lines.  Select lower (larger) window.  We split it again.
        (select-window (split-window nil size))
        (find-file (car file-list)))

      ;; Decrement.
      (setq file-list (cdr file-list)))))

(defun count-region (beginning end)
  "Print number of words and chars that are in selected text."
  (interactive "r")
  (message "Counting ...")
  (save-excursion
    (let (wcount charCount)
      (setq wcount 0)
      (setq charCount (- end beginning))
      (goto-char beginning)
      (while (and (< (point) end)
                  (re-search-forward "\\w+\\W*" end t))
        (setq wcount (1+ wcount)))

      (message "Words: %d. Chars: %d." wcount charCount)
      )))

(defvar hexcolor-keywords
  '(("#[abcdef[:digit:]]\\{6\\}"
     (0 (put-text-property
         (match-beginning 0)
         (match-end 0)
         'face (list :background
                     (match-string-no-properties 0)))))))
(defun hexcolor-add-to-font-lock ()
  (interactive)
  (font-lock-add-keywords nil hexcolor-keywords))
(add-hook 'css-mode-hook 'hexcolor-add-to-font-lock)

(defun insert-column-counter (n)
  "Insert a sequence of integers vertically.
For example, if your text is:

a b
c d
e f

and your cursor is after “a”, then calling this function with argument
3 will change it to become:

a1 b
c2 d
e3 f

If there are not enough existing lines after the cursor
when this function is called, it aborts at the last line.

See also: `kill-rectangle' and `string-rectangle'."
  (interactive "nEnter the max integer: ")
  (let ((i 1) colpos)
    (setq colpos (- (point) (point-at-bol)))
    (while (<= i n)
      (insert (number-to-string i))
      (next-line) (beginning-of-line) (forward-char colpos)
      (setq i (1+ i))
      )))

(defun beep-for-n-min (n)
  "Beep 1 beep per sec for n min"
  (dotimes (i (* 60 n)) (progn (beep) (sleep-for 1)))
)

(defun set-alarm-after-n-min (n)
  "Set alarm beep after 5 min."
  (interactive "nHow many minutes from now: ")
  (run-with-timer
   (* 60 n) nil
   'beep-for-n-min 5
   ))

(defun xah-erase-buffer ()
  "Delete the entire contents of the current buffer.\n
Same as erase-buffer, but also works if the buffer is image (image-mode)."
  (interactive)
  (when (equal major-mode 'image-mode)
    (text-mode))
  (erase-buffer))

(defun fix-timestamp-string (timestr)
  "Returns yyyy-mm-dd format of timestr.

For example: “Nov. 28, 1994” ⇒ “1994-11-28”.

The result only contains year, month, date.
Any century, “day of week”, or time info are discarded."
  (let (li year month date yyyy mm dd)
    (setq timestr (replace-regexp-in-string "January " "Jan. " timestr))
    (setq timestr (replace-regexp-in-string "February " "Feb. " timestr))
    (setq timestr (replace-regexp-in-string "March " "Mar. " timestr))
    (setq timestr (replace-regexp-in-string "April " "Apr. " timestr))
    (setq timestr (replace-regexp-in-string "May " "May. " timestr))
    (setq timestr (replace-regexp-in-string "June " "Jun. " timestr))
    (setq timestr (replace-regexp-in-string "July " "Jul. " timestr))
    (setq timestr (replace-regexp-in-string "August " "Aug. " timestr))
    (setq timestr (replace-regexp-in-string "September " "Sep. " timestr))
    (setq timestr (replace-regexp-in-string "October " "Oct. " timestr))
    (setq timestr (replace-regexp-in-string "November " "Nov. " timestr))
    (setq timestr (replace-regexp-in-string "December " "Dec. " timestr))

    (setq li (parse-time-string timestr))
    (setq year (nth 5 li))
    (setq month (nth 4 li))
    (setq date (nth 3 li))

    (setq yyyy (number-to-string year))

    (setq mm
          (if (< month 10)
              (concat "0" (number-to-string month))
            (number-to-string month)))

    (setq dd
          (if (< date 10)
              (concat "0" (number-to-string date))
            (number-to-string date)))

    (concat yyyy "-" mm "-" dd)))

(defun fix-timestamp-region (start end)
  "Change the highlighted timestamp into a yyyy-mm-dd format.
Note: This function works on the region,
and the region must contain just the time stamp,
all other text are discarded.

See `fix-timestamp-string' for detail."
  (interactive "r")
  (let (timestr)
    (setq timestr (buffer-substring start end))
    (delete-region start end)
    (insert (fix-timestamp-string timestr)) ))

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

(defun html-previous-content ()
  "Move cursor to the previous html tag's content."
  (interactive)
  (search-backward-regexp ">\\([^§]+?\\)</")
  (forward-char 1)
  )

(defun copy-file-path ()
  "Copy the current buffer's file path to kill-ring."
  (interactive)
  (kill-new (buffer-file-name))
  (message "File path copied.")
)

(defadvice elisp-index-search (before interactive-default activate)
  "Provide the symbol at point as the default when reading TOPIC interactively."
   (interactive
    (let ((symbol-at-point (thing-at-point 'symbol)))
      (list (read-string (if symbol-at-point
                             (format "Topic (%s): " symbol-at-point)
                           (format "Topic: "))
                         nil nil symbol-at-point)))))


(defun compact-parens ()
  "Removing white spaces in ending parenthesises.
Removes white space from cursor point to end of code block (\n\n).
Or, act on a text selection.
Warning: This command does not preserve texts inside double quotes."
  (interactive)
  (let (meat meatNew p1 p2)
    (setq myword
          (if (and transient-mark-mode mark-active)
              (progn (setq p1 (region-beginning) ) (setq p2 (region-end) ))
            (save-excursion
              (setq p1 (point) )
              (search-forward-regexp "\n\n" nil t)
              (setq p2 (- (point) 2))
              )))

    (setq meat (buffer-substring-no-properties p1 p2))

    (setq meatNew
          (with-temp-buffer
            (insert meat)
            (goto-char (point-min))
            (while (search-forward-regexp "[ \t\n]+)[ \t\n]+" nil t) (replace-match " )" t t))
            (buffer-string)
            ))

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

;; (defun show-file-in-dired-old ()
;;   "Show the current file in dired."
;;   (interactive)
;;   (let ()
;;     (dired buffer-file-name)
;;     )
;;   )

(defun show-file-in-dired ()
  "Show the current file in dired."
  (interactive)
  (let (fname dname)
    (setq fname buffer-file-name)
    (setq dname (file-name-directory fname) )
    (dired dname)
    (search-forward (file-name-nondirectory fname))
    )
  )