ls-lisp.el 8.4 KB
Newer Older
1 2 3 4
;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp

;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Keywords: unix
Sebastian Kremer's avatar
Sebastian Kremer committed
5

6
;; Copyright (C) 1992 by Sebastian Kremer <sk@thp.uni-koeln.de>
Sebastian Kremer's avatar
Sebastian Kremer committed
7

8
;; This program is free software; you can redistribute it and/or modify
Sebastian Kremer's avatar
Sebastian Kremer committed
9 10 11
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.
12 13
;;
;; This program is distributed in the hope that it will be useful,
Sebastian Kremer's avatar
Sebastian Kremer committed
14 15 16
;; 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.
17
;;
Sebastian Kremer's avatar
Sebastian Kremer committed
18
;; You should have received a copy of the GNU General Public License
19 20 21 22 23
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;; INSTALLATION =======================================================
;; 
24
;; Put this file into your load-path.  To use it, load it
25
;; with (load "ls-lisp").
Sebastian Kremer's avatar
Sebastian Kremer committed
26

27 28
;; OVERVIEW ===========================================================

29 30
;; This file overloads the function insert-directory to implement it
;; 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 34 35
;; under VMS, or if you don't have the ls program, or if you want
;; different format from what ls offers.

36 37 38
;; This function uses regexps instead of shell
;; wildcards.  If you enter regexps remember to double each $ sign.
;; For example, to include files *.el, enter `.*\.el$$',
39
;; resulting in the regexp `.*\.el$'.
Sebastian Kremer's avatar
Sebastian Kremer committed
40

41
;;  RESTRICTIONS =====================================================
Sebastian Kremer's avatar
Sebastian Kremer committed
42

43
;; * many ls switches are ignored, see docstring of `insert-directory'.
44 45 46 47 48

;; * Only numeric uid/gid

;; TODO ==============================================================

Sebastian Kremer's avatar
Sebastian Kremer committed
49
;; Recognize some more ls switches: R F
50

51 52
;;; Code:

53 54 55 56
(defun insert-directory (file &optional switches wildcard full-directory-p)
  "Insert directory listing for of FILE, formatted according to SWITCHES.
Leaves point after the inserted text.
Optional third arg WILDCARD means treat FILE as shell wildcard.
57
Optional fourth arg FULL-DIRECTORY-P means file is a directory and
58 59
switches do not contain `d', so that a full listing is expected.

