;;; 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)) (defun prelude-file-owner-uid (filename) "Return the UID of the FILENAME as an integer. See `file-attributes' for more info." (nth 2 (file-attributes filename 'integer))) (defun prelude-file-owned-by-user-p (filename) "Return t if file FILENAME is owned by the currently logged in user." (equal (prelude-file-owner-uid filename) (user-uid))) (defun prelude-find-alternate-file-as-root (filename) "Wraps `find-alternate-file' with opening a file as root." (find-alternate-file (concat "/sudo:root@localhost:" filename))) (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): "))) (prelude-find-alternate-file-as-root buffer-file-name))) (defun prelude-reopen-as-root () "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) (prelude-file-owned-by-user-p buffer-file-name)) (prelude-find-alternate-file-as-root buffer-file-name))) (add-hook 'find-file-hook 'prelude-reopen-as-root) (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) (when (and prelude-tips (not (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