;;==============================================================================
;;; functions-extra
;;
;;; Emacs Extra Functions
;;
;;; Author: Kyle W T Sherman
;;
;; Time-stamp: <2008-07-31 11:51:58 (kyle)>
;;==============================================================================

(message ";;; functions-extra --> Start")

;; execute buffer
;; TODO: need to test
(message ";;; functions-extra --> execute-buffer")
(defun execute-buffer ()
  "Execute or compile current file."
  (interactive)
  (let* ((file-name (shell-quote-argument (buffer-file-name)))
         (file-type (shell-command (concat "file " file-name)))
         (type-map '(("Lisp" . "clisp")
                     ("bash" . "bash")
                     ("perl" . "perl")
                     ("python" . "python")
                     ("java" . "javac")
                     ("php" . "php")
                     (" c " . "gcc")))
         cmd)
    (kill-buffer "*Shell Command Output*")
    (delete-other-windows)
    (do ((type type-map (cdr type)))
        ((or (not type) cmd))
      (when (search (car type) file-type)
        (setq cmd (cdr type))))
    (shell-command (concat cmd " " file-name))
    ))

;; file in exec path
(message ";;; functions-extra --> file-in-exec-path")
(defun file-in-exec-path (name)
  "Return non-nil if NAME is a file found in `exec-path'."
  (catch 'found
    (dolist (dir exec-path)
      (when (file-exists-p (concat (file-name-as-directory dir) name))
        (throw 'found t)))
    nil))

;; ;; resolve file link
;; ;; TODO: does not work with ido
;; (message ";;; functions-extra --> resolve-file-link")
;; (defun resolve-file-link ()
;;   "Replace the file name at point with the true path."
;;   (interactive)
;;   (beginning-of-line)
;;   (let* ((file (buffer-substring (point)
;;                                  (save-excursion (end-of-line) (point))))
;;          (file-dir (file-name-directory file))
;;          (file-true-dir (file-truename file-dir))
;;          (file-name (file-name-nondirectory file)))
;;     (delete-region (point) (save-excursion (end-of-line) (point)))
;;     (insert (concat file-true-dir file-name))))
;; (define-key minibuffer-local-completion-map "\C-r" 'resolve-file-link)

;; unicode shell
(defun unicode-shell ()
  "Execute the shell buffer in UTF-8 encoding.
\nNote that you need to set the environment variable LANG and
others appropriately."
  (interactive)
  (let ((coding-system-for-read 'utf-8)
        (coding-system-for-write 'utf-8)
        (coding-system-require-warning t))
    (call-interactively 'shell)))

;;------------------------------------------------------------------------------
;; Custom Grep Searches
;;------------------------------------------------------------------------------

;; grep custom elisp files
(message ";;; functions-extra --> grep-elisp")
(defun grep-elisp (&optional query)
  "Grep custom elisp directories for QUERY.

Run `grep' COMMAND, where COMMAND is:

  `grep-default-command' QUERY FILES

FILES is a list of files generated from the following
files/directories:

  ~/.emacs
  ~/.emacs.d
  ~/.elisp/NAME

NAME is `user-login-name'.

A file matching pattern of `*.el$' is used."
  (interactive)
  (unless query
    (setq query (read-from-minibuffer "Grep custom elisp files: ")))
  (let ((paths (nreverse `("~/.emacs" "~/.emacs.d" ,(concat "~/.elisp/" user-login-name))))
        path
        files)
    ;; loop through paths
    (while paths
      (setq path (expand-file-name (car paths)))
      (setq paths (cdr paths))
      ;; traverse directories
      (if (file-directory-p path)
          ;; loop through files
          (dolist (file (nreverse (directory-files path t)))
            ;; ignore `.'
            (unless (string-match "^\\." (file-name-nondirectory file))
              ;; add directories to paths
              (if (file-directory-p file)
                  (push file paths)
                ;; add elisp file
                (when (string-match "\\.el$" file)
                  (push file files)))))
        ;; add file
        (push path files)))
    ;; build command
    (let ((cmd (or grep-command "grep -n -H -i -e ")))
      ;; add query
      (setq cmd (concat cmd " \"" query "\""))
      ;; add files
      (dolist (file files)
        (setq cmd (concat cmd " \"" file "\"")))
      ;; execute command using `grep' command
      (grep cmd))))

;; grep custom generate macro
(message ";;; functions-extra --> grep-custom-generate")
(defmacro grep-custom-generate (name prompt dirs match)
  "Create custom function.
\nNAME is the function name.
PROMPT is displayed if no query is given.
DIRS is a list of the directories to search.
MATCH is the file pattern to match.
\nNote: This macro is not side-effect safe; DIRS and MATCH are
both used more than once and might not work correctly if set to
functions with side-effects."
  `(defun ,name (&optional query)
     ,(concat "Grep custom directories for QUERY.\n\n"
              "Run `grep' COMMAND, where COMMAND is:\n\n"
              "`grep-default-command' QUERY FILES\n\n"
              "FILES is a list of files generated from the following\n"
              "files/directories:\n\n"
              (concat "  " (reduce #'(lambda (x y) (concat x "\n  " y)) dirs) "\n\n")
              "A file matching pattern of `" match "' is used.")
     (interactive)
     (unless query
       (setq query (read-from-minibuffer ,prompt)))
     (let ((paths (nreverse ',dirs))
           path
           files)
       ;; loop through paths
       (while paths
         (setq path (expand-file-name (car paths)))
         (setq paths (cdr paths))
         ;; traverse directories
         (if (file-directory-p path)
             ;; loop through files
             (dolist (file (nreverse (directory-files path t)))
               ;; ignore `.'
               (unless (string-match "^\\." (file-name-nondirectory file))
                 ;; add directories to paths
                 (if (file-directory-p file)
                     (push file paths)
                   ;; add files in directories to files
                   (when (string-match ,match file)
                     (push file files)))))
           ;; add file
           (push path files)))
       ;; build command
       (let ((cmd (or grep-command "grep -n -H -i -e ")))
         ;; add query
         (setq cmd (concat cmd " \"" query "\""))
         ;; add files
         (dolist (file files)
           (setq cmd (concat cmd " \"" file "\"")))
         ;; execute command using `grep' command
         (grep cmd)))))

;; ;; grep custom generate macro
;; (message ";;; functions-extra --> grep-custom-generate")
;; (defmacro grep-custom-generate (name prompt dirs match)
;;   "Create custom function.
;; \nNAME is the function name.
;; PROMPT is displayed if no query is given.
;; DIRS is a list of the directories to search.
;; MATCH is the file pattern to match."
;;   (let ((d (gemsym))
;;         (m (gemsym)))
;;     `(let
;;   `(defun ,name (&optional query)
;;      ,(concat "Grep custom directories for QUERY.\n\n"
;;               "Run `grep' COMMAND, where COMMAND is:\n\n"
;;               "`grep-default-command' QUERY FILES\n\n"
;;               "FILES is a list of files generated from the following\n"
;;               "files/directories:\n\n"
;;               (concat "  " (reduce #'(lambda (x y) (concat x "\n  " y)) dirs) "\n\n")
;;               "A file matching pattern of `" match "' is used.")
;;      (interactive)
;;      (unless query
;;        (setq query (read-from-minibuffer ,prompt)))
;;      (let ((paths (nreverse ',dirs))
;;            path
;;            files)
;;        ;; loop through paths
;;        (while paths
;;          (setq path (expand-file-name (car paths)))
;;          (setq paths (cdr paths))
;;          ;; traverse directories
;;          (if (file-directory-p path)
;;              ;; loop through files
;;              (dolist (file (nreverse (directory-files path t)))
;;                ;; ignore `.'
;;                (unless (string-match "^\\." (file-name-nondirectory file))
;;                  ;; add directories to paths
;;                  (if (file-directory-p file)
;;                      (push file paths)
;;                    ;; add elisp file
;;                    (when (string-match ,match file)
;;                      (push file files)))))
;;            ;; add file
;;            (push path files)))
;;        ;; build command
;;        (let ((cmd (or grep-command "grep -n -H -i -e ")))
;;          ;; add query
;;          (setq cmd (concat cmd " \"" query "\""))
;;          ;; add files
;;          (dolist (file files)
;;            (setq cmd (concat cmd " \"" file "\"")))
;;          ;; execute command using `grep' command
;;          (grep cmd)))))

;; grep clisp
(message ";;; functions-extra --> grep-clisp")
(grep-custom-generate grep-clisp "Grep CLISP files: " ("~/clisp") "\\.lisp$")

;; grep profile
(message ";;; functions-extra --> grep-profile")
(grep-custom-generate grep-profile "Grep shell profile files: "
                      ("~/.bashrc"
                       "~/.alias" "~/.alias-local" "~/.alias-work"
                       "~/.funct" "~/.funct-local" "~/.funct-work"
                       "~/.profile" "~/.profile-local" "~/.profile-work"
                       ) ".*")

;;==============================================================================
;;; Code Reformatting Functions
;;==============================================================================

(message ";;; functions-extra --> Code Reformatting Functions")

;; c fix code
(message ";;; functions --> c-fix-code")
(defun c-fix-code ()
  "Clean up c/c++ code."
  (interactive "*")
  (save-excursion
    ;; remove tabs
    (remove-tabs)
    ;; remove trailing blanks
    (remove-trailing-blanks)
    ;; remove extra spaces from functions
    (goto-char (point-min))
    (while (re-search-forward "([ \t]*" nil t)
      (replace-match "(" nil nil))
    (goto-char (point-min))
    (while (re-search-forward "[ \t]*)" nil t)
      (replace-match ")" nil nil))
    ;; remove extra spaces from template references
    ;;(goto-char (point-min))
    ;;(while (re-search-forward "<[ \t]*\\(.*?\\)[ \t]*>" nil t)
    ;;  (replace-match "<\\1>" nil nil))
    ;; add spaces after commas
    (goto-char (point-min))
    (while (re-search-forward "\\,\\([^ ]\\)" nil t)
      (replace-match ", \\1" nil nil))
    ;; remove double or more blank lines
    (goto-char (point-min))
    (while (re-search-forward "\n\n\n+" nil t)
      (replace-match "\n\n" nil nil))
    ;; remove blank line before block start
    (goto-char (point-min))
    (while (re-search-forward "\n\n[ \t]*{" nil t)
      (replace-match "\n{" nil nil)
      (indent-according-to-mode))
    ;; indent buffer
    (indent-region (point-min) (point-max) nil)
    ))

;; ruby fix code
(message ";;; functions --> ruby-fix-code")
(defun ruby-fix-code ()
  "Clean up ruby code."
  (interactive "*")
  (save-excursion
    ;; remove tabs
    (remove-tabs)
    ;; remove trailing blanks
    (remove-trailing-blanks)
    ;; remove extra spaces from functions
    (goto-char (point-min))
    (while (re-search-forward "([ \t]*\\(.*?\\)[ \t]*)" nil t)
      (replace-match "(\\1)" nil nil))
    ;; remove extra spaces from variable references
    (goto-char (point-min))
    (while (re-search-forward "#{[ \t]*\\(.*?\\)[ \t]*}" nil t)
      (replace-match "#{\\1}" nil nil))
    ;; remove extra spaces from hash references
    (goto-char (point-min))
    (while (re-search-forward "\\[[ \t]*\\(.*?\\)[ \t]*\\]" nil t)
      (replace-match "[\\1]" nil nil))
    ;; remove extra spaces from each clauses
    (goto-char (point-min))
    (while (re-search-forward "|[ \t]*\\(.*?\\)[ \t]*|" nil t)
      (replace-match "|\\1|" nil nil))
    ;; add spaces after commas
    (goto-char (point-min))
    (while (re-search-forward "\\,\\([^ ]\\)" nil t)
      (replace-match ", \\1" nil nil))
    ;; remove double or more blank lines
    (goto-char (point-min))
    (while (re-search-forward "\n\n\n+" nil t)
      (replace-match "\n\n" nil nil))
    ;; indent buffer
    (indent-region (point-min) (point-max) nil)
    ))

;; java fix code
(message ";;; functions --> java-fix-code")
(defun java-fix-code ()
  "Clean up Java code."
  (interactive "*")
  (save-excursion
    ;; remove tabs
    (remove-tabs)
    ;; remove trailing blanks
    (remove-trailing-blanks)
    ;; remove extra spaces from functions
    (goto-char (point-min))
    (while (re-search-forward "([ \t]*" nil t)
      (replace-match "(" nil nil))
    (goto-char (point-min))
    (while (re-search-forward "[ \t]*)" nil t)
      (replace-match ")" nil nil))
    ;; add spaces after commas
    (goto-char (point-min))
    (while (re-search-forward "\\,\\([^ ]\\)" nil t)
      (replace-match ", \\1" nil nil))
    ;; add spaces after function names
    (dolist (name '("catch" "else" "for" "if" "return"))
      (goto-char (point-min))
      (while (re-search-forward (concat name "(") nil t)
        (replace-match (concat name " (") nil nil)))
    ;; split "} CONNECTOR {" into two lines
    (dolist (name '("catch" "else"))
      (goto-char (point-min))
      (while (re-search-forward (concat "} " name) nil t)
        (replace-match (concat "}\n" name) nil nil)
        (indent-according-to-mode)))
    ;; remove double or more blank lines
    (goto-char (point-min))
    (while (re-search-forward "\n\n\n+" nil t)
      (replace-match "\n\n" nil nil))
    ;; remove blank line before block start
    (goto-char (point-min))
    (while (re-search-forward "\n\n[ \t]*{" nil t)
      (replace-match "\n{" nil nil)
      (indent-according-to-mode))
    ;; indent buffer
    (indent-region (point-min) (point-max) nil)
    ))

;; xml format
(message ";;; functions --> xml-format")
(defun xml-format ()
  "Format XML buffer.
\nConvert poorly formatted XML into something better."
  (interactive "*")
  (xml-mode)
  (let ((xml-eol "[ \t]*\n[ \t]*")
        (xml-tag-end-regexp ">")
        (xml-close-tag-regexp "</")
        (xml-block-regexp "<[^>]*>[^<]*</[^>]*>"))
    (save-excursion
      ;; preserve search data
      (save-match-data
        ;; remove all existing EOL characters
        (goto-char (point-min))
        (while (re-search-forward xml-eol nil t)
          (replace-match "" nil nil))
        ;; move down code adding newlines were needed
        (goto-char (point-min))
        (while (re-search-forward xml-tag-end-regexp nil t)
          (insert "\n")
          (when (and
                 (looking-at xml-block-regexp)
                 (not (looking-at xml-close-tag-regexp)))
            (re-search-forward xml-block-regexp nil t)
            (forward-char -1)))
        ;; indent buffer
        (indent-region (point-min) (point-max))
        ))))

;;==============================================================================
;;; Complex Functions
;;==============================================================================

(message ";;; functions-extra --> Complex Functions")

;;------------------------------------------------------------------------------
;; Fahrenheit/Celsius Conversions
;;------------------------------------------------------------------------------

(message ";;; functions --> fahrenheit/celsius")

;; convert fahrenheit to celsius
(defun fahrenheit-to-celsius (deg)
  "Convert fahrenheit degrees to celsius."
  (/ (* (- deg 32) 5) 9))

;; convert fahrenheit to celsius with user query
(defun fahrenheit-to-celsius-query (&optional deg)
  "Prompt user for fahrenheit degrees to convert to celsius."
  (interactive)
  (unless deg
    (setq deg (string-to-number
               (read-from-minibuffer "Fahrenheit degrees: "))))
  (setq cel (fahrenheit-to-celsius deg))
  (message "Celsius degrees: %s" cel))

;; convert celsius to fahrenheit
(defun celsius-to-fahrenheit (deg)
  "Convert celsius degrees to fahrenheit."
  (+ (* (/ deg 5) 9) 32))

;; convert celsius to fahrenheit with user query
(defun celsius-to-fahrenheit-query (&optional deg)
  "Prompt user for celsius degrees to convert to fahrenheit."
  (interactive)
  (unless deg
    (setq deg (string-to-number
               (read-from-minibuffer "Celsius degrees: "))))
  (setq cel (celsius-to-fahrenheit deg))
  (message "Fahrenheit degrees: %s" cel))

;;------------------------------------------------------------------------------
;;; Web Query Functions
;;------------------------------------------------------------------------------

(message ";;; functions --> Web Query Functions")

;; ;; web query prefix
;; (defcustom web-query-prefix
;;   "http://www.google.com/search?q="
;;   "URL prefix to use for querying.
;; \nExample: \"http://www.google.com/search?q=\" for google."
;;   :type 'string
;;   :group 'web-query)

;; web query list
(defcustom web-query-list
  '(("all" . (:google "http://"))
    ;;("wikipedia" . (:google "http://www.wikipedia.org/"))
    ("wikipedia" . (:custom "http://en.wikipedia.org/wiki/Special:Search?search="))
    ("java" . (:google "http://java.sun.com/javase/6/docs/api/"))
    ("emacswiki" . (:google "http://www.emacswiki.org/"))
    ;;("freshmeat" . (:google "http://freshmeat.net/"))
    ("freshmeat" . (:custom "http://freshmeat.net/search/?section=projects&q="))
    ("lisp" . (:custom "http://lispdoc.com/?search=Basic+search&q="))
    ("nullman" . (:google "http://nullman.org/"))
    )
  "*Association list of names to query type and URL to use with `web-query'.

The following format is used:

  ((NAME . (TYPE URL))
   (...))

  NAME is a descriptive name.
  TYPE is one of:
    :google
    :custom
  URL is dependent on TYPE as follows:
    If :google then URL is used for 'site:'.
    If :custom then URL is used as prefix to query string."
  :type 'list
  :group 'web-query)

;; web query lucky
(defcustom web-query-lucky
  t
  "If non-nil, perform Google lucky query instead of normal query."
  :type 'boolean
  :group 'web-query)

;; name history
(defvar web-query-name-history
  (mapcar 'car web-query-list)
  "History of `web-query' name arguments.
\nInitialized with `web-query-list'.")

;; query history
(defvar web-query-query-history
  nil
  ;;(mapcar '(lambda (x) (list (car x) nil)) web-query-list)
  "History of `web-query' query arguments.
\nOne association list per query name.")

;; web query custom
(defun web-query-custom (url query)
  "Browse result of a custom QUERY appended to URL.
\nUsed internally by `web-query'."
  (funcall browse-url-browser-function
           (concat url (w3m-url-encode-string query))))

;; web query google
(defun web-query-google (url query)
  "Browse result of a Google QUERY limited to URL site.
\nUsed internally by `web-query'."
  (funcall browse-url-browser-function
           (concat "http://www.google.com/search?q="
                   (w3m-url-encode-string (concat query " site:" url))
                   (if web-query-lucky
                       "&btnI=Search"
                     "&btnG=Search"))))

;; web query
(defun web-query (name &optional query)
  "Lookup NAME in `web-query-list', then submit associated URL and QUERY to `web-query-google'."
  (interactive
   (let* ((name (read-from-minibuffer "Name: "
                                      (car web-query-name-history)
                                      nil nil
                                      'web-query-name-history))
          (hist (progn
                  (unless (assoc name web-query-query-history)
                    (push (list name nil) web-query-query-history))
                  (cadr (assoc name web-query-query-history))))
          (query (read-from-minibuffer "Query: "
                                       nil nil nil
                                       'hist)))
     (list name query)))
  (let ((hist (cadr (assoc name web-query-query-history))))
    ;; prompt for query if not given
    (unless query
      (read-from-minibuffer "Query: " nil nil nil 'hist))
    ;; update history
    (when (member query hist)
      (setq hist (remove query hist)))
    (push query hist)
    (setcdr (assoc name web-query-query-history) (list hist))
    ;; perform query
    (multiple-value-bind (type url) (cdr (assoc name web-query-list))
      (case type
        (:custom (web-query-custom url query))
        (:google (web-query-google url query))))))


;;------------------------------------------------------------------------------
;; Code Formatting Functions
;;------------------------------------------------------------------------------

(message ";;; functions --> Code Formatting Functions")

;; find begin and end of current code block
(message ";;; functions --> find-code-block")
(defun find-code-block (&optional regexp indent)
  "Find the begin and end of code block containing point.

When run interactively, then begin and end points of the block
are printed in the mini-buffer.  Otherwise, a list containing
them is returned.

A code block is defined as contiguous lines of text having the
same indentation.  So a code block ends when either the
indentation changes or a blank line is reached.

The begin point will be at the start of a line and the end point
will be at the end of a line, unless point is not in a code block
in which case nil is returned for both.

The optional parameter REGEXP is an additional regular expression
to match on.  If non-nil, every line in the code block must also
match REGEXP.

If optional parameter INDENT is non-nil then each line will be
indented via `indent-according-to-mode'."
  (interactive "*")
  (let (beg
        end
        (ind 0)
        (blank-line-regexp "^[\t ]*$"))
    (save-excursion
      ;; indent if INDENT is t
      ;;(when indent
      ;;  (indent-according-to-mode))
      (setq ind (current-indentation))
      (goto-char (point-at-bol))
      ;; continue if we are in a code block
      (unless (or
               (looking-at blank-line-regexp)
               (if regexp
                   (not (looking-at regexp))
                 nil))
        ;; move up to first line in block
        (while (and
                (not (bobp))
                (not (looking-at blank-line-regexp))
                (= ind (current-indentation))
                (if regexp
                    (looking-at regexp)
                  t))
          (forward-line -1)
          ;; indent if INDENT is t
          ;;(when indent
          ;;  (indent-according-to-mode))
          (goto-char (point-at-bol))
          )
        ;; if current line is not part of range, then move down
        (unless (and
                 (not (looking-at blank-line-regexp))
                 (= ind (current-indentation))
                 (if regexp
                     (looking-at regexp)
                   t))
          (forward-line 1))
        (goto-char (point-at-bol))
        (setq beg (point))
        ;; indent if INDENT is t
        (when indent
          (indent-according-to-mode))
        (setq ind (current-indentation))
        ;; move down to last line in block
        (while (and
                (not (eobp))
                (not (looking-at blank-line-regexp))
                (= ind (current-indentation))
                (if regexp
                    (looking-at regexp)
                  t))
          (forward-line 1)
          ;; indent if INDENT is t
          (when indent
            (indent-according-to-mode))
          (goto-char (point-at-bol))
          )
        (unless (and
                 (not (looking-at blank-line-regexp))
                 (= ind (current-indentation))
                 (if regexp
                     (looking-at regexp)
                   t))
          (forward-line -1))
        (end-of-line)
        (setq end (point))
        ))
    (if (interactive-p)
        (message "%s %s" beg end)
      (list beg end))
    ))

;; line up assignment commands
(message ";;; functions --> lineup-assignment-commands")
(defun lineup-assignment-commands (&optional indent)
  "Line up a block of variable assignment commands.

Match any contiguous block of code (presumably assignment
commands) and line up the equal signs.

If optional parameter INDENT is non-nil then each line will be
indented via `indent-according-to-mode'.

Example:

  // assignments
  var1 = value1; // var1
  variable2 = value2; // var2

Becomes:

  // assignments
  var1      = value1;             // var1
  variable2 = value2;             // var2"
  (interactive "*")
  (let (beg
        end
        (pos 0)
        (equal-regexp "[\t ]+=[\t ]+"))
    (save-excursion
      ;; get code block range
      (setq range (find-code-block nil indent))
      (setq beg (car range))
      (setq end (cadr range))
      ;; if there are lines in range, continue
      (when (> end beg)
        ;; preserve block range
        (save-restriction
          (narrow-to-region beg end)
          ;; preserve search data
          (save-match-data
            ;; move down code block
            (goto-char (point-min))
            (while (< (point) (point-max))
              ;; store farthest equal sign that is not in a comment
              (when (and
                     (re-search-forward equal-regexp (point-at-eol) t)
                     (not (equal (get-char-property (point) 'face)
                                 'font-lock-comment-face)))
                ;; remove extra whitespace
                (goto-char (point-at-bol))
                (re-search-forward equal-regexp (point-at-eol))
                (replace-match " = ")
                ;; put point before the equal sign
                (backward-char 2)
                ;; store point if larger than others
                (when (> (- (point) (point-at-bol)) pos)
                  (setq pos (- (point) (point-at-bol)))))
              (goto-char (point-at-bol))
              (forward-line 1))
            ;; move through the block, padding as needed
            (goto-char (point-min))
            (while (< (point) (point-max))
              (when (and
                     (re-search-forward equal-regexp (point-at-eol) t)
                     (not (equal (get-char-property (point) 'face)
                                 'font-lock-comment-face)))
                (backward-char 2)
                ;; pad as needed
                (while (< (- (point) (point-at-bol)) pos)
                  (insert " ")))
              (goto-char (point-at-bol))
              (forward-line 1))
            ;; handle lines that ends in a comment
            (goto-char (point-min))
            (while (< (point) (point-max))
              (goto-char (point-at-bol))
              (forward-char (current-indentation))
              ;; if line is not a comment line and line ends in a comment, then
              ;; call comment-indent
              (when (and
                     (not (equal (get-char-property (point-at-eol) 'face)
                                 'font-lock-comment-face))
                     (equal (get-char-property (point-at-eol) 'face)
                            'font-lock-comment-face))
                (comment-indent))
              (forward-line 1))
            ))))))

;; line up declaration commands
;; TODO: fix removal of extra whitespace in block
;; TODO: fix adding whitespace where needed in block
(message ";;; functions --> lineup-declaration-commands")
(defun lineup-declaration-commands (&optional indent)
  "Line up a block of variable declaration commands.

If optional parameter INDENT is non-nil then each line will be
indented via `indent-according-to-mode'.

Example:

  // variables
  public Integer i; // int example
  public String s; // string example
  private Integer i2; // int 2
  private String s2; // string 2
  protected Date dte; // date example

Becomes:

  // variables
  public    Integer i;            // int example
  public    String  s;            // string example
  private   Integer i2;           // int 2
  private   String  s2;           // string 2
  protected Date    dte;          // date example"
  (interactive "*")
  (let (beg                             ; begin of range
        end                             ; end of range
        face                            ; current font face
        prev-face                       ; previous font face
        (change -1)                     ; current column to line up on
        (prev-change -2)                ; previous column to line up on
        (whitespace-regexp "[\t ]+"))   ; regexp to match whitespace
    (save-excursion
      ;; get code block range
      (setq range (find-code-block nil indent))
      (setq beg (car range))
      (setq end (cadr range))
      ;; if there are lines in range, continue
      (when (> end beg)
        ;; preserve block range
        (save-restriction
          (narrow-to-region beg end)
          ;; preserve search data
          (save-match-data
            ;; remove extra whitespace
            (goto-char (point-min))
            (while (< (point) (point-max))
              (forward-char (current-indentation))
              (re-search-forward whitespace-regexp (point-at-eol) t)
              (replace-match " ")
              (goto-char (point-at-bol))
              (forward-line 1))
            ;; loop until all face changes have been analyzed
            (while (> change prev-change)
              ;; update prev-change
              (setq prev-change change)
              ;; set prev-change to indent on first pass
              (when (< prev-change 0)
                (setq prev-change (current-indentation)))
              ;; clear face
              (setq face nil)
              ;; clear prev-face
              (setq prev-face nil)
              ;; goto start of range
              (goto-char (point-min))
              ;; loop through all lines in range
              (while (< (point) (point-max))
                ;; goto start of line + indentation
                (goto-char (point-at-bol))
                (forward-char (current-indentation))
                ;; ignore comment lines
                (unless (equal (get-char-property (point) 'face)
                               'font-lock-comment-face)
                  ;; goto start of line + prev-change
                  (goto-char (point-at-bol))
                  (forward-char prev-change)
                  ;; get prev-face of first non-whitespace character
                  (unless prev-face
                    (while (and (< (point) (point-at-eol))
                                (looking-at whitespace-regexp))
                      (forward-char))
                    (setq prev-face (get-char-property (point) 'face)))
                  ;; move forward until we hit whitespace
                  (while (and (< (point) (point-at-eol))
                              (not (looking-at whitespace-regexp)))
                    (forward-char))
                  ;; move forward until a non-whitespace character is reached that
                  ;; changes the face
                  (while (and (< (point) (point-at-eol))
                              (or
                               (looking-at whitespace-regexp)
                               (equal prev-face (get-char-property (point) 'face))))
                    (forward-char))
                  ;; if the face changed and it is farther than the current
                  ;; change, set the face and change value; face is set on the
                  ;; first pass after which a match is expected
                  (when (and (< (point) (point-at-eol))
                             (< change (- (point) (point-at-bol)))
                             (if face
                                 (equal face (get-char-property (point) 'face))
                               t))
                    ;; only set face on first pass
                    ;;(debug)
                    (unless face
                      (setq face (get-char-property (point) 'face)))
                    (setq change (- (point) (point-at-bol)))))
                ;; move to next line and continue
                (forward-line 1))
              ;; if a face change is found, lineup lines
              (when (> change prev-change)
                ;; goto start of range
                (goto-char (point-min))
                ;; loop through all lines in range
                (while (< (point) (point-max))
                  ;; goto start of line + indentation
                  (goto-char (point-at-bol))
                  (forward-char (current-indentation))
                  ;; ignore comment lines
                  (unless (equal (get-char-property (point) 'face)
                                 'font-lock-comment-face)
                    ;; goto start of line + prev-change
                    (goto-char (point-at-bol))
                    (forward-char prev-change)
                    ;; find start of face change
                    ;; move forward until whitespace is reached
                    (while (and (< (point) (point-at-eol))
                                (not (looking-at whitespace-regexp)))
                      (forward-char))
                    ;; move forward until a non-whitespace character is reached
                    ;; that matches the face change
                    (while (and (< (point) (point-at-eol))
                                (or
                                 (looking-at whitespace-regexp)
                                 (not (equal face (get-char-property (point) 'face)))))
                      (forward-char))
                    ;; space as needed
                    ;;(debug)
                    (while (< (- (point) (point-at-bol)) change)
                      ;; TODO: as a precaution check that previous character is
                      ;; whitespace
                      (insert " ")))
                  ;; move to next line and continue
                  (forward-line 1))))
            ;; handle lines that ends in a comment
            (goto-char (point-min))
            (while (< (point) (point-max))
              (goto-char (point-at-bol))
              (forward-char (current-indentation))
              ;; if line is not a comment line and line ends in a comment, then
              ;; call comment-indent
              (when (and
                     (not (equal (get-char-property (point-at-eol) 'face)
                                 'font-lock-comment-face))
                     (equal (get-char-property (point-at-eol) 'face)
                            'font-lock-comment-face))
                (comment-indent))
              (forward-line 1))
            ))))))

;;------------------------------------------------------------------------------
;; Automatic Indent on Yank
;;------------------------------------------------------------------------------

;; TODO: this is not working
;; error: Variable binding depth exceeds max-specpdl-size

;; (message ";;; functions-extra --> Automatic Indent on Yank")

;; ;; modes to automatically indent in
;; (defvar yank-indent-modes '(emacs-lisp-mode
;;                             lisp-interaction-mode
;;                             c-mode c++-mode
;;                             tcl-mode sql-mode
;;                             perl-mode cperl-mode
;;                             java-mode jde-mode
;;                             LaTeX-mode TeX-mode
;;                             xml-mode nxml-mode
;;                             ruby-mode)
;;   "Modes in which to indent regions that are yanked (or yank-popped).")

;; ;; (defvar yank-advised-indent-threshold 1000
;; ;;   "Threshold (# chars) over which indentation does not automatically occur.")

;; ;; (defun yank-advised-indent-function (beg end)
;; ;;   "Do indentation, as long as the region isn't too large."
;; ;;   (if (<= (- end beg) yank-advised-indent-threshold)
;; ;;       (indent-region beg end nil)))

;; ;; yank advice
;; (defadvice yank (after yank-indent activate)
;;   "If current mode is one of `yank-indent-modes', indent yanked
;; text (with prefix arg do not indent)."
;;   (when (and (not (ad-get-arg 0))
;;              (member major-mode yank-indent-modes))
;;     (let ((transient-mark-mode nil))
;;       ;;(yank-advised-indent-function (region-beginning) (region-end)))))
;;       (indent-region (region-beginning) (region-end) nil))))

;; ;; yank-pop advice
;; (defadvice yank-pop (after yank-pop-indent activate)
;;   "If current mode is one of `yank-indent-modes', indent yanked
;; text (with prefix arg do not indent)."
;;   (when (and (not (ad-get-arg 0))
;;              (member major-mode yank-indent-modes))
;;     (let ((transient-mark-mode nil))
;;       ;;(yank-advised-indent-function (region-beginning) (region-end)))))
;;       (indent-region (region-beginning) (region-end) nil))))

;;==============================================================================
;;; Esoteric Functions
;;==============================================================================

(message ";;; functions-extra --> Esoteric Functions") ;

;; lidf update xml
(message ";;; functions --> ldif-update-xml")
(defun ldif-update-xml ()
  "Update an LDIF node with the base64 encoded value of an XML block.
\nMust be run from the attribute being updated, which must be in
the form of `attribute::'."
  (interactive "*")
  (let (beg
        end
        attr
        block
        (blank-line-regexp "^[\t ]*$"))
    (save-excursion
      (save-match-data
        ;; save attr position
        (goto-char (point-at-bol))
        (when (search-forward "::" (point-at-eol))
          (setq attr (point))
          ;; find xml block
          (when (search-forward "<?xml")
            ;; get xml block range (fron starting <?xml to first blank line)
            ;; TODO: make this better by search for starting and ending xml
            ;; nodes
            (setq beg (point-at-bol))
            (while (and
                    (not (eobp))
                    (not (looking-at blank-line-regexp)))
              (forward-line 1))
            (forward-line -1)
            (end-of-line)
            (setq end (point))
            ;; copy block to temp buffer
            (setq block (buffer-substring beg end))
            ;; following two lines used for debugging
            ;;(save-current-buffer
            ;;  (set-buffer (get-buffer-create "*Temp*"))
            (with-temp-buffer
              (insert block)
              (goto-char (point-min))
              ;; if block is commented out, then uncomment
              (search-forward "<?xml")
              (goto-char (point-at-bol))
              (when (char-equal (char-after (point)) ?#)
                (while (char-equal (char-after (point)) ?#)
                  ;; remove leading #
                  (delete-char 1)
                  ;; remove single space if exists
                  (when (char-equal (char-after (point)) ? )
                    (delete-char 1))
                  (forward-line 1)
                  (goto-char (point-at-bol))
                  ))
              ;; remove comment lines
              (goto-char (point-min))
              (while (re-search-forward "^#" (point-max) t)
                (delete-region (point-at-bol) (point-at-eol))
                (unless (eobp)
                  (delete-char 1)))
              ;; base64 encode block
              (base64-encode-region (point-min) (point-max))
              ;; append every line with a space
              (goto-char (point-min))
              (while (not (eobp))
                (goto-char (point-at-bol))
                (insert " ")
                (forward-line 1))
              ;; copy encoded block
              (setq block (buffer-substring (point-min) (point-max)))
              )
            ;; delete attr data
            (goto-char attr)
            (delete-region (point) (point-at-eol))
            (forward-line 1)
            (goto-char (point-at-bol))
            (while (char-equal (char-after (point)) ? )
              (delete-region (point-at-bol) (point-at-eol))
              (delete-char 1))
            ;; paste encoded block
            (goto-char attr)
            (insert block)
            ))))))

;;==============================================================================
;;; Games
;;==============================================================================

(message ";;; functions-extra --> Games")

;; towers of hanoi solution
(message ";;; functions --> towers")
(defun towers (n)
  "Solve the clasical Towers of Hanoi problem for N levels."
  (interactive)
  (let ((buffer "*Towers*"))
    ;; setup buffer
    (get-buffer-create buffer)
    (set-buffer buffer)
    (setq buffer-read-only nil)
    (erase-buffer)
    ;; print header
    (insert (format "Towers of Hanio puzzle with %d disks" n))
    (newline)
    (newline)
    ;; make initial call to towers move
    ;; move from peg 1 to 3 using 2
    (towers-move n 1 3 2)
    ;; set buffer to read-only
    (setq buffer-read-only t)
    ;; switch to buffer
    (switch-to-buffer buffer)
    (goto-char (point-min)))
  ;; no return value
  (values))

;; towers of hanoi function to handle a move
(message ";;; functions --> towers-move")
(defun towers-move (n from to using)
  "Make one Towers of Hanoi move.
\nN is the number of disks to move.
FROM is the source peg.
TO is the target peg.
USING is the remaining peg."
  (when (> n 0)
    ;; in order to move N disks FROM one peg TO another, we first move N-1
    ;; disks FROM one peg to a USING peg
    (towers-move (1- n) from using to)
    ;; then we move the one remaining peg FROM the starting peg TO the
    ;; finishing peg
    (insert (format "move %d --> %d" from to))
    (newline)
    ;; finally we move the N-1 disks now on the USING peg to the TO peg using
    ;; FROM
    (towers-move (1- n) using to from)))

(message ";;; functions-extra --> End")

;;==============================================================================
;;; End of File
;;==============================================================================