*** empty log message ***
[bpt/emacs.git] / lisp / ls-lisp.el
index 5a3c1b5..fa7b462 100644 (file)
@@ -106,7 +106,8 @@ file names.
 
 Not all `ls' switches are supported.  The switches that work
 are: A a c i r S s t u"
-  (let ((handler (find-file-name-handler file 'insert-directory)))
+  (let ((handler (find-file-name-handler file 'insert-directory))
+       fattr)
     (if handler
        (funcall handler 'insert-directory file switches
                 wildcard full-directory-p)
@@ -134,28 +135,18 @@ are: A a c i r S s t u"
                 (sum 0)
                 elt
                 short
-                (file-list (directory-files dir nil wildcard))
-                file-alist 
+                (file-alist (directory-files-and-attributes dir nil wildcard))
                 (now (current-time))
                 ;; do all bindings here for speed
+                file-size
                 fil attr)
            (cond ((memq ?A switches)
-                  (setq file-list
-                        (ls-lisp-delete-matching "^\\.\\.?$" file-list)))
+                  (setq file-alist
+                        (ls-lisp-delete-matching "^\\.\\.?$" file-alist)))
                  ((not (memq ?a switches))
                   ;; if neither -A  nor -a, flush . files
-                  (setq file-list
-                        (ls-lisp-delete-matching "^\\." file-list))))
-           (setq file-alist
-                 (mapcar
-                  (function
-                   (lambda (x)
-                     ;; file-attributes("~bogus") bombs
-                     (cons x (file-attributes (expand-file-name x)))))
-                  ;; inserting the call to directory-files right here
-                  ;; seems to stimulate an Emacs bug
-                  ;; ILLEGAL DATATYPE (#o37777777727) or #o67
-                  file-list))
+                  (setq file-alist
+                        (ls-lisp-delete-matching "^\\." file-alist))))
            ;; ``Total'' line (filled in afterwards).
            (insert (if (car-safe file-alist)
                        "total \007\n"
@@ -168,29 +159,44 @@ are: A a c i r S s t u"
              (setq elt (car file-alist)
                    file-alist (cdr file-alist)
                    short (car elt)
-                   attr (cdr elt))
+                   attr (cdr elt)
+                   file-size (nth 7 attr))
              (and attr
-                  (setq sum (+ sum (nth 7 attr)))
-                  (insert (ls-lisp-format short attr switches now))))
+                  (setq sum
+                        ;; Even if neither SUM nor file's size
+                        ;; overflow, their sum could.
+                        (if (or (< sum (- 134217727 file-size))
+                                (floatp sum)
+                                (floatp file-size))
+                            (+ sum file-size)
+                          (+ (float sum) file-size)))
+                  (insert (ls-lisp-format short attr file-size switches now))
+                  ))
            ;; Fill in total size of all files:
            (save-excursion
              (search-backward "total \007")
              (goto-char (match-end 0))
              (delete-char -1)
-             (insert (format "%d" (if (zerop sum) 0 (1+ (/ sum 1024)))))))
+             (insert (format "%.0f" (fceiling (/ sum 1024.0))))))
        ;; if not full-directory-p, FILE *must not* end in /, as
        ;; file-attributes will not recognize a symlink to a directory
        ;; must make it a relative filename as ls does:
-       (setq file (file-name-nondirectory file))
-       (insert (ls-lisp-format file (file-attributes file) switches
-                               (current-time)))))))
+       (if (eq (aref file (1- (length file))) ?/)
+           (setq file (substring file 0 (1- (length file)))))
+       (setq fattr (file-attributes file))
+       (if fattr
+           (insert (ls-lisp-format file fattr (nth 7 fattr)
+                                   switches (current-time)))
+         (message "%s: doesn't exist or is inaccessible" file)
+         (ding)
+         (sit-for 2))))))
 
 (defun ls-lisp-delete-matching (regexp list)
   ;; Delete all elements matching REGEXP from LIST, return new list.
   ;; Should perhaps use setcdr for efficiency.
   (let (result)
     (while list
-      (or (string-match regexp (car list))
+      (or (string-match regexp (car (car list)))
          (setq result (cons (car list) result)))
       (setq list (cdr list)))
     result))
@@ -240,19 +246,21 @@ are: A a c i r S s t u"
             (< lo0 lo1)))))
 
 
-(defun ls-lisp-format (file-name file-attr switches now)
+(defun ls-lisp-format (file-name file-attr file-size switches now)
   (let ((file-type (nth 0 file-attr)))
     (concat (if (memq ?i switches)     ; inode number
                (format "%6d " (nth 10 file-attr)))
            ;; nil is treated like "" in concat
            (if (memq ?s switches)      ; size in K
-               (format "%4d " (1+ (/ (nth 7 file-attr) 1024))))
+               (format "%4.0f " (fceiling (/ file-size 1024.0))))
            (nth 8 file-attr)           ; permission bits
            ;; numeric uid/gid are more confusing than helpful
            ;; Emacs should be able to make strings of them.
            ;; user-login-name and user-full-name could take an
            ;; optional arg.
-           (format " %3d %-8s %-8s %8d "
+           (format (if (floatp file-size)
+                       " %3d %-8s %-8s %8.0f "
+                     " %3d %-8s %-8s %8d ")
                    (nth 1 file-attr)   ; no. of links
                    (if (= (user-uid) (nth 2 file-attr))
                        (user-login-name)
@@ -260,7 +268,7 @@ are: A a c i r S s t u"
                    (if (eq system-type 'ms-dos)
                        "root"          ; everything is root on MSDOS.
                      (int-to-string (nth 3 file-attr)))        ; gid
-                   (nth 7 file-attr)   ; size in bytes
+                   file-size
                    )
            (ls-lisp-format-time file-attr switches now)
            " "
@@ -289,15 +297,17 @@ are: A a c i r S s t u"
         (diff (+ (ash diff16 16) (- (car (cdr time)) (car (cdr now)))))
         (past-cutoff (- (* 6 30 24 60 60)))    ; 6 30-day months
         (future-cutoff (* 60 60)))             ; 1 hour
-    (format-time-string
-     (if (and
-         (<= past-cutoff diff) (<= diff future-cutoff)
-         ;; Sanity check in case `diff' computation overflowed.
-         (<= (1- (ash past-cutoff -16)) diff16)
-         (<= diff16 (1+ (ash future-cutoff -16))))
-        "%b %e %H:%M"
-       "%b %e  %Y")
-     time)))
+    (condition-case nil
+       (format-time-string
+        (if (and
+             (<= past-cutoff diff) (<= diff future-cutoff)
+             ;; Sanity check in case `diff' computation overflowed.
+             (<= (1- (ash past-cutoff -16)) diff16)
+             (<= diff16 (1+ (ash future-cutoff -16))))
+            "%b %e %H:%M"
+          "%b %e  %Y")
+        time)
+      (error "Unk  0  0000"))))
 
 (provide 'ls-lisp)