diff --git a/conf.org b/conf.org index 475ba8a..a57e723 100644 --- a/conf.org +++ b/conf.org @@ -314,6 +314,32 @@ desktop file exec directive." "Scan MOUNT-PATH (defaults to /media/$USER for devices that have been mounted by udevil." (seq-filter #'file-directory-p (directory-files nd/device-mount-dir t "^\\([^.]\\|\\.[^.]\\|\\.\\..\\)"))) + +(defun nd/device-mountable-p (devpath) + "Returns label or uuid if device at DEVPATH is has a readable +filesystem and is a usb drive." + (let ((devprops (shell-command-to-string (concat "udevadm info --query=property " devpath)))) + (and (string-match-p (regexp-quote "ID_FS_TYPE") devprops) + (string-match-p (regexp-quote "ID_BUS=usb") devprops) + (progn + (or (string-match "ID_FS_LABEL=\\(.*\\)\n" devprops) + (string-match "ID_FS_UUID=\\(.*\\)\n" devprops)) + (match-string 1 devprops))))) + +(defun nd/get-mountable-devices () + "Return paths of all mountable devices. (see `nd/device-mountable-p')." + (seq-filter #'car + (mapcar (lambda (d) `(,(nd/device-mountable-p d) . ,d)) + (directory-files "/dev" t "sd.[0-9]+")))) + +(defun nd/mount-device (dev &rest opts) + "Mount device DEV using udevil." + (call-process "udevil" nil nil nil "mount" s)) + +(defun nd/get-mountpoint (dev) + "Get the filesystem mountpoint for device DEV." + (let ((mp (shell-command-to-string (concat "printf %s \"$(findmnt -n -o TARGET " dev ")\"")))) + (and (not (equal "" mp)) mp))) #+END_SRC ** interactive #+BEGIN_SRC emacs-lisp @@ -1913,22 +1939,35 @@ By default dired uses =ls -whatever= to get its output. This does not have recur (setq dired-du-size-format t)) #+END_SRC *** mounted devices -All my devices should be mounted in =/media/$USER=, so implement a simple help search to navigate this directory after mounting with udevil. +If dired is to replace all other file managers it must handle devices. This function assumes all my devices are mounted on =/media/$USER= and that udevil is installed. It provides mount and mount/follow ops for all usb removable media and follow/unmount for all mounted devices (note the latter includes things that are not mounted here such as samba drives, which I normally hotkey to my window manager). This /almost/ replicates the functionality of gvfs that I actually use without the bloat; the only missing piece is MPT for android (which will come later). #+BEGIN_SRC emacs-lisp -(defun nd/dired-mounted-devices () - "Navigate to a directory for a mounted device." +(defun nd/helm-devices () + "Mount, unmount, and navigate to removable media using helm." (interactive) - (let ((dev (nd/get-mounted-directories))) - (if dev - (helm - :sources - (helm-build-sync-source "Devices" - :candidates (mapcar (lambda (d) `(,(file-name-base d) . ,d)) dev) - :action - '(("Open" . (lambda (s) (find-file s))) - ("Unmount" . (lambda (s) (start-process "unmount" nil "udevil" "unmount" s))))) - :buffer "*helm device buffer*") - (message "No devices mounted")))) + (let* ((mounted (mapcar + (lambda (d) + `(,(file-name-base d) . ,d)) + (nd/get-mounted-directories))) + (mountable (seq-filter + (lambda (d) (not (member (car d) (mapcar #'car mounted)))) + (nd/get-mountable-devices)))) + (helm + :sources + (list + (helm-build-sync-source "Mounted Devices" + :candidates mounted + :action + '(("Open" . (lambda (s) (find-file s))) + ("Unmount" . (lambda (s) (start-process "unmount" nil "udevil" "unmount" s))))) + (helm-build-sync-source "Mountable Devices" + :candidates mountable + :action + '(("Mount and Follow" . (lambda (s) + (nd/mount-device s) + (find-file (nd/get-mountpoint s)))) + ("Mount" . (lambda (s) (nd/mount-device s)))))) + :buffer "*helm device buffer*" + :prompt "Device: "))) #+END_SRC ** mu4e *** basic @@ -2533,6 +2572,7 @@ The function keys are nice because they are almost (not always) free in every mo (global-unset-key (kbd "C-x c")) (global-set-key (kbd "C-x k") 'nd/kill-current-buffer) (global-set-key (kbd "C-x C-d") 'helm-bookmarks) +(global-set-key (kbd "C-x C-c C-d") 'nd/helm-devices) (global-set-key (kbd "C-x C-f") 'helm-find-files) (global-set-key (kbd "C-x C-b") 'helm-buffers-list)