code.delx.au - gnu-emacs/blob - lisp/ls-lisp.el

   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 (defvar ls-lisp-support-shell-wildcards t
  54   "*Non-nil means file patterns are treated as shell wildcards.
  55 nil means they are treated as Emacs regexps (for backward compatibility).
  56 This variable is checked by \\[insert-directory] only when `ls-lisp.el'
  57 package is used.")
  58
  59 (defun insert-directory (file &optional switches wildcard full-directory-p)
  60   "Insert directory listing for FILE, formatted according to SWITCHES.
  61 Leaves point after the inserted text.
  62 Optional third arg WILDCARD means treat FILE as shell wildcard.
  63 Optional fourth arg FULL-DIRECTORY-P means file is a directory and
  64 switches do not contain `d', so that a full listing is expected.
  65
  66 This version of the function comes from `ls-lisp.el'.  It doesn not
  67 run any external programs or shells.  It supports ordinary shell
  68 wildcards if `ls-lisp-support-shell-wildcards' variable is non-nil;
  69 otherwise, it interprets wildcards as regular expressions to match
  70 file names.
  71
  72 Not all `ls' switches are supported.  The switches that work
  73 are: A a c i r S s t u"
  74   (let ((handler (find-file-name-handler file 'insert-directory)))
  75     (if handler
  76         (funcall handler 'insert-directory file switches
  77                  wildcard full-directory-p)
  78       ;; Sometimes we get ".../foo*/" as FILE.  While the shell and
  79       ;; `ls' don't mind, we certainly do, because it makes us think
  80       ;; there is no wildcard, only a directory name.
  81       (if (and ls-lisp-support-shell-wildcards
  82                (string-match "[[?*]" file))
  83           (progn
  84             (or (not (eq (aref file (1- (length file))) ?/))
  85                 (setq file (substring file 0 (1- (length file)))))
  86             (setq wildcard t)))
  87       ;; Convert SWITCHES to a list of characters.
  88       (setq switches (append switches nil))
  89       (if wildcard
  90           (setq wildcard
  91                 (if ls-lisp-support-shell-wildcards
  92                     (wildcard-to-regexp (file-name-nondirectory file))
  93                   (file-name-nondirectory file))
  94                 file (file-name-directory file)))
  95       (if (or wildcard
  96               full-directory-p)
  97           (let* ((dir (file-name-as-directory file))
  98                  (default-directory dir);; so that file-attributes works
  99                  (sum 0)
 100                  elt
 101                  short
 102                  (file-list (directory-files dir nil wildcard))
 103                  file-alist
 104                  ;; do all bindings here for speed
 105                  fil attr)
 106             (cond ((memq ?A switches)
 107                    (setq file-list
 108                          (ls-lisp-delete-matching "^\\.\\.?$" file-list)))
 109                   ((not (memq ?a switches))
 110                    ;; if neither -A  nor -a, flush . files
 111                    (setq file-list
 112                          (ls-lisp-delete-matching "^\\." file-list))))
 113             (setq file-alist
 114                   (mapcar
 115                    (function
 116                     (lambda (x)
 117                       ;; file-attributes("~bogus") bombs
 118                       (cons x (file-attributes (expand-file-name x)))))
 119                    ;; inserting the call to directory-files right here
 120                    ;; seems to stimulate an Emacs bug
 121                    ;; ILLEGAL DATATYPE (#o37777777727) or #o67
 122                    file-list))
 123             ;; ``Total'' line (filled in afterwards).
 124             (insert (if (car-safe file-alist)
 125                         "total \007\n"
 126                       ;; Shell says ``No match'' if no files match
 127                       ;; the wildcard; let's say something similar.
 128                       "(No match)\ntotal \007\n"))
 129             (setq file-alist
 130                   (ls-lisp-handle-switches file-alist switches))
 131             (while file-alist
 132               (setq elt (car file-alist)
 133                     file-alist (cdr file-alist)
 134                     short (car elt)
 135                     attr (cdr elt))
 136               (and attr
 137                    (setq sum (+ sum (nth 7 attr)))
 138                    (insert (ls-lisp-format short attr switches))))
 139             ;; Fill in total size of all files:
 140             (save-excursion
 141               (search-backward "total \007")
 142               (goto-char (match-end 0))
 143               (delete-char -1)
 144               (insert (format "%d" (if (zerop sum) 0 (1+ (/ sum 1024)))))))
 145         ;; if not full-directory-p, FILE *must not* end in /, as
 146         ;; file-attributes will not recognize a symlink to a directory
 147         ;; must make it a relative filename as ls does:
 148         (setq file (file-name-nondirectory file))
 149         (insert (ls-lisp-format file (file-attributes file) switches))))))
 150
 151 (defun ls-lisp-delete-matching (regexp list)
 152   ;; Delete all elements matching REGEXP from LIST, return new list.
 153   ;; Should perhaps use setcdr for efficiency.
 154   (let (result)
 155     (while list
 156       (or (string-match regexp (car list))
 157           (setq result (cons (car list) result)))
 158       (setq list (cdr list)))
 159     result))
 160
 161 (defun ls-lisp-handle-switches (file-alist switches)
 162   ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES).
 163   ;; Return new alist sorted according to SWITCHES which is a list of
 164   ;; characters.  Default sorting is alphabetically.
 165   (let (index)
 166     (setq file-alist
 167           (sort file-alist
 168                 (cond ((memq ?S switches) ; sorted on size
 169                        (function
 170                         (lambda (x y)
 171                           ;; 7th file attribute is file size
 172                           ;; Make largest file come first
 173                           (< (nth 7 (cdr y))
 174                              (nth 7 (cdr x))))))
 175                       ((memq ?t switches) ; sorted on time
 176                        (setq index (ls-lisp-time-index switches))
 177                        (function
 178                         (lambda (x y)
 179                           (ls-lisp-time-lessp (nth index (cdr y))
 180                                               (nth index (cdr x))))))
 181                       (t                ; sorted alphabetically
 182                        (function
 183                         (lambda (x y)
 184                           (string-lessp (car x)
 185                                         (car y)))))))))
 186   (if (memq ?r switches)                ; reverse sort order
 187       (setq file-alist (nreverse file-alist)))
 188   file-alist)
 189
 190 ;; From Roland McGrath.  Can use this to sort on time.
 191 (defun ls-lisp-time-lessp (time0 time1)
 192   (let ((hi0 (car time0))
 193         (hi1 (car time1))
 194         (lo0 (car (cdr time0)))
 195         (lo1 (car (cdr time1))))
 196     (or (< hi0 hi1)
 197         (and (= hi0 hi1)
 198              (< lo0 lo1)))))
 199
 200
 201 (defun ls-lisp-format (file-name file-attr &optional switches)
 202   (let ((file-type (nth 0 file-attr)))
 203     (concat (if (memq ?i switches)      ; inode number
 204                 (format "%6d " (nth 10 file-attr)))
 205             ;; nil is treated like "" in concat
 206             (if (memq ?s switches)      ; size in K
 207                 (format "%4d " (1+ (/ (nth 7 file-attr) 1024))))
 208             (nth 8 file-attr)           ; permission bits
 209             ;; numeric uid/gid are more confusing than helpful
 210             ;; Emacs should be able to make strings of them.
 211             ;; user-login-name and user-full-name could take an
 212             ;; optional arg.
 213             (format " %3d %-8s %-8s %8d "
 214                     (nth 1 file-attr)   ; no. of links
 215                     (if (= (user-uid) (nth 2 file-attr))
 216                         (user-login-name)
 217                       (int-to-string (nth 2 file-attr)))        ; uid
 218                     (if (eq system-type 'ms-dos)
 219                         "root"          ; everything is root on MSDOS.
 220                       (int-to-string (nth 3 file-attr)))        ; gid
 221                     (nth 7 file-attr)   ; size in bytes
 222                     )
 223             (ls-lisp-format-time file-attr switches)
 224             " "
 225             file-name
 226             (if (stringp file-type)     ; is a symbolic link
 227                 (concat " -> " file-type)
 228               "")
 229             "\n"
 230             )))
 231
 232 (defun ls-lisp-time-index (switches)
 233   ;; Return index into file-attributes according to ls SWITCHES.
 234   (cond
 235    ((memq ?c switches) 6)               ; last mode change
 236    ((memq ?u switches) 4)               ; last access
 237    ;; default is last modtime
 238    (t 5)))
 239
 240 (defun ls-lisp-format-time (file-attr switches)
 241   ;; Format time string for file with attributes FILE-ATTR according
 242   ;; to SWITCHES (a list of ls option letters of which c and u are recognized).
 243   ;; file-attributes's time is in a braindead format
 244   ;; Emacs 19 can format it using a new optional argument to
 245   ;; current-time-string, for Emacs 18 we just return the faked fixed
 246   ;; date "Jan 00 00:00 ".
 247   (condition-case error-data
 248       (let* ((time (current-time-string
 249                     (nth (ls-lisp-time-index switches) file-attr)))
 250              (date (substring time 4 11)) ; "Apr 30 "
 251              (clock (substring time 11 16)) ; "11:27"
 252              (year (substring time 19 24)) ; " 1992"
 253              (same-year (equal year (substring (current-time-string) 19 24))))
 254         (concat date                    ; has trailing SPC
 255                 (if same-year
 256                     ;; this is not exactly the same test used by ls
 257                     ;; ls tests if the file is older than 6 months
 258                     ;; but we can't do time differences easily
 259                     clock
 260                   year)))
 261     (error
 262      "Jan 00 00:00")))
 263
 264 (provide 'ls-lisp)
 265
 266 ;;; ls-lisp.el ends here