Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
267 lines (219 sloc) 9.23 KB
;;; starter-kit-defuns.el --- Define some custom functions
;; Part of the Emacs Starter Kit
(require 'thingatpt)
(require 'imenu)
;; Network
(defun view-url ()
"Open a new buffer containing the contents of URL."
(let* ((default (thing-at-point-url-at-point))
(url (read-from-minibuffer "URL: " default)))
(switch-to-buffer (url-retrieve-synchronously url))
(rename-buffer url t)
;; TODO: switch to nxml/nxhtml mode
(cond ((search-forward "<?xml" nil t) (xml-mode))
((search-forward "<html" nil t) (html-mode)))))
;; Buffer-related
(defun ido-imenu ()
"Update the imenu index and then use ido to select a symbol to navigate to.
Symbols matching the text at point are put first in the completion list."
(let ((name-and-pos '())
(symbol-names '()))
(flet ((addsymbols (symbol-list)
(when (listp symbol-list)
(dolist (symbol symbol-list)
(let ((name nil) (position nil))
((and (listp symbol) (imenu--subalist-p symbol))
(addsymbols symbol))
((listp symbol)
(setq name (car symbol))
(setq position (cdr symbol)))
((stringp symbol)
(setq name symbol)
(setq position (get-text-property 1 'org-imenu-marker symbol))))
(unless (or (null position) (null name))
(add-to-list 'symbol-names name)
(add-to-list 'name-and-pos (cons name position))))))))
(addsymbols imenu--index-alist))
;; If there are matching symbols at point, put them at the beginning of `symbol-names'.
(let ((symbol-at-point (thing-at-point 'symbol)))
(when symbol-at-point
(let* ((regexp (concat (regexp-quote symbol-at-point) "$"))
(matching-symbols (delq nil (mapcar (lambda (symbol)
(if (string-match regexp symbol) symbol))
(when matching-symbols
(sort matching-symbols (lambda (a b) (> (length a) (length b))))
(mapc (lambda (symbol) (setq symbol-names (cons symbol (delete symbol symbol-names))))
(let* ((selected-symbol (ido-completing-read "Symbol? " symbol-names))
(position (cdr (assoc selected-symbol name-and-pos))))
(goto-char position))))
;;; These belong in coding-hook:
;; We have a number of turn-on-* functions since it's advised that lambda
;; functions not go in hooks. Repeatedly evaling an add-to-list with a
;; hook value will repeatedly add it since there's no way to ensure
;; that a lambda doesn't already exist in the list.
(defun local-column-number-mode ()
(make-local-variable 'column-number-mode)
(column-number-mode t))
(defun local-comment-auto-fill ()
(set (make-local-variable 'comment-auto-fill-only-comments) t)
(auto-fill-mode t))
(defun turn-on-hl-line-mode ()
(when (> (display-color-cells) 8) (hl-line-mode t)))
(defun turn-on-save-place-mode ()
(setq save-place t))
(defun turn-on-whitespace ()
(whitespace-mode t))
(defun turn-on-paredit ()
(paredit-mode t))
(defun turn-off-tool-bar ()
(tool-bar-mode -1))
(defun add-watchwords ()
nil '(("\\<\\(FIX\\|TODO\\|FIXME\\|HACK\\|REFACTOR\\):"
1 font-lock-warning-face t))))
(add-hook 'coding-hook 'local-column-number-mode)
(add-hook 'coding-hook 'local-comment-auto-fill)
(add-hook 'coding-hook 'turn-on-hl-line-mode)
(add-hook 'coding-hook 'turn-on-save-place-mode)
(add-hook 'coding-hook 'pretty-lambdas)
(add-hook 'coding-hook 'add-watchwords)
(add-hook 'coding-hook 'idle-highlight)
(defun run-coding-hook ()
"Enable things that are convenient across all coding buffers."
(run-hooks 'coding-hook))
(defun untabify-buffer ()
(untabify (point-min) (point-max)))
(defun indent-buffer ()
(indent-region (point-min) (point-max)))
(defun cleanup-buffer ()
"Perform a bunch of operations on the whitespace content of a buffer."
(defun recentf-ido-find-file ()
"Find a recent file using ido."
(let ((file (ido-completing-read "Choose recent file: " recentf-list nil t)))
(when file
(find-file file))))
;; Cosmetic
(defun pretty-lambdas ()
nil `(("(?\\(lambda\\>\\)"
(0 (progn (compose-region (match-beginning 1) (match-end 1)
,(make-char 'greek-iso8859-7 107))
;; Other
(defun eval-and-replace ()
"Replace the preceding sexp with its value."
(condition-case nil
(prin1 (eval (read (current-kill 0)))
(error (message "Invalid expression")
(insert (current-kill 0)))))
(defun recompile-init ()
"Byte-compile all your dotfiles again."
(byte-recompile-directory dotfiles-dir 0)
;; TODO: remove elpa-to-submit once everything's submitted.
(byte-recompile-directory (concat dotfiles-dir "elpa-to-submit/") 0))
(defun regen-autoloads (&optional force-regen)
"Regenerate the autoload definitions file if necessary and load it."
(interactive "P")
(let ((autoload-dir (concat dotfiles-dir "/elpa-to-submit"))
(generated-autoload-file autoload-file))
(when (or force-regen
(not (file-exists-p autoload-file))
(some (lambda (f) (file-newer-than-file-p f autoload-file))
(directory-files autoload-dir t "\\.el$")))
(message "Updating autoloads...")
(let (emacs-lisp-mode-hook)
(update-directory-autoloads autoload-dir))))
(load autoload-file))
(defun sudo-edit (&optional arg)
(interactive "p")
(if (or arg (not buffer-file-name))
(find-file (concat "/sudo:root@localhost:" (ido-read-file-name "File: ")))
(find-alternate-file (concat "/sudo:root@localhost:" buffer-file-name))))
(defun lorem ()
"Insert a lorem ipsum."
(insert "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do "
"eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim"
"ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut "
"aliquip ex ea commodo consequat. Duis aute irure dolor in "
"reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla "
"pariatur. Excepteur sint occaecat cupidatat non proident, sunt in "
"culpa qui officia deserunt mollit anim id est laborum."))
(defun switch-or-start (function buffer)
"If the buffer is current, bury it, otherwise invoke the function."
(if (equal (buffer-name (current-buffer)) buffer)
(if (get-buffer buffer)
(switch-to-buffer buffer)
(funcall function))))
(defun insert-date ()
"Insert a time-stamp according to locale's date and time format."
(insert (format-time-string "%c" (current-time))))
(defun pairing-bot ()
"If you can't pair program with a human, use this instead."
(message (if (y-or-n-p "Do you have a test for that? ") "Good." "Bad!")))
(defun esk-paredit-nonlisp ()
"Turn on paredit mode for non-lisps."
(set (make-local-variable 'paredit-space-delimiter-chars)
(list ?\"))
(paredit-mode 1))
(defun esk-space-for-delimiter? (endp delimiter)
(not (member major-mode '(ruby-mode espresso-mode js2-mode))))
(eval-after-load 'paredit
'(add-to-list 'paredit-space-for-delimiter-predicates
(defun message-point ()
(message "%s" (point)))
(defun esk-disapproval ()
(insert "ಠ_ಠ"))
(defun esk-agent-path ()
(if (eq system-type 'darwin)
(defun esk-find-agent ()
(let* ((path-clause (format "-path \"%s\"" (esk-agent-path)))
(find-command (format "$(find -L /tmp -uid $UID %s -type s 2> /dev/null)"
(first (split-string
(format "/bin/ls -t1 %s | head -1" find-command))))))
(defun fix-agent ()
(let ((agent (esk-find-agent)))
(setenv "SSH_AUTH_SOCK" agent)
(message agent)))
(defun toggle-fullscreen ()
;; TODO: this only works for X. patches welcome for other OSes.
(x-send-client-message nil 0 nil "_NET_WM_STATE" 32
(x-send-client-message nil 0 nil "_NET_WM_STATE" 32
;; A monkeypatch to cause annotate to ignore whitespace
(defun vc-git-annotate-command (file buf &optional rev)
(let ((name (file-relative-name file)))
(vc-git-command buf 0 name "blame" "-w" rev)))
(provide 'starter-kit-defuns)
;;; starter-kit-defuns.el ends here