451 lines
18 KiB
EmacsLisp
451 lines
18 KiB
EmacsLisp
;;; core-funcs.el --- Spacemacs Core File
|
||
;;
|
||
;; Copyright (c) 2012-2021 Sylvain Benner & Contributors
|
||
;;
|
||
;; Author: Sylvain Benner <sylvain.benner@gmail.com>
|
||
;; URL: https://github.com/syl20bnr/spacemacs
|
||
;;
|
||
;; This file is not part of GNU Emacs.
|
||
;;
|
||
;; 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
|
||
(defvar configuration-layer--protected-packages)
|
||
(defvar dotspacemacs-filepath)
|
||
(defvar spacemacs-repl-list '()
|
||
"List of all registered REPLs.")
|
||
|
||
(defmacro spacemacs|dotspacemacs-backward-compatibility (variable default)
|
||
"Return `if' sexp for backward compatibility with old dotspacemacs
|
||
values."
|
||
`(if (boundp ',variable) ,variable ',default))
|
||
|
||
(defun spacemacs/system-is-mac ()
|
||
(eq system-type 'darwin))
|
||
(defun spacemacs/system-is-linux ()
|
||
(eq system-type 'gnu/linux))
|
||
(defun spacemacs/system-is-mswindows ()
|
||
(eq system-type 'windows-nt))
|
||
|
||
(defun spacemacs/window-system-is-mac ()
|
||
;; ns is returned instead of mac on Emacs 25+
|
||
(memq (window-system) '(mac ns)))
|
||
|
||
(defun spacemacs/mplist-get-values (plist prop)
|
||
"Get the values associated to PROP in PLIST, a modified plist.
|
||
|
||
A modified plist is one where keys are keywords and values are
|
||
all non-keywords elements that follow it.
|
||
|
||
If there are multiple properties with the same keyword, only the first property
|
||
and its values is returned.
|
||
|
||
Currently this function infloops when the list is circular."
|
||
(let ((tail plist)
|
||
result)
|
||
(while (and (consp tail) (not (eq prop (car tail))))
|
||
(pop tail))
|
||
;; pop the found keyword
|
||
(pop tail)
|
||
(while (and (consp tail) (not (keywordp (car tail))))
|
||
(push (pop tail) result))
|
||
(nreverse result)))
|
||
|
||
(defun spacemacs/mplist-get-value (plist prop)
|
||
"Get a single value associated to PROP in PLIST, a modified plist.
|
||
|
||
You should always use this function instead of builtin `plist-get'
|
||
in Spacemacs.
|
||
|
||
A modified plist is one where keys are keywords and values are
|
||
all non-keywords elements that follow it.
|
||
|
||
If there are multiple properties with the same keyword, only the first property
|
||
and its values is returned.
|
||
|
||
Currently this function infloops when the list is circular."
|
||
(car (spacemacs/mplist-get-values plist prop)))
|
||
|
||
(defun spacemacs/mplist-remove (plist prop)
|
||
"Return a copy of a modified PLIST without PROP and its values.
|
||
|
||
If there are multiple properties with the same keyword, only the first property
|
||
and its values are removed."
|
||
(let ((tail plist)
|
||
result)
|
||
(while (and (consp tail) (not (eq prop (car tail))))
|
||
(push (pop tail) result))
|
||
(when (eq prop (car tail))
|
||
(pop tail)
|
||
(while (and (consp tail) (not (keywordp (car tail))))
|
||
(pop tail)))
|
||
(while (consp tail)
|
||
(push (pop tail) result))
|
||
(nreverse result)))
|
||
|
||
;; Originally based on http://stackoverflow.com/questions/2321904/elisp-how-to-save-data-in-a-file
|
||
(defun spacemacs/dump-vars-to-file (varlist filename)
|
||
"simplistic dumping of variables in VARLIST to a file FILENAME"
|
||
(with-temp-file filename
|
||
(spacemacs/dump-vars varlist (current-buffer))
|
||
(make-directory (file-name-directory filename) t)))
|
||
|
||
;; From http://stackoverflow.com/questions/2321904/elisp-how-to-save-data-in-a-file
|
||
(defun spacemacs/dump-vars (varlist buffer)
|
||
"insert into buffer the setq statement to recreate the variables in VARLIST"
|
||
(cl-loop for var in varlist do
|
||
(print (list 'setq var (list 'quote (symbol-value var)))
|
||
buffer)))
|
||
|
||
(defvar spacemacs--init-redisplay-count 0
|
||
"The number of calls to `redisplay'")
|
||
(defun spacemacs//redisplay ()
|
||
"`redisplay' wrapper."
|
||
(setq spacemacs--init-redisplay-count (1+ spacemacs--init-redisplay-count))
|
||
(force-window-update)
|
||
(redisplay))
|
||
|
||
(defun spacemacs//create-key-binding-form (props func)
|
||
"Helper which returns a from to bind FUNC to a key according to PROPS.
|
||
|
||
Supported properties:
|
||
|
||
`:evil-leader STRING'
|
||
One or several key sequence strings to be set with `spacemacs/set-leader-keys .
|
||
|
||
`:evil-leader-for-mode CONS CELL'
|
||
One or several cons cells (MODE . KEY) where MODE is a major-mode symbol
|
||
and KEY is a key sequence string to be set with
|
||
`spacemacs/set-leader-keys-for-major-mode'.
|
||
|
||
`:global-key STRING'
|
||
One or several key sequence strings to be set with `global-set-key'.
|
||
|
||
`:define-key CONS CELL'
|
||
One or several cons cells (MAP . KEY) where MAP is a mode map and KEY is a
|
||
key sequence string to be set with `define-key'. "
|
||
(let ((evil-leader (spacemacs/mplist-get-values props :evil-leader))
|
||
(evil-leader-for-mode (spacemacs/mplist-get-values props :evil-leader-for-mode))
|
||
(global-key (spacemacs/mplist-get-values props :global-key))
|
||
(def-key (spacemacs/mplist-get-values props :define-key)))
|
||
(append
|
||
(when evil-leader
|
||
`((dolist (key ',evil-leader)
|
||
(spacemacs/set-leader-keys key ',func))))
|
||
(when evil-leader-for-mode
|
||
`((dolist (val ',evil-leader-for-mode)
|
||
(spacemacs/set-leader-keys-for-major-mode
|
||
(car val) (cdr val) ',func))))
|
||
(when global-key
|
||
`((dolist (key ',global-key)
|
||
(global-set-key (kbd key) ',func))))
|
||
(when def-key
|
||
`((dolist (val ',def-key)
|
||
(define-key (eval (car val)) (kbd (cdr val)) ',func)))))))
|
||
|
||
(defun spacemacs/prettify-org-buffer ()
|
||
"Apply visual enchantments to the current buffer.
|
||
The buffer's major mode should be `org-mode'."
|
||
(interactive)
|
||
(unless (derived-mode-p 'org-mode)
|
||
(user-error "org-mode should be enabled in the current buffer."))
|
||
(if (require 'space-doc nil t)
|
||
(space-doc-mode)
|
||
;; Make ~SPC ,~ work, reference:
|
||
;; http://stackoverflow.com/questions/24169333/how-can-i-emphasize-or-verbatim-quote-a-comma-in-org-mode
|
||
(setcar (nthcdr 2 org-emphasis-regexp-components) " \t\n")
|
||
(org-set-emph-re 'org-emphasis-regexp-components org-emphasis-regexp-components)
|
||
(setq-local org-emphasis-alist '(("*" bold)
|
||
("/" italic)
|
||
("_" underline)
|
||
("=" org-verbatim verbatim)
|
||
("~" org-kbd)
|
||
("+"
|
||
(:strike-through t))))))
|
||
|
||
(defun spacemacs/view-org-file (file &optional anchor-text expand-scope)
|
||
"Open org file and apply visual enchantments.
|
||
FILE is the org file to be opened.
|
||
If ANCHOR-TEXT is `nil' then run `re-search-forward' with ^ (beginning-of-line).
|
||
If ANCHOR-TEXT is a GitHub style anchor then find a corresponding header.
|
||
If ANCHOR-TEXT isn't a GitHub style anchor then run `re-search-forward' with
|
||
ANCHOR-TEXT.
|
||
If EXPAND-SCOPE is `subtree' then run `outline-show-subtree' at the matched line.
|
||
If EXPAND-SCOPE is `all' then run `outline-show-all' at the matched line."
|
||
(interactive)
|
||
(find-file file)
|
||
(spacemacs/prettify-org-buffer)
|
||
(goto-char (point-min))
|
||
(when anchor-text
|
||
;; If `anchor-text' is GitHub style link.
|
||
(if (string-prefix-p "#" anchor-text)
|
||
;; If the toc-org package is loaded.
|
||
(if (configuration-layer/package-used-p 'toc-org)
|
||
;; For each heading. Search the heading that corresponds
|
||
;; to `anchor-text'.
|
||
(while (and (re-search-forward "^[\\*]+\s\\(.*\\).*$" nil t)
|
||
(not (string= (toc-org-hrefify-gh (match-string 1))
|
||
anchor-text))))
|
||
;; This is not a problem because without the space-doc package
|
||
;; those links will be opened in the browser.
|
||
(message (format (concat "Can't follow the GitHub style anchor: '%s' "
|
||
"without the org layer.") anchor-text)))
|
||
(re-search-forward anchor-text)))
|
||
(beginning-of-line)
|
||
(cond
|
||
((eq expand-scope 'subtree)
|
||
(outline-show-subtree))
|
||
((eq expand-scope 'all)
|
||
(outline-show-all))
|
||
(t nil)))
|
||
|
||
(defun spacemacs//test-var (pred var test-desc)
|
||
"Test PRED against VAR and print test result, incrementing
|
||
passed-tests and total-tests."
|
||
(let ((var-name (symbol-name var))
|
||
(var-val (symbol-value var)))
|
||
(when (boundp 'total-tests) (setq total-tests (1+ total-tests)))
|
||
(insert (format "** TEST: [[file:%s::%s][%s]] %s\n"
|
||
dotspacemacs-filepath var-name var-name test-desc))
|
||
(if (funcall pred var-val)
|
||
(progn
|
||
(when (boundp 'passed-tests) (setq passed-tests (1+ passed-tests)))
|
||
(insert (format "*** PASS: %s\n" var-val)))
|
||
(insert (propertize (format "*** FAIL: %s\n" var-val)
|
||
'font-lock-face 'font-lock-warning-face)))))
|
||
|
||
(defun spacemacs//test-list (pred varlist test-desc &optional element-desc)
|
||
"Test PRED against each element of VARLIST and print test
|
||
result, incrementing passed-tests and total-tests."
|
||
(let ((varlist-name (symbol-name varlist))
|
||
(varlist-val (symbol-value varlist)))
|
||
(if element-desc
|
||
(insert (format "** TEST: Each %s in [[file:%s::%s][%s]] %s\n"
|
||
element-desc dotspacemacs-filepath varlist-name
|
||
varlist-name test-desc))
|
||
(insert (format "** TEST: Each element of [[file:%s::%s][%s]] %s\n"
|
||
dotspacemacs-filepath varlist-name varlist-name
|
||
test-desc)))
|
||
(dolist (var varlist-val)
|
||
(when (boundp 'total-tests) (setq total-tests (1+ total-tests)))
|
||
(if (funcall pred var)
|
||
(progn
|
||
(when (boundp 'passed-tests) (setq passed-tests (1+ passed-tests)))
|
||
(insert (format "*** PASS: %s\n" var)))
|
||
(insert (propertize (format "*** FAIL: %s\n" var) 'font-lock-face 'font-lock-warning-face))))))
|
||
|
||
;; hide mode line
|
||
;; from http://bzg.fr/emacs-hide-mode-line.html
|
||
(defvar-local hidden-mode-line-mode nil)
|
||
(defvar-local hide-mode-line nil)
|
||
(define-minor-mode hidden-mode-line-mode
|
||
"Minor mode to hide the mode-line in the current buffer."
|
||
:init-value nil
|
||
:global t
|
||
:variable hidden-mode-line-mode
|
||
:group 'editing-basics
|
||
(if hidden-mode-line-mode
|
||
(setq hide-mode-line mode-line-format
|
||
mode-line-format nil)
|
||
(setq mode-line-format hide-mode-line
|
||
hide-mode-line nil))
|
||
(force-mode-line-update)
|
||
;; Apparently force-mode-line-update is not always enough to
|
||
;; redisplay the mode-line
|
||
(redraw-display)
|
||
(when (and (called-interactively-p 'interactive)
|
||
hidden-mode-line-mode)
|
||
(run-with-idle-timer
|
||
0 nil 'message
|
||
(concat "Hidden Mode Line Mode enabled. "
|
||
"Use M-x hidden-mode-line-mode to make the mode-line appear."))))
|
||
|
||
;; https://github.com/syl20bnr/spacemacs/issues/8414
|
||
(defun spacemacs/recompile-elpa (arg &optional dir)
|
||
"Compile or recompile packages in elpa or given directory.
|
||
This function compiles all `.el' files in the elpa directory
|
||
if it's corresponding `.elc' file is missing or outdated.
|
||
|
||
This is useful if you switch Emacs versions or there
|
||
are issues with a local package which require a recompile.
|
||
|
||
If ARG is non-nil, force recompile of all found `.el' files.
|
||
If DIR is non-nil, use a given directory for recompilation instead of elpa."
|
||
(interactive "P")
|
||
;; Replace default directories if dir parameter is filled
|
||
(let ((user-emacs-dir (or dir user-emacs-directory))
|
||
(package-user-dir (or dir package-user-dir)))
|
||
;; First argument must be 0 (not nil) to get missing .elc files rebuilt.
|
||
;; Bonus: Optionally force recompilation with universal ARG
|
||
(when arg
|
||
(seq-do
|
||
(lambda (fname)
|
||
(when (file-exists-p fname)
|
||
(delete-file fname)))
|
||
(directory-files-recursively user-emacs-directory "\\.elc$" t)))
|
||
(byte-recompile-directory package-user-dir 0 arg)))
|
||
|
||
(defun spacemacs/register-repl (feature repl-func &optional tag)
|
||
"Register REPL-FUNC to the global list of REPLs SPACEMACS-REPL-LIST.
|
||
FEATURE will be loaded before running the REPL, in case it is not already
|
||
loaded. If TAG is non-nil, it will be used as the string to show in the helm
|
||
buffer."
|
||
(push `(,(or tag (symbol-name repl-func))
|
||
. (,feature . ,repl-func))
|
||
spacemacs-repl-list))
|
||
|
||
;; http://stackoverflow.com/questions/11847547/emacs-regexp-count-occurrences
|
||
(defun spacemacs/how-many-str (regexp str)
|
||
(cl-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/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/derived-mode-p (mode &rest modes)
|
||
"Non-nil if MODE is derived from one of MODES."
|
||
;; We could have copied the built-in `derived-mode-p' and modified it a bit so
|
||
;; it works on arbitrary modes instead of only the current major-mode. We
|
||
;; don't do that because then we will need to modify the function if
|
||
;; `derived-mode-p' changes.
|
||
(let ((major-mode mode))
|
||
(apply #'derived-mode-p modes)))
|
||
|
||
(defun spacemacs/alternate-buffer (&optional window)
|
||
"Switch back and forth between current and last buffer in the
|
||
current window.
|
||
|
||
If `spacemacs-layouts-restrict-spc-tab' is `t' then this only switches between
|
||
the current layouts buffers."
|
||
(interactive)
|
||
(cl-destructuring-bind (buf start pos)
|
||
(if (bound-and-true-p spacemacs-layouts-restrict-spc-tab)
|
||
(let ((buffer-list (persp-buffer-list))
|
||
(my-buffer (window-buffer window)))
|
||
;; find buffer of the same persp in window
|
||
(seq-find (lambda (it) ;; predicate
|
||
(and (not (eq (car it) my-buffer))
|
||
(member (car it) buffer-list)))
|
||
(window-prev-buffers)
|
||
;; default if found none
|
||
(list nil nil nil)))
|
||
(or (cl-find (window-buffer window) (window-prev-buffers)
|
||
:key #'car :test-not #'eq)
|
||
(list (other-buffer) nil nil)))
|
||
(if (not buf)
|
||
(message "Last buffer not found.")
|
||
(set-window-buffer-start-and-point window buf start pos))))
|
||
|
||
(defun spacemacs/alternate-window ()
|
||
"Switch back and forth between current and last window in the
|
||
current frame."
|
||
(interactive)
|
||
(let (;; switch to first window previously shown in this frame
|
||
(prev-window (get-mru-window nil t t)))
|
||
;; Check window was not found successfully
|
||
(unless prev-window (user-error "Last window not found."))
|
||
(select-window prev-window)))
|
||
|
||
(defun spacemacs/comint-clear-buffer ()
|
||
(interactive)
|
||
(let ((comint-buffer-maximum-size 0))
|
||
(comint-truncate-buffer)))
|
||
|
||
|
||
;; 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)
|
||
(not next-error-function))
|
||
'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/last-error ()
|
||
"Go to last flycheck or standard emacs error."
|
||
(interactive)
|
||
(when (save-excursion (spacemacs/next-error))
|
||
(evil-goto-line)
|
||
(spacemacs/previous-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-char (point-min))
|
||
(forward-line (1- spacemacs--gne-cur-line))
|
||
(funcall spacemacs--gne-line-func
|
||
(buffer-substring (point-at-bol) (point-at-eol))))
|
||
|
||
(defun spacemacs/terminal-fix-mode-line-indicator-overlap (str)
|
||
"Add a space between two mode line indicators,
|
||
to fix an overlapping issue, that occurs when
|
||
Spacemacs is started in a terminal,
|
||
and a modes mode line name is diminished to:
|
||
- A unicode character followed by a non unicode character, ex: \" Ⓔh\"
|
||
- Or to two unicode characters, ex: \" Ⓔⓗ\""
|
||
(let ((first-char (substring str 1 2)) ; first char after the space
|
||
second-char)
|
||
(if (equal (char-charset (string-to-char first-char)) 'unicode)
|
||
(progn
|
||
(setq second-char (substring str 2 3)) ; second char after the space
|
||
(concat first-char " " second-char))
|
||
str)))
|
||
|
||
(provide 'core-funcs)
|