emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Move {core,modules}/lib/*.el to {core,modules}/defuns/

Browse source
This commit is contained in:
Henrik Lissner 2016-01-29 02:05:16 -05:00
parent 976d60b5da
commit 5eb60220ee
41 changed files with 68 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

23
core/defuns/defuns-auto-insert.el Normal file
View file

@ -0,0 +1,23 @@
;;; defuns-auto-insert.el
;; for ../core-auto-insert.el
;;;###autoload
(defun narf/auto-insert-snippet (key &optional mode project-only)
"Auto insert a snippet of yasnippet into new file."
(interactive)
(when (if project-only (narf/project-p) t)
(let ((is-yasnippet-on (not (cond ((functionp yas-dont-activate)
(funcall yas-dont-activate))
((consp yas-dont-activate)
(some #'funcall yas-dont-activate))
(yas-dont-activate))))
(snippet (let ((template (cdar (mapcan #'(lambda (table) (yas--fetch table key))
(yas--get-snippet-tables mode)))))
(if template (yas--template-content template) nil))))
(when (and is-yasnippet-on snippet)
(yas-expand-snippet snippet)
(when (and (featurep 'evil) evil-mode)
(evil-initialize-state 'insert))))))
(provide 'defuns-auto-insert)
;;; defuns-auto-insert.el ends here

284
core/defuns/defuns-buffers.el Normal file
View file

@ -0,0 +1,284 @@
;;; defuns-buffers.el
;;;###autoload (autoload 'narf:narrow "defuns-buffers" nil t)
(evil-define-operator narf:narrow (&optional beg end bang)
"Restrict editing in this buffer to the current region, indirectly. With BANG,
clone the buffer and hard-narrow the selection. Otherwise use fancy-narrow. If
mark isn't active, then widen the buffer (if narrowed).
Inspired from http://demonastery.org/2013/04/emacs-evil-narrow-region/"
(interactive "<r><!>")
(if (region-active-p)
(progn
(deactivate-mark)
(let ((buf (clone-indirect-buffer nil nil)))
(with-current-buffer buf
(narrow-to-region beg end))
(switch-to-buffer buf)))
(widen)))
;;;###autoload
(defun narf/set-read-only-region (begin end)
"See http://stackoverflow.com/questions/7410125"
(let ((modified (buffer-modified-p)))
(add-text-properties begin end '(read-only t))
(set-buffer-modified-p modified)))
;;;###autoload
(defun narf/set-region-writeable (begin end)
"See http://stackoverflow.com/questions/7410125"
(let ((modified (buffer-modified-p))
(inhibit-read-only t))
(remove-text-properties begin end '(read-only t))
(set-buffer-modified-p modified)))
;; Buffer Life and Death ;;;;;;;;;;;;;;;
;;;###autoload
(defun narf/get-buffers (&optional project-p all-p)
"Get all buffers in the current workgroup.
If PROJECT-P is non-nil, get all buffers in current workgroup
If ALL-P is non-nil, get all buffers across all workgroups
If both are non-nil, get all project buffers across all workgroups"
(let* ((wg (wg-current-workgroup t))
(buffers (if (and wg (not all-p))
(wg-workgroup-associated-buffers wg)
(if wg-mess-with-buffer-list
(wg-buffer-list-emacs)
(buffer-list)))))
(let (project-root)
(if (and project-p (setq project-root (narf/project-root t)))
(funcall (if (eq project-p 'not) '-remove '-filter)
(lambda (b) (projectile-project-buffer-p b project-root))
buffers)
buffers))))
;;;###autoload
(defun narf/get-all-buffers (&optional project-p)
"Get all buffers across all workgroups and projects (unless PROJECT-P is non-nil)."
(narf/get-buffers project-p t))
;;;###autoload
(defun narf/get-visible-windows (&optional buffer-list)
(-map #'get-buffer-window
(narf/get-visible-buffers (or buffer-list (narf/get-all-buffers)))))
;;;###autoload
(defun narf/get-visible-buffers (&optional buffer-list)
"Get a list of buffers that are not buried (i.e. visible)"
(-filter #'get-buffer-window (or buffer-list (narf/get-all-buffers))))
;;;###autoload
(defun narf/get-buried-buffers (&optional buffer-list)
"Get a list of buffers that are buried (i.e. not visible)"
(let* ((buffers (or buffer-list (narf/get-buffers)))
(old-len (length buffers)))
(-remove 'get-buffer-window buffers)))
;;;###autoload
(defun narf/get-matching-buffers (pattern &optional buffer-list)
"Get a list of buffers that match the pattern"
(--filter (string-match-p pattern (buffer-name it))
(or buffer-list (narf/get-buffers))))
;;;###autoload
(defun narf/get-buffers-in-modes (modes &optional buffer-list)
"Get a list of buffers whose major-mode is one of MODES"
(--filter (with-current-buffer it (memq major-mode modes))
(or buffer-list (narf/get-buffers))))
;;;###autoload
(defun narf/get-real-buffers (&optional buffer-list)
(-filter #'narf/real-buffer-p (or buffer-list (narf/get-buffers))))
;;;###autoload
(defun narf/kill-real-buffer ()
"Kill buffer (but only bury scratch buffer), then switch to a real buffer."
(interactive)
(let ((bname (buffer-name)))
(cond ((string-match-p "^\\*scratch\\*" bname)
(erase-buffer))
(t ;; bury duplicate buffers in other windows
(let ((this-window (get-buffer-window)))
(mapc (lambda (w)
(unless (eq this-window w)
(with-selected-window w (narf/previous-real-buffer))))
(get-buffer-window-list (current-buffer) nil nil)))
;; Then kill
(kill-this-buffer))))
(if (narf/popup-p (selected-window))
(narf/popup-close)
(unless (narf/real-buffer-p (current-buffer))
(narf/previous-real-buffer))))
;;;###autoload
(defun narf/kill-unreal-buffers ()
"Kill all buried, unreal buffers in current frame. See `narf-unreal-buffers'"
(interactive)
(let* ((all-buffers (narf/get-all-buffers))
(real-buffers (narf/get-real-buffers all-buffers))
(kill-list (--filter (not (memq it real-buffers))
(narf/get-buried-buffers all-buffers))))
(mapc 'kill-buffer kill-list)
(narf/kill-process-buffers)
(message "Cleaned up %s buffers" (length kill-list))))
;;;###autoload
(defun narf/kill-process-buffers ()
"Kill all buffers that represent running processes and aren't visible."
(interactive)
(let ((buffer-list (narf/get-buffers))
(killed-processes 0))
(dolist (p (process-list))
(let* ((process-name (process-name p))
(assoc (assoc process-name narf-cleanup-processes-alist)))
(when (and assoc
(not (string= process-name "server"))
(process-live-p p)
(not (--any? (let ((mode (buffer-local-value 'major-mode it)))
(eq mode (cdr assoc)))
buffer-list)))
(delete-process p)
(incf killed-processes))))
(message "Cleaned up %s processes" killed-processes)))
;;;###autoload
(defun narf/kill-matching-buffers (regexp &optional buffer-list)
(interactive)
(let ((i 0))
(mapc (lambda (b)
(when (string-match-p regexp (buffer-name b))
(kill-buffer b)
(setq i (1+ i))))
(if buffer-list buffer-list (narf/get-buffers)))
(message "Killed %s matches" i)))
;;;###autoload
(defun narf/cycle-real-buffers (&optional n scratch-default)
"Switch to the previous buffer and avoid special buffers. If there's nothing
left, create a scratch buffer."
(let* ((start-buffer (current-buffer))
(move-func (if (< n 0) 'switch-to-next-buffer 'switch-to-prev-buffer))
(real-buffers (narf/get-real-buffers))
(realc (length real-buffers))
(max 25)
(i 0)
(continue t))
(if (or (= realc 0)
(and (= realc 1) (eq (car real-buffers) (current-buffer))))
(progn
(narf|update-scratch-buffer-cwd)
(switch-to-buffer "*scratch*")
(message "Nowhere to go"))
(funcall move-func)
(while (and continue (< i max))
(let ((current-buffer (current-buffer)))
(cond ((eq current-buffer start-buffer)
(when scratch-default
(narf|update-scratch-buffer-cwd)
(switch-to-buffer "*scratch*"))
(setq continue nil))
((not (memq current-buffer real-buffers))
(funcall move-func))
(t
(setq continue nil))))
(cl-incf i)))))
;;;###autoload
(defun narf/real-buffer-p (&optional buffer-or-name)
(let ((buffer (if buffer-or-name (get-buffer buffer-or-name) (current-buffer))))
(when (buffer-live-p buffer)
(not (--any? (if (stringp it)
(string-match-p it (buffer-name buffer))
(eq (buffer-local-value 'major-mode buffer) it))
narf-unreal-buffers)))))
;; Inspired by spacemacs <https://github.com/syl20bnr/spacemacs/blob/master/spacemacs/funcs.el>
;;;###autoload
(defun narf/next-real-buffer ()
"Switch to the next buffer and avoid special buffers."
(interactive)
(narf/cycle-real-buffers +1))
;;;###autoload
(defun narf/previous-real-buffer ()
"Switch to the previous buffer and avoid special buffers."
(interactive)
(narf/cycle-real-buffers -1))
(defun narf--kill-buffers (buffers &optional filter-func)
(let ((buffers (if filter-func (funcall filter-func buffers) buffers))
(affected 0))
(mapc (lambda (b) (when (kill-buffer b) (incf affected))) buffers)
(unless (narf/real-buffer-p)
(narf/previous-real-buffer))
(message "Killed %s buffers" affected)))
;;;###autoload (autoload 'narf:kill-all-buffers "defuns-buffers" nil t)
(evil-define-command narf:kill-all-buffers (&optional bang)
"Kill all project buffers. If BANG, kill *all* buffers (in workgroup)."
(interactive "<!>")
(narf--kill-buffers (narf/get-buffers bang))
(when bang
(delete-other-windows)))
;;;###autoload (autoload 'narf:kill-buried-buffers "defuns-buffers" nil t)
(evil-define-command narf:kill-buried-buffers (&optional bang)
"Kill buried project buffers (in workgroup) and report how many it found. BANG = get all
buffers regardless of project."
(interactive "<!>")
(narf-kill-buffers (narf/get-buffers (not bang)) 'narf/get-buried-buffers))
;;;###autoload (autoload 'narf:kill-buried-buffers "defuns-buffers" nil t)
(evil-define-command narf:kill-matching-buffers (&optional bang pattern)
"Kill project buffers matching regex pattern PATTERN. If BANG, then extend search to
buffers regardless of project."
:repeat nil
(interactive "<!><a>")
(narf-kill-buffers (narf/get-matching-buffers pattern (narf/get-buffers (not bang)))))
;;;###autoload (autoload 'narf:send-to-scratch-or-org "defuns-buffers" nil t)
(evil-define-operator narf:send-to-scratch-or-org (&optional beg end bang)
"Send a selection to the scratch buffer. If BANG, then send it to org-capture instead."
:move-point nil
:type inclusive
(interactive "<r><!>")
(let ((mode major-mode)
(text (when (and (evil-visual-state-p) beg end)
(buffer-substring beg end))))
(if bang
(org-capture-string text)
;; or scratch buffer by default
(let* ((project-dir (narf/project-root t))
(buffer-name "*scratch*"))
(narf/popup-buffer buffer-name)
(with-current-buffer buffer-name
(when project-dir
(cd project-dir))
(if text (insert text))
(funcall mode))
))))
;;;###autoload (autoload 'narf:cd "defuns-buffers" nil t)
(evil-define-command narf:cd (dir)
"Ex-command alias for `cd'"
:repeat nil
(interactive "<f>")
(cd (if (zerop (length dir)) "~" dir)))
;;;###autoload
(defun narf/kill-all-buffers-do-not-remember ()
"Kill all buffers so that workgroups2 will wipe its current session."
(interactive)
(let ((confirm-kill-emacs nil))
(mapc 'kill-buffer (narf/get-buffers))
(kill-this-buffer)
(delete-other-windows)
(wg-save-session t)
(save-buffers-kill-terminal)))
(provide 'defuns-buffers)
;;; defuns-buffers.el ends here

48
core/defuns/defuns-company.el Normal file
View file

@ -0,0 +1,48 @@
;;; defuns-company.el
;;;###autoload
(defun narf/company-evil-complete-next (&optional arg)
(call-interactively 'company-dabbrev)
(if (eq company-candidates-length 1)
(company-complete)))
;;;###autoload
(defun narf/company-evil-complete-previous (&optional arg)
(let ((company-selection-wrap-around t))
(call-interactively 'company-dabbrev)
(if (eq company-candidates-length 1)
(company-complete)
(call-interactively 'company-select-previous))))
;;;###autoload
(defun narf/company-complete-common-or-complete-full ()
(interactive)
(when (company-manual-begin)
(if (eq last-command #'company-complete-common-or-cycle)
(let ((company-selection-wrap-around t))
(call-interactively #'company-complete-selection))
(let ((buffer-mod-tick (buffer-chars-modified-tick)))
(call-interactively #'company-complete-common)
(when (= buffer-mod-tick (buffer-chars-modified-tick))
(call-interactively #'company-complete-selection)
(call-interactively #'company-complete))))))
(defun narf--company-whole-lines ()
(split-string
(replace-regexp-in-string
"^[\t\s]+" ""
(concat (buffer-substring-no-properties (point-min) (line-beginning-position))
(buffer-substring-no-properties (line-end-position) (point-max))))
"\\(\r\n\\|[\n\r]\\)" t))
;;;###autoload
(defun narf/company-whole-lines (command &optional arg &rest ignored)
(interactive (list 'interactive))
(let ((lines (narf--company-whole-lines)))
(cl-case command
(interactive (company-begin-backend 'narf/company-whole-lines))
(prefix (company-grab-line "^[\t\s]*\\(.+\\)" 1))
(candidates (all-completions arg lines)))))
(provide 'defuns-company)
;;; defuns-company.el ends here

30
core/defuns/defuns-compile.el Normal file
View file

@ -0,0 +1,30 @@
;;; defuns-compile.el
;;;###autoload
(defun narf/is-recompilable-p ()
"Does an .elc file exist and is this file in the .emacs.d folder?"
(let ((file-name (buffer-file-name)))
;; TODO Detect init.el and init-load-path.el
(and (f-exists? (f-expand (concat (f-base file-name) ".elc") (f-dirname file-name)))
(--any? (f-child-of? file-name it)
(append (list narf-core-dir narf-modules-dir
narf-core-dir narf-modules-dir
narf-private-dir))))))
;;;###autoload (autoload 'narf:compile-el "defuns-compile" nil t)
(evil-define-command narf:compile-el (&optional bang)
:repeat nil
(interactive "<!>")
(byte-recompile-file (f-expand "init-load-path.el" narf-emacs-dir) nil 0)
(if (and (eq major-mode 'emacs-lisp-mode) (not bang))
(byte-recompile-file (buffer-file-name) t 0)
(load (concat narf-script-dir "byte-compile.el"))))
;;;###autoload (autoload 'narf:compile-autoloads "defuns-compile" nil t)
(evil-define-command narf:compile-autoloads (&optional bang)
:repeat nil
(interactive "<!>")
(load (concat narf-script-dir "generate-autoloads.el")))
(provide 'defuns-compile)
;;; defuns-compile.el ends here

52
core/defuns/defuns-debug.el Normal file
View file

@ -0,0 +1,52 @@
;;; defuns-debug.el
;;;###autoload
(defun what-face (pos)
"Tells you the name of the face (point) is on."
(interactive "d")
(let ((hl-line-p hl-line-mode))
(if hl-line-p (hl-line-mode -1))
(let ((face (or (get-char-property (point) 'read-face-name)
(get-char-property (point) 'face))))
(if face (message "Face: %s" face) (message "No face at %d" pos)))
(if hl-line-p (hl-line-mode 1))))
;;;###autoload
(defun what-col ()
(interactive)
(message "Column %d" (current-column)))
;;;###autoload
(defun what-bindings (key)
(list
(minor-mode-key-binding key)
(local-key-binding key)
(global-key-binding key)))
;;;###autoload
(defun what-major-mode ()
(interactive)
(message "Mode: %s" major-mode))
;;;###autoload
(defun what-minor-modes ()
(interactive)
(let ((buf (get-buffer-create "*minor-modes*")))
(with-current-buffer buf
(insert "Active minor modes:\n + ")
(insert (s-join "\n + " (-filter
(lambda (k) (and k (not (string= k ""))))
(mapcar (lambda (mm) (symbol-name (car mm)))
minor-mode-alist)))))
(narf/popup-buffer buf)))
;;;###autoload (autoload 'narf:echo "defuns-debug" nil t)
(evil-define-command narf:echo (bang message)
"Display MSG in echo-area without logging it in *Messages* buffer."
(interactive "<!><a>")
(let (message-log-max)
(message "%s%s" (if bang ">> " "") message)))
(provide 'defuns-debug)
;;; defuns-debug.el ends here

43
core/defuns/defuns-editor.el Normal file
View file

@ -0,0 +1,43 @@
;;; defuns-editor.el
;; for ../core-editor.el
(defvar *linum-mdown-line* nil)
(defun narf--line-at-click ()
(save-excursion
(let ((click-y (cdr (cdr (mouse-position))))
(line-move-visual-store line-move-visual))
(setq line-move-visual t)
(goto-char (window-start))
(next-line (1- click-y))
(setq line-move-visual line-move-visual-store)
;; If you are using tabbar substitute the next line with
;; (line-number-at-pos))))
(1+ (line-number-at-pos)))))
;;;###autoload
(defun narf/mouse-drag-line ()
(interactive)
(goto-line (narf--line-at-click))
(set-mark (point))
(setq *linum-mdown-line* (line-number-at-pos)))
;;;###autoload
(defun narf/mouse-select-line ()
(interactive)
(when *linum-mdown-line*
(let (mu-line)
(setq mu-line (narf--line-at-click))
(goto-line *linum-mdown-line*)
(if (> mu-line *linum-mdown-line*)
(progn
(set-mark (point))
(goto-line mu-line)
(end-of-line))
(set-mark (line-end-position))
(goto-line mu-line)
(beginning-of-line))
(setq *linum-mdown-line* nil))))
(provide 'defuns-editor)
;;; defuns-editor.el ends here

136
core/defuns/defuns-evil.el Normal file
View file

@ -0,0 +1,136 @@
;;; defuns-evil.el
;; for ../core-evil.el
;;;###autoload (autoload 'narf:evil-open-folds "defuns-evil" nil t)
(evil-define-command narf/evil-open-folds (count)
"Instead of `evil-open-folds'. Accepts COUNT for dictating fold level."
(interactive "P")
(unless (bound-and-true-p hs-minor-mode)
(hs-minor-mode 1))
(if count (hs-hide-level count) (evil-open-folds)))
;;;###autoload (autoload 'narf:evil-open-folds "defuns-evil" nil t)
(evil-define-command narf/evil-close-folds (count)
"Instead of `evil-close-folds'. Accepts COUNT for dictating fold level."
(interactive "P")
(unless (bound-and-true-p hs-minor-mode)
(hs-minor-mode 1))
(if count (hs-hide-level count) (evil-close-folds)))
;;;###autoload (autoload 'narf/multi-next-line "defuns-evil" nil t)
(evil-define-motion narf/multi-next-line (count)
"Move down 6 lines"
:type line (evil-line-move 6))
;;;###autoload (autoload 'narf/multi-previous-line "defuns-evil" nil t)
(evil-define-motion narf/multi-previous-line (count)
"Move up 6 lines"
:type line (evil-line-move -6))
;;;###autoload
(defun narf/evil-visual-line-state-p ()
"Returns non-nil if in visual-line mode, nil otherwise."
(and (evil-visual-state-p)
(eq (evil-visual-type) 'line)))
;;;###autoload
(defun narf:iedit-restrict-to-region ()
(interactive)
(if (iedit-current-occurrence-string)
(let ((current-prefix-arg '(4)))
(iedit-done)
(call-interactively 'iedit-mode)
(save-excursion (iedit-restrict-region (region-beginning) (region-end)))
(evil-previous-line))
(call-interactively 'evil-ret)))
;;;###autoload
(defun narf*evil-exchange-off ()
(when evil-exchange--overlays
(evil-exchange-cancel)))
;;;###autoload
(defun narf/evil-surround-escaped ()
"Escaped surround characters."
(let* ((char (string (read-char "\\")))
(pair (cond ((string-match-p "[]})[{(]" char)
(let ((-pair (cdr (assoc (string-to-char char) evil-surround-pairs-alist))))
`(,(car -pair) . ,(cdr -pair))))
(t
`(,char . ,char))))
(format (if (sp-point-in-string) "\\\\%s" "\\%s")))
(cons (format format (car pair))
(format format (cdr pair)))))
;;;###autoload
(defun narf/evil-surround-latex ()
"LaTeX commands"
(let* ((command (read-string "\\")))
(cons (format "\\%s{" command) "}")))
;;;###autoload (autoload 'narf/evil-macro-on-all-lines "defuns-evil" nil t)
(evil-define-operator narf/evil-macro-on-all-lines (beg end &optional macro)
"Apply macro to each line."
:motion nil
:move-point nil
(interactive "<r><a>")
(unless (and beg end)
(setq beg (region-beginning)
end (region-end)))
(evil-ex-normal beg end
(concat "@"
(single-key-description
(or macro (read-char "@-"))))))
;;;###autoload
(defmacro define-text-object! (key start-regex end-regex)
(let ((inner-name (make-symbol "narf--inner-name"))
(outer-name (make-symbol "narf--outer-name")))
`(progn
(evil-define-text-object ,inner-name (count &optional beg end type)
(evil-select-paren ,start-regex ,end-regex beg end type count nil))
(evil-define-text-object ,outer-name (count &optional beg end type)
(evil-select-paren ,start-regex ,end-regex beg end type count t))
(define-key evil-inner-text-objects-map ,key (quote ,inner-name))
(define-key evil-outer-text-objects-map ,key (quote ,outer-name)))))
;;; Custom argument handlers
;;;###autoload
(defun narf/-ex-match-init (name &optional face update-hook)
(with-current-buffer evil-ex-current-buffer
(cond
((eq flag 'start)
(evil-ex-make-hl name
:face (or face 'evil-ex-substitute-matches)
:update-hook (or update-hook #'evil-ex-pattern-update-ex-info))
(setq flag 'update))
((eq flag 'stop)
(evil-ex-delete-hl name)))))
;;;###autoload
(defun narf/-ex-buffer-match (arg &optional hl-name flags beg end)
(when (and (eq flag 'update)
evil-ex-substitute-highlight-all
(not (zerop (length arg))))
(condition-case lossage
(let ((pattern (evil-ex-make-substitute-pattern
(if evil-ex-bang (regexp-quote arg) arg)
(or flags (list))))
(range (or (evil-copy-range evil-ex-range)
(evil-range (or beg (line-beginning-position))
(or end (line-end-position))
'line
:expanded t))))
(evil-expand-range range)
(evil-ex-hl-set-region hl-name
(evil-range-beginning range)
(evil-range-end range))
(evil-ex-hl-change hl-name pattern))
(end-of-file
(evil-ex-pattern-update-ex-info nil "incomplete replacement"))
(user-error
(evil-ex-pattern-update-ex-info nil (format "?%s" lossage))))))
(provide 'defuns-evil)
;;; defuns-evil.el ends here

62
core/defuns/defuns-file.el Normal file
View file

@ -0,0 +1,62 @@
;;; defuns-file.el
;;;###autoload (autoload 'narf:file-delete "defuns-file" nil t)
(evil-define-command narf:file-delete (&optional bang filename)
"Delete current buffer's file. If bang, then kill the buffer afterwards as well."
:repeat nil
(interactive "<!><f>")
(let ((filename (file-truename (or filename (buffer-file-name)))))
(if (not (file-exists-p filename))
(error "File doesn't exist: %s" filename)
(when (or bang (and (not bang) (y-or-n-p (format "Delete %s?" (f-base filename)))))
(delete-file filename)
(kill-this-buffer)
(unless (narf/real-buffer-p)
(narf/previous-real-buffer))
(save-place-forget-unreadable-files)
(message "File successfully deleted: %s" filename)))))
(defun narf--save-exit() (save-buffer) (kill-buffer) (remove-hook 'yas-after-exit-snippet-hook '--save-exit))
;;;###autoload (autoload 'narf:file-create "defuns-file" nil t)
(evil-define-command narf:file-create (path &optional bang)
"Deploy files (and their associated templates) quickly. Will prompt
you to fill in each snippet field before buffer closes unless BANG is
provided."
:repeat nil
(interactive "<f><!>")
(let ((dir (f-dirname path))
(fullpath (f-full path))
(is-auto t))
(when (and bang (not (file-exists-p dir))) (f-mkdir dir))
(if (file-exists-p dir)
(if (file-exists-p fullpath)
(error "File already exists: %s" path)
(find-file fullpath)
(add-hook 'yas-after-exit-snippet-hook 'narf--save-exit)
(if bang (narf--save-exit)))
(error "Directory doesn't exist: %s" dir))))
;;;###autoload (autoload 'narf:file-move "defuns-file" nil t)
(evil-define-command narf:file-move (path)
"Move current buffer's file to PATH. Replaces %, # and other variables (see
`evil-ex-replace-special-filenames')"
:repeat nil
(interactive "<f>")
(let* ((old-path (buffer-file-name))
(new-path (cond ((f-dir? path)
(f-expand (f-filename old-path) path))
((f-dir? (f-dirname path))
(f-full path))
(t (user-error "Not a valid destination: %s" path))))
(project-root (narf/project-root)))
(rename-file old-path new-path 1)
(rename-buffer (f-filename new-path))
(set-visited-file-name new-path)
(set-buffer-modified-p nil)
(save-place-forget-unreadable-files)
(setq narf--spaceline-file-path nil)
(message "File '%s' successfully renamed to '%s'"
(f-relative old-path project-root) (f-relative new-path project-root))))
(provide 'defuns-file)
;;; defuns-file.el ends here

39
core/defuns/defuns-flycheck.el Normal file
View file

@ -0,0 +1,39 @@
;;; defuns-flycheck.el
;; for ../core-flycheck.el
;;;###autoload
(defun narf|flycheck-enable-maybe ()
(unless (or (bound-and-true-p org-src-mode)
(eq major-mode 'org-mode))
(flycheck-mode +1)))
;;;###autoload
(defun narf*flycheck-buffer ()
(when (bound-and-true-p flycheck-mode)
(flycheck-buffer)))
;;;###autoload
(defun narf/flycheck-next-error ()
(interactive)
(call-interactively
(if (bound-and-true-p flycheck-mode)
'flycheck-next-error
'next-error)))
;;;###autoload
(defun narf/flycheck-previous-error ()
(interactive)
(call-interactively
(if (bound-and-true-p flycheck-mode)
'flycheck-previous-error
'previous-error)))
;;;###autoload
(defun narf/flycheck-errors ()
(interactive)
(when (bound-and-true-p flycheck-mode)
(flycheck-buffer)
(flycheck-list-errors)))
(provide 'defuns-flycheck)
;;; defuns-flycheck.el ends here

100
core/defuns/defuns-helm.el Normal file
View file

@ -0,0 +1,100 @@
;;; defuns-helm.el
;; see ../core-helm.el
;;;###autoload
(defun narf|projectile-invalidate-cache-maybe ()
(when (narf/project-p)
(projectile-invalidate-cache nil)))
;;;###autoload (autoload 'narf:helm-recentf "defuns-helm" nil t)
(evil-define-command narf:helm-recentf (&optional bang)
"Ex-mode interface for `helm-recentf' and `helm-projectile-recentf'. If
`bang', then `search' is interpreted as regexp."
:repeat nil
(interactive "<!>")
(if bang (helm-recentf) (helm-projectile-recentf)))
;; Ex-mode interface for `helm-ag'. If `bang', then `search' is interpreted as
;; regexp.
;;;###autoload (autoload 'narf:helm-ag-search "defuns-helm" nil t)
(evil-define-operator narf:helm-ag-search (beg end &optional search hidden-files-p pwd-p regex-p)
:type inclusive
:repeat nil
(interactive "<r><a><!>")
(require 'helm-ag)
(let* ((helm-ag--default-directory (if pwd-p default-directory (concat (narf/project-root) "/")))
(helm-ag-command-option (concat (unless regex-p "-Q ")
(if hidden-files-p "--hidden ")))
(input "")
(header-name (format "Search in %s" helm-ag--default-directory)))
(if search
(progn
(helm-attrset 'search-this-file nil helm-ag-source)
(setq helm-ag--last-query search))
(if (and beg end (/= beg (1- end)))
(setq input (buffer-substring-no-properties beg end))))
(helm-attrset 'name header-name helm-ag-source)
(helm :sources (if search helm-ag-source '(helm-source-do-ag))
:buffer "*helm-ag*"
:keymap helm-ag-map
:input input)))
;;;###autoload (autoload 'narf:helm-ag-regex-search "defuns-helm" nil t)
(evil-define-operator narf:helm-ag-regex-search (beg end &optional search bang)
:type inclusive :repeat nil
(interactive "<r><a><!>")
(narf:helm-ag-search beg end search bang nil t))
;;;###autoload (autoload 'narf:helm-ag-search-cwd "defuns-helm" nil t)
(evil-define-operator narf:helm-ag-search-cwd (beg end &optional search bang)
;; Ex-mode interface for `helm-do-ag'. If `bang', then `search' is interpreted
;; as regexp
:type inclusive :repeat nil
(interactive "<r><a><!>")
(narf:helm-ag-search beg end search bang t nil))
;;;###autoload (autoload 'narf:helm-ag-regex-search-cwd "defuns-helm" nil t)
(evil-define-operator narf:helm-ag-regex-search-cwd (beg end &optional search bang)
:type inclusive :repeat nil
(interactive "<r><a><!>")
(narf:helm-ag-search beg end search bang t t))
;; Ex-mode interface for `helm-swoop', `helm-multi-swoop-all' (if `bang'), or
;; `helm-css-scss' and `helm-css-scss-multi' (if `bang') if major-mode is
;; `scss-mode'
;;;###autoload (autoload 'narf:helm-swoop "defuns-helm" nil t)
(evil-define-command narf:helm-swoop (&optional search bang)
:repeat nil
(interactive "<a><!>")
(if bang (helm-multi-swoop-all search) (helm-swoop :$query search)))
;;;###autoload
(defun narf/helm-find-in-emacsd ()
(interactive)
(in! narf-emacs-dir (helm-projectile-find-file)))
;;;###autoload
(defun narf/helm-find-in-dotfiles ()
(interactive)
(in! (expand-file-name ".dotfiles" "~") (helm-projectile-find-file)))
;;;###autoload
(defun narf/helm-buffers-dwim (&optional all-p)
"Displays open buffers in current project. If ALL-P, then show all open
buffers."
(interactive)
(if (and (not all-p) (narf/project-p))
(cl-letf (((symbol-function 'buffer-list) 'narf/get-buffers))
(helm-buffers-list))
(helm-buffers-list)))
;;;###autoload
(defun narf/helm-org-find-files ()
(interactive)
(in! org-directory
(let ((helm-ff-skip-boring-files t))
(helm-find-files-1 org-directory))))
(provide 'defuns-helm)
;;; defuns-helm.el ends here

66
core/defuns/defuns-ido.el Normal file
View file

@ -0,0 +1,66 @@
;;; defuns-ido.el
;;;###autoload
(defun narf*ido-sort-mtime ()
"Sort ido filelist by mtime instead of alphabetically."
(setq ido-temp-list
(sort ido-temp-list
(lambda (a b)
(ignore-errors
(time-less-p
(sixth (file-attributes (concat ido-current-directory b)))
(sixth (file-attributes (concat ido-current-directory a))))))))
(ido-to-end ;; move . files to end (again)
(delq nil (mapcar
(lambda (x) (and (char-equal (string-to-char x) ?.) x))
ido-temp-list))))
;;;###autoload
(defun narf|ido-setup-home-keybind ()
"Go to $HOME with ~"
(define-key ido-file-completion-map (kbd "~")
(λ! (if (looking-back "/")
(insert "~/")
(call-interactively 'self-insert-command)))))
;;;###autoload
(defun narf/ido-find-file (&optional dir)
(interactive)
(let ((default-directory (or dir default-directory)))
(ido-find-file)))
;;;###autoload
(defun narf/ido-find-file-other-window (&optional dir)
(interactive)
(let ((default-directory (or dir default-directory)))
(ido-find-file-other-window)))
;;;###autoload
(defun narf/ido-find-project-file ()
(interactive)
(let ((default-directory (narf/project-root)))
(ido-find-file)))
;;;###autoload
(defun narf/ido-find-org-file ()
(interactive)
(let ((default-directory org-directory))
(ido-find-file)))
;;;###autoload
(defun narf/ido-recentf ()
"Use `ido-completing-read' to \\[find-file] a recent file"
(interactive)
(if (find-file (ido-completing-read "Find recent file: " recentf-list))
(message "Opening file...")
(message "Aborting")))
;;;###autoload (autoload 'narf:ido-find-file-in-emacsd "defuns-ido" nil t)
(evil-define-command narf:ido-find-file-in-emacsd (&optional bang) :repeat nil
(interactive "<!>")
(if bang
(ido-find-file-in-dir narf-modules-dir)
(ido-find-file-in-dir narf-emacs-dir)))
(provide 'defuns-ido)
;;; defuns-ido.el ends here

35
core/defuns/defuns-neotree.el Normal file
View file

@ -0,0 +1,35 @@
;;; defuns-neotree.el
;; for ../core-project.el
;;;###autoload
(defun narf/neotree ()
"Toggle the neotree window"
(interactive)
(let ((in-neotree (and (neo-global--window-exists-p)
(window-live-p neo-global--buffer)
(eq (current-buffer) neo-global--buffer))))
(if in-neotree
(neotree-hide)
(unless (neo-global--window-exists-p)
(neotree-dir (narf/project-root)))
(neotree-find))))
;;;###autoload
(defun narf|neotree-close-on-window-change ()
"Close neotree to prevent ensuing mindow buggery."
(unless (and (neo-global--window-exists-p)
(eq (current-buffer) (neo-global--get-buffer)))
(neotree-hide)))
;;;###autoload
(defun narf*neo-buffer-fold-symbol (name)
"Custom hybrid ascii theme with leading whitespace."
(let ((n-insert-symbol (lambda (n)
(neo-buffer--insert-with-face
n 'neo-expand-btn-face))))
(or (and (eq name 'open) (funcall n-insert-symbol "- "))
(and (eq name 'close) (funcall n-insert-symbol "+ "))
(and (eq name 'leaf) (funcall n-insert-symbol " ")))))
(provide 'defuns-neotree)
;;; defuns-neotree.el ends here

11
core/defuns/defuns-nlinum.el Normal file
View file

@ -0,0 +1,11 @@
;;; defuns-nlinum.el
;;;###autoload
(defun narf/nlinum-toggle ()
(interactive)
(if (bound-and-true-p nlinum-mode)
(narf|nlinum-disable)
(narf|nlinum-enable)))
(provide 'defuns-nlinum)
;;; defuns-nlinum.el ends here

51
core/defuns/defuns-project.el Normal file
View file

@ -0,0 +1,51 @@
;;; defuns-project.el
;;;###autoload
(defun narf/project-root (&optional strict-p)
"Get the path to the root of your project. Uses `narf-project-root-files' to
determine if a directory is a project."
(let (projectile-require-project-root strict-p) (projectile-project-root))
;; (let ((home (file-truename "~"))
;; (path default-directory))
;; (unless (file-name-absolute-p path)
;; (setq path (expand-file-name path)))
;; (catch 'found
;; (ignore-errors
;; (f-traverse-upwards
;; (lambda (path)
;; (let ((path (file-truename path)))
;; (if (file-equal-p home path)
;; (throw 'found (if strict-p nil default-directory))
;; (dolist (file narf-project-root-files)
;; (when (file-exists-p (expand-file-name file path))
;; (throw 'found path))))))
;; path))
;; default-directory))
)
;;;###autoload
(defun narf/project-has-files (files &optional root)
"Return non-nil if `file' exists in the project root."
(let ((root (or root (narf/project-root)))
(files (if (listp files) files (list files)))
found-p file)
(while (and files (not found-p))
(setq file (pop files))
(setq found-p (file-exists-p (narf/project-path-to file root))))
found-p))
;;;###autoload
(defun narf/project-path-to (file &optional root)
(let ((root (or root (narf/project-root))))
(expand-file-name file root)))
;;;###autoload
(defun narf/project-name (&optional root)
(file-name-nondirectory (directory-file-name (or root (narf/project-root)))))
;;;###autoload
(defun narf/project-p ()
(not (null (narf/project-root t))))
(provide 'defuns-project)
;;; defuns-project.el ends here

74
core/defuns/defuns-quickrun.el Normal file
View file

@ -0,0 +1,74 @@
;;; defuns-quickrun.el
;;;; Code building ;;;;;;;;;;;;;;;;;;;;;;
;;;###autoload
(defvar narf--build-command '("make %s" . "Makefile"))
(make-variable-buffer-local 'narf--build-command)
;;;###autoload
(defun narf/set-build-command (command &optional file)
(when (or (null file)
(narf/project-has-files file))
(setq narf--build-command `(,command . ,file))))
;;;###autoload (autoload 'narf:build "defuns-quickrun" nil t)
(evil-define-command narf:build (arg)
"Call a build command in the current directory.
If ARG is nil this function calls `recompile', otherwise it calls
`compile' passing ARG as build command."
(interactive "<sh>")
(when (null narf--build-command)
(user-error "No build command was set"))
(let ((build-file (cdr narf--build-command))
(build-cmd (car narf--build-command)))
(if (or (null build-file) (narf/project-has-files build-file))
(compile (format "cd '%s' && %s" (narf/project-root) (format build-cmd (or arg ""))))
(error "Could not find Makefile"))))
;;;; Code running ;;;;;;;;;;;;;;;;;;;;;;
;;;###autoload (autoload 'narf:eval-buffer "defuns-quickrun" nil t)
(evil-define-command narf:eval-buffer ()
:move-point nil
:repeat nil
(interactive)
(cond ((eq major-mode 'emacs-lisp-mode)
(narf:eval-region (point-min) (point-max)))
(t (quickrun))))
;;;###autoload (autoload 'narf:eval-region "defuns-quickrun" nil t)
(evil-define-operator narf:eval-region (beg end)
:move-point nil
:repeat nil
(interactive "<r>")
(cond ((eq major-mode 'emacs-lisp-mode)
(let* ((pp-escape-newlines nil)
(out (s-trim (pp-to-string (eval (read (buffer-substring-no-properties beg end))))))
(lines (length (s-lines out))))
(if (< lines 5)
(princ out t)
(let ((buf (get-buffer-create "*eval*")))
(with-current-buffer buf
(read-only-mode -1)
(emacs-lisp-mode)
(setq-local scroll-margin 0)
(erase-buffer)
(insert out)
(goto-char (point-min))
(read-only-mode 1)
(narf/popup-buffer buf))))))
(t (quickrun-region beg end))))
;;;###autoload (autoload 'narf:eval-region-and-replace "defuns-quickrun" nil t)
(evil-define-operator narf:eval-region-and-replace (beg end)
(interactive "<r>")
(cond ((eq major-mode 'emacs-lisp-mode)
(kill-region beg end)
(condition-case nil
(prin1 (eval (read (current-kill 0)))
(current-buffer))
(error (message "Invalid expression")
(insert (current-kill 0)))))
(t (quickrun-replace-region beg end))))
(provide 'defuns-quickrun)
;;; defuns-quickrun.el ends here

35
core/defuns/defuns-repl.el Normal file
View file

@ -0,0 +1,35 @@
;;; defuns-repl.el
(defvar narf--repl-buffer nil)
;;;###autoload (autoload 'narf:repl "defuns-repl" nil t)
(evil-define-command narf:repl (&optional bang)
:repeat nil
(interactive "<!>")
(if (and narf--repl-buffer (buffer-live-p narf--repl-buffer))
(if (popwin:popup-window-live-p)
(popwin:select-popup-window)
(popwin:pop-to-buffer narf--repl-buffer))
(rtog/toggle-repl (if (use-region-p) 4))
(setq narf--repl-buffer (current-buffer))))
;;;###autoload (autoload 'narf:repl-eval "defuns-repl" nil t)
(evil-define-operator narf:repl-eval (&optional beg end bang)
:type inclusive
:repeat nil
(interactive "<r><!>")
(let ((region-p (use-region-p))
(selection (s-trim (buffer-substring-no-properties beg end))))
(narf:repl bang)
(when (and region-p beg end)
(let* ((buf narf--repl-buffer)
(win (get-buffer-window buf)))
(unless (eq buf popwin:popup-buffer)
(popwin:pop-to-buffer buf nil t))
(when (and narf--repl-buffer (buffer-live-p narf--repl-buffer))
(with-current-buffer narf--repl-buffer
(goto-char (point-max))
(insert selection)))))))
(provide 'defuns-repl)
;;; defuns-repl.el ends here

13
core/defuns/defuns-spaceline.el Normal file
View file

@ -0,0 +1,13 @@
;;; defuns-spaceline.el
;;;###autoload
(defun narf|spaceline-env-update ()
(when narf--env-command
(let ((default-directory (narf/project-root)))
(let ((s (shell-command-to-string narf--env-command)))
(setq narf--env-version (if (string-match "[ \t\n\r]+\\'" s)
(replace-match "" t t s)
s))))))
(provide 'defuns-spaceline)
;;; defuns-spaceline.el ends here

69
core/defuns/defuns-ui.el Normal file
View file

@ -0,0 +1,69 @@
;;; defuns-ui.el
;; for ../core-ui.el
;;;###autoload
(defun narf:toggle-transparency ()
(interactive)
(let* ((alpha (frame-parameter nil 'alpha))
(alpha-val (if (listp alpha) (car alpha) alpha)))
(if (/= alpha-val 97)
(set-frame-parameter nil 'alpha 100)
(set-frame-parameter nil 'alpha 0))))
;;;###autoload (autoload 'narf:toggle-fullscreen "defuns-ui" nil t)
(after! evil
(evil-define-command narf:toggle-fullscreen (&optional bang)
(interactive "<!>")
(if bang
(writeroom-mode (if writeroom-mode -1 1))
(set-frame-parameter nil 'fullscreen (if (not (frame-parameter nil 'fullscreen)) 'fullboth)))))
(defvar narf--big-mode nil)
;;;###autoload
(defun narf:toggle-big-mode ()
(interactive)
(set-frame-font (if narf--big-mode narf-default-font narf-big-font))
(setq narf--big-mode (not narf--big-mode)))
;;;###autoload
(defun narf/reset-theme ()
(interactive)
(narf/load-theme (or narf-current-theme narf-theme)))
;;;###autoload
(defun narf/load-font (font)
(interactive)
(set-frame-font font)
(setq narf-current-font font))
;;;###autoload
(defun narf/load-theme (theme &optional suppress-font)
(interactive)
(when narf-current-theme
(disable-theme narf-current-theme))
(load-theme theme t)
(unless suppress-font
(narf/load-font narf-current-font))
(setq narf-current-theme theme))
;;;###autoload
(defun narf/default-font ()
(interactive)
(set-frame-font narf-default-font))
;;;###autoload
(defun narf/big-font ()
(interactive)
(set-frame-font narf-big-font))
;;;###autoload
(defun narf/show-as (how &optional pred)
(let* ((beg (match-beginning 1))
(end (match-end 1))
(ok (or (not pred) (funcall pred beg end))))
(when ok
(compose-region beg end how 'decompose-region))
nil))
(provide 'defuns-ui)
;;; defuns-ui.el ends here

179
core/defuns/defuns-whitespace.el Normal file
View file

@ -0,0 +1,179 @@
;;; defuns-whitespace.el
;;;###autoload
(defun narf--point-at-bol-non-blank()
(save-excursion (evil-first-non-blank) (point)))
;;;###autoload
(defun narf/surrounded-p ()
(and (looking-back "[[{(]\\(\s+\\|\n\\)?\\(\s\\|\t\\)*")
(let* ((whitespace (match-string 1))
(match-str (concat whitespace (match-string 2) "[])}]")))
(looking-at-p match-str))))
;;;###autoload
(defun narf/backward-kill-to-bol-and-indent ()
"Kill line to the first non-blank character. If invoked again
afterwards, kill line to column 1."
(interactive)
(let ((empty-line (sp-point-in-blank-line)))
(evil-delete (point-at-bol) (point))
(if (not empty-line)
(indent-according-to-mode))))
;;;###autoload
(defun narf/move-to-bol ()
"Moves cursor to the first non-blank character on the line. If
already there, move it to the true bol."
(interactive)
(evil-save-goal-column
(let ((point-at-bol (narf--point-at-bol-non-blank))
(point (point)))
(if (= point-at-bol point)
(evil-move-beginning-of-line)
(unless (= (point-at-bol) point)
(evil-first-non-blank))))))
;;;###autoload
(defun narf/move-to-eol ()
(interactive)
(evil-save-goal-column
(let ((old-point (point)))
(when (comment-search-forward (point-at-eol) t)
(goto-char (match-beginning 0))
(skip-syntax-backward " ^<*" (narf--point-at-bol-non-blank))
(if (eq old-point (point)) ;
(evil-move-end-of-line))))))
;; Mimic expandtab in vim
;;;###autoload
(defun narf/backward-delete-whitespace-to-column ()
"Delete back to the previous column of whitespace, or as much
whitespace as possible, or just one char if that's not possible."
(interactive)
(cond ;; If in a string
((sp-point-in-string)
(call-interactively 'backward-delete-char-untabify))
;; If using tabs (or at bol), just delete normally
((or indent-tabs-mode
(= (point-at-bol) (point)))
(call-interactively 'backward-delete-char))
;; Delete up to the nearest tab column IF only whitespace between point
;; and bol.
((looking-back "^[\\t ]*" (point-at-bol))
(let ((movement (% (current-column) tab-width))
(p (point)))
(when (= movement 0)
(setq movement tab-width))
(save-match-data
(if (string-match "\\w*\\(\\s-+\\)$"
(buffer-substring-no-properties (- p movement) p))
(backward-delete-char (- (match-end 1) (match-beginning 1)))
(backward-delete-char-untabify 1)))))
;; Otherwise do a regular delete
(t (backward-delete-char-untabify 1))))
;;;###autoload
(defun narf/dumb-indent (&optional smart)
"Inserts a tab character (or spaces x tab-width). Checks if the
auto-complete window is open."
(interactive)
(if indent-tabs-mode
(insert "\t")
(let* ((movement (% (current-column) tab-width))
(spaces (if (zerop movement) tab-width (- tab-width movement))))
(insert (s-repeat spaces " ")))))
;;;###autoload
(defun narf/smart-indent ()
(interactive)
(save-excursion
(back-to-indentation)
(narf/dumb-indent)))
;;;###autoload
(defun narf/dumb-dedent ()
(interactive)
(if indent-tabs-mode
(delete-char -1)
(save-excursion
(unless (looking-back "^[\s\t]*")
(evil-first-non-blank))
(let* ((movement (% (current-column) tab-width))
(spaces (if (zerop movement) tab-width (- tab-width movement))))
(delete-char (- spaces))))))
;;;###autoload
(defun narf/inflate-space-maybe ()
"Checks if point is surrounded by {} [] () delimiters and adds a
space on either side of the point if so."
(interactive)
(if (narf/surrounded-p)
(progn (call-interactively 'self-insert-command)
(save-excursion (call-interactively 'self-insert-command)))
(call-interactively 'self-insert-command)))
;;;###autoload
(defun narf/deflate-space-maybe ()
"Checks if point is surrounded by {} [] () delimiters, and deletes
spaces on either side of the point if so. Resorts to
`narf/backward-delete-whitespace-to-column' otherwise."
(interactive)
(save-match-data
(if (narf/surrounded-p)
(let ((whitespace-match (match-string 1)))
(cond ((not whitespace-match)
(call-interactively 'sp-backward-delete-char))
((string-match "\n" whitespace-match)
(evil-delete (point-at-bol) (point))
(delete-char -1)
(save-excursion (delete-char 1)))
(t
(just-one-space 0))))
(narf/backward-delete-whitespace-to-column))))
;;;###autoload
(defun narf/newline-and-indent ()
(interactive)
(cond ((sp-point-in-string)
(newline))
((sp-point-in-comment)
(cond ((eq major-mode 'js2-mode)
(js2-line-break))
((-contains? '(java-mode php-mode) major-mode)
(c-indent-new-comment-line))
((-contains? '(c-mode c++-mode objc-mode css-mode scss-mode) major-mode)
(newline-and-indent)
(insert "* ")
(indent-according-to-mode))
(t (indent-new-comment-line))))
(t
(newline nil t)
(indent-according-to-mode))))
;;;###autoload (autoload 'narf:whitespace-retab "defuns-whitespace" nil t)
(evil-define-operator narf:whitespace-retab (beg end)
"Akin to vim's retab, this changes all tabs-to-spaces or spaces-to-tabs,
depending on `indent-tab-mode'. Untested."
:motion nil
:move-point nil
:type line
(interactive "<r>")
(unless (and beg end)
(setq beg (point-min))
(setq end (point-max)))
(if indent-tabs-mode
(tabify beg end)
(untabify beg end)))
;;;###autoload (autoload 'narf:whitespace-align "defuns-whitespace" nil t)
(evil-define-command narf:whitespace-align (beg end &optional regexp bang)
:repeat nil
(interactive "<r><a><!>")
(when regexp
(align-regexp beg end
(concat "\\(\\s-*\\)" (rxt-pcre-to-elisp regexp)) 1 1)))
(provide 'defuns-whitespace)
;;; defuns-whitespace.el ends here

119
core/defuns/defuns-window.el Normal file
View file

@ -0,0 +1,119 @@
;;; defuns-window.el --- library for acting on windows
;;;###autoload
(defun narf/evil-window-split ()
(interactive)
(call-interactively 'evil-window-split)
(evil-window-down 1))
;;;###autoload
(defun narf/evil-window-vsplit ()
(interactive)
(call-interactively 'evil-window-vsplit)
(evil-window-right 1))
(defun narf--evil-swap-windows (a b)
(let ((a-buffer (window-buffer a))
(b-buffer (window-buffer b)))
(with-selected-window b
(switch-to-buffer a-buffer))
(with-selected-window a
(switch-to-buffer b-buffer))
(select-window b)))
(defun narf--evil-window-move (direction)
"Move current window to the next window in DIRECTION. If there are no windows
there and there is only one window, split in that direction and place this
window there. If there are no windows and this isn't the only window, use
evil-window-move-* (e.g. `evil-window-move-far-left')"
(let* ((this-window (get-buffer-window))
(this-buffer (current-buffer))
(that-window (windmove-find-other-window direction nil this-window))
(that-buffer (window-buffer that-window)))
(when (minibufferp that-buffer)
(setq that-buffer nil that-window nil))
(if (and (not that-window) (not (one-window-p t)))
(funcall (case direction
('left 'evil-window-move-far-left)
('right 'evil-window-move-far-right)
('up 'evil-window-move-very-top)
('down 'evil-window-move-very-bottom)))
(unless that-window
(setq that-window
(split-window this-window nil (cond ((eq direction 'up) 'above)
((eq direction 'down) 'below)
(t direction))))
(with-selected-window that-window
(switch-to-buffer "*scratch*"))
(setq that-buffer (window-buffer that-window)))
(with-selected-window this-window
(switch-to-buffer that-buffer))
(with-selected-window that-window
(switch-to-buffer this-buffer))
(select-window that-window))))
;;;###autoload
(defun narf/new-buffer ()
(interactive)
(switch-to-buffer (generate-new-buffer "*new*")))
;;;###autoload
(defun narf/new-frame ()
(interactive)
(let ((nlinum-p (and (featurep 'nlinum)
(memq 'nlinum--setup-window window-configuration-change-hook))))
;; Disable nlinum to fix elusive "invalid face linum" bug
(remove-hook 'window-configuration-change-hook 'nlinum--setup-window t)
(let ((frame (new-frame))
(frame-name (format "*new-%s*" (length narf-wg-frames))))
(with-selected-frame frame
(wg-create-workgroup frame-name t)
(add-to-list 'narf-wg-frames (cons frame frame-name))))
(when nlinum-p
(add-hook 'window-configuration-change-hook 'nlinum--setup-window nil t))))
;;;###autoload
(defun narf/close-frame ()
(interactive)
(let ((data (assq (selected-frame) narf-wg-frames)))
(if data
(progn (wg-delete-workgroup (wg-get-workgroup (cdr data)))
(delete-frame (car data)))
(delete-frame))))
;;;###autoload
(defun narf/evil-window-move-left ()
"See `narf--evil-window-move'"
(interactive)
(narf--evil-window-move 'left))
;;;###autoload
(defun narf/evil-window-move-down ()
"See `narf--evil-window-move'"
(interactive)
(narf--evil-window-move 'down))
;;;###autoload
(defun narf/evil-window-move-up ()
"See `narf--evil-window-move'"
(interactive)
(narf--evil-window-move 'up))
;;;###autoload
(defun narf/evil-window-move-right ()
"See `narf--evil-window-move'"
(interactive)
(narf--evil-window-move 'right))
;;;###autoload
(defun narf/window-reorient ()
"Reorient all windows that are scrolled to the right."
(interactive)
(let ((i 0))
(mapc (lambda (w)
(with-selected-window w
(when (> (window-hscroll) 0)
(cl-incf i)
(evil-beginning-of-line))))
(narf/get-visible-windows))
(message "Reoriented %s windows" i)))
(provide 'defuns-window)
;;; defuns-window.el ends here

200
core/defuns/defuns-workgroup.el Normal file
View file

@ -0,0 +1,200 @@
;;; defuns-workgroup.el
;;;###autoload
(defun narf/wg-helm-switch-to-workgroup (name)
(wg-switch-to-workgroup (wg-get-workgroup name)))
;;;###autoload
(defun narf:helm-wg ()
(interactive)
(require 'helm)
(helm :sources '(narf/helm-source-wg)))
;;;###autoload
(defun narf/wg-projectile-switch-project ()
(let ((workgroup-name (file-name-nondirectory (directory-file-name (narf/project-root)))))
(wg-create-workgroup workgroup-name t)
(helm-projectile-find-file)
;; TODO narf/workgroup-display?
))
;;;###autoload (autoload 'narf:save-session "defuns-workgroup" nil t)
(evil-define-command narf:save-session (&optional bang session-name)
(interactive "<!><a>")
(if session-name
(wg-save-session-as (concat wg-workgroup-directory session-name) (not bang))
(wg-save-session)))
;;;###autoload (autoload 'narf:load-session "defuns-workgroup" nil t)
(evil-define-command narf:load-session (&optional session-name)
(interactive "<a>")
(wg-open-session (if session-name
(concat wg-workgroup-directory session-name)
wg-session-file))
(narf/workgroup-display t))
;;;###autoload (autoload 'narf:workgroup-new "defuns-workgroup" nil t)
(evil-define-command narf:workgroup-new (bang name &optional silent)
"Create a new workgroup. If BANG, clone the current one to it."
(interactive "<!><a>")
(unless name
(setq name (format "#%s" (length (wg-workgroup-list)))))
(if bang
(wg-clone-workgroup (wg-current-workgroup) name)
(wg-create-workgroup name t))
(unless silent
(narf--workgroup-display (wg-previous-workgroup)
(format "Created %s" name)
'success)))
;;;###autoload (autoload 'narf:workgroup-rename "defuns-workgroup" nil t)
(evil-define-command narf:workgroup-rename (bang &optional new-name)
(interactive "<!><a>")
(let* ((wg (wg-current-workgroup))
(wg-uid (wg-workgroup-uid wg))
(old-name (wg-workgroup-name wg)))
(if bang
(setq narf-wg-names (delete wg-uid narf-wg-names))
(unless new-name
(user-error "You didn't enter in a name"))
(wg-rename-workgroup new-name wg)
(add-to-list 'narf-wg-names wg-uid)
(narf--workgroup-display wg (format "Renamed '%s'->'%s'" old-name new-name) 'success))))
;;;###autoload (autoload 'narf:workgroup-delete "defuns-workgroup" nil t)
(evil-define-command narf:workgroup-delete (&optional bang name)
(interactive "<!><a>")
(let* ((current-wg (wg-current-workgroup))
(wg-name (or name (wg-workgroup-name current-wg))))
(when bang
(setq wg-name (wg-read-workgroup-name)))
(let ((wg (wg-get-workgroup name)))
(if (eq wg current-wg)
(wg-kill-workgroup)
(wg-delete-workgroup wg))
(narf--workgroup-display nil (format "Deleted %s" wg-name) 'success))))
;;;###autoload
(defun narf:kill-other-workgroups ()
"Kill all other workgroups."
(interactive)
(let (workgroup (wg-current-workgroup))
(dolist (w (wg-workgroup-list))
(unless (wg-current-workgroup-p w)
(wg-kill-workgroup w)))))
(defun narf--num-to-unicode (num)
"Return a nice unicode representation of a single-digit number STR."
(cl-case num
(1 "➊")
(2 "➋")
(3 "➌")
(4 "➍")
(5 "➎")
(6 "❻")
(7 "➐")
(8 "➑")
(9 "➒")
(0 "➓")))
(defun narf--workgroup-display (&optional suppress-update message message-face)
(message "%s%s" (narf/workgroup-display suppress-update t)
(propertize message 'face message-face)))
;;;###autoload
(defun narf/workgroup-display (&optional suppress-update return-p message)
(interactive)
(when (wg-current-session t)
(unless (eq suppress-update t)
(narf/workgroup-update-names (if (wg-workgroup-p suppress-update) suppress-update)))
(let ((output (wg-display-internal
(lambda (workgroup index)
(if (not workgroup) wg-nowg-string
(wg-element-display
workgroup
(format " %s %s " (narf--num-to-unicode (1+ index)) (wg-workgroup-name workgroup))
'wg-current-workgroup-p)))
(wg-workgroup-list))))
(if return-p
output
(message "%s%s" output (or message ""))))))
;;;###autoload
(defun narf/workgroup-update-names (&optional wg)
(let ((wg (or wg (wg-current-workgroup))))
(unless (memq wg narf-wg-names)
(ignore-errors
(let ((old-name (wg-workgroup-name wg))
(new-name (f-filename (narf/project-root))))
(unless (string= new-name old-name)
(wg-rename-workgroup new-name wg)))))))
(defun narf--switch-to-workgroup (direction &optional count)
(interactive "<c>")
(assert (memq direction '(left right)))
(condition-case err
(progn
(if count
(wg-switch-to-workgroup-at-index (1- count))
(funcall (intern (format "wg-switch-to-workgroup-%s" direction))))
(narf/workgroup-display t))
(error (narf/workgroup-display t nil (format "Nope! %s" (cadr err))))))
;;;###autoload (autoload 'narf:switch-to-workgroup-left "defuns-workgroup" nil t)
(evil-define-command narf:switch-to-workgroup-left (count)
(interactive "<c>")
(narf--switch-to-workgroup 'left))
;;;###autoload (autoload 'narf:switch-to-workgroup-right "defuns-workgroup" nil t)
(evil-define-command narf:switch-to-workgroup-right (count)
(interactive "<c>")
(narf--switch-to-workgroup 'right))
;;;###autoload
(defun narf:switch-to-workgroup-at-index (index)
(interactive)
(narf/workgroup-update-names)
(let ((wgs (wg-workgroup-list-or-error)))
(unless (eq (nth index wgs) (wg-current-workgroup t))
(wg-switch-to-workgroup-at-index index)))
(narf/workgroup-display t))
;;;###autoload
(defun narf/undo-window-change ()
(interactive)
(call-interactively (if (wg-current-workgroup t) 'wg-undo-wconfig-change 'winner-undo)))
;;;###autoload
(defun narf/redo-window-change ()
(interactive)
(call-interactively (if (wg-current-workgroup t) 'wg-redo-wconfig-change 'winner-redo)))
;;;###autoload
(defun narf/close-window-or-workgroup ()
(interactive)
(if (and (= (length (window-list)) 1)
(> (length (wg-workgroup-list)) 1))
(if (string= (wg-workgroup-name (wg-current-workgroup)) wg-first-wg-name)
(evil-window-delete)
(narf:workgroup-delete))
(evil-window-delete)))
(defvar narf-wg-autosave-interval 600)
(defvar narf-wg-autosave-timer nil)
;;;###autoload
(defun narf/wg-autosave ()
(when (and (wg-current-session t) (not (minibufferp)))
(shut-up! (wg-save-session))))
;;;###autoload
(defun narf|wg-autosave-enable ()
(setq narf-wg-autosave-timer (run-with-timer 0 narf-wg-autosave-interval 'narf/wg-autosave)))
;;;###autoload
(defun narf|wg-autosave-disable ()
(cancel-timer narf-wg-autosave-timer)
(narf/wg-autosave))
(provide 'defuns-workgroup)
;;; defuns-workgroup.el ends here

93
core/defuns/defuns-yasnippet.el Normal file
View file

@ -0,0 +1,93 @@
;;; defuns-yasnippet.el
;; for ../core-yasnippet.el
;;;###autoload
(defun narf|yas-before-expand ()
"Strip out the shitespace before a line selection."
(when (narf/evil-visual-line-state-p)
(setq-local
yas-selected-text
(replace-regexp-in-string
"\\(^ *\\|\n? $\\)" ""
(buffer-substring-no-properties (region-beginning)
(1- (region-end)))))))
;;;###autoload
(defun narf|yas-after-expand ()
"Switch to insert mode when expanding a template via backtab, or go back to
normal mode if there are no fields."
(setq yas-selected-text nil))
;;;###autoload
(defun narf/yas-insert-snippet ()
"Switch to insert mode when expanding a template via backtab, or go back to
normal mode if there are no fields."
(interactive)
(yas-insert-snippet)
(let* ((snippet (first (yas--snippets-at-point)))
(fields (yas--snippet-fields snippet)))
(evil-insert-state +1)
(unless fields (evil-change-state 'normal))))
;;;###autoload
(defun narf/yas-goto-start-of-field ()
"Go to the beginning of a field."
(interactive)
(let* ((snippet (car (yas--snippets-at-point)))
(position (yas--field-start (yas--snippet-active-field snippet))))
(if (= (point) position)
(move-beginning-of-line 1)
(goto-char position))))
;;;###autoload
(defun narf/yas-goto-end-of-field ()
(interactive)
(let* ((snippet (car (yas--snippets-at-point)))
(position (yas--field-end (yas--snippet-active-field snippet))))
(if (= (point) position)
(move-end-of-line 1)
(goto-char position))))
;;;###autoload
(defun narf/yas-backspace (&optional field)
"Prevents Yas from stepping on my toes when I use backspace."
(interactive)
(let ((field (or field (and yas--active-field-overlay
(overlay-buffer yas--active-field-overlay)
(overlay-get yas--active-field-overlay 'yas--field)))))
(cond ((eq (point) (marker-position (yas--field-start field))) nil)
(t (delete-char -1)))))
;;;###autoload
(defun narf/yas-delete (&optional field)
(interactive)
(let ((field (or field (and yas--active-field-overlay
(overlay-buffer yas--active-field-overlay)
(overlay-get yas--active-field-overlay 'yas--field)))))
(cond ((and field
(not (yas--field-modified-p field))
(eq (point) (marker-position (yas--field-start field))))
(yas--skip-and-clear field)
(yas-next-field 1))
((eq (point) (marker-position (yas--field-end field))) nil)
(t (delete-char 1)))))
;;;###autoload
(defun narf/yas-clear-to-sof (&optional field)
(interactive)
(let* ((field (or field (and yas--active-field-overlay
(overlay-buffer yas--active-field-overlay)
(overlay-get yas--active-field-overlay 'yas--field))))
(sof (marker-position (yas--field-start field))))
(when (and field (> (point) sof))
(delete-region sof (point)))))
;; Snippet helpers ;;;;;;;;;;;;;;;;;;;;;
;;;###autoload
(defun narf/yas-find-file ()
"Browse through snippets folder"
(interactive)
(narf/ido-find-file (car narf-snippet-dirs)))
(provide 'defuns-yasnippet)
;;; nlinum-defuns.el ends here

22
core/defuns/macros-company.el Normal file
View file

@ -0,0 +1,22 @@
;;; macros-company.el --- macros for company-mode
;; for ../core-company.el
;;;###autoload
(defmacro define-company-backend! (hook backends)
"Register a company backend for a mode."
(let ((def-name (intern (format "narf--init-company-%s" hook)))
(quoted (eq (car-safe backends) 'quote)))
`(progn
(defun ,def-name ()
(set (make-local-variable 'company-backends)
(append '((,@(mapcar (lambda (backend)
(if quoted
backend
(intern (format "company-%s" backend))))
(if quoted (cadr backends) backends))
company-semantic company-yasnippet))
company-backends)))
(add-hook ',(intern (format "%s-hook" hook)) ',def-name))))
(provide 'macros-company)
;;; macros-company.el ends here

17
core/defuns/macros-quickrun.el Normal file
View file

@ -0,0 +1,17 @@
;;; macros-quickrun.el
;;;###autoload
(defmacro define-builder! (mode command &optional build-file)
"Register major/minor MODE with build COMMAND. If FILES are provided, do an
additional check to make sure they exist in the project root."
`(add-hook! ,mode
(when (or (null ,build-file)
(narf/project-has-files ,build-file))
(setq narf--build-command '(,command . ,build-file)))))
;;;###autoload
(defmacro define-repl! (mode command)
`(push '(,mode . ,command) rtog/mode-repl-alist))
(provide 'macros-quickrun)
;;; macros-quickrun.el ends here

10
core/defuns/macros-spaceline.el Normal file
View file

@ -0,0 +1,10 @@
;;; defuns-spaceline.el
;;;###autoload
(defmacro define-env-command! (mode command)
(add-hook! (focus-in find-file) 'narf|spaceline-env-update)
`(add-hook ',(intern (format "%s-hook" (symbol-name mode)))
(lambda () (setq narf--env-command ,command))))
(provide 'defuns-spaceline)
;;; defuns-spaceline.el ends here

16
core/defuns/macros-yasnippet.el Normal file
View file

@ -0,0 +1,16 @@
;;; macros-yasnippet.el
;; for ../core-yasnippet.el
;;;###autoload
(defmacro add-yas-minor-mode! (mode)
"Register minor MODES in yasnippet."
`(after! yasnippet
(when (boundp 'yas-extra-modes)
(add-hook ',(intern (concat (symbol-name (cadr mode)) "-hook"))
(lambda ()
(if (symbol-value ,mode)
(yas-activate-extra-mode ,mode)
(yas-deactivate-extra-mode ,mode)))))))
(provide 'macros-yasnippet)
;;; macros-yasnippet.el ends here