A set of functions that I use in my emacs configuration and to automate tasks. Some functions have been acquired and some I have written myself.
(defun lispdoc ()
"searches lispdoc.com for SYMBOL, which is by default the symbol
currently under the curser"
(interactive)
(let* ((word-at-point (word-at-point))
(symbol-at-point (symbol-at-point))
(default (symbol-name symbol-at-point))
(inp (read-from-minibuffer
(if (or word-at-point symbol-at-point)
(concat "Symbol (default " default "): ")
"Symbol (no default): "))))
(if (and (string= inp "") (not word-at-point) (not
symbol-at-point))
(message "you didn't enter a symbol!")
(let ((search-type (read-from-minibuffer
"full-text (f) or basic (b) search (default b)? ")))
(browse-url (concat "http://lispdoc.com?q="
(if (string= inp "")
default
inp)
"&search="
(if (string-equal search-type "f")
"full+text+search"
"basic+search")))))))
(defun scratch ()
(interactive)
(switch-to-buffer "*scratch*")
(lisp-interaction-mode)
(if current-prefix-arg
(delete-region (point-min) (point-max))
(goto-char (point-max))))
(defun find-function-in-elisp-manual (function)
(interactive
(let ((fn (function-called-at-point))
(enable-recursive-minibuffers t)
val)
(setq val
(completing-read
(if fn
(format "Find function (default %s): " fn)
"Find function: ")
obarray 'fboundp t nil nil (symbol-name fn)))
(list (if (equal val "")
fn
val))))
(Info-goto-node "(elisp)Index")
(condition-case err
(progn
(search-forward (concat "* "function":"))
(Info-follow-nearest-node))
(error (message "`%s' not found" function))))
(defvar insert-time-format "%H:%M"
"*Format for \\[insert-time] (c-h f 'format-time-string' for info on how to format).")
(defvar insert-date-format "%d %b %Y"
"*Format for \\[insert-date] (c-h f 'format-time-string' for info on how to format).")
(defun insert-time ()
"Insert the current time according to the variable \"insert-time-format\"."
(interactive "*")
(insert (concat (format-time-string insert-time-format (current-time)) " ")))
(defun insert-date ()
"Insert the current date according to the variable \"insert-date-format\"."
(interactive "*")
(insert (concat (format-time-string insert-date-format (current-time))" ")))
(defun insert-date-time ()
"Insert the current date according to the variable \"insert-date-format\", then a space, then the current time according to the variable \"insert-time-format\"."
(interactive "*")
(progn
(insert-date)
(insert " ")
(insert-time)))
(defun insert-current-file-name ()
(interactive)
(insert (file-name-nondirectory (buffer-file-name (current-buffer)) "\/")))
(defun insert-current-path ()
(interactive)
(insert (buffer-file-name (current-buffer))))
(defun ascii-table (&optional extended)
"Print the ascii table (up to char 127). Given an optional argument, print up to char 255."
(interactive "P")
(defvar col)
(defvar limit)
(setq limit 255)
(if (null extended)
(setq limit 127))
(setq col (/ (+ 1 limit) 4))
(switch-to-buffer "*ASCII*")
(erase-buffer)
(insert (format "ASCII characters up to %d. (00 is NULL character)\n\n" limit))
(insert " DEC OCT HEX CHAR\t\t DEC OCT HEX CHAR\t\t DEC OCT HEX CHAR\t\t DEC OCT HEX CHAR\n")
(insert " ----------------\t\t ----------------\t\t ----------------\t\t ----------------\n")
(let ((i 0) (right 0) (tab-width 4))
(while (< i col)
(setq col2 (+ i col))
(setq col3 (+ i (* col 2)))
(setq col4 (+ i (* col 3)))
(cond
((= i 9)
(insert (format "%4d%4o%4x <TAB>\t\t%4d%4o%4x%4c\t\t%4d%4o%4x%4c\t\t%4d%4o%4x%4c\n"
i i i col2 col2 col2 col2 col3 col3 col3 col3 col4 col4 col4 col4)))
((= i 10)
(insert (format "%4d%4o%4x <LF>\t\t%4d%4o%4x%4c\t\t%4d%4o%4x%4c\t\t%4d%4o%4x%4c\n"
i i i col2 col2 col2 col2 col3 col3 col3 col3 col4 col4 col4 col4)))
(t
(insert (format "%4d%4o%4x%4c>\t\t%4d%4o%4x%4c\t\t%4d%4o%4x%4c\t\t%4d%4o%4x%4c\n"
i i i i col2 col2 col2 col2 col3 col3 col3 col3 col4 col4 col4 col4))))
(setq i (+ i 1))))
(beginning-of-buffer)
(local-set-key "q" (quote bury-buffer)))
(defun explorer ()
"Launch the windows explorer in the current directory"
(interactive)
(w32-shell-execute
"open"
"explorer"
(concat "/e, " (convert-standard-filename default-directory))))
(defun cmd ()
"Launch the NT Command console"
(interactive)
(w32-shell-execute
"open"
"cmd"))
(defun tomcat ()
"launch tomcat in debug mode."
(interactive)
(let* ((cwd (getenv "CATALINA_HOME"))
(tcat (concat cwd "/bin/startdbg.bat")))
(find-file tcat)
(w32-shell-execute
"open"
tcat)
(kill-buffer (get-file-buffer tcat))))
(defun dbg-tomcat ()
"launch a debug console for tomcat."
(interactive)
(let ((dbg (concat (getenv "JAVA_HOME") "/bin/jdb.exe")))
(w32-shell-execute
nil
dbg
"-attach jdbconn")))
(defun run-cmd (cmd)
(interactive "sCommand: ")
(start-process cmd "*scratch*" "cmd" (concat "/c " cmd))
(switch-to-buffer "*scratch*"))
(defun replace-all (string to-string)
(interactive (progn (setq string (read-from-minibuffer "Replace string: "))
(setq to-string (read-from-minibuffer
(format "Replace %s with: " string)))
(list string to-string)))
"Replaces string with to-string in all buffers"
(let ((buffs (buffer-list))
(current-buffer (current-buffer)))
(while (car buffs)
(switch-to-buffer (buffer-name (car buffs)))
(let ((pos (point)))
(goto-char 0)
(query-replace string to-string)
(goto-char pos))
(setq buffs (cdr buffs)))
(switch-to-buffer current-buffer)))
(defun filter (fn lst)
(let ((acc nil))
(dolist (x lst)
(let ((val (funcall fn x)))
(if val (push val acc))))
(nreverse acc)))
(defun setOverlayBookmark ()
(interactive)
(let*
((pnt (line-beginning-position))
(ovrly (make-overlay pnt (line-end-position))))
(overlay-put ovrly 'face 'highlight)
(overlay-put ovrly 'pointHistory t)
ovrly))
(defun overlayBookmarkFilterFunc (ovrly) (and (overlay-get ovrly 'pointHistory) ovrly))
(defun overlayBookmarkFilterStartsFunc (ovrly) (and (overlay-get ovrly 'pointHistory) (overlay-start ovrly)))
(defun nextOverlayBookmark ()
(interactive)
(let*((pnt (line-end-position))
(ovrly_starts (or (filter 'overlayBookmarkFilterStartsFunc (overlays-in pnt (point-max)))
(filter 'overlayBookmarkFilterStartsFunc (overlays-in (point-min) pnt)))))
(if ovrly_starts
(goto-char (reduce (lambda (a b) (if (< a b) a b)) ovrly_starts))
(message "no items in history"))))
(defun clearOverlayBookmarks ()
(interactive)
(let
((ovrlys (filter 'overlayBookmarkFilterFunc (overlays-in (point-min) (point-max)))))
(mapcar 'delete-overlay ovrlys)
(message "cleared point history")))
(defun toggleOverlayBookmark ()
(interactive)
(let
((ovrlys (filter 'overlayBookmarkFilterFunc (overlays-in (line-beginning-position) (line-end-position)))))
(if ovrlys
(mapcar 'delete-overlay ovrlys)
(setOverlayBookmark))))
(defun overlayBookmarkRefresh ()
"stretches the overlays from the beginning to end of a line"
(interactive)
(let
((ovrlys (filter 'overlayBookmarkFilterFunc (overlays-in (point-min) (point-max))))
(lf (lambda (tmp) (save-excursion
(goto-char (overlay-start tmp))
(move-overlay tmp (overlay-start tmp) (line-end-position))))))
(if ovrlys
(mapcar lf ovrlys)
(setPointHistory))))
(defun pcomplete/eshell-mode/bmk ()
"Completion for `bmk'"
(pcomplete-here (bookmark-all-names)))
(defun eshell/bmk (&rest args)
"Integration between EShell and bookmarks. For usage, execute without arguments."
(setq args (eshell-flatten-list args))
(let ((bookmark (car args))
filename name)
(cond
((eq nil args)
(format "Usage: bmk BOOKMARK to change directory pointed to by BOOKMARK
or bmk . BOOKMARK to bookmark current directory in BOOKMARK.
Completion is available."))
((string= "." bookmark)
(if (setq name (car (cdr args)))
(progn
(bookmark-set name)
(bookmark-set-filename name (eshell/pwd))
(format "Saved current directory in bookmark %s" name))
(error "You must enter a bookmark name")))
(t
(if (setq filename (cdr (car (bookmark-get-bookmark-record bookmark))))
(if (file-directory-p filename)
(eshell/cd filename)
(error "Bookmark %s points to %s which is not a directory"
bookmark filename)))))))
(defun eshell/start (FILE)
"Invoke (w32-shell-execute \"Open\" FILE) and substitute slashes for backslashes"
(w32-shell-execute "Open" (substitute ?\\ ?/ (expand-file-name FILE))))
(defun setenv-from-list (env strlst)
"Set an environment variable using the contents of a list."
(setenv env (join "; " strlst)))
(defun join-strings (sep &rest strngs)
"join a bunch of strings with sep concatinated after each string."
(let ((rslt ""))
(dolist (str strngs)
(setq rslt (concat rslt str sep)))
rslt))
(defun join (sep strlst)
"join a list of strings with sep between each."
(let ((rslt ""))
(dolist (str strlst)
(setq rslt (concat rslt str sep)))
rslt))
(defun join-ba (before after strlst)
"join a list of strings with before and after pre/post pended to each string."
(let ((rslt ""))
(dolist (str strlst)
(setq rslt (concat rslt (format "%s%s%s" before str after))))
rslt))
(defun setup-load-paths (edir subdirlst)
"Setup load paths. edir is the elisp directory path and subdirlst is a list of subdirectories."
(mapcar (lambda (subdir) (add-to-list 'load-path (concat edir subdir)))
subdirlst)
(add-to-list 'load-path edir))
(defun copy-to-scratch ()
"copies selected text to the scratch buffer."
(interactive)
(let ((txt (buffer-substring (region-beginning) (region-end))))
(save-current-buffer
(set-buffer "*scratch*")
(insert txt "\n"))))
(defun search-all-buffers (srch-str &optional match-buffers)
"Search across all open buffers."
(interactive "sSearch String: \nsMatch Buffers: ")
(let (buffer-re)
(if (stringp match-buffers)
(setq buffer-re match-buffers)
(setq buffer-re "."))
(multi-occur-in-matching-buffers buffer-re srch-str t)))
(defun todo ()
"Find all todo items in all buffers."
(interactive)
(multi-occur-in-matching-buffers "." "TODO: " t))
(defun multi-find-file (root-dir name-regx)
"Find multiple files starting in root-dir and descending directories."
(interactive "sDirectory to search from: \nsMatch files Regx: ")
(if (and (and (stringp root-dir) (> (length root-dir) 0))
(and (stringp name-regx) (> (length name-regx) 0)))
(let ((files-to-open nil)
(subdirs nil)
(names-list nil))
(setq names-list (directory-files root-dir t))
(unless names-list (message "names-list is nil."))
(dolist (name names-list)
(cond
((file-directory-p name) (unless (string-match "[.]+$" name) (setq subdirs (cons name subdirs))))
((string-match name-regx (file-name-nondirectory name)) (setq files-to-open (cons name files-to-open)))
))
(dolist (item files-to-open)
(find-file-other-window item))
(setq file-to-open nil)
(setq names-list nil)
(dolist (item subdirs)
(multi-find-file item name-regx)))
(message "Need values for root-dir and name-regx.")))