Commit | Line | Data |
---|---|---|
4d3a2554 | 1 | ;;;; dired-lisp.el - emulate ls completely in Emacs Lisp. $Revision: 1.2 $ |
7d4a41dc SK |
2 | ;;;; Copyright (C) 1991 Sebastian Kremer <sk@thp.uni-koeln.de> |
3 | ||
4 | ;;;; READ THE WARNING BELOW BEFORE USING THIS PROGRAM! | |
d88c0e93 SK |
5 | |
6 | ;;;; Useful if you cannot afford to fork Emacs on a real memory UNIX, | |
7 | ;;;; under VMS, or if you don't have the ls program. | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation; either version 1, or (at your option) | |
14 | ;; any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
23 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
24 | ||
25 | ;;;; WARNING: | |
26 | ||
4d3a2554 | 27 | ;;;; Sometimes I get an internal Emacs error: |
d88c0e93 SK |
28 | |
29 | ;;;; Signalling: (wrong-type-argument natnump #<EMACS BUG: ILLEGAL | |
30 | ;;;; DATATYPE (#o37777777727) Save your buffers immediately and please | |
31 | ;;;; report this bug>) | |
32 | ||
4d3a2554 | 33 | ;;;; Sometimes emacs just crashes with a fatal error. |
d88c0e93 SK |
34 | |
35 | ;;; RESTRICTIONS: | |
36 | ;;;; Always sorts by name (ls switches are completely ignored for now) | |
37 | ;;;; Cannot display date of file, displays a fake date "Jan 00 00:00" instead | |
38 | ;;;; Only numeric uid/gid | |
4d3a2554 | 39 | ;;;; Loading ange-ftp breaks it |
d88c0e93 SK |
40 | |
41 | ;;;; It is surprisingly fast, though! | |
42 | ||
43 | ;;;; TODO: | |
44 | ;;;; Recognize at least some ls switches: l R g F i | |
45 | ||
4d3a2554 | 46 | (require 'dired) ; we will redefine this function: |
d88c0e93 SK |
47 | |
48 | (defun dired-ls (file &optional switches wildcard full-directory-p) | |
4d3a2554 | 49 | "dired-lisp.el's version of dired-ls." |
d88c0e93 SK |
50 | ; "Insert ls output of FILE, optionally formatted with SWITCHES. |
51 | ;Optional third arg WILDCARD means treat FILE as shell wildcard. | |
52 | ;Optional fourth arg FULL-DIRECTORY-P means file is a directory and | |
53 | ;switches do not contain `d'. | |
54 | ; | |
55 | ;SWITCHES default to dired-listing-switches." | |
56 | (or switches (setq switches dired-listing-switches)) | |
57 | (if wildcard | |
58 | (error "Cannot handle wildcards in lisp emulation of `ls'.")) | |
59 | (if full-directory-p | |
60 | (let* ((dir (file-name-as-directory file)) | |
61 | (start (length dir)) | |
62 | (sum 0)) | |
63 | (insert "total \007\n") ; fill in afterwards | |
64 | (insert | |
65 | (mapconcat | |
66 | (function (lambda (short) | |
67 | (let* ((fil (concat dir short)) | |
68 | (attr (file-attributes fil)) | |
69 | (size (nth 7 attr))) | |
70 | ;;(debug) | |
71 | (setq sum (+ sum size)) | |
72 | (dired-lisp-format | |
73 | ;;(file-name-nondirectory fil) | |
74 | ;;(dired-make-relative fil dir) | |
75 | ;;(substring fil start) | |
76 | short | |
77 | attr | |
78 | switches)))) | |
79 | (directory-files dir) | |
80 | "")) | |
81 | (save-excursion | |
82 | (search-backward "total \007") | |
83 | (goto-char (match-end 0)) | |
84 | (delete-char -1) | |
85 | (insert (format "%d" sum))) | |
86 | ) | |
87 | ;; if not full-directory-p, FILE *must not* end in /, as | |
88 | ;; file-attributes will not recognize a symlink to a directory | |
89 | ;; must make it a relative filename as ls does: | |
90 | (setq file (file-name-nondirectory file)) | |
91 | (insert (dired-lisp-format file (file-attributes file) switches))) | |
92 | ) | |
93 | ||
94 | (defun dired-lisp-format (file-name file-attr &optional switches) | |
95 | (let ((file-type (nth 0 file-attr))) | |
96 | (concat (nth 8 file-attr) ; permission bits | |
97 | " " | |
98 | (dired-lisp-pad (nth 1 file-attr) -3) ; no. of links | |
99 | ;; numeric uid/gid are more confusing than helpful | |
100 | ;; Emacs should be able to make strings of them | |
101 | " " (dired-lisp-pad (nth 2 file-attr) -6) ; uid | |
102 | " " (dired-lisp-pad (nth 3 file-attr) -6) ; gid | |
103 | " " | |
104 | (dired-lisp-pad (nth 7 file-attr) -8) ; size in bytes | |
105 | ;; file-attributes's time is in a braindead format | |
106 | ;; Emacs should have a ctime function | |
107 | " " "Jan 00 00:00 " ; fake time | |
108 | file-name | |
109 | (if (stringp file-type) ; is a symbolic link | |
110 | (concat " -> " file-type) | |
111 | "") | |
112 | "\n" | |
113 | ))) | |
114 | ||
115 | ;; format should really do anything printf can!! | |
116 | (defun dired-lisp-pad (arg width &optional pad-char) | |
117 | "Pad ARG to WIDTH, from left if WIDTH < 0. | |
118 | Non-nil third arg optional PAD-CHAR defaults to a space." | |
119 | (or pad-char (setq pad-char ?\040)) | |
120 | (if (integerp arg) | |
121 | (setq arg (int-to-string arg))) | |
122 | (let (l pad reverse) | |
123 | (if (< width 0) | |
124 | (setq reverse t | |
125 | width (- width))) | |
126 | (setq l (length arg) | |
127 | pad (- width l)) | |
128 | (if (> pad 0) | |
129 | (if reverse | |
130 | (concat (make-string pad pad-char) arg) | |
131 | (concat arg (make-string pad pad-char))) | |
132 | arg))) |