buffer-sets.el 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338
  1. ;;; buffer-sets.el --- Sets of Buffers for Buffer Management
  2. ;; Copyright (C) 2016 Samuel Flint
  3. ;; Author: Samuel W. Flint <swflint@flintfam.org>
  4. ;; Version: 2.5
  5. ;; Package-Requires: ((cl-lib "0.5"))
  6. ;; Keywords: buffer-management
  7. ;; URL: http://github.com/swflint/buffer-sets
  8. ;;; Commentary:
  9. ;;
  10. ;;; Code:
  11. (require 'cl-lib)
  12. ;;; Variables and Structures
  13. (cl-defstruct buffer-set
  14. name
  15. files
  16. select
  17. on-apply
  18. on-apply-source
  19. on-remove
  20. on-remove-source)
  21. (defvar *buffer-sets* nil
  22. "List of all defined buffer sets.")
  23. (defvar *buffer-sets-applied* nil
  24. "List of applied buffer-sets.")
  25. (defvar *buffer-set-definitions* nil
  26. "List of all buffer set definitions.")
  27. (defvar *buffer-set-buffers* nil
  28. "List of buffers in loaded buffer sets.")
  29. (defvar buffer-sets-mode-p nil)
  30. (defvar buffer-sets-load-set-hook '()
  31. "Hook run on set load.")
  32. (defvar buffer-sets-unload-hook '()
  33. "Hook run on set unload.")
  34. (defcustom buffer-set-file "~/.emacs.d/buffer-set-definitions.el"
  35. "The file to store buffer set definitions in."
  36. :type 'file :group 'editing)
  37. ;;;###autoload
  38. (defcustom buffer-sets-load-on-start (list)
  39. "A list of buffer-sets to load on Emacs start."
  40. :type '(repeat symbol) :group 'editing)
  41. ;;;###autoload
  42. (defcustom buffer-sets-ignore-save (list)
  43. "A list of buffer-sets to ignore on saving."
  44. :type '(repeat symbol) :group 'editing)
  45. ;;; Utility Functions
  46. (defun buffer-sets-applied-p (set)
  47. "Returns true if SET is applied."
  48. (member set *buffer-sets-applied*))
  49. (defun buffer-set--get-buffer-set-definition (set-name)
  50. (car (cl-remove-if-not (lambda (set)
  51. (eq set-name (buffer-set-name set))) *buffer-set-definitions*)))
  52. (defun buffer-set--generate-buffers-list (set-name)
  53. (intern (format "*buffer-set-%s--buffers*" set-name)))
  54. ;;; Set Definition
  55. ;;;###autoload
  56. (cl-defmacro define-buffer-set (name &key files select on-apply on-remove)
  57. "Define a buffer set named NAME, taking FILES, RUN-ON-APPLY, RUN-ON-REMOVE and BUFFER-TO-SELECT as keyword arguments."
  58. `(progn
  59. (cl-pushnew ',name *buffer-sets*)
  60. (setq *buffer-set-definitions* (cons (make-buffer-set :name ',name
  61. :files ',files
  62. :select ,select
  63. :on-apply-source ',on-apply
  64. :on-remove-source ',on-remove
  65. :on-apply (lambda () ,@on-apply)
  66. :on-remove (lambda () ,@on-remove))
  67. (cl-remove-if (lambda (structure)
  68. (eq ',name (buffer-set-name structure)))
  69. *buffer-set-definitions*)))
  70. (defvar ,(buffer-set--generate-buffers-list name) nil)
  71. ',name))
  72. ;;; Interactive Functions
  73. ;;;###autoload
  74. (defun buffer-sets-load-set (name)
  75. (interactive (list (intern (completing-read "Set Name: "
  76. (cl-remove-if #'(lambda (set) (member set *buffer-sets-applied*)) *buffer-sets*)
  77. nil t))))
  78. (let ((set-definition (buffer-set--get-buffer-set-definition name)))
  79. (if (not (buffer-set-p set-definition))
  80. (error "Set Undefined: %s" name)
  81. (let ((files (buffer-set-files set-definition))
  82. (select (buffer-set-select set-definition))
  83. (on-apply (buffer-set-on-apply set-definition))
  84. (buffers-list (buffer-set--generate-buffers-list name)))
  85. (setf (symbol-value buffers-list) (mapcar #'find-file files))
  86. (funcall on-apply)
  87. (when (stringp select)
  88. (switch-to-buffer select))
  89. (add-to-list '*buffer-sets-applied* name)
  90. (run-hooks 'buffer-sets-load-set-hook)
  91. (message "Applied buffer set %s." name)))))
  92. (defalias 'load-buffer-set 'buffer-sets-load-set)
  93. (defun buffer-sets-in-buffers-list (set buffer)
  94. (cl-pushnew buffer (symbol-value (buffer-set--generate-buffers-list set))))
  95. ;;;###autoload
  96. (defun buffer-sets-unload-buffer-set (name)
  97. "Unload Buffer Set named NAME."
  98. (interactive (list (intern (completing-read "Set Name: " *buffer-sets-applied*))))
  99. (let ((set-definition (buffer-set--get-buffer-set-definition name)))
  100. (if (not (buffer-set-p set-definition))
  101. (error "Set Undefined: %s" name)
  102. (let ((buffers-list (buffer-set--generate-buffers-list name))
  103. (on-remove (buffer-set-on-remove set-definition)))
  104. (mapc (lambda (buffer)
  105. (when (buffer-live-p buffer)
  106. (with-current-buffer buffer
  107. (save-buffer)
  108. (kill-buffer buffer))))
  109. (symbol-value buffers-list))
  110. (funcall on-remove)
  111. (setf (symbol-value buffers-list) nil)
  112. (setq *buffer-sets-applied* (delq name *buffer-sets-applied*))
  113. (run-hooks 'buffer-sets-unload-hook)
  114. (message "Removed Buffer Set: %s" name)))))
  115. ;;;###autoload
  116. (defun buffer-sets-unload-last-loaded-set ()
  117. (interactive)
  118. (let ((set (cl-first *buffer-sets-applied*)))
  119. (buffer-sets-unload-buffer-set set)))
  120. ;;;###autoload
  121. (defun buffer-sets-list ()
  122. "Produce a list of defined buffer sets."
  123. (interactive)
  124. (when (buffer-live-p "*Buffer Sets*")
  125. (kill-buffer "*Buffer Sets*"))
  126. (with-help-window "*Buffer Sets*"
  127. (with-current-buffer "*Buffer Sets*"
  128. (insert "Defined Buffer Sets:\n\n")
  129. (dolist (set *buffer-sets*)
  130. (if (not (buffer-sets-applied-p set))
  131. (insert (format " - %s\n" set))
  132. (insert (format " - %s (Applied)\n" set)))
  133. (dolist (buffer (symbol-value (buffer-set--generate-buffers-list set)))
  134. (if (buffer-live-p buffer)
  135. (if (null (get-buffer-window-list buffer nil t))
  136. (progn
  137. (insert " - ")
  138. (insert-text-button (buffer-name buffer) 'action (eval `(lambda (but) (switch-to-buffer ,buffer))))
  139. (insert "\n"))
  140. (progn
  141. (insert " - ")
  142. (insert-text-button (buffer-name buffer) 'action (eval `(lambda (but) (switch-to-buffer ,buffer))))
  143. (insert " - %s (visible)\n")))
  144. ""))))))
  145. ;;;###autoload
  146. (defun buffer-sets-unload-all-buffer-sets ()
  147. "Unload all loaded buffer sets."
  148. (interactive)
  149. (dolist (buffer-set *buffer-sets-applied*)
  150. (buffer-sets-unload-buffer-set buffer-set)))
  151. ;;;###autoload
  152. (defun buffer-sets-create-set (name)
  153. "Create a new set."
  154. (interactive "SNew Set Name: ")
  155. (when (not (member name *buffer-sets*))
  156. (cl-pushnew name *buffer-sets*)
  157. (setf (symbol-value (buffer-set--generate-buffers-list name)) nil)
  158. (cl-pushnew (make-buffer-set :name name
  159. :on-apply (lambda () nil)
  160. :on-remove (lambda () nil)) *buffer-set-definitions*)))
  161. ;;;###autoload
  162. (defun buffer-sets-add-file-to-set (name file)
  163. "Add a file to the set."
  164. (interactive (list
  165. (intern (completing-read "Set Name: " *buffer-sets* nil t))
  166. (read-file-name "File Name: ")))
  167. (let ((set (buffer-set--get-buffer-set-definition name)))
  168. (setf (buffer-set-files set) (append (buffer-set-files set) (list file)))))
  169. ;;;###autoload
  170. (defun buffer-sets-add-directory-to-set (name directory)
  171. (interactive (list
  172. (intern (completing-read "Set Name: " *buffer-sets* nil t))
  173. (read-directory-name "Directory: ")))
  174. (let ((set (buffer-set--get-buffer-set-definition name)))
  175. (setf (buffer-set-files set) (append (buffer-set-files set) (list directory)))))
  176. ;;;###autoload
  177. (defun buffer-sets-add-buffer-to-set (name buffer)
  178. "Add a buffer to the given set."
  179. (interactive (list
  180. (intern (completing-read "Set Name: " *buffer-sets* nil t))
  181. (get-buffer (read-buffer "Buffer: " (current-buffer)))))
  182. (let ((set (buffer-set--get-buffer-set-definition name))
  183. (file (buffer-file-name buffer)))
  184. (setf (buffer-set-files set) (append (buffer-set-files set) (list file)))))
  185. ;; (defun buffer-sets-edit-load-actions (set)
  186. ;; "Edit the actions to be preformed on buffer set load."
  187. ;; (interactive (list (completing-read "Set: " *buffer-sets* nil t))))
  188. ;; (defun buffer-sets-edit-remove-actions (set)
  189. ;; "Edit the actions to be preformed on buffer set removal."
  190. ;; (interactive (list (completing-read "Set: " *buffer-sets* nil t))))
  191. ;;;###autoload
  192. (defun buffer-sets-set-buffer-to-select (name)
  193. "Set the buffer to automatically select."
  194. (interactive (list (intern (completing-read "Set Name: " *buffer-sets* nil t))))
  195. (let* ((set (buffer-set--get-buffer-set-definition name))
  196. (files (buffer-set-files set)))
  197. (setf (buffer-set-select set)
  198. (completing-read "Buffer: " (mapcar #'buffer-name (symbol-value (buffer-set--generate-buffers-list name))) nil t))))
  199. ;;;###autoload
  200. (defun buffer-sets-remove-file (set)
  201. (interactive (list (intern (completing-read "Set Name: " *buffer-sets* nil t))))
  202. (let ((set (buffer-set--get-buffer-set-definition set)))
  203. (setf (buffer-set-files set)
  204. (delq (completing-read "File: " (buffer-set-files set) nil t)
  205. (buffer-set-files set)))))
  206. ;;; File Functions
  207. (defun buffer-sets-save (the-set)
  208. "Save defined buffer sets."
  209. (if (not (member the-set buffer-sets-ignore-save))
  210. (insert (format "%S\n\n" (let ((name (buffer-set-name the-set))
  211. (files (buffer-set-files the-set))
  212. (select (buffer-set-select the-set))
  213. (on-apply (buffer-set-on-apply-source the-set))
  214. (on-remove (buffer-set-on-remove-source the-set)))
  215. `(define-buffer-set ,name
  216. :files ,files
  217. :select ,select
  218. :on-apply ,on-apply
  219. :on-remove ,on-remove))))))
  220. ;;;###autoload
  221. (defun buffer-sets-load-definitions-file ()
  222. "Load buffer set definitions file."
  223. (interactive)
  224. (load buffer-set-file t t)
  225. (message "Loaded Buffer Set Definitions."))
  226. ;;;###autoload
  227. (defun buffer-sets-save-definitions ()
  228. (interactive)
  229. (with-current-buffer (find-file buffer-set-file)
  230. (kill-region (buffer-end -1) (buffer-end 1))
  231. (mapc #'buffer-sets-save (reverse *buffer-set-definitions*))
  232. (save-buffer)
  233. (kill-buffer))
  234. (message "Saved Buffer Set Definitions."))
  235. ;;; Mode Definition
  236. (defvar buffer-sets-mode-map
  237. (let ((keymap (make-keymap)))
  238. (define-key keymap (kbd "C-x L l") #'buffer-sets-load-set)
  239. (define-key keymap (kbd "C-x L L") #'buffer-sets-list)
  240. (define-key keymap (kbd "C-x L u") #'buffer-sets-unload-buffer-set)
  241. (define-key keymap (kbd "C-x L U") #'buffer-sets-unload-all-buffer-sets)
  242. (define-key keymap (kbd "C-x L c") #'buffer-sets-create-set)
  243. (define-key keymap (kbd "C-x L f") #'buffer-sets-add-file-to-set)
  244. (define-key keymap (kbd "C-x L b") #'buffer-sets-add-buffer-to-set)
  245. (define-key keymap (kbd "C-x L d") #'buffer-sets-add-directory-to-set)
  246. (define-key keymap (kbd "C-x L R") #'buffer-sets-remove-file)
  247. (define-key keymap (kbd "C-x L s") #'buffer-sets-set-buffer-to-select)
  248. (define-key keymap (kbd "C-x L p") #'buffer-sets-unload-last-loaded-set)
  249. (define-key keymap (kbd "C-x L C-f") #'buffer-sets-load-definitions-file)
  250. (define-key keymap (kbd "C-x L C-s") #'buffer-sets-save-definitions)
  251. keymap)
  252. "Keymap for buffer-set commands.")
  253. ;;;###autoload
  254. (define-minor-mode buffer-sets-mode
  255. "A mode for managing sets of buffers."
  256. :lighter " BSM" :global t :variable buffer-sets-mode-p :keymap buffer-sets-mode-map
  257. (if buffer-sets-mode-p
  258. (progn
  259. (buffer-sets-load-definitions-file)
  260. (add-hook 'kill-emacs-hook #'buffer-sets-unload-all-buffer-sets)
  261. (add-hook 'kill-emacs-hook #'buffer-sets-save-definitions))
  262. (progn
  263. (buffer-sets-save-definitions)
  264. (remove-hook 'kill-emacs-hook #'buffer-sets-unload-all-buffer-sets)
  265. (remove-hook 'kill-emacs-hook #'buffer-sets-save-definitions))))
  266. ;;;###autoload
  267. (define-ibuffer-filter in-buffer-set
  268. "Check to see if a buffer is in a given buffer-set."
  269. (:reader (intern (completing-read "Set Name: " *buffer-sets-applied*)))
  270. (let ((buffers-list (symbol-value (buffer-set--generate-buffers-list qualifier))))
  271. (member buf buffers-list)))
  272. ;;;###autoload
  273. (defun buffer-sets-install-emacs-start-hook ()
  274. "Install the hook to load buffer-sets on Emacs start."
  275. (add-hook 'after-init-hook #'buffer-sets-after-init))
  276. (defun buffer-sets-after-init ()
  277. "Load buffer-sets on Emacs start."
  278. (mapcar #'load-buffer-set buffer-sets-load-on-start))
  279. (provide 'buffer-sets)
  280. ;;; buffer-sets.el ends here