60
This version of the function comes from `ls-lisp.el'.
61 62 63 64
It does not support ordinary shell wildcards; instead, it allows
regular expressions to match file names.

The switches that work are: A a c i r S s t u"
65
  (let ((handler (find-file-name-handler file)))
66 67 68
    (if handler
	(funcall handler 'insert-directory file switches
		 wildcard full-directory-p)
69 70
      ;; Convert SWITCHES to a list of characters.
      (setq switches (append switches nil))
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
      (if wildcard
	  (setq wildcard (file-name-nondirectory file) ; actually emacs regexp
		;; perhaps convert it from shell to emacs syntax?
		file (file-name-directory file)))
      (if (or wildcard
	      full-directory-p)
	  (let* ((dir (file-name-as-directory file))
		 (default-directory dir);; so that file-attributes works
		 (sum 0)
		 elt
		 short
		 (file-list (directory-files dir nil wildcard))
		 file-alist 
		 ;; do all bindings here for speed
		 fil attr)
	    (cond ((memq ?A switches)
		   (setq file-list
			 (ls-lisp-delete-matching "^\\.\\.?$" file-list)))
		  ((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))
	    (insert "total \007\n")	; filled in afterwards
	    (setq file-alist
		  (ls-lisp-handle-switches file-alist switches))
	    (while file-alist
	      (setq elt (car file-alist)
		    short (car elt)
		    attr  (cdr elt)
		    file-alist (cdr file-alist)
		    fil (concat dir short)
		    sum (+ sum (nth 7 attr)))
	      (insert (ls-lisp-format short attr switches)))
	    ;; Fill in total size of all files:
	    (save-excursion
	      (search-backward "total \007")
	      (goto-char (match-end 0))
	      (delete-char -1)
	      (insert (format "%d" (1+ (/ sum 1024))))))
	;; 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))))))

(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 130 131 132 133 134 135
  (let (result)
    (while list
      (or (string-match regexp (car list))
	  (setq result (cons (car list) result)))
      (setq list (cdr list)))
    result))

136
(defun ls-lisp-handle-switches (file-alist switches)
137
  ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES).
138 139
  ;; Return new alist sorted according to SWITCHES which is a list of
  ;; characters.  Default sorting is alphabetically.
140 141 142 143 144 145 146 147 148 149 150
  (let (index)
    (setq file-alist
	  (sort file-alist
		(cond ((memq ?S switches) ; sorted on size
		       (function
			(lambda (x y)
			  ;; 7th file attribute is file size
			  ;; Make largest file come first
			  (< (nth 7 (cdr y))
			     (nth 7 (cdr x))))))
		      ((memq ?t switches) ; sorted on time
151
		       (setq index (ls-lisp-time-index switches))
152 153
		       (function
			(lambda (x y)
154 155
			  (ls-lisp-time-lessp (nth index (cdr y))
					      (nth index (cdr x))))))
156 157 158 159 160
		      (t		; sorted alphabetically
		       (function
			(lambda (x y)
			  (string-lessp (car x)
					(car y)))))))))
161 162 163
  (if (memq ?r switches)		; reverse sort order
      (setq file-alist (nreverse file-alist)))
  file-alist)
Sebastian Kremer's avatar
Sebastian Kremer committed
164

165
;; From Roland McGrath.  Can use this to sort on time.
166
(defun ls-lisp-time-lessp (time0 time1)
167 168 169 170 171 172 173 174 175
  (let ((hi0 (car time0))
	(hi1 (car time1))
	(lo0 (car (cdr time0)))
	(lo1 (car (cdr time1))))
    (or (< hi0 hi1)
	(and (= hi0 hi1)
	     (< lo0 lo1)))))


176
(defun ls-lisp-format (file-name file-attr &optional switches)
Sebastian Kremer's avatar
Sebastian Kremer committed
177
  (let ((file-type (nth 0 file-attr)))
178
    (concat (if (memq ?i switches)	; inode number
179 180
		(format "%6d " (nth 10 file-attr)))
	    ;; 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
Sebastian Kremer's avatar
Sebastian Kremer committed
184
	    ;; numeric uid/gid are more confusing than helpful
185 186 187
	    ;; Emacs should be able to make strings of them.
	    ;; user-login-name and user-full-name could take an
	    ;; optional arg.
188
	    (format " %3d %8s %8s %8d "
189
		    (nth 1 file-attr)	; no. of links
190 191
		    (if (= (user-uid) (nth 2 file-attr))
			(user-login-name)
192
		      (int-to-string (nth 2 file-attr)))	; uid
193 194
		    (if (eq system-type 'ms-dos)
			"root"		; everything is root on MSDOS.
195
		      (int-to-string (nth 3 file-attr)))	; gid
196 197
		    (nth 7 file-attr)	; size in bytes
		    )
198
	    (ls-lisp-format-time file-attr switches)
199
	    " "
Sebastian Kremer's avatar
Sebastian Kremer committed
200 201 202 203 204 205 206
	    file-name
	    (if (stringp file-type)	; is a symbolic link
		(concat " -> " file-type)
	      "")
	    "\n"
	    )))

207
(defun ls-lisp-time-index (switches)
208 209 210 211 212 213 214
  ;; Return index into file-attributes according to ls SWITCHES.
  (cond
   ((memq ?c switches) 6)		; last mode change
   ((memq ?u switches) 4)		; last access
   ;; default is last modtime
   (t 5)))

215
(defun ls-lisp-format-time (file-attr switches)
216 217 218 219 220 221 222 223
  ;; Format time string for file with attributes FILE-ATTR according
  ;; to SWITCHES (a list of ls option letters of which c and u are recognized).
  ;; file-attributes's time is in a braindead format
  ;; Emacs 19 can format it using a new optional argument to
  ;; current-time-string, for Emacs 18 we just return the faked fixed
  ;; date "Jan 00 00:00 ".
  (condition-case error-data
      (let* ((time (current-time-string
224
		    (nth (ls-lisp-time-index switches) file-attr)))
225 226 227 228 229 230 231 232 233 234 235 236 237 238
	     (date (substring time 4 11)) ; "Apr 30 "
	     (clock (substring time 11 16)) ; "11:27"
	     (year (substring time 19 24)) ; " 1992"
	     (same-year (equal year (substring (current-time-string) 19 24))))
	(concat date			; has trailing SPC
		(if same-year
		    ;; this is not exactly the same test used by ls
		    ;; ls tests if the file is older than 6 months
		    ;; but we can't do time differences easily
		    clock
		  year)))
    (error
     "Jan 00 00:00")))

239
(provide 'ls-lisp)
240

241
;;; ls-lisp.el ends here