| 1 | ;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp |
| 2 | |
| 3 | ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de> |
| 4 | ;; Keywords: unix |
| 5 | |
| 6 | ;; Copyright (C) 1992, 1994 by Sebastian Kremer <sk@thp.uni-koeln.de> |
| 7 | |
| 8 | ;; This program is free software; you can redistribute it and/or modify |
| 9 | ;; it under the terms of the GNU General Public License as published by |
| 10 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 11 | ;; any later version. |
| 12 | ;; |
| 13 | ;; This program is distributed in the hope that it will be useful, |
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 16 | ;; GNU General Public License for more details. |
| 17 | ;; |
| 18 | ;; You should have received a copy of the GNU General Public License |
| 19 | ;; along with this program; if not, write to the Free Software |
| 20 | ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
| 21 | |
| 22 | ;; INSTALLATION ======================================================= |
| 23 | ;; |
| 24 | ;; Put this file into your load-path. To use it, load it |
| 25 | ;; with (load "ls-lisp"). |
| 26 | |
| 27 | ;; OVERVIEW =========================================================== |
| 28 | |
| 29 | ;; This file overloads the function insert-directory to implement it |
| 30 | ;; directly from Emacs lisp, without running `ls' in a subprocess. |
| 31 | |
| 32 | ;; It is useful if you cannot afford to fork Emacs on a real memory UNIX, |
| 33 | ;; under VMS, or if you don't have the ls program, or if you want |
| 34 | ;; different format from what ls offers. |
| 35 | |
| 36 | ;; This function uses regexps instead of shell |
| 37 | ;; wildcards. If you enter regexps remember to double each $ sign. |
| 38 | ;; For example, to include files *.el, enter `.*\.el$$', |
| 39 | ;; resulting in the regexp `.*\.el$'. |
| 40 | |
| 41 | ;; RESTRICTIONS ===================================================== |
| 42 | |
| 43 | ;; * many ls switches are ignored, see docstring of `insert-directory'. |
| 44 | |
| 45 | ;; * Only numeric uid/gid |
| 46 | |
| 47 | ;; TODO ============================================================== |
| 48 | |
| 49 | ;; Recognize some more ls switches: R F |
| 50 | \f |
| 51 | ;;; Code: |
| 52 | |
| 53 | (defun insert-directory (file &optional switches wildcard full-directory-p) |
| 54 | "Insert directory listing for of FILE, formatted according to SWITCHES. |
| 55 | Leaves point after the inserted text. |
| 56 | Optional third arg WILDCARD means treat FILE as shell wildcard. |
| 57 | Optional fourth arg FULL-DIRECTORY-P means file is a directory and |
| 58 | switches do not contain `d', so that a full listing is expected. |
| 59 | |
| 60 | This version of the function comes from `ls-lisp.el'. |
| 61 | It does not support ordinary shell wildcards; instead, it allows |
| 62 | regular expressions to match file names. |
| 63 | |
| 64 | The switches that work are: A a c i r S s t u" |
| 65 | (let ((handler (find-file-name-handler file 'insert-directory))) |
| 66 | (if handler |
| 67 | (funcall handler 'insert-directory file switches |
| 68 | wildcard full-directory-p) |
| 69 | ;; Convert SWITCHES to a list of characters. |
| 70 | (setq switches (append switches nil)) |
| 71 | (if wildcard |
| 72 | (setq wildcard (file-name-nondirectory file) ; actually emacs regexp |
| 73 | ;; perhaps convert it from shell to emacs syntax? |
| 74 | file (file-name-directory file))) |
| 75 | (if (or wildcard |
| 76 | full-directory-p) |
| 77 | (let* ((dir (file-name-as-directory file)) |
| 78 | (default-directory dir);; so that file-attributes works |
| 79 | (sum 0) |
| 80 | elt |
| 81 | short |
| 82 | (file-list (directory-files dir nil wildcard)) |
| 83 | file-alist |
| 84 | ;; do all bindings here for speed |
| 85 | fil attr) |
| 86 | (cond ((memq ?A switches) |
| 87 | (setq file-list |
| 88 | (ls-lisp-delete-matching "^\\.\\.?$" file-list))) |
| 89 | ((not (memq ?a switches)) |
| 90 | ;; if neither -A nor -a, flush . files |
| 91 | (setq file-list |
| 92 | (ls-lisp-delete-matching "^\\." file-list)))) |
| 93 | (setq file-alist |
| 94 | (mapcar |
| 95 | (function |
| 96 | (lambda (x) |
| 97 | ;; file-attributes("~bogus") bombs |
| 98 | (cons x (file-attributes (expand-file-name x))))) |
| 99 | ;; inserting the call to directory-files right here |
| 100 | ;; seems to stimulate an Emacs bug |
| 101 | ;; ILLEGAL DATATYPE (#o37777777727) or #o67 |
| 102 | file-list)) |
| 103 | (insert "total \007\n") ; filled in afterwards |
| 104 | (setq file-alist |
| 105 | (ls-lisp-handle-switches file-alist switches)) |
| 106 | (while file-alist |
| 107 | (setq elt (car file-alist) |
| 108 | file-alist (cdr file-alist) |
| 109 | short (car elt) |
| 110 | attr (cdr elt)) |
| 111 | (and attr |
| 112 | (setq sum (+ sum (nth 7 attr))) |
| 113 | (insert (ls-lisp-format short attr switches)))) |
| 114 | ;; Fill in total size of all files: |
| 115 | (save-excursion |
| 116 | (search-backward "total \007") |
| 117 | (goto-char (match-end 0)) |
| 118 | (delete-char -1) |
| 119 | (insert (format "%d" (1+ (/ sum 1024)))))) |
| 120 | ;; if not full-directory-p, FILE *must not* end in /, as |
| 121 | ;; file-attributes will not recognize a symlink to a directory |
| 122 | ;; must make it a relative filename as ls does: |
| 123 | (setq file (file-name-nondirectory file)) |
| 124 | (insert (ls-lisp-format file (file-attributes file) switches)))))) |
| 125 | |
| 126 | (defun ls-lisp-delete-matching (regexp list) |
| 127 | ;; Delete all elements matching REGEXP from LIST, return new list. |
| 128 | ;; Should perhaps use setcdr for efficiency. |
| 129 | (let (result) |
| 130 | (while list |
| 131 | (or (string-match regexp (car list)) |
| 132 | (setq result (cons (car list) result))) |
| 133 | (setq list (cdr list))) |
| 134 | result)) |
| 135 | |
| 136 | (defun ls-lisp-handle-switches (file-alist switches) |
| 137 | ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES). |
| 138 | ;; Return new alist sorted according to SWITCHES which is a list of |
| 139 | ;; characters. Default sorting is alphabetically. |
| 140 | (let (index) |
| 141 | (setq file-alist |
| 142 | (sort file-alist |
| 143 | (cond ((memq ?S switches) ; sorted on size |
| 144 | (function |
| 145 | (lambda (x y) |
| 146 | ;; 7th file attribute is file size |
| 147 | ;; Make largest file come first |
| 148 | (< (nth 7 (cdr y)) |
| 149 | (nth 7 (cdr x)))))) |
| 150 | ((memq ?t switches) ; sorted on time |
| 151 | (setq index (ls-lisp-time-index switches)) |
| 152 | (function |
| 153 | (lambda (x y) |
| 154 | (ls-lisp-time-lessp (nth index (cdr y)) |
| 155 | (nth index (cdr x)))))) |
| 156 | (t ; sorted alphabetically |
| 157 | (function |
| 158 | (lambda (x y) |
| 159 | (string-lessp (car x) |
| 160 | (car y))))))))) |
| 161 | (if (memq ?r switches) ; reverse sort order |
| 162 | (setq file-alist (nreverse file-alist))) |
| 163 | file-alist) |
| 164 | |
| 165 | ;; From Roland McGrath. Can use this to sort on time. |
| 166 | (defun ls-lisp-time-lessp (time0 time1) |
| 167 | (let ((hi0 (car time0)) |
| 168 | (hi1 (car time1)) |
| 169 | (lo0 (car (cdr time0))) |
| 170 | (lo1 (car (cdr time1)))) |
| 171 | (or (< hi0 hi1) |
| 172 | (and (= hi0 hi1) |
| 173 | (< lo0 lo1))))) |
| 174 | |
| 175 | |
| 176 | (defun ls-lisp-format (file-name file-attr &optional switches) |
| 177 | (let ((file-type (nth 0 file-attr))) |
| 178 | (concat (if (memq ?i switches) ; inode number |
| 179 | (format "%6d " (nth 10 file-attr))) |
| 180 | ;; nil is treated like "" in concat |
| 181 | (if (memq ?s switches) ; size in K |
| 182 | (format "%4d " (1+ (/ (nth 7 file-attr) 1024)))) |
| 183 | (nth 8 file-attr) ; permission bits |
| 184 | ;; numeric uid/gid are more confusing than helpful |
| 185 | ;; Emacs should be able to make strings of them. |
| 186 | ;; user-login-name and user-full-name could take an |
| 187 | ;; optional arg. |
| 188 | (format " %3d %8s %8s %8d " |
| 189 | (nth 1 file-attr) ; no. of links |
| 190 | (if (= (user-uid) (nth 2 file-attr)) |
| 191 | (user-login-name) |
| 192 | (int-to-string (nth 2 file-attr))) ; uid |
| 193 | (if (eq system-type 'ms-dos) |
| 194 | "root" ; everything is root on MSDOS. |
| 195 | (int-to-string (nth 3 file-attr))) ; gid |
| 196 | (nth 7 file-attr) ; size in bytes |
| 197 | ) |
| 198 | (ls-lisp-format-time file-attr switches) |
| 199 | " " |
| 200 | file-name |
| 201 | (if (stringp file-type) ; is a symbolic link |
| 202 | (concat " -> " file-type) |
| 203 | "") |
| 204 | "\n" |
| 205 | ))) |
| 206 | |
| 207 | (defun ls-lisp-time-index (switches) |
| 208 | ;; Return index into file-attributes according to ls SWITCHES. |
| 209 | (cond |
| 210 | ((memq ?c switches) 6) ; last mode change |
| 211 | ((memq ?u switches) 4) ; last access |
| 212 | ;; default is last modtime |
| 213 | (t 5))) |
| 214 | |
| 215 | (defun ls-lisp-format-time (file-attr switches) |
| 216 | ;; Format time string for file with attributes FILE-ATTR according |
| 217 | ;; to SWITCHES (a list of ls option letters of which c and u are recognized). |
| 218 | ;; file-attributes's time is in a braindead format |
| 219 | ;; Emacs 19 can format it using a new optional argument to |
| 220 | ;; current-time-string, for Emacs 18 we just return the faked fixed |
| 221 | ;; date "Jan 00 00:00 ". |
| 222 | (condition-case error-data |
| 223 | (let* ((time (current-time-string |
| 224 | (nth (ls-lisp-time-index switches) file-attr))) |
| 225 | (date (substring time 4 11)) ; "Apr 30 " |
| 226 | (clock (substring time 11 16)) ; "11:27" |
| 227 | (year (substring time 19 24)) ; " 1992" |
| 228 | (same-year (equal year (substring (current-time-string) 19 24)))) |
| 229 | (concat date ; has trailing SPC |
| 230 | (if same-year |
| 231 | ;; this is not exactly the same test used by ls |
| 232 | ;; ls tests if the file is older than 6 months |
| 233 | ;; but we can't do time differences easily |
| 234 | clock |
| 235 | year))) |
| 236 | (error |
| 237 | "Jan 00 00:00"))) |
| 238 | |
| 239 | (provide 'ls-lisp) |
| 240 | |
| 241 | ;;; ls-lisp.el ends here |