path: root/aeronaut.el
blob: f45480be18f004bc7c2c931df276ca8246ebdc83 (plain) (tree)














































































;;; aeronaut.el --- An alternative file browser -*- lexical-binding: t; -*-

;; Copyright (C) 2021 Étienne Deparis

;; Maintener: Étienne Deparis <>
;; Author: Étienne Deparis <>
;; Created: 1 April 2021
;; Version: 1.0
;; Package-Requires: ((emacs "26.1"))
;; Keywords: files
;; Homepage:

;;; Commentary:

;; Allows file browsing in a similar maneer to the pine/pico or nano embed
;; file browser.

;;; License:

;; This file is not part of GNU Emacs.
;; However, it is distributed under the same license.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Code:

;; Use the same faces than dired-mode
(require 'dired)

;;;; Configuration options:

(defgroup aeronaut nil
  "Aeronaut file browser options"
  :link '(url-link :tag "Homepage" "")
  :link '(emacs-commentary-link :tag "Commentary" "aeronaut.el")
  :group 'files)

(defcustom aeronaut-file-size-unit 'binary
  "Use the given unit to display file size when non-nil.

You can use either `decimal' (multiple of 1000) or `binary' (multiple of 1024)
or nil.  When nil, the file size will be hidden.  Default is `binary'."
  :type '(choice (const :tag "Multiple of 1000" 'decimal)
                 (const :tag "Multiple of 1024" 'binary)
                 (const nil))
  :package-version "1.0"
  :group 'aeronaut)

(defcustom aeronaut-show-hidden-files nil
  "Wether to display hidden files."
  :type 'boolean
  :package-version "1.0"
  :group 'aeronaut)

(defvar-local aeronaut-marked-files nil
  "List of marked files in current buffer.")

(defvar-local aeronaut-flagged-files nil
  "List of flagged files for deletion in current buffer.")

;;;; Helper methods:

(defun aeronaut--get-file-name (&optional pos)
  "Return filename at POS in a aeronaut buffer.

If POS is nil, the file-name will be taken at point."
  (unless pos (setq pos (point)))
  (let ((file-name (get-text-property pos 'field)))
    (when (and file-name (string-match "^goto: \\(.+\\)$" file-name))
      (match-string 1 file-name))))

(defun aeronaut--build-file-info (file &optional directory)
  "Build an info plist for the given FILE.

If DIRECTORY is nil, FILE is expected to be an absolute path.  If DIRECTORY is
non-nil, FILE is expected to be only a filename to be concatenated with
DIRECTORY to have an absolute path."
  (let* ((file-path (if directory (concat directory file) file))
         (file-name (if directory file (file-name-nondirectory file)))
         (file-attr (file-attributes file-path))
         (file-raw-type (file-attribute-type file-attr))
         (file-type (cond ((stringp file-raw-type) "link")
                          (file-raw-type "dir")
                          ((file-regular-p file-path) "file")
                          (t "special")))
         (file-size (when (equal "file" file-type)
                       (file-attribute-size file-attr)))))
    `(:name ,file-name
      :path ,file-path
      :type ,file-type
      :size ,file-size)))

(defun aeronaut--cell-face (file-info)
  "Return the best suitable face for the cell of the  given FILE-INFO plist."
  (let ((file-path (plist-get file-info :path))
        (file-type (plist-get file-info :type)))
    (cond ((and aeronaut-flagged-files
                (member file-path aeronaut-flagged-files))
          ((and aeronaut-marked-files
                (member file-path aeronaut-marked-files))
          ((equal "link" file-type) 'dired-symlink)
          ((equal "dir" file-type) 'dired-directory)
          ((equal "special" file-type) 'dired-special)
            (concat "\\(" (regexp-opt completion-ignored-extensions) "\\)$")

(defun aeronaut--mark-or-flag (pos &optional flag)
  "Mark the file at POS for later use.

If FLAG is non-nil, then this function will flag the found file for deletion,
instead of marking it, i.e. add it to the `aeronaut-flagged-files' list, instead
of adding it to the `aeronaut-marked-files'."
  (let ((file-name (get-text-property pos 'field)))
    (when (and file-name (string-match "^goto: \\(.+\\)$" file-name))
      ;; Change file face
      (let ((buffer-read-only nil))
        (put-text-property (field-beginning pos t) (field-end pos t)
                           'face (if flag 'dired-flagged 'dired-marked)))
      ;; Add it to the marked files list
      (add-to-list (if flag 'aeronaut-flagged-files 'aeronaut-marked-files)
                   (match-string 1 file-name))

(defun aeronaut--propertize-file-cell (file-info cell-width)
  "Propertize FILE-INFO data making sure it will not extend CELL-WIDTH."
  (let* ((file-name (plist-get file-info :name))
         (file-path (plist-get file-info :path))
         (file-type (plist-get file-info :type))
         (file-size (plist-get file-info :size))
         (field-name (concat "goto: " file-path))
         (cell-face (aeronaut--cell-face file-info))
          (cond ((plist-member file-info :label)
                 (plist-get file-info :label))
                ((equal "dir" file-type) "(dir)")
                ((stringp file-size) (format "%s" file-size))
                (t "--")))
         (max-cell-width (- cell-width (length label) 3))
           (truncate-string-to-width file-name max-cell-width 0 ?\s)
           " "
     (propertize cell-display-name
                 'field field-name
                 'face cell-face 'mouse-face 'highlight
                 'help-echo (format "Mouse-1, RET: Go to %s" file-name))
     "  ")))

(defun aeronaut--insert-file-list (list col-number col-width
                                     &optional cur-col)
  "Insert LIST members of DIRECTORY on COL-NUMBER columns of COL-WIDTH width.

If the optional CUR-COL parameter is given, it is taken as
starting column number.  Columns numbering starts at 1.

This function returns the CUR-COL value."
  (unless cur-col (setq cur-col 1))
  (dolist (file-info list cur-col)
    (let* ((cell (aeronaut--propertize-file-cell file-info col-width)))
      (when (= 0 (mod cur-col col-number))
        (setq cell (concat cell "\n")))
      (insert cell))
    (setq cur-col (1+ cur-col))))

(defun aeronaut--human-file-size (size)
  "Return a human readable file SIZE.

This function will read the `aeronaut-file-size-unit' variable to know how to
convert the given byte SIZE into something better readable.  This methods
return nil if `aeronaut-file-size-unit' is nil."
  (when aeronaut-file-size-unit
    (let ((unit-list
           (if (eq 'decimal aeronaut-file-size-unit)
               '("B" "kB" "MB" "GB" "TB" "PB" "EB")
             '("B" "KiB" "MiB" "GiB" "TiB" "PiB" "EiB")))
          (divisor (if (eq 'decimal aeronaut-file-size-unit) 1000.0 1024.0))
          (iteration 0))
      (while (> size divisor)
        (setq size (/ size divisor))
        (setq iteration (1+ iteration)))
      (setq size (let* ((rounded (/ (round (* size 10)) 10.0))
                        (strval (format "%s" rounded)))
                   (if (string-suffix-p ".0" strval)
                       (round rounded)
      (format "%s %s" size
              (if (eq 'decimal aeronaut-file-size-unit)
                  (downcase (nth iteration unit-list))
                (nth iteration unit-list))))))

(defun aeronaut--insert-directory-files (directory)
  "Insert file listing of DIRECTORY.

This function makes use of `directory-files' under the hood."
  (let* (dir-list file-list
          (+ (if (null aeronaut-file-size-unit) 8 12)
             (let ((cell-len 0)
                           (if (null aeronaut-file-size-unit) 10 14)))
               (dolist (file (reverse (directory-files directory)) cell-len)
                 (unless (or (equal file ".")
                             (equal file "..")
                             (and (not aeronaut-show-hidden-files)
                                  (string-prefix-p "." file)))
                   (let ((file-info (aeronaut--build-file-info file directory)))
                     (if (equal "dir" (plist-get file-info :type))
                         (push file-info dir-list)
                       (push file-info file-list)))
                   (let ((namelen (string-width file)))
                     (when (> namelen cell-len)
                       (setq cell-len namelen)))))
               (if (< cell-len min-cell-size) min-cell-size cell-len))))
         (col-number (/ (window-body-width) col-width)))
     `(:name ".."
       :path ,(expand-file-name (concat directory ".."))
       :type "dir"
       :label "(parent dir)")
    (setq file-list (append dir-list file-list))
    (aeronaut--insert-file-list file-list col-number col-width)))

(defun aeronaut--flag-or-mark-pop-up (buffer-name file-list function &optional args)
  "Open a buffer BUFFER-NAME listing FILE-LIST during execution of FUNCTION.

If ARGS is non-nil, it must be an arguments list passed to FUNCTION with
  (let ((buffer (get-buffer-create buffer-name)))
    (with-displayed-buffer-window buffer
        (cons 'display-buffer-below-selected
	          '((window-height . fit-window-to-buffer)
	            (preserve-size . (nil . t))))
        (lambda (window _value)
	      (with-selected-window window
		        (apply function args)
	          (when (window-live-p window)
		        (quit-restore-window window 'kill)))))
      (with-current-buffer buffer
        (dolist (file file-list)
          (insert (format "%s\n" file)))))))

(defun aeronaut--visit-or-browse (path &optional other-window)
  "Browse PATH if it is a directory, or visit it.

When OTHER-WINDOW is non-nil, this function will display the
resulting buffer in window other than the selected one.  In that
case, it may use another existing window or split the current
  (when path
    (if (file-directory-p path)
        (aeronaut path other-window)
      (if other-window
          (find-file-other-window path)
        (find-file path)))))

(defun aeronaut--rename-one-file (old-path)
  "Rename or move OLD-PATH, asking for its new name or path."
  (when (and old-path (file-exists-p old-path))
    (let ((new-path
           (read-file-name (format "Rename %s to: " old-path))))
      (when new-path
        (rename-file old-path (expand-file-name new-path))
        (when (member old-path aeronaut-marked-files)
          (setq aeronaut-marked-files
                (delete old-path aeronaut-marked-files)))))))

(defun aeronaut--delete-one-file (file-path &optional recursive)
  "Delete FILE-PATH.

If FILE-PATH is a directory and RECURSIVE is nil and FILE-PATH contains any
files, this function signals an error."
  (when (and file-path (file-exists-p file-path))
    (if (file-directory-p file-path)
        (delete-directory file-path recursive)
      (delete-file file-path))
    (when (member file-path aeronaut-flagged-files)
      (setq aeronaut-flagged-files
            (delete file-path aeronaut-flagged-files)))))

(defun aeronaut--revert-buffer (&optional _ignore-auto _noconfirm)
  "Replace the current buffer content by an up-to-date listing of files."
  ;; We are working on a read only buffer, thus deactivate it first
  (let ((buffer-read-only nil))
    (aeronaut--insert-directory-files default-directory)
  (goto-char (point-min)))

(defun aeronaut--resize-window (window)
  "Resize all possible Aeronaut buffer in the WINDOW frame."
  (dolist (buffer (buffer-list (window-frame window)))
    (when (and (string-match-p "^*Aeronaut .+*$" (buffer-name buffer))
               (buffer-live-p buffer))
      (with-current-buffer buffer

;;;; Motion command

(defun aeronaut-forward-cell (&optional number)
  "Move point forward NUMBER cells.

If NUMBER is omitted or nil, move point forward one cell.
If NUMBER is a negative number, move backward instead.
Return new point value.

If INC-FUN is given, it must be a function, used to increment point during
If EDGE-FUN is given, it must be a function, used to determine original
position of point during excursion."
  (interactive "p")
  ;; number may be nil
  (setq number (or number 1))
  ;; Set function to be used to move around
  (let ((inc-fun '1+)
        (edge-fun #'field-end)
        (eof-fun #'eobp))
    (when (< number 0)
      (setq inc-fun '1-)
      (setq edge-fun #'field-beginning)
      (setq eof-fun #'bobp))
    ;; Real move begin now
    (let ((cur-field (get-text-property (point) 'field))
      (dotimes (_i (abs number))
        (goto-char (funcall inc-fun (funcall edge-fun (point) t)))
        (setq new-field (get-text-property (point) 'field))
        (while (and (not (funcall eof-fun))
                    (or (not new-field)
                        (equal cur-field new-field)))
          (goto-char (funcall inc-fun (point)))
          (setq new-field (get-text-property (point) 'field))))
      ;; Now go back to beginning of cell if necessary (for exemple during
      ;; backward excursion)
      (let ((beg-test (field-beginning (point))))
        (when (and (/= beg-test (point))
                   (equal new-field (get-text-property beg-test 'field)))
          (goto-char beg-test)))))
  ;; If we reach the end of the buffer, stick to the last real cell
  (when (equal
         (apply #'concat
                 (buffer-substring-no-properties (point) (point-max))))
    (goto-char (field-beginning (point)))))

(defun aeronaut-backward-cell (&optional number)
  "Move point backward NUMBER cells.

If NUMBER is omitted or nil, move point backward one cell.
If NUMBER is a negative number, move forward instead.
Return new point value."
  (interactive "p")
  ;; number may be nil
  (setq number (or number -1))
  (aeronaut-forward-cell (- number)))

;;;; Special buffer major mode methods

(defun aeronaut-show-hiden-file ()
  "Toggle visibility of hidden files."
  (setq aeronaut-show-hidden-files (not aeronaut-show-hidden-files))

(defun aeronaut-mouse-visit-or-browse (event)
  "Visit or browse place focused by EVENT mouse click."
  (interactive "e")
   (aeronaut--get-file-name (posn-point (event-end event)))))

(defun aeronaut-find-file (&optional other-window)
  "Visit or browse file at point, in OTHER-WINDOW if non-nil."
  (interactive "P")
  (aeronaut--visit-or-browse (aeronaut--get-file-name) other-window))

(defun aeronaut-find-file-other-window ()
  "Visit or browse file at point in other window."
  (aeronaut-find-file t))

(defun aeronaut-rename-file ()
  "Rename the file at point or the marked files if any."
  (if aeronaut-marked-files
      (dolist (file aeronaut-marked-files)
        (aeronaut--rename-one-file file))
    (aeronaut--rename-one-file (aeronaut--get-file-name)))

(defun aeronaut-touch-file (&optional new)
  "Touch the file at point or create a NEW one if non-nil."
  (interactive "P")
  (let ((touch-fun
         (lambda (file-name)
           (when file-name ;; may be nil if we abort creation
             (call-process "touch" nil nil nil file-name)))))
    (if aeronaut-marked-files
        ;; If we have marked files, obviously we do not want to create new
        ;; one...
        (dolist (file aeronaut-marked-files)
          (funcall touch-fun file))
      (funcall touch-fun (or (and new (read-string "New name: "))

(defun aeronaut-delete-flagged-files (&optional recursive)
  "Delete the flagged files or directories, if any.

With prefix argument RECURSIVE non-nil, flagged directories will
be removed even if they still contain files."
  (interactive "P")
  (when aeronaut-flagged-files
    (let ((flagged-count (length aeronaut-flagged-files)))
      (if (aeronaut--flag-or-mark-pop-up
           " *Deletions*" aeronaut-flagged-files
           `(,(format "Delete %d %s"
                      (if (< flagged-count 2)
              (dolist (file aeronaut-flagged-files)
                (aeronaut--delete-one-file file recursive))
        (message "(No deletions performed)")))))

(defun aeronaut-delete-file (&optional recursive)
  "Delete the file or directory at point.

With prefix argument RECURSIVE non-nil, the directory under point
will be removed even if they still contain files."
  (interactive "P")
  (let ((file-path (aeronaut--get-file-name)))
    (if (yes-or-no-p (format "Delete %s" file-path))
            (aeronaut--delete-one-file file-path recursive)
      (message "(No deletions performed)"))))

(defun aeronaut-mark ()
  "Mark the file at point for later use."
  (aeronaut--mark-or-flag (point)))

(defun aeronaut-flag-file-deletion ()
  "Mark the file at point for later use."
  (aeronaut--mark-or-flag (point) t))

(defun aeronaut-unmark ()
  "Unmark the file at point if it was already marked for later use."
  (let ((file-name (get-text-property (point) 'field)))
    (when (and file-name (string-match "^goto: \\(.+\\)$" file-name))
      (let ((buffer-read-only nil)
            (file-path (match-string 1 file-name)))
        ;; Remove it from the marked and flagged lists
        (setq aeronaut-flagged-files (delete file-path aeronaut-flagged-files))
        (setq aeronaut-marked-files (delete file-path aeronaut-marked-files))
        ;; Change file face
        (put-text-property (field-beginning (point) t) (field-end (point) t)
                           'face (aeronaut--cell-face
                                  (aeronaut--build-file-info file-path))))

(defvar aeronaut-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "." #'aeronaut-show-hiden-file)
    (define-key map "d" #'aeronaut-flag-file-deletion)
    (define-key map "D" #'aeronaut-delete-file)
    (define-key map "m" #'aeronaut-mark)
    (define-key map "o" #'aeronaut-find-file-other-window)
    (define-key map "R" #'aeronaut-rename-file)
    (define-key map "u" #'aeronaut-unmark)
    (define-key map "T" #'aeronaut-touch-file)
    (define-key map "x" #'aeronaut-delete-flagged-files)
    (define-key map (kbd "<left>") #'aeronaut-backward-cell)
    (define-key map (kbd "<right>") #'aeronaut-forward-cell)
    (define-key map (kbd "<mouse-1>") #'aeronaut-mouse-visit-or-browse)
    (define-key map (kbd "<RET>") #'aeronaut-find-file)
  "Keymap for `aeronaut-mode'.")

(define-derived-mode aeronaut-mode special-mode
  "Aeronaut mode"
  "Mode used to display directory listings like the pine/pico embed file browser.
You can move using the usual cursor motion commands.
The buffer is read-only.
Type \\[aeronaut-flag-file-deletion] to flag a file for deletion.
Type \\[aeronaut-mark] to Mark a file or subdirectory for later commands.
Type \\[aeronaut-unmark] to Unmark a file or all files of an inserted subdirectory.
Type \\[aeronaut-delete-flagged-files] to delete (eXpunge) the flagged files flagged.
Type \\[aeronaut-find-file] to Find the current line's file or browse it in another buffer, if it
  is a directory.
Type \\[aeronaut-find-file-other-window] to find file or browse directory in Other window.
Type \\[aeronaut-rename-file] to Rename a file or move the marked files to another directory.
Type \\[revert-buffer] to render aGain the current directory listing.
  This retains all marks and flags.  It can be usefull if you change the Aeronaut
  window geometry or split its window, which will break its current display."
  (setq show-trailing-whitespace nil)
  (when (bound-and-true-p global-linum-mode)
    (linum-mode -1))
  (when (and (fboundp 'nlinum-mode)
             (bound-and-true-p global-nlinum-mode))
    (nlinum-mode -1))
  (when (and (fboundp 'display-line-numbers-mode)
             (bound-and-true-p global-display-line-numbers-mode))
    (display-line-numbers-mode -1)))

;;;; Definition public methods:

(defun aeronaut (directory &optional other-window)
  "Browse files of DIRECTORY.

With prefix argument OTHER-WINDOW non-nil, this function will display the
resulting buffer in window other than the selected one.  In that case, it may
use another existing window or split the current window."
  (interactive "DAeronaut (directory): \nP")
  (let* ((exp-path (expand-file-name directory))
         (clean-path (if (file-directory-p exp-path)
                         (file-name-as-directory exp-path)
         (buffer-name (format "*Aeronaut %s*" clean-path))
         (buffer (get-buffer-create buffer-name)))
    (if other-window
        (pop-to-buffer buffer)
      (switch-to-buffer buffer))
    (setq-local default-directory clean-path
                revert-buffer-function #'aeronaut--revert-buffer
                 (format "Aeronaut %s:" (abbreviate-file-name clean-path))
                 'face 'dired-header))
    (setq-local window-size-change-functions '(aeronaut--resize-window))))

(defun aeronaut-dired (directory &optional _switches)
  "Browse files of DIRECTORY.

This function has been created as a wrapper for `aeronaut', but with the same
signature as `dired', to let you define it as a dired alias if you wish.

    (advice-add 'dired :override #'aeronaut-dired)

Warning: overriding dired may have several side effects and is only proposed
as some kind of temporary experience."
  (interactive "DAeronaut (directory): ")
  (aeronaut directory))

(provide 'aeronaut)
;;; aeronaut.el ends here