Mercurial > emacs
annotate lisp/ls-lisp.el @ 184:c3060611e9af
Added copyleft and warnings.
author | Sebastian Kremer <sk@thp.uni-koeln.de> |
---|---|
date | Sat, 02 Feb 1991 13:30:43 +0000 |
parents | 121e45aa6ad0 |
children | 7811acc9c926 |
rev | line source |
---|---|
184
c3060611e9af
Added copyleft and warnings.
Sebastian Kremer <sk@thp.uni-koeln.de>
parents:
183
diff
changeset
|
1 ;;;; dired-lisp.el - emulate ls completely in Emacs Lisp. $Revision$ |
c3060611e9af
Added copyleft and warnings.
Sebastian Kremer <sk@thp.uni-koeln.de>
parents:
183
diff
changeset
|
2 ;;;; Copyright (C) 1991 Sebastian Kremer <sk@thp.uni-koeln.de> |
c3060611e9af
Added copyleft and warnings.
Sebastian Kremer <sk@thp.uni-koeln.de>
parents:
183
diff
changeset
|
3 |
c3060611e9af
Added copyleft and warnings.
Sebastian Kremer <sk@thp.uni-koeln.de>
parents:
183
diff
changeset
|
4 ;;;; READ THE WARNING BELOW BEFORE USING THIS PROGRAM! |
183 | 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 | |
27 ;;;; I initially used file-name-all-completions instead of | |
28 ;;;; directory-files and got an internal Emacs error: | |
29 | |
30 ;;;; Signalling: (wrong-type-argument natnump #<EMACS BUG: ILLEGAL | |
31 ;;;; DATATYPE (#o37777777727) Save your buffers immediately and please | |
32 ;;;; report this bug>) | |
33 | |
34 ;;;; It has never happened again and had no bad aftereffects, but do be | |
35 ;;;; careful! | |
36 | |
37 ;;; RESTRICTIONS: | |
38 ;;;; Always sorts by name (ls switches are completely ignored for now) | |
39 ;;;; Cannot display date of file, displays a fake date "Jan 00 00:00" instead | |
40 ;;;; Only numeric uid/gid | |
41 | |
42 ;;;; It is surprisingly fast, though! | |
43 | |
44 ;;;; TODO: | |
45 ;;;; Recognize at least some ls switches: l R g F i | |
46 | |
47 (require 'dired) | |
48 | |
49 (or (fboundp 'tree-dired-ls) ; save original function definition | |
50 (fset 'tree-dired-ls (symbol-function 'dired-ls))) | |
51 | |
52 ;; perhaps buffer-local (he he) | |
53 (defvar dired-ls-function 'dired-lisp-ls | |
54 "*Function dired uses to obtain ls output. | |
55 Possible values 'tree-dired-ls and 'dired-lisp-ls. | |
56 Arglist is (FILE &optional SWITCHES WILDCARD FULL-DIRECTORY-P).") | |
57 | |
58 (defun dired-ls (file &optional switches wildcard full-directory-p) | |
59 (funcall dired-ls-function file switches wildcard full-directory-p)) | |
60 | |
61 (defun dired-lisp-ls (file &optional switches wildcard full-directory-p) | |
62 ; "Insert ls output of FILE, optionally formatted with SWITCHES. | |
63 ;Optional third arg WILDCARD means treat FILE as shell wildcard. | |
64 ;Optional fourth arg FULL-DIRECTORY-P means file is a directory and | |
65 ;switches do not contain `d'. | |
66 ; | |
67 ;SWITCHES default to dired-listing-switches." | |
68 (or switches (setq switches dired-listing-switches)) | |
69 (if wildcard | |
70 (error "Cannot handle wildcards in lisp emulation of `ls'.")) | |
71 (if full-directory-p | |
72 (let* ((dir (file-name-as-directory file)) | |
73 (start (length dir)) | |
74 (sum 0)) | |
75 (insert "total \007\n") ; fill in afterwards | |
76 (insert | |
77 (mapconcat | |
78 (function (lambda (short) | |
79 (let* ((fil (concat dir short)) | |
80 (attr (file-attributes fil)) | |
81 (size (nth 7 attr))) | |
82 ;;(debug) | |
83 (setq sum (+ sum size)) | |
84 (dired-lisp-format | |
85 ;;(file-name-nondirectory fil) | |
86 ;;(dired-make-relative fil dir) | |
87 ;;(substring fil start) | |
88 short | |
89 attr | |
90 switches)))) | |
91 (directory-files dir) | |
92 "")) | |
93 (save-excursion | |
94 (search-backward "total \007") | |
95 (goto-char (match-end 0)) | |
96 (delete-char -1) | |
97 (insert (format "%d" sum))) | |
98 ) | |
99 ;; if not full-directory-p, FILE *must not* end in /, as | |
100 ;; file-attributes will not recognize a symlink to a directory | |
101 ;; must make it a relative filename as ls does: | |
102 (setq file (file-name-nondirectory file)) | |
103 (insert (dired-lisp-format file (file-attributes file) switches))) | |
104 ) | |
105 | |
106 (defun dired-lisp-format (file-name file-attr &optional switches) | |
107 (let ((file-type (nth 0 file-attr))) | |
108 (concat (nth 8 file-attr) ; permission bits | |
109 " " | |
110 (dired-lisp-pad (nth 1 file-attr) -3) ; no. of links | |
111 ;; numeric uid/gid are more confusing than helpful | |
112 ;; Emacs should be able to make strings of them | |
113 " " (dired-lisp-pad (nth 2 file-attr) -6) ; uid | |
114 " " (dired-lisp-pad (nth 3 file-attr) -6) ; gid | |
115 " " | |
116 (dired-lisp-pad (nth 7 file-attr) -8) ; size in bytes | |
117 ;; file-attributes's time is in a braindead format | |
118 ;; Emacs should have a ctime function | |
119 " " "Jan 00 00:00 " ; fake time | |
120 file-name | |
121 (if (stringp file-type) ; is a symbolic link | |
122 (concat " -> " file-type) | |
123 "") | |
124 "\n" | |
125 ))) | |
126 | |
127 ;; format should really do anything printf can!! | |
128 (defun dired-lisp-pad (arg width &optional pad-char) | |
129 "Pad ARG to WIDTH, from left if WIDTH < 0. | |
130 Non-nil third arg optional PAD-CHAR defaults to a space." | |
131 (or pad-char (setq pad-char ?\040)) | |
132 (if (integerp arg) | |
133 (setq arg (int-to-string arg))) | |
134 (let (l pad reverse) | |
135 (if (< width 0) | |
136 (setq reverse t | |
137 width (- width))) | |
138 (setq l (length arg) | |
139 pad (- width l)) | |
140 (if (> pad 0) | |
141 (if reverse | |
142 (concat (make-string pad pad-char) arg) | |
143 (concat arg (make-string pad pad-char))) | |
144 arg))) |