doomemacs/core/defuns/defuns-buffers.el

;;; defuns-buffers.el

(defvar doom-buffer)
(defvar-local doom--narrowed-origin nil)

;;;###autoload (autoload 'doom:narrow "defuns-buffers" nil t)
(evil-define-operator doom: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. 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)
        (when bang
          (let ((old-buf (current-buffer)))
            (switch-to-buffer (clone-indirect-buffer nil nil))
            (setq doom--narrowed-origin old-buf)))
        (narrow-to-region beg end))
    (if doom--narrowed-origin
        (progn
          (kill-this-buffer)
          (switch-to-buffer doom--narrowed-origin)
          (setq doom--narrowed-origin nil))
      (widen))))

;;;###autoload
(defun doom/set-read-only-region (begin end)
  "Mark a region as read-only (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 doom/set-region-writeable (begin end)
  "Undoes `doom/set-read-only-region' (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 doom/get-buffers (&optional all-p)
  "Get all buffers in the current project, in the current workgroup.

    If ALL-P is non-nil, get all buffers across all projects in current
workgroup."
  (let ((buffers (if (wg-current-workgroup t)
                     (doom/get-buffers-in-workgroup)
                   (buffer-list)))
        (project-root (and (not all-p) (doom/project-root t))))
    (append (if project-root
                (funcall (if (eq all-p 'not) '-remove '-filter)
                         (lambda (b) (projectile-project-buffer-p b project-root))
                         buffers)
              buffers)
            (list doom-buffer))))

;;;###autoload
(defun doom/get-buffers-in-workgroup ()
  "Get a list of buffers in current workgroup. Returns nil if workgroups2 isn't
loaded."
  (when (featurep 'workgroups2)
    (let ((assoc-bufs (wg-workgroup-associated-buffers nil)))
      (--filter (memq it assoc-bufs) (buffer-list)))))

;;;###autoload
(defun doom/get-buffer-names (&optional buffer-list)
  "Get a list of names of buffers in the current workgroup, OR return the names
of the buffers in BUFFER-LIST."
  (mapcar #'buffer-name (or buffer-list (doom/get-buffers))))

;;;###autoload
(defun doom/get-visible-windows (&optional window-list)
  "Get a list of the visible windows in the current frame (that aren't popups),
OR return only the visible windows in WINDOW-LIST."
  (-remove #'doom/popup-p (or window-list (window-list))))

;;;###autoload
(defun doom/get-visible-buffers (&optional buffer-list)
  "Get a list of unburied buffers in the current project and workgroup, OR
return only the unburied buffers in BUFFER-LIST (a list of BUFFER-OR-NAMEs)."
  (-filter #'get-buffer-window (or buffer-list (doom/get-buffers))))

;;;###autoload
(defun doom/get-buried-buffers (&optional buffer-list)
  "Get a list of buried buffers in the current project and workgroup, OR return
only the buried buffers in BUFFER-LIST (a list of BUFFER-OR-NAMEs)."
  (-remove 'get-buffer-window (or buffer-list (doom/get-buffers))))

;;;###autoload
(defun doom/get-matching-buffers (pattern &optional buffer-list)
  "Get a list of all buffers (in the current workgroup OR in BUFFER-LIST) that
match the regex PATTERN."
  (--filter (string-match-p pattern (buffer-name it))
            (or buffer-list (doom/get-buffers))))

;;;###autoload
(defun doom/get-buffers-in-modes (modes &optional buffer-list)
  "Get a list of all buffers (in the current workgroup OR in BUFFER-LIST) whose
`major-mode' is one of MODES."
  (--filter (memq (buffer-local-value 'major-mode it) modes)
            (or buffer-list (doom/get-buffers))))

;;;###autoload
(defun doom/get-real-buffers (&optional buffer-list)
  "Get a list of all buffers (in the current workgroup OR in BUFFER-LIST) that
`doom/real-buffer-p' returns non-nil for."
  (-filter #'doom/real-buffer-p (or buffer-list (doom/get-buffers))))

;;;###autoload
(defun doom/kill-real-buffer (&optional arg)
  "Kill buffer then switch to a real buffer. Only buries the buffer if it is
being displayed in another window.

NOTE: only buries scratch buffer.

See `doom/real-buffer-p' for what 'real' means."
  (interactive (list t))
  (let* ((scratch-p (eq (current-buffer) doom-buffer))
         (old-project (doom/project-root))
         (buffer (current-buffer))
         (only-buffer-window-p (= (length (get-buffer-window-list buffer nil t)) 1)))
    (unless scratch-p
      (when (and only-buffer-window-p buffer-file-name (buffer-modified-p))
        (if (yes-or-no-p "Buffer is unsaved, save it?")
            (save-buffer)
          (set-buffer-modified-p nil)))
      (when arg
        (doom/previous-real-buffer)
        (when (eq buffer (current-buffer))
          (switch-to-buffer doom-buffer t t))
        (when only-buffer-window-p
          (kill-buffer buffer))))
    (when (eq (current-buffer) doom-buffer)
      (doom-reload-scratch-buffer old-project)))
  t)

;;;###autoload
(defun doom/kill-unreal-buffers ()
  "Kill all buried buffers in current frame that match any of the rules in
`doom-unreal-buffers'."
  (interactive)
  (let ((kill-list (-remove 'doom/real-buffer-p
                            (doom/get-buried-buffers (buffer-list)))))
    (mapc 'kill-buffer kill-list)
    (doom/kill-process-buffers)
    (message "Cleaned up %s buffers" (length kill-list))))

;;;###autoload
(defun doom/kill-process-buffers ()
  "Kill all buried buffers that represent running processes."
  (interactive)
  (let ((buffer-list (buffer-list))
        (killed-processes 0))
    (dolist (p (process-list))
      (let* ((process-name (process-name p))
             (assoc (assoc process-name doom-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 doom/kill-matching-buffers (pattern &optional buffer-list)
  "Kill all buffers (in current workgroup OR in BUFFER-LIST) that match the
regex PATTERN."
  (interactive)
  (let ((i 0))
    (mapc (lambda (b)
            (when (string-match-p pattern (buffer-name b))
              (kill-buffer b)
              (setq i (1+ i))))
          (if buffer-list buffer-list (doom/get-buffers)))
    (message "Killed %s matches" i)))

;;;###autoload
(defun doom/cycle-real-buffers (&optional n)
  "Switch to the previous buffer, skipping over 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))
         (max 25)
         (i 0)
         (continue t)
         (buffers (doom/get-real-buffers (doom/get-buffers t)))
         destbuf)
    (setq destbuf
          (catch 'goto
            (if (or (not buffers)
                    (= (length buffers) 1))
                (progn (message "No other buffers in workgroup")
                       (throw 'goto (current-buffer)))
              (funcall move-func)
              (while (not (memq (current-buffer) buffers))
                (if (or (eq (current-buffer) start-buffer)
                        (>= i max))
                    (throw 'goto doom-buffer)
                  (funcall move-func))
                (cl-incf i))
              (current-buffer))))
    (when (eq destbuf doom-buffer)
      (doom-reload-scratch-buffer)
      (message "Nowhere to go"))
    (switch-to-buffer destbuf)))

;;;###autoload
(defun doom/real-buffer-p (&optional buffer)
  "Returns whether BUFFER a 'real' buffer or not. Real means: a) it isn't a
popup (or temporary) window and b) it isn't a special buffer (e.g. scratch or
*messages* buffer)."
  (setq buffer (or (and (bufferp buffer) buffer)
                   (and (stringp buffer) (get-buffer buffer))
                   (current-buffer)))
  (or (eq buffer doom-buffer)
      (when (buffer-live-p buffer)
        (with-current-buffer buffer
          (not (or (apply #'derived-mode-p (-filter 'symbolp doom-unreal-buffers))
                   (--any? (string-match-p it (buffer-name buffer))
                           (-filter 'stringp doom-unreal-buffers))))))))

;;;###autoload
(defun doom/next-real-buffer ()
  "Switch to the next real buffer, skipping special buffers. See
`doom/real-buffer-p'."
  (interactive)
  (doom/cycle-real-buffers +1))

;;;###autoload
(defun doom/previous-real-buffer ()
  "Switch to the previous real buffer, skipping special buffers. See
`doom/real-buffer-p'."
  (interactive)
  (doom/cycle-real-buffers -1))

(defun doom--kill-buffers (buffers &optional filter-func)
  (let ((buffers (if filter-func (-filter filter-func buffers) buffers))
        (affected 0))
    (mapc (lambda (b) (when (kill-buffer b) (incf affected))) buffers)
    (unless (doom/real-buffer-p)
      (doom/previous-real-buffer))
    (message "Killed %s buffers" affected)))

;;;###autoload (autoload 'doom:kill-all-buffers "defuns-buffers" nil t)
(evil-define-command doom:kill-all-buffers (&optional bang)
  "Kill all project buffers. If BANG, kill *all* buffers (in workgroup)."
  (interactive "<!>")
  (doom--kill-buffers (--filter (not (eq it doom-buffer)) (doom/get-buffers (not bang))))
  (mapc (lambda (w) (when (eq (window-buffer w) doom-buffer)
                 (delete-window w)))
        (doom/get-visible-windows)))

;;;###autoload (autoload 'doom:kill-other-buffers "defuns-buffers" nil t)
(evil-define-command doom:kill-other-buffers (&optional bang)
  "Kill all other project buffers. If BANG, kill *all* other buffers (in workgroup)."
  (interactive "<!>")
  (doom--kill-buffers (doom/get-buffers (not bang))
                      (lambda (b) (not (eq b (current-buffer)))))
  (when bang
    (delete-other-windows)))

;;;###autoload (autoload 'doom:kill-buried-buffers "defuns-buffers" nil t)
(evil-define-command doom:kill-buried-buffers (&optional bang)
  "Kill buried project buffers in current workgroup and report how many it
found. If BANG, then include buffers that aren't part of the current project."
  (interactive "<!>")
  (doom--kill-buffers (doom/get-buried-buffers (doom/get-buffers (not bang)))))

;;;###autoload (autoload 'doom:kill-buried-buffers "defuns-buffers" nil t)
(evil-define-command doom:kill-matching-buffers (&optional bang pattern)
  "Kill project buffers in current workgroup that match regex PATTERN. If BANG,
then include buffers that aren't part of the current project."
  :repeat nil
  (interactive "<!><a>")
  (doom-kill-buffers (doom/get-matching-buffers pattern (doom/get-buffers (not bang)))))

;;;###autoload (autoload 'doom:scratch-buffer "defuns-buffers" nil t)
(evil-define-operator doom:scratch-buffer (&optional beg end bang)
  "Send a region to and pop up the scratch buffer. If BANG, don't use a popup
(use the current window)."
  :move-point nil
  :type inclusive
  (interactive "<r><!>")
  (let ((text (when (and (evil-visual-state-p) beg end)
                (buffer-substring beg end)))
        (mode major-mode)
        (old-project (doom/project-root))
        (new-buf (get-buffer-create "*doom:scratch*")))
    (with-current-buffer new-buf
      (setq default-directory old-project)
      (setq mode-line-format (doom-modeline))
      (when (and (not (eq major-mode mode))
                 (functionp mode))
        (funcall mode))
      (if text (insert text)))
    (if bang (switch-to-buffer new-buf) (doom/popup-buffer new-buf))))

;;;###autoload (autoload 'doom:cd "defuns-buffers" nil t)
(evil-define-command doom:cd (dir)
  "Change the `default-directory' to DIR (alias for `cd')"
  :repeat nil
  (interactive "<f>")
  (cd (if (zerop (length dir)) "~" dir)))

;;;###autoload
(defun doom/kill-workgroup-and-quit ()
  "Wipe the current workgroup session and save the blank slate."
  (interactive)
  (let (confirm-kill-emacs)
    (mapc 'kill-buffer (doom/get-buffers t))
    (kill-this-buffer)
    (delete-other-windows)
    (wg-save-session t)
    (save-buffers-kill-terminal)))

(provide 'defuns-buffers)
;;; defuns-buffers.el ends here