This repository has been archived on 2024-10-22. You can view files and clone it, but cannot push or open issues or pull requests.
spacemacs/layers/+distributions/spacemacs-base/funcs.el

1100 lines
39 KiB
EmacsLisp
Raw Normal View History

;;; funcs.el --- Spacemacs Base Layer functions File
;;
;; Copyright (c) 2012-2016 Sylvain Benner & Contributors
;;
;; Author: Sylvain Benner <sylvain.benner@gmail.com>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;; add emacs binary helper functions
(defun spacemacs/emacsbin-path ()
(interactive)
(concat exec-directory (if (spacemacs/system-is-mswindows) "bin/") "emacs"))
(defun spacemacs/emacs-start ()
(interactive)
(call-process (spacemacs/emacsbin-path) nil 0 nil)
(message "Started 'emacs' - it will be ready soon ..."))
(defun spacemacs/emacs-debug-init ()
(interactive)
(call-process (spacemacs/emacsbin-path) nil 0 nil "--debug-init")
(message "Started 'emacs --debug-init' - it will be ready soon ..."))
(defun spacemacs/emacs-reload ()
(interactive)
(load-file user-init-file)
(message ".emacs reloaded successfully"))
(defun spacemacs/emacs-Q ()
(interactive)
(call-process (spacemacs/emacsbin-path) nil 0 nil "-Q")
(message "Started 'emacs -Q' - it will be ready soon ..."))
;; from https://github.com/cofi/dotfiles/blob/master/emacs.d/config/cofi-util.el#L38
(defun spacemacs/add-to-hooks (fun hooks)
"Add function to hooks"
(dolist (hook hooks)
(add-hook hook fun)))
(defun spacemacs/add-all-to-hook (hook &rest funs)
"Add functions to hook."
(spacemacs/add-to-hook hook funs))
(defun spacemacs/add-to-hook (hook funs)
"Add list of functions to hook."
(dolist (fun funs)
(add-hook hook fun)))
2016-06-24 15:54:47 +00:00
(defun spacemacs//run-local-vars-mode-hook ()
"Run a hook for the major-mode after the local variables have been processed."
(run-hooks (intern (format "%S-local-vars-hook" major-mode))))
2016-06-24 15:54:47 +00:00
(defun spacemacs/echo (msg &rest args)
"Display MSG in echo-area without logging it in *Messages* buffer."
(interactive)
(let ((message-log-max nil))
(apply 'message msg args)))
(defun spacemacs/jump-in-buffer ()
(interactive)
(call-interactively
(cond
((and (configuration-layer/layer-usedp 'helm)
(eq major-mode 'org-mode))
'helm-org-in-buffer-headings)
((configuration-layer/layer-usedp 'helm)
'helm-semantic-or-imenu)
((configuration-layer/layer-usedp 'ivy)
'counsel-imenu)
(t 'imenu))))
(defun spacemacs/split-and-new-line ()
"Split a quoted string or s-expression and insert a new line with
auto-indent."
(interactive)
(sp-split-sexp 1)
(sp-newline))
(defun spacemacs/push-mark-and-goto-beginning-of-line ()
"Push a mark at current location and go to the beginnign of the line."
(interactive)
(push-mark (point))
(evil-beginning-of-line))
(defun spacemacs/push-mark-and-goto-end-of-line ()
"Push a mark at current location and go to the end of the line."
(interactive)
(push-mark (point))
(evil-end-of-line))
;; insert one or several line below without changing current evil state
(defun spacemacs/evil-insert-line-below (count)
"Insert one of several lines below the current point's line without changing
the current state and point position."
(interactive "p")
(save-excursion
(evil-save-state (evil-open-below count))))
;; insert one or several line above without changing current evil state
(defun spacemacs/evil-insert-line-above (count)
"Insert one of several lines above the current point's line without changing
the current state and point position."
(interactive "p")
(save-excursion
(evil-save-state (evil-open-above count))))
(defun spacemacs/evil-goto-next-line-and-indent (&optional count)
(interactive "p")
(let ((counter (or count 1)))
(while (> counter 0)
(join-line 1)
(newline-and-indent)
(setq counter (1- counter)))))
;; from Prelude
;; TODO: dispatch these in the layers
(defvar spacemacs-indent-sensitive-modes
'(coffee-mode
elm-mode
haml-mode
haskell-mode
slim-mode
makefile-mode
makefile-bsdmake-mode
makefile-gmake-mode
makefile-imake-mode
2016-02-23 19:53:44 +00:00
python-mode
yaml-mode)
"Modes for which auto-indenting is suppressed.")
(defcustom spacemacs-yank-indent-threshold 1000
"Threshold (# chars) over which indentation does not automatically occur."
:type 'number
:group 'spacemacs)
(defcustom spacemacs-large-file-modes-list
'(archive-mode tar-mode jka-compr git-commit-mode image-mode
doc-view-mode doc-view-mode-maybe ebrowse-tree-mode
pdf-view-mode)
"Major modes which `spacemacs/check-large-file' will not be
automatically applied to."
:group 'spacemacs
:type '(list symbol))
(defun spacemacs/indent-region-or-buffer ()
"Indent a region if selected, otherwise the whole buffer."
(interactive)
(unless (member major-mode spacemacs-indent-sensitive-modes)
(save-excursion
(if (region-active-p)
(progn
(indent-region (region-beginning) (region-end))
(message "Indented selected region."))
(progn
(evil-indent (point-min) (point-max))
(message "Indented buffer.")))
(whitespace-cleanup))))
2015-03-26 05:42:58 +00:00
;; idea from http://www.reddit.com/r/emacs/comments/312ge1/i_created_this_function_because_i_was_tired_of/
(defun spacemacs/eval-current-form ()
"Looks for the current def* or set* command then evaluates, unlike `eval-defun', does not go to topmost function"
(interactive)
(save-excursion
(search-backward-regexp "(def\\|(set")
(forward-list)
(call-interactively 'eval-last-sexp)))
;; from magnars
(defun spacemacs/eval-and-replace ()
"Replace the preceding sexp with its value."
(interactive)
(backward-kill-sexp)
(condition-case-unless-debug nil
(prin1 (eval (read (current-kill 0)))
(current-buffer))
(error (message "Invalid expression")
(insert (current-kill 0)))))
;; from https://gist.github.com/3402786
(defun spacemacs/toggle-maximize-buffer ()
2014-05-01 01:41:26 +00:00
"Maximize buffer"
(interactive)
(if (and (= 1 (length (window-list)))
(assoc ?_ register-alist))
(jump-to-register ?_)
(progn
(window-configuration-to-register ?_)
(delete-other-windows))))
;; https://tsdh.wordpress.com/2007/03/28/deleting-windows-vertically-or-horizontally/
(defun spacemacs/maximize-horizontally ()
"Delete all windows left or right of the current window."
(interactive)
(require 'windmove)
(save-excursion
(while (condition-case nil (windmove-left) (error nil))
(delete-window))
(while (condition-case nil (windmove-right) (error nil))
(delete-window))))
(defun spacemacs/toggle-centered-buffer-mode ()
"Toggle `spacemacs-centered-buffer-mode'."
(interactive)
(when (require 'centered-buffer-mode nil t)
(call-interactively 'spacemacs-centered-buffer-mode)))
(defun spacemacs/centered-buffer-mode-full-width ()
"Center buffer in the frame."
(interactive)
(when (require 'centered-buffer-mode nil t)
(spacemacs/maximize-horizontally)
(call-interactively 'spacemacs-centered-buffer-mode)))
(defun spacemacs/useless-buffer-p (buffer)
"Determines if a buffer is useful."
(let ((buf-paren-major-mode (get (with-current-buffer buffer
major-mode)
'derived-mode-parent))
(buf-name (buffer-name buffer)))
;; first find if useful buffer exists, if so returns nil and don't check for
;; useless buffers. If no useful buffer is found, check for useless buffers.
(unless (cl-loop for regexp in spacemacs-useful-buffers-regexp do
(when (or (eq buf-paren-major-mode 'comint-mode)
(string-match regexp buf-name))
(return t)))
(cl-loop for regexp in spacemacs-useless-buffers-regexp do
(when (string-match regexp buf-name)
(return t))))))
;; from magnars modified by ffevotte for dedicated windows support
(defun spacemacs/rotate-windows (count)
2015-04-13 19:29:46 +00:00
"Rotate your windows.
Dedicated windows are left untouched. Giving a negative prefix
2013-02-20 19:06:31 +00:00
argument takes the kindows rotate backwards."
2015-04-13 19:29:46 +00:00
(interactive "p")
(let* ((non-dedicated-windows (remove-if 'window-dedicated-p (window-list)))
(num-windows (length non-dedicated-windows))
(i 0)
(step (+ num-windows count)))
(cond ((not (> num-windows 1))
(message "You can't rotate a single window!"))
(t
(dotimes (counter (- num-windows 1))
(let* ((next-i (% (+ step i) num-windows))
(w1 (elt non-dedicated-windows i))
(w2 (elt non-dedicated-windows next-i))
(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)
(setq i next-i)))))))
2012-12-18 05:48:12 +00:00
(defun spacemacs/rotate-windows-backward (count)
2015-04-13 19:29:46 +00:00
"Rotate your windows backward."
2013-02-20 19:06:31 +00:00
(interactive "p")
(spacemacs/rotate-windows (* -1 count)))
2015-04-13 19:29:46 +00:00
(defun spacemacs/next-useful-buffer ()
"Switch to the next buffer and avoid special buffers."
2015-03-26 05:15:16 +00:00
(interactive)
2015-04-13 19:29:46 +00:00
(let ((start-buffer (current-buffer)))
(next-buffer)
(while (and (spacemacs/useless-buffer-p (current-buffer))
2015-04-13 19:29:46 +00:00
(not (eq (current-buffer) start-buffer)))
(next-buffer))))
(defun spacemacs/previous-useful-buffer ()
"Switch to the previous buffer and avoid special buffers."
2015-03-26 05:15:16 +00:00
(interactive)
2015-04-13 19:29:46 +00:00
(let ((start-buffer (current-buffer)))
(previous-buffer)
(while (and (spacemacs/useless-buffer-p (current-buffer))
2015-04-13 19:29:46 +00:00
(not (eq (current-buffer) start-buffer)))
(previous-buffer))))
2015-03-26 05:15:16 +00:00
(defun spacemacs/rename-file (filename &optional new-filename)
"Rename FILENAME to NEW-FILENAME.
When NEW-FILENAME is not specified, asks user for a new name.
Also renames associated buffer (if any exists), invalidates
projectile cache when it's possible and update recentf list."
(interactive "f")
(when (and filename (file-exists-p filename))
(let* ((buffer (find-buffer-visiting filename))
(short-name (file-name-nondirectory filename))
(new-name (if new-filename new-filename
(read-file-name
(format "Rename %s to: " short-name)))))
(cond ((get-buffer new-name)
(error "A buffer named '%s' already exists!" new-name))
(t
(let ((dir (file-name-directory new-name)))
(when (and (not (file-exists-p dir)) (yes-or-no-p (format "Create directory '%s'?" dir)))
(make-directory dir t)))
(rename-file filename new-name 1)
(when buffer
(kill-buffer buffer)
(find-file new-name))
(when (fboundp 'recentf-add-file)
(recentf-add-file new-name)
(recentf-remove-if-non-kept filename))
(when (and (configuration-layer/package-usedp 'projectile)
(projectile-project-p))
(call-interactively #'projectile-invalidate-cache))
(message "File '%s' successfully renamed to '%s'" short-name (file-name-nondirectory new-name)))))))
;; from magnars
(defun spacemacs/rename-current-buffer-file ()
"Renames current buffer and file it is visiting."
(interactive)
(let* ((name (buffer-name))
(filename (buffer-file-name))
(dir (file-name-directory filename)))
(if (not (and filename (file-exists-p filename)))
(error "Buffer '%s' is not visiting a file!" name)
(let ((new-name (read-file-name "New name: " dir)))
(cond ((get-buffer new-name)
(error "A buffer named '%s' already exists!" new-name))
(t
(let ((dir (file-name-directory new-name)))
(when (and (not (file-exists-p dir)) (yes-or-no-p (format "Create directory '%s'?" dir)))
(make-directory dir t)))
(rename-file filename new-name 1)
(rename-buffer new-name)
(set-visited-file-name new-name)
(set-buffer-modified-p nil)
(when (fboundp 'recentf-add-file)
(recentf-add-file new-name)
(recentf-remove-if-non-kept filename))
(when (and (configuration-layer/package-usedp 'projectile)
(projectile-project-p))
(call-interactively #'projectile-invalidate-cache))
(message "File '%s' successfully renamed to '%s'" name (file-name-nondirectory new-name))))))))
(defun spacemacs/delete-file (filename &optional ask-user)
"Remove specified file or directory.
Also kills associated buffer (if any exists) and invalidates
projectile cache when it's possible.
When ASK-USER is non-nil, user will be asked to confirm file
removal."
(interactive "f")
(when (and filename (file-exists-p filename))
(let ((buffer (find-buffer-visiting filename)))
(when buffer
(kill-buffer buffer)))
(when (or (not ask-user)
(yes-or-no-p "Are you sure you want to delete this file? "))
(delete-file filename)
(when (and (configuration-layer/package-usedp 'projectile)
(projectile-project-p))
(call-interactively #'projectile-invalidate-cache)))))
;; from magnars
(defun spacemacs/delete-current-buffer-file ()
"Removes file connected to current buffer and kills buffer."
(interactive)
(let ((filename (buffer-file-name))
(buffer (current-buffer))
(name (buffer-name)))
(if (not (and filename (file-exists-p filename)))
(ido-kill-buffer)
(when (yes-or-no-p "Are you sure you want to delete this file? ")
(delete-file filename t)
(kill-buffer buffer)
(when (and (configuration-layer/package-usedp 'projectile)
(projectile-project-p))
(call-interactively #'projectile-invalidate-cache))
(message "File '%s' successfully removed" filename)))))
;; from magnars
(defun spacemacs/sudo-edit (&optional arg)
(interactive "p")
(let ((fname (if (or arg (not buffer-file-name))
(read-file-name "File: ")
buffer-file-name)))
(find-file
(cond ((string-match-p "^/ssh:" fname)
(with-temp-buffer
(insert fname)
(search-backward ":")
(let ((last-match-end nil)
(last-ssh-hostname nil))
(while (string-match "@\\\([^:|]+\\\)" fname last-match-end)
(setq last-ssh-hostname (or (match-string 1 fname)
last-ssh-hostname))
(setq last-match-end (match-end 0)))
(insert (format "|sudo:%s" (or last-ssh-hostname "localhost"))))
(buffer-string)))
(t (concat "/sudo:root@localhost:" fname))))))
;; check when opening large files - literal file open
(defun spacemacs/check-large-file ()
(let* ((filename (buffer-file-name))
(size (nth 7 (file-attributes filename))))
(when (and
(not (memq major-mode spacemacs-large-file-modes-list))
size (> size (* 1024 1024 dotspacemacs-large-file-size))
(y-or-n-p (format (concat "%s is a large file, open literally to "
"avoid performance issues?")
filename)))
2016-03-12 16:45:41 +00:00
(setq buffer-read-only t)
(buffer-disable-undo)
(fundamental-mode))))
(defun spacemacs/delete-window (&optional arg)
"Delete the current window.
If the universal prefix argument is used then kill the buffer too."
(interactive "P")
(if (equal '(4) arg)
(kill-buffer-and-window)
(delete-window)))
(defun spacemacs/ace-delete-window (&optional arg)
"Ace delete window.
If the universal prefix argument is used then kill the buffer too."
(interactive "P")
(require 'ace-window)
(aw-select
" Ace - Delete Window"
(lambda (window)
(when (equal '(4) arg)
(with-selected-window window
(spacemacs/kill-this-buffer arg)))
(aw-delete-window window))))
;; our own implementation of kill-this-buffer from menu-bar.el
(defun spacemacs/kill-this-buffer (&optional arg)
"Kill the current buffer.
If the universal prefix argument is used then kill also the window."
(interactive "P")
(if (window-minibuffer-p)
(abort-recursive-edit)
(if (equal '(4) arg)
(kill-buffer-and-window)
(kill-buffer))))
(defun spacemacs/ace-kill-this-buffer (&optional arg)
"Ace kill visible buffer in a window.
If the universal prefix argument is used then kill also the window."
(interactive "P")
(require 'ace-window)
(let (golden-ratio-mode)
(aw-select
" Ace - Kill buffer in Window"
(lambda (window)
(with-selected-window window
(spacemacs/kill-this-buffer arg))))))
;; found at http://emacswiki.org/emacs/KillingBuffers
(defun spacemacs/kill-other-buffers (&optional arg)
"Kill all other buffers.
If the universal prefix argument is used then will the windows too."
(interactive "P")
(when (yes-or-no-p (format "Killing all buffers except \"%s\"? "
(buffer-name)))
2015-11-03 12:53:10 +00:00
(mapc 'kill-buffer (delq (current-buffer) (buffer-list)))
(when (equal '(4) arg) (delete-other-windows))
2015-11-03 12:53:10 +00:00
(message "Buffers deleted!")))
;; from http://dfan.org/blog/2009/02/19/emacs-dedicated-windows/
(defun spacemacs/toggle-current-window-dedication ()
"Toggle dedication state of a window."
(interactive)
(let* ((window (selected-window))
(dedicated (window-dedicated-p window)))
(set-window-dedicated-p window (not dedicated))
(message "Window %sdedicated to %s"
(if dedicated "no longer " "")
(buffer-name))))
;; http://camdez.com/blog/2013/11/14/emacs-show-buffer-file-name/
(defun spacemacs/show-and-copy-buffer-filename ()
"Show and copy the full path to the current file in the minibuffer."
(interactive)
2016-02-18 18:36:16 +00:00
;; list-buffers-directory is the variable set in dired buffers
(let ((file-name (or (buffer-file-name) list-buffers-directory)))
(if file-name
2016-02-18 18:36:16 +00:00
(message (kill-new file-name))
(error "Buffer not visiting a file"))))
;; adapted from bozhidar
2013-11-15 15:55:23 +00:00
;; http://emacsredux.com/blog/2013/05/18/instant-access-to-init-dot-el/
(defun spacemacs/find-user-init-file ()
"Edit the `user-init-file', in the current window."
2013-11-15 15:55:23 +00:00
(interactive)
(find-file-existing user-init-file))
2013-11-15 15:55:23 +00:00
(defun spacemacs/find-dotfile ()
"Edit the `dotfile', in the current window."
(interactive)
(find-file-existing (dotspacemacs/location)))
(defun spacemacs/ediff-dotfile-and-template ()
"ediff the current `dotfile' with the template"
(interactive)
(ediff-files (dotspacemacs/location)
(concat dotspacemacs-template-directory ".spacemacs.template")))
2015-09-10 11:26:57 +00:00
(defun spacemacs/new-empty-buffer ()
"Create a new buffer called untitled(<n>)"
(interactive)
(let ((newbuf (generate-new-buffer-name "untitled")))
(switch-to-buffer newbuf)))
;; from https://gist.github.com/timcharper/493269
(defun spacemacs/split-window-vertically-and-switch ()
(interactive)
(split-window-vertically)
(other-window 1))
(defun spacemacs/split-window-horizontally-and-switch ()
(interactive)
(split-window-horizontally)
(other-window 1))
(defun spacemacs/layout-triple-columns ()
" Set the layout to triple columns. "
(interactive)
(delete-other-windows)
(dotimes (i 2) (split-window-right))
(balance-windows))
(defun spacemacs/layout-double-columns ()
" Set the layout to double columns. "
(interactive)
(delete-other-windows)
(split-window-right))
(defalias 'spacemacs/home 'spacemacs-buffer/goto-buffer
"Go to home Spacemacs buffer")
(defun spacemacs/home-delete-other-windows ()
"Open home Spacemacs buffer and delete other windows.
Useful for making the home buffer the only visible buffer in the frame."
(interactive)
(spacemacs/home)
(delete-other-windows))
(defun spacemacs/insert-line-above-no-indent (count)
(interactive "p")
(let ((p (+ (point) count)))
(save-excursion
(if (eq (line-number-at-pos) 1)
(evil-move-beginning-of-line)
(progn
(evil-previous-line)
(evil-move-end-of-line)))
(while (> count 0)
(insert "\n")
(setq count (1- count))))
(goto-char p)))
(defun spacemacs/insert-line-below-no-indent (count)
"Insert a new line below with no identation."
(interactive "p")
(save-excursion
(evil-move-end-of-line)
(while (> count 0)
(insert "\n")
(setq count (1- count)))))
;; from https://github.com/gempesaw/dotemacs/blob/emacs/dg-defun.el
(defun spacemacs/kill-matching-buffers-rudely (regexp &optional internal-too)
"Kill buffers whose name matches the specified REGEXP. This
function, unlike the built-in `kill-matching-buffers` does so
WITHOUT ASKING. The optional second argument indicates whether to
kill internal buffers too."
(interactive "sKill buffers matching this regular expression: \nP")
(dolist (buffer (buffer-list))
(let ((name (buffer-name buffer)))
(when (and name (not (string-equal name ""))
(or internal-too (/= (aref name 0) ?\s))
(string-match regexp name))
(kill-buffer buffer)))))
2014-05-01 01:41:26 +00:00
;; advise to prevent server from closing
(defvar spacemacs-really-kill-emacs nil
"prevent window manager close from closing instance.")
(defun spacemacs/persistent-server-running-p ()
2015-03-30 01:41:09 +00:00
"Requires spacemacs-really-kill-emacs to be toggled and
dotspacemacs-persistent-server to be t"
(and (fboundp 'server-running-p)
(server-running-p)
dotspacemacs-persistent-server))
(defadvice kill-emacs (around spacemacs-really-exit activate)
"Only kill emacs if a prefix is set"
2015-03-30 01:41:09 +00:00
(if (and (not spacemacs-really-kill-emacs)
(spacemacs/persistent-server-running-p))
(spacemacs/frame-killer)
2015-03-30 01:41:09 +00:00
ad-do-it))
(defadvice save-buffers-kill-emacs (around spacemacs-really-exit activate)
"Only kill emacs if a prefix is set"
(if (or spacemacs-really-kill-emacs (not dotspacemacs-persistent-server))
ad-do-it
(spacemacs/frame-killer)))
(defun spacemacs/save-buffers-kill-emacs ()
"Save all changed buffers and exit Spacemacs"
(interactive)
(setq spacemacs-really-kill-emacs t)
(save-buffers-kill-emacs))
(defun spacemacs/kill-emacs ()
"Lose all changes and exit Spacemacs"
(interactive)
(setq spacemacs-really-kill-emacs t)
(kill-emacs))
(defun spacemacs/prompt-kill-emacs ()
"Prompt to save changed buffers and exit Spacemacs"
(interactive)
(setq spacemacs-really-kill-emacs t)
(save-some-buffers)
(kill-emacs))
(defun spacemacs/frame-killer ()
"Kill server buffer and hide the main Emacs window"
(interactive)
(condition-case-unless-debug nil
(delete-frame nil 1)
(error
(make-frame-invisible nil 1))))
(defun spacemacs/toggle-frame-fullscreen ()
"Respect the `dotspacemacs-fullscreen-use-non-native' variable when
toggling fullscreen."
(interactive)
(if dotspacemacs-fullscreen-use-non-native
(spacemacs/toggle-frame-fullscreen-non-native)
(toggle-frame-fullscreen)))
(defun spacemacs/toggle-fullscreen ()
"Toggle full screen on X11 and Carbon"
(interactive)
(cond
((eq window-system 'x)
(set-frame-parameter nil 'fullscreen
(when (not (frame-parameter nil 'fullscreen))
'fullboth)))
((eq window-system 'mac)
2014-07-11 03:52:39 +00:00
(set-frame-parameter
nil 'fullscreen
(when (not (frame-parameter nil 'fullscreen)) 'fullscreen)))))
(defun spacemacs/toggle-frame-fullscreen-non-native ()
"Toggle full screen non-natively. Uses the `fullboth' frame paramerter
rather than `fullscreen'. Useful to fullscreen on OSX w/o animations."
(interactive)
(modify-frame-parameters
nil
`((maximized
. ,(unless (memq (frame-parameter nil 'fullscreen) '(fullscreen fullboth))
(frame-parameter nil 'fullscreen)))
(fullscreen
. ,(if (memq (frame-parameter nil 'fullscreen) '(fullscreen fullboth))
(if (eq (frame-parameter nil 'maximized) 'maximized)
'maximized)
'fullboth)))))
;; taken from Prelude: https://github.com/bbatsov/prelude
(defmacro spacemacs|advise-commands (advice-name commands class &rest body)
"Apply advice named ADVICE-NAME to multiple COMMANDS.
The body of the advice is in BODY."
`(progn
,@(mapcar (lambda (command)
`(defadvice ,command
(,class ,(intern (format "%S-%s" command advice-name))
activate)
,@body))
commands)))
(defun spacemacs/safe-revert-buffer ()
"Prompt before reverting the file."
(interactive)
(revert-buffer nil nil))
(defun spacemacs/safe-erase-buffer ()
"Prompt before erasing the content of the file."
(interactive)
(if (y-or-n-p (format "Erase content of buffer %s ? " (current-buffer)))
(erase-buffer)))
(defun spacemacs/ert-run-tests-buffer ()
"Run all the tests in the current buffer."
(interactive)
(save-buffer)
(load-file (buffer-file-name))
(ert t))
(defun spacemacs/alternate-buffer ()
2015-08-05 19:48:00 +00:00
"Switch back and forth between current and last buffer in the
current window."
(interactive)
2015-08-05 19:48:00 +00:00
(if (evil-alternate-buffer)
(switch-to-buffer (car (evil-alternate-buffer)))
(switch-to-buffer (other-buffer (current-buffer) t))))
2014-11-26 19:57:01 +00:00
2015-01-03 10:17:32 +00:00
(defun current-line ()
"Return the line at point as a string."
(buffer-substring (line-beginning-position) (line-end-position)))
2015-01-12 04:00:13 +00:00
(defun spacemacs/open-in-external-app ()
"Open current file in external application."
(interactive)
(let ((file-path (if (eq major-mode 'dired-mode)
(dired-get-file-for-visit)
(buffer-file-name))))
(if file-path
(cond
((spacemacs/system-is-mswindows) (w32-shell-execute "open" (replace-regexp-in-string "/" "\\\\" file-path)))
((spacemacs/system-is-mac) (shell-command (format "open \"%s\"" file-path)))
((spacemacs/system-is-linux) (let ((process-connection-type nil))
(start-process "" nil "xdg-open" file-path))))
(message "No file associated to this buffer."))))
(defun spacemacs/switch-to-minibuffer-window ()
"switch to minibuffer window (if active)"
(interactive)
(when (active-minibuffer-window)
(select-window (active-minibuffer-window))))
(defun spacemacs/comint-clear-buffer ()
(interactive)
(let ((comint-buffer-maximum-size 0))
(comint-truncate-buffer)))
;; http://stackoverflow.com/a/10216338/4869
(defun spacemacs/copy-whole-buffer-to-clipboard ()
"Copy entire buffer to clipboard"
(interactive)
(clipboard-kill-ring-save (point-min) (point-max)))
(defun spacemacs/copy-clipboard-to-whole-buffer ()
"Copy clipboard and replace buffer"
(interactive)
(delete-region (point-min) (point-max))
(clipboard-yank)
(deactivate-mark))
;; BEGIN align functions
;; modified function from http://emacswiki.org/emacs/AlignCommands
(defun spacemacs/align-repeat (start end regexp &optional justify-right after)
"Repeat alignment with respect to the given regular expression.
If JUSTIFY-RIGHT is non nil justify to the right instead of the
left. If AFTER is non-nil, add whitespace to the left instead of
the right."
(interactive "r\nsAlign regexp: ")
(let ((complete-regexp (if after
(concat regexp "\\([ \t]*\\)")
(concat "\\([ \t]*\\)" regexp)))
(group (if justify-right -1 1)))
(align-regexp start end complete-regexp group 1 t)))
;; Modified answer from http://emacs.stackexchange.com/questions/47/align-vertical-columns-of-numbers-on-the-decimal-point
(defun spacemacs/align-repeat-decimal (start end)
"Align a table of numbers on decimal points and dollar signs (both optional)"
(interactive "r")
(require 'align)
(align-region start end nil
'((nil (regexp . "\\([\t ]*\\)\\$?\\([\t ]+[0-9]+\\)\\.?")
(repeat . t)
(group 1 2)
(spacing 1 1)
(justify nil t)))
nil))
(defmacro spacemacs|create-align-repeat-x (name regexp &optional justify-right default-after)
(let ((new-func (intern (concat "spacemacs/align-repeat-" name))))
`(defun ,new-func (start end switch)
(interactive "r\nP")
(let ((after (not (eq (if switch t nil) (if ,default-after t nil)))))
2015-09-03 20:21:37 +00:00
(spacemacs/align-repeat start end ,regexp ,justify-right after)))))
(spacemacs|create-align-repeat-x "comma" "," nil t)
(spacemacs|create-align-repeat-x "semicolon" ";" nil t)
(spacemacs|create-align-repeat-x "colon" ":" nil t)
(spacemacs|create-align-repeat-x "equal" "=")
(spacemacs|create-align-repeat-x "math-oper" "[+\\-*/]")
(spacemacs|create-align-repeat-x "ampersand" "&")
(spacemacs|create-align-repeat-x "bar" "|")
(spacemacs|create-align-repeat-x "left-paren" "(")
(spacemacs|create-align-repeat-x "right-paren" ")" t)
2016-02-25 19:16:34 +00:00
(spacemacs|create-align-repeat-x "backslash" "\\\\")
;; END align functions
(defun spacemacs/dos2unix ()
"Converts the current buffer to UNIX file format."
(interactive)
(set-buffer-file-coding-system 'undecided-unix nil))
(defun spacemacs/unix2dos ()
"Converts the current buffer to DOS file format."
(interactive)
(set-buffer-file-coding-system 'undecided-dos nil))
(defun spacemacs/copy-file ()
"Write the file under new name."
(interactive)
(call-interactively 'write-file))
2015-07-06 10:13:41 +00:00
(defun spacemacs//imagep (object)
"Tests whether the given object is an image (a list whose
first element is the symbol `image')."
(and (listp object)
object
(eq 'image (car object))))
(defun spacemacs/uniquify-lines ()
"Remove duplicate adjacent lines in region or current buffer"
(interactive)
(save-excursion
(save-restriction
(let ((beg (if (region-active-p) (region-beginning) (point-min)))
(end (if (region-active-p) (region-end) (point-max))))
(goto-char beg)
(while (re-search-forward "^\\(.*\n\\)\\1+" end t)
(replace-match "\\1"))))))
(defun spacemacs/sort-lines ()
"Sort lines in region or current buffer"
(interactive)
(let ((beg (if (region-active-p) (region-beginning) (point-min)))
(end (if (region-active-p) (region-end) (point-max))))
(sort-lines nil beg end)))
;; BEGIN linum mouse helpers
(defvar spacemacs-linum-mdown-line nil
"Define persistent variable for linum selection")
(defun spacemacs/line-at-click ()
"Determine the visual line at click"
(save-excursion
(let ((click-y (cddr (mouse-position)))
(debug-on-error t)
(line-move-visual t))
(goto-char (window-start))
(next-line (1- click-y))
(1+ (line-number-at-pos))
)))
(defun spacemacs/md-select-linum (event)
"Set point as spacemacs-linum-mdown-line"
(interactive "e")
(mouse-select-window event)
(goto-line (spacemacs/line-at-click))
(set-mark (point))
(setq spacemacs-linum-mdown-line
(line-number-at-pos)))
(defun spacemacs/mu-select-linum ()
"Select code block between point and spacemacs-linum-mdown-line"
(interactive)
(when spacemacs-linum-mdown-line
(let (mu-line)
(setq mu-line (spacemacs/line-at-click))
(goto-line (max spacemacs-linum-mdown-line mu-line))
(set-mark (line-end-position))
(goto-line (min spacemacs-linum-mdown-line mu-line))
(setq spacemacs-linum-mdown-line nil))))
(defun spacemacs/select-current-block ()
"Select the current block of text between blank lines."
(interactive)
(let (p1 p2)
(progn
(if (re-search-backward "\n[ \t]*\n" nil "move")
(progn (re-search-forward "\n[ \t]*\n")
(setq p1 (point)))
(setq p1 (point)))
(if (re-search-forward "\n[ \t]*\n" nil "move")
(progn (re-search-backward "\n[ \t]*\n")
(setq p2 (point)))
(setq p2 (point))))
(set-mark p1)))
;; END linum mouse helpers
;; From http://xugx2007.blogspot.ca/2007/06/benjamin-rutts-emacs-c-development-tips.html
(setq compilation-finish-function
(lambda (buf str)
(if (or (string-match "exited abnormally" str)
(string-match "FAILED" (buffer-string)))
;; there were errors
(message "There were errors. SPC-e-n to visit.")
(unless (or (string-match "Grep finished" (buffer-string))
(string-match "Ag finished" (buffer-string))
(string-match "nosetests" (buffer-name)))
;; no errors
(message "compilation ok.")))))
;; from http://www.emacswiki.org/emacs/WordCount
(defun spacemacs/count-words-analysis (start end)
"Count how many times each word is used in the region.
Punctuation is ignored."
(interactive "r")
(let (words alist_words_compare (formated ""))
(save-excursion
(goto-char start)
(while (re-search-forward "\\w+" end t)
(let* ((word (intern (match-string 0)))
(cell (assq word words)))
(if cell
(setcdr cell (1+ (cdr cell)))
(setq words (cons (cons word 1) words))))))
(defun alist_words_compare (a b)
"Compare elements from an associative list of words count.
Compare them on count first,and in case of tie sort them alphabetically."
(let ((a_key (car a))
(a_val (cdr a))
(b_key (car b))
(b_val (cdr b)))
(if (eq a_val b_val)
(string-lessp a_key b_key)
(> a_val b_val))))
(setq words (cl-sort words 'alist_words_compare))
(while words
(let* ((word (pop words))
(name (car word))
(count (cdr word)))
(setq formated (concat formated (format "[%s: %d], " name count)))))
(when (interactive-p)
(if (> (length formated) 2)
(message (substring formated 0 -2))
(message "No words.")))
words))
;; indent on paste
;; from Prelude: https://github.com/bbatsov/prelude
(defun spacemacs/yank-advised-indent-function (beg end)
"Do indentation, as long as the region isn't too large."
(if (<= (- end beg) spacemacs-yank-indent-threshold)
(indent-region beg end nil)))
(spacemacs|advise-commands
"indent" (yank yank-pop evil-paste-before evil-paste-after) around
"If current mode is not one of spacemacs-indent-sensitive-modes
indent yanked text (with universal arg don't indent)."
(evil-start-undo-step)
ad-do-it
(if (and (not (equal '(4) (ad-get-arg 0)))
(not (member major-mode spacemacs-indent-sensitive-modes))
(or (derived-mode-p 'prog-mode)
(member major-mode spacemacs-indent-sensitive-modes)))
(let ((transient-mark-mode nil)
(save-undo buffer-undo-list))
(spacemacs/yank-advised-indent-function (region-beginning)
(region-end))))
(evil-end-undo-step))
;; find file functions in split
(defun spacemacs//display-in-split (buffer alist)
"Split selected window and display BUFFER in the new window.
BUFFER and ALIST have the same form as in `display-buffer'. If ALIST contains
a split-side entry, its value must be usable as the SIDE argument for
`split-window'."
(let ((window (split-window nil nil (cdr (assq 'split-side alist)))))
(window--display-buffer buffer window 'window alist)
window))
(defun spacemacs/find-file-vsplit (file)
"find file in vertical split"
(interactive "FFind file (vsplit): ")
(let ((buffer (find-file-noselect file)))
(pop-to-buffer buffer '(spacemacs//display-in-split (split-side . right)))))
(defun spacemacs/find-file-split (file)
"find file in horizonatl split"
(interactive "FFind file (split): ")
(let ((buffer (find-file-noselect file)))
(pop-to-buffer buffer '(spacemacs//display-in-split (split-side . below)))))
(defun spacemacs//intersperse (seq separator)
"Returns a list with `SEPARATOR' added between each element
of the list `SEQ'."
(cond
((not seq) nil)
((not (cdr seq)) seq)
(t (append (list (car seq) separator)
(spacemacs//intersperse (cdr seq) separator)))))
(defun spacemacs//mode-line-nonempty (seg)
"Checks whether a modeline segment (classical Emacs style)
is nonempty."
(let ((val (format-mode-line seg)))
(cond ((listp val) val)
((stringp val) (< 0 (length val)))
(t))))
(defun spacemacs/switch-to-scratch-buffer ()
"Switch to the `*scratch*' buffer. Create it first if needed."
(interactive)
(let ((exists (get-buffer "*scratch*")))
(switch-to-buffer (get-buffer-create "*scratch*"))
(when (and (not exists)
(not (eq major-mode dotspacemacs-scratch-mode))
(fboundp dotspacemacs-scratch-mode))
(funcall dotspacemacs-scratch-mode))))
;; http://stackoverflow.com/questions/11847547/emacs-regexp-count-occurrences
(defun how-many-str (regexp str)
(loop with start = 0
for count from 0
while (string-match regexp str start)
do (setq start (match-end 0))
finally return count))
(defun spacemacs/close-compilation-window ()
"Close the window containing the '*compilation*' buffer."
(interactive)
2016-03-13 16:19:21 +00:00
(when compilation-last-buffer
(delete-windows-on compilation-last-buffer)))
(defun no-linum (&rest ignore)
"Disable linum if current buffer."
(when (or 'linum-mode global-linum-mode)
(linum-mode 0)))
;; Generalized next-error system ("gne")
(defun spacemacs//error-delegate ()
"Decide which error API to delegate to.
Delegates to flycheck if it is enabled and the next-error buffer
is not visible. Otherwise delegates to regular Emacs next-error."
(if (and (bound-and-true-p flycheck-mode)
(let ((buf (next-error-find-buffer)))
(not (and buf (get-buffer-window buf)))))
'flycheck
'emacs))
(defun spacemacs/next-error (&optional n reset)
"Dispatch to flycheck or standard emacs error."
(interactive "P")
(let ((sys (spacemacs//error-delegate)))
(cond
((eq 'flycheck sys) (call-interactively 'flycheck-next-error))
((eq 'emacs sys) (call-interactively 'next-error)))))
(defun spacemacs/previous-error (&optional n reset)
"Dispatch to flycheck or standard emacs error."
(interactive "P")
(let ((sys (spacemacs//error-delegate)))
(cond
((eq 'flycheck sys) (call-interactively 'flycheck-previous-error))
((eq 'emacs sys) (call-interactively 'previous-error)))))
(defvar-local spacemacs--gne-min-line nil
"The first line in the buffer that is a valid result.")
(defvar-local spacemacs--gne-max-line nil
"The last line in the buffer that is a valid result.")
(defvar-local spacemacs--gne-cur-line 0
"The current line in the buffer. (It is problematic to use
point for this.)")
(defvar-local spacemacs--gne-line-func nil
"The function to call to visit the result on a line.")
(defun spacemacs//gne-next (num reset)
"A generalized next-error function. This function can be used
as `next-error-function' in any buffer that conforms to the
Spacemacs generalized next-error API.
The variables `spacemacs--gne-min-line',
`spacemacs--gne-max-line', and `spacemacs--line-func' must be
set."
(when reset (setq spacemacs--gne-cur-line
spacemacs--gne-min-line))
(setq spacemacs--gne-cur-line
(min spacemacs--gne-max-line
(max spacemacs--gne-min-line
(+ num spacemacs--gne-cur-line))))
(goto-line spacemacs--gne-cur-line)
(funcall spacemacs--gne-line-func
(buffer-substring (point-at-bol) (point-at-eol))))