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