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

core/defuns/defuns-buffers.el

@@ -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