summaryrefslogtreecommitdiffstats
path: root/aeronaut.el
blob: db74a79c8fe65ae13ab568be8f5cd7ff5f955f77 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
;;; aeronaut.el --- An alternative file browser -*- lexical-binding: t; -*-

;; Copyright (C) 2021 Étienne Deparis

;; Maintener: Étienne Deparis <etienne@depar.is>
;; Author: Étienne Deparis <etienne@depar.is>
;; Created: 1 April 2021
;; Version: 1.0
;; Package-Requires: ((emacs "26.1"))
;; Keywords: files
;; Homepage: https://git.umaneti.net/emacs.d/tree/modes/aeronaut.el

;;; 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; 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"
  :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)
                      (aeronaut--human-file-size
                       (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))
           'dired-flagged)
          ((and aeronaut-marked-files
                (member file-path aeronaut-marked-files))
           'dired-marked)
          ((equal "link" file-type) 'dired-symlink)
          ((equal "dir" file-type) 'dired-directory)
          ((equal "special" file-type) 'dired-special)
          ((string-match-p
            (concat "\\(" (regexp-opt completion-ignored-extensions) "\\)$")
            file-path)
           'dired-ignored))))

(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))
      (aeronaut-forward-cell))))

(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))
         (label
          (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))
         (cell-display-name
          (concat
           (truncate-string-to-width file-name max-cell-width 0 ?\s)
           " "
           label)))
    (concat
     (propertize cell-display-name
                 'field field-name
                 'face cell-face 'mouse-face 'highlight
                 'help-echo (format "mouse-1: 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)
                     strval)))
      (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
         (col-width
          (+ (if (null aeronaut-file-size-unit) 8 12)
             (let ((cell-len 0)
                   (min-cell-size
                           (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)))
    (push
     `(:name ".."
       :path ,(expand-file-name (concat directory ".."))
       :type "dir"
       :label "(parent dir)")
     dir-list)
    (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
`apply'."
  (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
	        (unwind-protect
		        (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
window."
  (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))
    (erase-buffer)
    (aeronaut--insert-directory-files default-directory)
    (delete-trailing-whitespace)))



;;;; 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
excursion.
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))
          new-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
                (split-string
                 (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."
  (interactive)
  (setq aeronaut-show-hidden-files (not aeronaut-show-hidden-files))
  (aeronaut--revert-buffer))

(defun aeronaut-mouse-visit-or-browse (event)
  "Visit or browse place focused by EVENT mouse click."
  (interactive "e")
  (aeronaut--visit-or-browse
   (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."
  (interactive)
  (aeronaut-find-file t))

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

(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: "))
                             (aeronaut--get-file-name)))))
  (aeronaut--revert-buffer))

(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
           'yes-or-no-p
           `(,(format "Delete %d %s"
                      flagged-count
                      (if (< flagged-count 2)
                          "file"
                        "files"))))
          (unwind-protect
              (dolist (file aeronaut-flagged-files)
                (aeronaut--delete-one-file file recursive))
            (aeronaut--revert-buffer))
        (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))
        (unwind-protect
            (aeronaut--delete-one-file file-path recursive)
          (aeronaut--revert-buffer))
      (message "(No deletions performed)"))))

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

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

(defun aeronaut-unmark ()
  "Unmark the file at point if it was already marked for later use."
  (interactive)
  (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))))
      (aeronaut-forward-cell))))

(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)
    map)
  "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."
  (buffer-disable-undo)
  (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:

;;;###autoload
(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)
                       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))
    (aeronaut-mode)
    (setq-local default-directory clean-path)
    (setq-local revert-buffer-function #'aeronaut--revert-buffer)
    (setq-local header-line-format
                (propertize
                 (format "Aeronaut %s:" (abbreviate-file-name clean-path))
                 'face 'dired-header))
    (aeronaut--revert-buffer)
    (goto-char (point-min))))

;;;###autoload
(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