ENH simplify helm device finder to only navigate to mounted devices

This commit is contained in:
Nathan Dwarshuis 2020-02-29 19:37:06 -05:00
parent a73274ae0a
commit dca3fe78ea
1 changed files with 14 additions and 46 deletions

View File

@ -207,38 +207,17 @@ desktop file exec directive."
(mt (shell-command-to-string cmd))) (mt (shell-command-to-string cmd)))
(replace-regexp-in-string "\n\\'" "" mt))) (replace-regexp-in-string "\n\\'" "" mt)))
(defvar nd/device-mount-dir (concat "/media/" (user-login-name))) (defconst nd/device-mount-dirs
(list
(f-join "/media" (user-login-name))
(f-join "/run" "media" (user-login-name))))
(defun nd/get-mounted-directories (&optional mount-path) (defun nd/get-mounted-directories ()
"Scan MOUNT-PATH (defaults to /media/$USER for devices that have "Return list of mountpoints for active devices.
been mounted by udevil." Will only consider directories in `nd/device-mount-dirs'."
(seq-filter #'file-directory-p (directory-files nd/device-mount-dir t "^\\([^.]\\|\\.[^.]\\|\\.\\..\\)"))) (->> (-filter #'f-exists? nd/device-mount-dirs)
(-mapcat #'f-directories)
(defun nd/device-mountable-p (devpath) (-filter #'file-directory-p)))
"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" dev))
(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)))
(defun nd/print-args (orig-fun &rest args) (defun nd/print-args (orig-fun &rest args)
"Prints ARGS of ORIG-FUN. Intended as :around advice." "Prints ARGS of ORIG-FUN. Intended as :around advice."
@ -2924,33 +2903,22 @@ By default dired uses =ls -whatever= to get its output. This does not have recur
(setq dired-du-size-format t)) (setq dired-du-size-format t))
#+END_SRC #+END_SRC
*** mounted devices *** mounted devices
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). I handle device mounting using rofi and a custom mounting script (elsewhere in my dotfiles). The only functionality I need/want here is the ability to quickly navigate to mounted directories using dired.
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defun nd/helm-devices () (defun nd/helm-devices ()
"Mount, unmount, and navigate to removable media using helm." "Navigate to mounted devices."
(interactive) (interactive)
(let* ((mounted (mapcar (let* ((mounted (mapcar
(lambda (d) (lambda (d)
`(,(file-name-base d) . ,d)) `(,(file-name-base d) . ,d))
(nd/get-mounted-directories))) (nd/get-mounted-directories))))
(mountable (seq-filter
(lambda (d) (not (member (car d) (mapcar #'car mounted))))
(nd/get-mountable-devices))))
(helm (helm
:sources :sources
(list (list
(helm-build-sync-source "Mounted Devices" (helm-build-sync-source "Mounted Devices"
:candidates mounted :candidates mounted
:action :action
'(("Open" . (lambda (s) (find-file s))) '(("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*" :buffer "*helm device buffer*"
:prompt "Device: "))) :prompt "Device: ")))
#+END_SRC #+END_SRC