From 510ef63c597f842e718dcf5a05d772e4005800fc Mon Sep 17 00:00:00 2001 From: Tom Willemse Date: Sun, 19 Jan 2014 14:40:14 +0100 Subject: Add desktop-registry-list-desktops This new command shows a list of all the registered desktops in a nice tabulated format. --- desktop-registry.el | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/desktop-registry.el b/desktop-registry.el index 5204798..6a2e01e 100644 --- a/desktop-registry.el +++ b/desktop-registry.el @@ -40,6 +40,12 @@ :group 'desktop-registry :type '(repeat (cons string directory))) +(defcustom desktop-registry-list-switch-buffer-function + #'switch-to-buffer-other-window + "The function to use to switch to the desktop list buffer." + :group 'desktop-registry + :type 'function) + (defvar desktop-registry--history nil "History variable for `desktop-registry'.") @@ -140,5 +146,44 @@ current desktop as default value." (remove-hook 'desktop-save-hook 'desktop-registry-add-current-desktop))) +(defun desktop-registry--prepare-row (data) + "Format a row of DATA for `tabulated-list-entries'." + (let* ((name (car data)) + (dir (cdr data)) + (existsp (and (file-exists-p dir) + (file-directory-p dir)))) + (list name (vector name (if existsp "yes" "no") dir)))) + +(defun desktop-registry--refresh-list () + "Fill `tabulated-list-entries' with registered desktops." + (setq tabulated-list-entries + (mapcar #'desktop-registry--prepare-row + desktop-registry-registry))) + +(define-derived-mode desktop-registry-list-mode tabulated-list-mode + "Desktop Registry" + "Major mode for listing registered desktops. + +\\ +\\{desktop-registry-list-mode-map}" + (setq tabulated-list-format [("Label" 30 t) + ("Exists" 6 nil) + ("Location" 0 t)] + tabulated-list-sort-key '("Label")) + (add-hook 'tabulated-list-revert-hook #'desktop-registry--refresh-list) + (tabulated-list-init-header)) + +;;;###autoload +(defun desktop-registry-list-desktops () + "Display a list of registered desktops." + (interactive) + (let ((buffer (get-buffer-create "*Desktop Registry*"))) + (with-current-buffer buffer + (desktop-registry-list-mode) + (desktop-registry--refresh-list) + (tabulated-list-print)) + (funcall desktop-registry-list-switch-buffer-function buffer)) + nil) + (provide 'desktop-registry) ;;; desktop-registry.el ends here -- cgit v1.2.3-54-g00ecf