sean-m
/
.emacs.d
mirror of https://github.com/sean-m/.emacs.d.git
1
0
Fork 0
Code Issues Releases Activity
.emacs.d/core/prelude-core.el

530 lines
19 KiB
EmacsLisp
Raw Permalink Blame History

;;; prelude-core.el --- Emacs Prelude: Core Prelude functions.
;;
;; Copyright © 2011-2015 Bozhidar Batsov
;;
;; Author: Bozhidar Batsov <bozhidar@batsov.com>
;; URL: https://github.com/bbatsov/prelude
;; Version: 1.0.0
;; Keywords: convenience
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Here are the definitions of most of the functions added by Prelude.
;;; License:
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 3
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
(require 'thingatpt)
(require 'dash)
(require 'ov)
(defun prelude-open-with (arg)
"Open visited file in default external program.
When in dired mode, open file under the cursor.
With a prefix ARG always prompt for command to use."
(interactive "P")
(let* ((current-file-name
(if (eq major-mode 'dired-mode)
(dired-get-file-for-visit)
buffer-file-name))
(open (pcase system-type
(`darwin "open")
((or `gnu `gnu/linux `gnu/kfreebsd) "xdg-open")))
(program (if (or arg (not open))
(read-shell-command "Open current file with: ")
open)))
(start-process "prelude-open-with-process" nil program current-file-name)))
(defun prelude-buffer-mode (buffer-or-name)
"Retrieve the `major-mode' of BUFFER-OR-NAME."
(with-current-buffer buffer-or-name
major-mode))
(defvar prelude-term-buffer-name "ansi"
"The default `ansi-term' name used by `prelude-visit-term-buffer'.
This variable can be set via .dir-locals.el to provide multi-term support.")
(defun prelude-visit-term-buffer ()
"Create or visit a terminal buffer."
(interactive)
(prelude-start-or-switch-to (lambda ()
(ansi-term (getenv "SHELL") (concat prelude-term-buffer-name "-term")))
(format "*%s-term*" prelude-term-buffer-name)))
(defun prelude-search (query-url prompt)
"Open the search url constructed with the QUERY-URL.
PROMPT sets the `read-string prompt."
(browse-url
(concat query-url
(url-hexify-string
(if mark-active
(buffer-substring (region-beginning) (region-end))
(read-string prompt))))))
(defmacro prelude-install-search-engine (search-engine-name search-engine-url search-engine-prompt)
"Given some information regarding a search engine, install the interactive command to search through them"
`(defun ,(intern (format "prelude-%s" search-engine-name)) ()
,(format "Search %s with a query or region if any." search-engine-name)
(interactive)
(prelude-search ,search-engine-url ,search-engine-prompt)))
(prelude-install-search-engine "google" "http://www.google.com/search?q=" "Google: ")
(prelude-install-search-engine "youtube" "http://www.youtube.com/results?search_query=" "Search YouTube: ")
(prelude-install-search-engine "github" "https://github.com/search?q=" "Search GitHub: ")
(prelude-install-search-engine "duckduckgo" "https://duckduckgo.com/?t=lm&q=" "Search DuckDuckGo: ")
(defun prelude-indent-rigidly-and-copy-to-clipboard (begin end arg)
"Indent region between BEGIN and END by ARG columns and copy to clipboard."
(interactive "r\nP")
(let ((arg (or arg 4))
(buffer (current-buffer)))
(with-temp-buffer
(insert-buffer-substring-no-properties buffer begin end)
(indent-rigidly (point-min) (point-max) arg)
(clipboard-kill-ring-save (point-min) (point-max)))))
(defun prelude-smart-open-line-above ()
"Insert an empty line above the current line.
Position the cursor at it's beginning, according to the current mode."
(interactive)
(move-beginning-of-line nil)
(newline-and-indent)
(forward-line -1)
(indent-according-to-mode))
(defun prelude-smart-open-line (arg)
"Insert an empty line after the current line.
Position the cursor at its beginning, according to the current mode.
With a prefix ARG open line above the current line."
(interactive "P")
(if arg
(prelude-smart-open-line-above)
(progn
(move-end-of-line nil)
(newline-and-indent))))
(defun prelude-top-join-line ()
"Join the current line with the line beneath it."
(interactive)
(delete-indentation 1))
(defun prelude-kill-whole-line (&optional arg)
"A simple wrapper around command `kill-whole-line' that respects indentation.
Passes ARG to command `kill-whole-line' when provided."
(interactive "p")
(kill-whole-line arg)
(back-to-indentation))
(defun prelude-move-beginning-of-line (arg)
"Move point back to indentation of beginning of line.
Move point to the first non-whitespace character on this line.
If point is already there, move to the beginning of the line.
Effectively toggle between the first non-whitespace character and
the beginning of the line.
If ARG is not nil or 1, move forward ARG - 1 lines first. If
point reaches the beginning or end of the buffer, stop there."
(interactive "^p")
(setq arg (or arg 1))
;; Move lines first
(when (/= arg 1)
(let ((line-move-visual nil))
(forward-line (1- arg))))
(let ((orig-point (point)))
(back-to-indentation)
(when (= orig-point (point))
(move-beginning-of-line 1))))
(global-set-key [remap move-beginning-of-line]
'prelude-move-beginning-of-line)
(defun prelude-indent-defun ()
"Indent the current defun."
(interactive)
(save-excursion
(mark-defun)
(indent-region (region-beginning) (region-end))))
(defun prelude-todo-ov-evaporate (_ov _after _beg _end &optional _length)
(let ((inhibit-modification-hooks t))
(if _after (ov-reset _ov))))
(defun prelude-annotate-todo ()
"Put fringe marker on TODO: lines in the curent buffer."
(interactive)
(ov-set (format "[[:space:]]*%s+[[:space:]]*TODO:" comment-start)
'before-string
(propertize (format "A")
'display '(left-fringe right-triangle))
'modification-hooks '(prelude-todo-ov-evaporate)))
(defun prelude-get-positions-of-line-or-region ()
"Return positions (beg . end) of the current line
or region."
(let (beg end)
(if (and mark-active (> (point) (mark)))
(exchange-point-and-mark))
(setq beg (line-beginning-position))
(if mark-active
(exchange-point-and-mark))
(setq end (line-end-position))
(cons beg end)))
(defun prelude-duplicate-current-line-or-region (arg)
"Duplicates the current line or region ARG times.
If there's no region, the current line will be duplicated. However, if
there's a region, all lines that region covers will be duplicated."
(interactive "p")
(pcase-let* ((origin (point))
(`(,beg . ,end) (prelude-get-positions-of-line-or-region))
(region (buffer-substring-no-properties beg end)))
(-dotimes arg
(lambda (n)
(goto-char end)
(newline)
(insert region)
(setq end (point))))
(goto-char (+ origin (* (length region) arg) arg))))
(defun prelude-duplicate-and-comment-current-line-or-region (arg)
"Duplicates and comments the current line or region ARG times.
If there's no region, the current line will be duplicated. However, if
there's a region, all lines that region covers will be duplicated."
(interactive "p")
(pcase-let* ((origin (point))
(`(,beg . ,end) (prelude-get-positions-of-line-or-region))
(region (buffer-substring-no-properties beg end)))
(comment-or-uncomment-region beg end)
(setq end (line-end-position))
(-dotimes arg
(lambda (n)
(goto-char end)
(newline)
(insert region)
(setq end (point))))
(goto-char (+ origin (* (length region) arg) arg))))
(defun prelude-rename-buffer-and-file ()
"Rename current buffer and if the buffer is visiting a file, rename it too."
(interactive)
(let ((filename (buffer-file-name)))
(if (not (and filename (file-exists-p filename)))
(rename-buffer (read-from-minibuffer "New name: " (buffer-name)))
(let ((new-name (read-file-name "New name: " filename)))
(cond
((vc-backend filename) (vc-rename-file filename new-name))
(t
(rename-file filename new-name t)
(set-visited-file-name new-name t t)))))))
(defun prelude-delete-file-and-buffer ()
"Kill the current buffer and deletes the file it is visiting."
(interactive)
(let ((filename (buffer-file-name)))
(when filename
(if (vc-backend filename)
(vc-delete-file filename)
(when (y-or-n-p (format "Are you sure you want to delete %s? " filename))
(delete-file filename)
(message "Deleted file %s" filename)
(kill-buffer))))))
(defun prelude-view-url ()
"Open a new buffer containing the contents of URL."
(interactive)
(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)
(goto-char (point-min))
(re-search-forward "^$")
(delete-region (point-min) (point))
(delete-blank-lines)
(set-auto-mode)))
(defun prelude-cleanup-buffer-or-region ()
"Cleanup a region if selected, otherwise the whole buffer."
(interactive)
(call-interactively 'untabify)
(unless (member major-mode prelude-indent-sensitive-modes)
(call-interactively 'indent-region))
(whitespace-cleanup))
(defun prelude-eval-and-replace ()
"Replace the preceding sexp with its value."
(interactive)
(let ((value (eval (preceding-sexp))))
(backward-kill-sexp)
(insert (format "%s" value))))
(defun prelude-recompile-init ()
"Byte-compile all your dotfiles again."
(interactive)
(byte-recompile-directory prelude-dir 0))
(require 'ido)
(defun prelude-sudo-edit (&optional arg)
"Edit currently visited file as root.
With a prefix ARG prompt for a file to visit.
Will also prompt for a file to visit if current
buffer is not visiting a file."
(interactive "P")
(if (or arg (not buffer-file-name))
(find-file (concat "/sudo:root@localhost:"
(ido-read-file-name "Find file(as root): ")))
(find-alternate-file (concat "/sudo:root@localhost:" buffer-file-name))))
(defadvice ido-find-file (after find-file-sudo activate)
"Find file as root if necessary."
(unless (or (tramp-tramp-file-p buffer-file-name)
(equal major-mode 'dired-mode)
(not (file-exists-p (file-name-directory buffer-file-name)))
(file-writable-p buffer-file-name))
(find-alternate-file (concat "/sudo:root@localhost:" buffer-file-name))))
(defun prelude-start-or-switch-to (function buffer-name)
"Invoke FUNCTION if there is no buffer with BUFFER-NAME.
Otherwise switch to the buffer named BUFFER-NAME. Don't clobber
the current buffer."
(if (not (get-buffer buffer-name))
(progn
(split-window-sensibly (selected-window))
(other-window 1)
(funcall function))
(switch-to-buffer-other-window buffer-name)))
(defun prelude-insert-date ()
"Insert a timestamp according to locale's date and time format."
(interactive)
(insert (format-time-string "%c" (current-time))))
(defun prelude-recentf-ido-find-file ()
"Find a recent file using ido."
(interactive)
(let ((file (ido-completing-read "Choose recent file: "
(-map 'abbreviate-file-name recentf-list)
nil t)))
(when file
(find-file file))))
(defun prelude-swap-windows ()
"If you have 2 windows, it swaps them."
(interactive)
(if (/= (count-windows) 2)
(message "You need exactly 2 windows to do this.")
(let* ((w1 (car (window-list)))
(w2 (cadr (window-list)))
(b1 (window-buffer w1))
(b2 (window-buffer w2))
(s1 (window-start w1))
(s2 (window-start w2)))
(set-window-buffer w1 b2)
(set-window-buffer w2 b1)
(set-window-start w1 s2)
(set-window-start w2 s1)))
(other-window 1))
(defun prelude-switch-to-previous-buffer ()
"Switch to previously open buffer.
Repeated invocations toggle between the two most recently open buffers."
(interactive)
(switch-to-buffer (other-buffer (current-buffer) 1)))
(defun prelude-kill-other-buffers ()
"Kill all buffers but the current one.
Doesn't mess with special buffers."
(interactive)
(when (y-or-n-p "Are you sure you want to kill all buffers but the current one? ")
(-each
(->> (buffer-list)
(-filter #'buffer-file-name)
(--remove (eql (current-buffer) it)))
#'kill-buffer)))
(defun prelude-create-scratch-buffer ()
"Create a new scratch buffer."
(interactive)
(let ((buf (generate-new-buffer "*scratch*")))
(switch-to-buffer buf)
(funcall initial-major-mode)))
(defvar prelude-tips
'("Press <C-c o> to open a file with external program."
"Press <C-c p f> to navigate a project's files with ido."
"Press <s-r> to open a recently visited file."
"Press <C-c p s g> to run grep on a project."
"Press <C-c p p> to switch between projects."
"Press <C-=> to expand the selected region."
"Press <C-c g> to search in Google."
"Press <C-c G> to search in GitHub."
"Press <C-c y> to search in YouTube."
"Press <C-c U> to search in DuckDuckGo."
"Press <C-c r> to rename the current buffer and the file it's visiting if any."
"Press <C-c t> to open a terminal in Emacs."
"Press <C-c k> to kill all the buffers, but the active one."
"Press <C-x g> to run magit-status."
"Press <C-c D> to delete the current file and buffer."
"Press <C-c s> to swap two windows."
"Press <S-RET> or <M-o> to open a line beneath the current one."
"Press <s-o> to open a line above the current one."
"Press <C-c C-z> in a Elisp buffer to launch an interactive Elisp shell."
"Press <C-Backspace> to kill a line backwards."
"Press <C-S-Backspace> or <s-k> to kill the whole line."
"Press <s-j> or <C-^> to join lines."
"Press <s-.> or <C-c j> to jump to the start of a word in any visible window."
"Press <f11> to toggle fullscreen mode."
"Press <f12> to toggle the menu bar."
"Explore the Tools->Prelude menu to find out about some of Prelude extensions to Emacs."
"Access the official Emacs manual by pressing <C-h r>."
"Visit the EmacsWiki at http://emacswiki.org to find out even more about Emacs."))
(defun prelude-tip-of-the-day ()
"Display a random entry from `prelude-tips'."
(interactive)
(unless (window-minibuffer-p)
;; pick a new random seed
(random t)
(message
(concat "Prelude tip: " (nth (random (length prelude-tips)) prelude-tips)))))
(defun prelude-eval-after-init (form)
"Add `(lambda () FORM)' to `after-init-hook'.
If Emacs has already finished initialization, also eval FORM immediately."
(let ((func (list 'lambda nil form)))
(add-hook 'after-init-hook func)
(when after-init-time
(eval form))))
(require 'epl)
(defun prelude-update ()
"Update Prelude to its latest version."
(interactive)
(when (y-or-n-p "Do you want to update Prelude? ")
(message "Updating installed packages...")
(epl-upgrade)
(message "Updating Prelude...")
(cd prelude-dir)
(shell-command "git pull")
(prelude-recompile-init)
(message "Update finished. Restart Emacs to complete the process.")))
(defun prelude-update-packages (&optional arg)
"Update Prelude's packages.
This includes package installed via `prelude-require-package'.
With a prefix ARG updates all installed packages."
(interactive "P")
(when (y-or-n-p "Do you want to update Prelude's packages? ")
(if arg
(epl-upgrade)
(epl-upgrade (-filter (lambda (p) (memq (epl-package-name p) prelude-packages))
(epl-installed-packages))))
(message "Update finished. Restart Emacs to complete the process.")))
;;; Emacs in OSX already has fullscreen support
;;; Emacs has a similar built-in command in 24.4
(defun prelude-fullscreen ()
"Make Emacs window fullscreen.
This follows freedesktop standards, should work in X servers."
(interactive)
(if (eq window-system 'x)
(x-send-client-message nil 0 nil "_NET_WM_STATE" 32
'(2 "_NET_WM_STATE_FULLSCREEN" 0))
(error "Only X server is supported")))
(defun prelude-find-user-init-file (&optional arg)
"Edit the `prelude-user-init-file', in another window.
With a prefix argument ARG, find the `user-init-file' instead."
(interactive "P")
(if arg (find-file-other-window user-init-file)
(find-file-other-window prelude-user-init-file)))
(defun prelude-find-shell-init-file ()
"Edit the shell init file in another window."
(interactive)
(let* ((shell (car (reverse (s-split "/" (getenv "SHELL")))))
(shell-init-file (cond
((s-equals? "zsh" shell) ".zshrc")
((s-equals? "bash" shell) ".bashrc")
(t (error "Unknown shell")))))
(find-file-other-window (expand-file-name shell-init-file (getenv "HOME")))))
(defun prelude-wrap-with (s)
"Create a wrapper function for smartparens using S."
`(lambda (&optional arg)
(interactive "P")
(sp-wrap-with-pair ,s)))
;; needed for prelude-goto-symbol
(require 'imenu)
(defun prelude-goto-symbol (&optional symbol-list)
"Refresh imenu and jump to a place in the buffer using Ido."
(interactive)
(cond
((not symbol-list)
(let (name-and-pos symbol-names position)
(while (progn
(imenu--cleanup)
(setq imenu--index-alist nil)
(prelude-goto-symbol (imenu--make-index-alist))
(setq selected-symbol
(completing-read "Symbol? " (reverse symbol-names)))
(string= (car imenu--rescan-item) selected-symbol)))
(unless (and (boundp 'mark-active) mark-active)
(push-mark nil t nil))
(setq position (cdr (assoc selected-symbol name-and-pos)))
(cond
((overlayp position)
(goto-char (overlay-start position)))
(t
(goto-char position)))
(recenter)))
((listp symbol-list)
(dolist (symbol symbol-list)
(let (name position)
(cond
((and (listp symbol) (imenu--subalist-p symbol))
(prelude-goto-symbol 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)
(string= (car imenu--rescan-item) name))
(add-to-list 'symbol-names (substring-no-properties name))
(add-to-list 'name-and-pos (cons (substring-no-properties name) position))))))))
(provide 'prelude-core)
;;; prelude-core.el ends here
Reference in New Issue View Git Blame Copy Permalink