buffer-layers.el 5.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150
  1. ;;; buffer-layers.el --- Layered Buffers for Buffer Management
  2. ;; Copyright (C) 2016 Samuel Flint
  3. ;; Author: Samuel W. Flint <swflint@flintfam.org>
  4. ;; Version: 1.5
  5. ;; Package-Requires: ((cl-lib "0.5"))
  6. ;; Keywords: buffer-management
  7. ;; URL: http://github.com/swflint/buffer-layers
  8. ;;; Commentary:
  9. ;;
  10. ;; This is Buffer Layers, a simple, layer-based buffer management system.
  11. ;;
  12. ;; It works by defining buffer layers using a fairly simple macro. An example is as follows:
  13. ;;
  14. ;; (define-buffer-layer org
  15. ;; :files ("~/org/"
  16. ;; "~/org/main.org")
  17. ;; :buffer-to-select "main.org"
  18. ;; :run-on-apply ((my/find-current-notes-file)))
  19. ;;; Code:
  20. (require 'cl-lib)
  21. (defvar *buffer-layers* nil
  22. "List of all defined buffer layers.")
  23. (defvar *buffer-layers-applied* nil
  24. "List of applied buffer-layers.")
  25. (defun buffer-layers-applied-p (layer)
  26. "Returns true if LAYER is applied."
  27. (member layer *buffer-layers-applied*))
  28. (defun buffer-layers--applier-name (name)
  29. "Generate name to apply a buffer layer based on NAME."
  30. (intern (format "apply-buffer-layers-%s" name)))
  31. (defun buffer-layers--remover-name (name)
  32. "Generate name to remove a buffer layer based on NAME."
  33. (intern (format "remove-buffer-layers-%s" name)))
  34. (defun buffer-layers--buffer-list-name (name)
  35. "Generate name to contain buffer layer buffer list based on NAME."
  36. (intern (format "*buffer-layers-%s-buffers*" name)))
  37. (cl-defmacro define-buffer-layer (name &key files run-on-apply run-on-remove buffer-to-select)
  38. "Define a buffer layer named NAME, taking FILES, RUN-ON-APPLY, RUN-ON-REMOVE and BUFFER-TO-SELECT as keyword arguments."
  39. (let ((applier (buffer-layers--applier-name name))
  40. (remover (buffer-layers--remover-name name))
  41. (buffers-list (buffer-layers--buffer-list-name name))
  42. (files-list (cons 'list
  43. (when (not (null files))
  44. (mapcar #'(lambda (name)
  45. (format "%s" name)) files)))))
  46. `(progn
  47. (add-to-list '*buffer-layers* ',name)
  48. (defvar ,buffers-list nil)
  49. (defun ,applier ()
  50. ,(format "Apply buffer-layer %s." name)
  51. (interactive)
  52. (mapcar #'(lambda (file)
  53. (add-to-list ',buffers-list (find-file file)))
  54. ,files-list)
  55. ,@run-on-apply
  56. (when (not (null ,buffer-to-select))
  57. (switch-to-buffer ,buffer-to-select))
  58. (add-to-list '*buffer-layers-applied* ',name)
  59. (message "Applied Buffer Layer %s" ',name))
  60. (defun ,remover ()
  61. ,(format "Remove buffer-layer %s." name)
  62. (interactive)
  63. (mapc #'(lambda (buffer)
  64. (when (buffer-live-p buffer)
  65. (with-current-buffer buffer
  66. (save-buffer)
  67. (kill-buffer))))
  68. ,buffers-list)
  69. ,@run-on-remove
  70. (setq ,buffers-list nil)
  71. (setq *buffer-layers-applied* (delq ',name *buffer-layers-applied*))
  72. (message "Removed Buffer Layer %s" ',name))
  73. (setq current-buffer-applier ',applier)
  74. (list ',applier ',remover))))
  75. (defun buffer-layers-load-buffer-layer (name-or-path load-it-p)
  76. "Load a buffer named NAME-OR-PATH, and if a file, apply if LOAD-IT-P is true."
  77. (interactive (list (completing-read "Buffer Layer Name or Path: " (cl-remove-if #'(lambda (layer)
  78. (member layer *buffer-layers-applied*))
  79. *buffer-layers*))
  80. nil))
  81. (if (functionp (buffer-layers--applier-name name-or-path))
  82. (funcall (buffer-layers--applier-name name-or-path))
  83. (load name-or-path)
  84. (when load-it-p
  85. (funcall current-buffer-applier))))
  86. (defalias 'load-buffer-layer 'buffer-layers-load-buffer-layer)
  87. (defun buffer-layers-unload-buffer-layer (name)
  88. "Unload Buffer Layer named NAME."
  89. (interactive (list (completing-read "Buffer Layer Name: " *buffer-layers-applied*)))
  90. (funcall (buffer-layers--remover-name name)))
  91. (defun buffer-layers-list ()
  92. "Produce a list of defined buffer layers."
  93. (interactive)
  94. (with-help-window "*Buffer Layers*"
  95. (when (buffer-live-p "*Buffer Layers*")
  96. (kill-buffer "*Buffer Layers*"))
  97. (with-current-buffer "*Buffer Layers*"
  98. (insert "Defined Buffer Layers:\n\n")
  99. (insert (with-temp-buffer
  100. (dolist (layer *buffer-layers*)
  101. (insert (format " - %s%s\n" layer (if (buffer-layers-applied-p layer) " (Applied)"
  102. ""))))
  103. (sort-lines nil (buffer-end -1) (buffer-end +1))
  104. (buffer-string))))))
  105. (defun buffer-layers-unload-all-buffer-layers ()
  106. "Unload all loaded buffer layers."
  107. (interactive)
  108. (dolist (buffer-layer *buffer-layers-applied*)
  109. (unload-buffer-layer buffer-layer)))
  110. (defvar buffer-layers-map (make-keymap)
  111. "Keymap for buffer-layer commands.")
  112. (define-key buffer-layers-map (kbd "l") #'buffer-layers-load-buffer-layer)
  113. (define-key buffer-layers-map (kbd "L") #'buffer-layers-list)
  114. (define-key buffer-layers-map (kbd "u") #'buffer-layers-unload-buffer-layer)
  115. (define-key buffer-layers-map (kbd "U") #'buffer-layers-unload-all-buffer-layers)
  116. (define-minor-mode buffer-layers-mode
  117. "A mode for managing layers of buffers."
  118. :lighter " BLM" :global t :variable buffer-layers-mode-p
  119. (if buffer-layers-mode-p
  120. (progn
  121. (define-key ctl-x-map (kbd "L") buffer-layers-map)
  122. (add-hook 'kill-emacs-hook #'buffer-layers-unload-all-buffer-layers))
  123. (progn
  124. (define-key ctl-x-map (kbd "L") nil)
  125. (remove-hook 'kill-emacs-hook #'buffer-layers-unload-all-buffer-layers))))
  126. (provide 'buffer-layers)
  127. ;;; buffer-layers.el ends here