lisp/ls-lisp.el

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