diff options
| author | Richard M. Stallman | 1992-10-05 04:54:07 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1992-10-05 04:54:07 +0000 |
| commit | 9dce08b6085492d9622daa7f08d6b5725f021cea (patch) | |
| tree | 6e505cadfa5e00480c4b20a99f9ed6938f9b00b7 | |
| parent | a1e2f9109ad756ea645d40a4060993c72cb0ab87 (diff) | |
| download | emacs-9dce08b6085492d9622daa7f08d6b5725f021cea.tar.gz emacs-9dce08b6085492d9622daa7f08d6b5725f021cea.zip | |
Most functions renamed to start with ls-lisp.
(insert-directory): Renamed from dired-ls.
| -rw-r--r-- | lisp/ls-lisp.el | 249 |
1 files changed, 99 insertions, 150 deletions
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 506b706bf39..54be933b2e3 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el | |||
| @@ -1,9 +1,4 @@ | |||
| 1 | ;;;; dired-lisp.el - emulate Tree Dired's ls completely in Emacs Lisp | 1 | ;;;; directory.el - emulate insert-directory completely in Emacs Lisp |
| 2 | |||
| 3 | ;;;; READ THE WARNING BELOW BEFORE USING THIS PROGRAM! | ||
| 4 | |||
| 5 | (defconst dired-lisp-version (substring "$Revision: 1.8 $" 11 -2) | ||
| 6 | "$Id: dired-lisp.el,v 1.8 1992/05/01 17:50:56 sk Exp sk $") | ||
| 7 | 2 | ||
| 8 | ;; Copyright (C) 1992 by Sebastian Kremer <sk@thp.uni-koeln.de> | 3 | ;; Copyright (C) 1992 by Sebastian Kremer <sk@thp.uni-koeln.de> |
| 9 | 4 | ||
| @@ -21,160 +16,114 @@ | |||
| 21 | ;; along with this program; if not, write to the Free Software | 16 | ;; along with this program; if not, write to the Free Software |
| 22 | ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. | 17 | ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
| 23 | 18 | ||
| 24 | ;; LISPDIR ENTRY for the Elisp Archive =============================== | ||
| 25 | ;; LCD Archive Entry: | ||
| 26 | ;; dired-lisp|Sebastian Kremer|sk@thp.uni-koeln.de | ||
| 27 | ;; |emulate Tree Dired's ls completely in Emacs Lisp | ||
| 28 | ;; |$Date: 1992/05/01 17:50:56 $|$Revision: 1.8 $| | ||
| 29 | |||
| 30 | ;; INSTALLATION ======================================================= | 19 | ;; INSTALLATION ======================================================= |
| 31 | ;; | 20 | ;; |
| 32 | ;; Put this file into your load-path. Loading it will result in | 21 | ;; Put this file into your load-path. To use it, load it |
| 33 | ;; redefining function dired-ls to not call ls. | 22 | ;; with (load "directory"). |
| 34 | |||
| 35 | ;; You need tree dired from ftp.cs.buffalo.edu:pub/Emacs/diredall.tar.Z, | ||
| 36 | ;; classic (e.g. 18.57) dired.el will not work. | ||
| 37 | 23 | ||
| 38 | ;; OVERVIEW =========================================================== | 24 | ;; OVERVIEW =========================================================== |
| 39 | 25 | ||
| 40 | ;; This file overloads tree dired so that all fileinfo is retrieved | 26 | ;; This file overloads the function insert-directory to implement it |
| 41 | ;; directly from Emacs lisp, without using an ls subprocess. | 27 | ;; directly from Emacs lisp, without running `ls' in a subprocess. |
| 42 | 28 | ||
| 43 | ;; Useful if you cannot afford to fork Emacs on a real memory UNIX, | 29 | ;; It is useful if you cannot afford to fork Emacs on a real memory UNIX, |
| 44 | ;; under VMS, or if you don't have the ls program, or if you want | 30 | ;; under VMS, or if you don't have the ls program, or if you want |
| 45 | ;; different format from what ls offers. | 31 | ;; different format from what ls offers. |
| 46 | 32 | ||
| 47 | ;; Beware that if you change the output format of dired-ls, you'll | 33 | ;; This function uses regexps instead of shell |
| 48 | ;; have to change dired-move-to-filename and | 34 | ;; wildcards. If you enter regexps remember to double each $ sign. |
| 49 | ;; dired-move-to-end-of-filename as well. | 35 | ;; For example, to include files *.el, enter `.*\.el$$', |
| 50 | |||
| 51 | ;; With this package is loaded, dired uses regexps instead of shell | ||
| 52 | ;; wildcards. If you enter regexps remember to double each $ sign. | ||
| 53 | ;; For example, to dired all elisp (*.el) files, enter `.*\.el$$', | ||
| 54 | ;; resulting in the regexp `.*\.el$'. | 36 | ;; resulting in the regexp `.*\.el$'. |
| 55 | 37 | ||
| 56 | ;; WARNING =========================================================== | ||
| 57 | |||
| 58 | ;; With earlier version of this program I sometimes got an internal | ||
| 59 | ;; Emacs error: | ||
| 60 | |||
| 61 | ;; Signalling: (wrong-type-argument natnump #<EMACS BUG: ILLEGAL | ||
| 62 | ;; DATATYPE (#o37777777727) Save your buffers immediately and please | ||
| 63 | ;; report this bug>) | ||
| 64 | |||
| 65 | ;; The datatype differs (I also got #o67 once). | ||
| 66 | |||
| 67 | ;; Sometimes emacs just crashed with a fatal error. | ||
| 68 | |||
| 69 | ;; After I've avoided using directory-files and file-attributes | ||
| 70 | ;; together inside a mapcar, the bug didn't surface any longer. | ||
| 71 | |||
| 72 | ;; RESTRICTIONS ===================================================== | 38 | ;; RESTRICTIONS ===================================================== |
| 73 | 39 | ||
| 74 | ;; * many ls switches are ignored, see docstring of `dired-ls'. | 40 | ;; * many ls switches are ignored, see docstring of `insert-directory'. |
| 75 | |||
| 76 | ;; * In Emacs 18: cannot display date of file, displays a fake date | ||
| 77 | ;; "Jan 00 00:00" instead (dates do work in Emacs 19) | ||
| 78 | 41 | ||
| 79 | ;; * Only numeric uid/gid | 42 | ;; * Only numeric uid/gid |
| 80 | 43 | ||
| 81 | ;; * if you load dired-lisp after ange-ftp, remote listings look | ||
| 82 | ;; really strange: | ||
| 83 | ;; | ||
| 84 | ;; total 1 | ||
| 85 | ;; d????????? -1 -1 -1 -1 Jan 1 1970 . | ||
| 86 | ;; d????????? -1 -1 -1 -1 Jan 1 1970 .. | ||
| 87 | ;; | ||
| 88 | ;; This is because ange-ftp's file-attributes does not return much | ||
| 89 | ;; useful information. | ||
| 90 | ;; | ||
| 91 | ;; If you load dired-lisp first, there seem to be no problems. | ||
| 92 | |||
| 93 | ;; TODO ============================================================== | 44 | ;; TODO ============================================================== |
| 94 | 45 | ||
| 95 | ;; Recognize some more ls switches: R F | 46 | ;; Recognize some more ls switches: R F |
| 96 | 47 | ||
| 97 | 48 | (defun insert-directory (file &optional switches wildcard full-directory-p) | |
| 98 | (require 'dired) ; we will redefine dired-ls: | 49 | "Insert directory listing for of FILE, formatted according to SWITCHES. |
| 99 | (or (fboundp 'dired-lisp-unix-ls) | 50 | Leaves point after the inserted text. |
| 100 | (fset 'dired-lisp-unix-ls (symbol-function 'dired-ls))) | 51 | Optional third arg WILDCARD means treat FILE as shell wildcard. |
| 101 | |||
| 102 | (fset 'dired-ls 'dired-lisp-ls) | ||
| 103 | |||
| 104 | (defun dired-lisp-ls (file &optional switches wildcard full-directory-p) | ||
| 105 | "dired-lisp.el's version of dired-ls. | ||
| 106 | Known switches: A a S r i s t | ||
| 107 | In Emacs 19, additional known switches are: c u | ||
| 108 | Others are ignored. | ||
| 109 | |||
| 110 | Insert ls output of FILE, optionally formatted with SWITCHES. | ||
| 111 | Optional third arg WILDCARD means treat non-directory part of FILE as | ||
| 112 | emacs regexp (_not_ a shell wildcard). If you enter regexps remember | ||
| 113 | to double each $ sign. | ||
| 114 | |||
| 115 | Optional fourth arg FULL-DIRECTORY-P means file is a directory and | 52 | Optional fourth arg FULL-DIRECTORY-P means file is a directory and |
| 116 | switches do not contain `d'. | 53 | switches do not contain `d', so that a full listing is expected. |
| 117 | 54 | ||
| 118 | SWITCHES default to dired-listing-switches." | 55 | This version of the function comes from `directory.el'. |
| 119 | (or switches (setq switches dired-listing-switches)) | 56 | It does not support ordinary shell wildcards; instead, it allows |
| 120 | (or (consp switches) ; convert to list of chars | 57 | regular expressions to match file names. |
| 121 | (setq switches (mapcar 'identity switches))) | 58 | |
| 122 | (if wildcard | 59 | The switches that work are: A a c i r S s t u" |
| 123 | (setq wildcard (file-name-nondirectory file) ; actually emacs regexp | 60 | (let (handler (handlers file-name-handler-alist)) |
| 124 | ;; perhaps convert it from shell to emacs syntax? | 61 | (save-match-data |
| 125 | file (file-name-directory file))) | 62 | (while (and (consp handlers) (null handler)) |
| 126 | (if (or wildcard | 63 | (if (and (consp (car handlers)) |
| 127 | full-directory-p) | 64 | (stringp (car (car handlers))) |
| 128 | (let* ((dir (file-name-as-directory file)) | 65 | (string-match (car (car handlers)) file)) |
| 129 | (default-directory dir);; so that file-attributes works | 66 | (setq handler (cdr (car handlers)))) |
| 130 | (sum 0) | 67 | (setq handlers (cdr handlers)))) |
| 131 | elt | 68 | (if handler |
| 132 | short | 69 | (funcall handler 'insert-directory file switches |
| 133 | (file-list (directory-files dir nil wildcard)) | 70 | wildcard full-directory-p) |
| 134 | file-alist | 71 | (if wildcard |
| 135 | ;; do all bindings here for speed | 72 | (setq wildcard (file-name-nondirectory file) ; actually emacs regexp |
| 136 | fil attr) | 73 | ;; perhaps convert it from shell to emacs syntax? |
| 137 | (cond ((memq ?A switches) | 74 | file (file-name-directory file))) |
| 138 | (setq file-list | 75 | (if (or wildcard |
| 139 | (dired-lisp-delete-matching "^\\.\\.?$" file-list))) | 76 | full-directory-p) |
| 140 | ((not (memq ?a switches)) | 77 | (let* ((dir (file-name-as-directory file)) |
| 141 | ;; if neither -A nor -a, flush . files | 78 | (default-directory dir);; so that file-attributes works |
| 142 | (setq file-list | 79 | (sum 0) |
| 143 | (dired-lisp-delete-matching "^\\." file-list)))) | 80 | elt |
| 144 | (setq file-alist | 81 | short |
| 145 | (mapcar | 82 | (file-list (directory-files dir nil wildcard)) |
| 146 | (function | 83 | file-alist |
| 147 | (lambda (x) | 84 | ;; do all bindings here for speed |
| 148 | ;; file-attributes("~bogus") bombs | 85 | fil attr) |
| 149 | (cons x (file-attributes (expand-file-name x))))) | 86 | (cond ((memq ?A switches) |
| 150 | ;; inserting the call to directory-files right here | 87 | (setq file-list |
| 151 | ;; seems to stimulate an Emacs bug | 88 | (ls-lisp-delete-matching "^\\.\\.?$" file-list))) |
| 152 | ;; ILLEGAL DATATYPE (#o37777777727) or #o67 | 89 | ((not (memq ?a switches)) |
| 153 | file-list)) | 90 | ;; if neither -A nor -a, flush . files |
| 154 | (insert "total \007\n") ; filled in afterwards | 91 | (setq file-list |
| 155 | (setq file-alist | 92 | (ls-lisp-delete-matching "^\\." file-list)))) |
| 156 | (dired-lisp-handle-switches file-alist switches)) | 93 | (setq file-alist |
| 157 | (while file-alist | 94 | (mapcar |
| 158 | (setq elt (car file-alist) | 95 | (function |
| 159 | short (car elt) | 96 | (lambda (x) |
| 160 | attr (cdr elt) | 97 | ;; file-attributes("~bogus") bombs |
| 161 | file-alist (cdr file-alist) | 98 | (cons x (file-attributes (expand-file-name x))))) |
| 162 | fil (concat dir short) | 99 | ;; inserting the call to directory-files right here |
| 163 | sum (+ sum (nth 7 attr))) | 100 | ;; seems to stimulate an Emacs bug |
| 164 | (insert (dired-lisp-format short attr switches))) | 101 | ;; ILLEGAL DATATYPE (#o37777777727) or #o67 |
| 165 | ;; Fill in total size of all files: | 102 | file-list)) |
| 166 | (save-excursion | 103 | (insert "total \007\n") ; filled in afterwards |
| 167 | (search-backward "total \007") | 104 | (setq file-alist |
| 168 | (goto-char (match-end 0)) | 105 | (ls-lisp-handle-switches file-alist switches)) |
| 169 | (delete-char -1) | 106 | (while file-alist |
| 170 | (insert (format "%d" (1+ (/ sum 1024)))))) | 107 | (setq elt (car file-alist) |
| 171 | ;; if not full-directory-p, FILE *must not* end in /, as | 108 | short (car elt) |
| 172 | ;; file-attributes will not recognize a symlink to a directory | 109 | attr (cdr elt) |
| 173 | ;; must make it a relative filename as ls does: | 110 | file-alist (cdr file-alist) |
| 174 | (setq file (file-name-nondirectory file)) | 111 | fil (concat dir short) |
| 175 | (insert (dired-lisp-format file (file-attributes file) switches)))) | 112 | sum (+ sum (nth 7 attr))) |
| 176 | 113 | (insert (ls-lisp-format short attr switches))) | |
| 177 | (defun dired-lisp-delete-matching (regexp list) | 114 | ;; Fill in total size of all files: |
| 115 | (save-excursion | ||
| 116 | (search-backward "total \007") | ||
| 117 | (goto-char (match-end 0)) | ||
| 118 | (delete-char -1) | ||
| 119 | (insert (format "%d" (1+ (/ sum 1024)))))) | ||
| 120 | ;; if not full-directory-p, FILE *must not* end in /, as | ||
| 121 | ;; file-attributes will not recognize a symlink to a directory | ||
| 122 | ;; must make it a relative filename as ls does: | ||
| 123 | (setq file (file-name-nondirectory file)) | ||
| 124 | (insert (ls-lisp-format file (file-attributes file) switches)))))) | ||
| 125 | |||
| 126 | (defun ls-lisp-delete-matching (regexp list) | ||
| 178 | ;; Delete all elements matching REGEXP from LIST, return new list. | 127 | ;; Delete all elements matching REGEXP from LIST, return new list. |
| 179 | ;; Should perhaps use setcdr for efficiency. | 128 | ;; Should perhaps use setcdr for efficiency. |
| 180 | (let (result) | 129 | (let (result) |
| @@ -184,7 +133,7 @@ SWITCHES default to dired-listing-switches." | |||
| 184 | (setq list (cdr list))) | 133 | (setq list (cdr list))) |
| 185 | result)) | 134 | result)) |
| 186 | 135 | ||
| 187 | (defun dired-lisp-handle-switches (file-alist switches) | 136 | (defun ls-lisp-handle-switches (file-alist switches) |
| 188 | ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES). | 137 | ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES). |
| 189 | ;; Return new alist sorted according to SWITCHES which is a list of | 138 | ;; Return new alist sorted according to SWITCHES which is a list of |
| 190 | ;; characters. Default sorting is alphabetically. | 139 | ;; characters. Default sorting is alphabetically. |
| @@ -199,11 +148,11 @@ SWITCHES default to dired-listing-switches." | |||
| 199 | (< (nth 7 (cdr y)) | 148 | (< (nth 7 (cdr y)) |
| 200 | (nth 7 (cdr x)))))) | 149 | (nth 7 (cdr x)))))) |
| 201 | ((memq ?t switches) ; sorted on time | 150 | ((memq ?t switches) ; sorted on time |
| 202 | (setq index (dired-lisp-time-index switches)) | 151 | (setq index (ls-lisp-time-index switches)) |
| 203 | (function | 152 | (function |
| 204 | (lambda (x y) | 153 | (lambda (x y) |
| 205 | (time-lessp (nth index (cdr y)) | 154 | (ls-lisp-time-lessp (nth index (cdr y)) |
| 206 | (nth index (cdr x)))))) | 155 | (nth index (cdr x)))))) |
| 207 | (t ; sorted alphabetically | 156 | (t ; sorted alphabetically |
| 208 | (function | 157 | (function |
| 209 | (lambda (x y) | 158 | (lambda (x y) |
| @@ -214,7 +163,7 @@ SWITCHES default to dired-listing-switches." | |||
| 214 | file-alist) | 163 | file-alist) |
| 215 | 164 | ||
| 216 | ;; From Roland McGrath. Can use this to sort on time. | 165 | ;; From Roland McGrath. Can use this to sort on time. |
| 217 | (defun time-lessp (time0 time1) | 166 | (defun ls-lisp-time-lessp (time0 time1) |
| 218 | (let ((hi0 (car time0)) | 167 | (let ((hi0 (car time0)) |
| 219 | (hi1 (car time1)) | 168 | (hi1 (car time1)) |
| 220 | (lo0 (car (cdr time0))) | 169 | (lo0 (car (cdr time0))) |
| @@ -224,7 +173,7 @@ SWITCHES default to dired-listing-switches." | |||
| 224 | (< lo0 lo1))))) | 173 | (< lo0 lo1))))) |
| 225 | 174 | ||
| 226 | 175 | ||
| 227 | (defun dired-lisp-format (file-name file-attr &optional switches) | 176 | (defun ls-lisp-format (file-name file-attr &optional switches) |
| 228 | (let ((file-type (nth 0 file-attr))) | 177 | (let ((file-type (nth 0 file-attr))) |
| 229 | (concat (if (memq ?i switches) ; inode number | 178 | (concat (if (memq ?i switches) ; inode number |
| 230 | (format "%6d " (nth 10 file-attr))) | 179 | (format "%6d " (nth 10 file-attr))) |
| @@ -242,7 +191,7 @@ SWITCHES default to dired-listing-switches." | |||
| 242 | (nth 3 file-attr) ; gid | 191 | (nth 3 file-attr) ; gid |
| 243 | (nth 7 file-attr) ; size in bytes | 192 | (nth 7 file-attr) ; size in bytes |
| 244 | ) | 193 | ) |
| 245 | (dired-lisp-format-time file-attr switches) | 194 | (ls-lisp-format-time file-attr switches) |
| 246 | " " | 195 | " " |
| 247 | file-name | 196 | file-name |
| 248 | (if (stringp file-type) ; is a symbolic link | 197 | (if (stringp file-type) ; is a symbolic link |
| @@ -251,7 +200,7 @@ SWITCHES default to dired-listing-switches." | |||
| 251 | "\n" | 200 | "\n" |
| 252 | ))) | 201 | ))) |
| 253 | 202 | ||
| 254 | (defun dired-lisp-time-index (switches) | 203 | (defun ls-lisp-time-index (switches) |
| 255 | ;; Return index into file-attributes according to ls SWITCHES. | 204 | ;; Return index into file-attributes according to ls SWITCHES. |
| 256 | (cond | 205 | (cond |
| 257 | ((memq ?c switches) 6) ; last mode change | 206 | ((memq ?c switches) 6) ; last mode change |
| @@ -259,7 +208,7 @@ SWITCHES default to dired-listing-switches." | |||
| 259 | ;; default is last modtime | 208 | ;; default is last modtime |
| 260 | (t 5))) | 209 | (t 5))) |
| 261 | 210 | ||
| 262 | (defun dired-lisp-format-time (file-attr switches) | 211 | (defun ls-lisp-format-time (file-attr switches) |
| 263 | ;; Format time string for file with attributes FILE-ATTR according | 212 | ;; Format time string for file with attributes FILE-ATTR according |
| 264 | ;; to SWITCHES (a list of ls option letters of which c and u are recognized). | 213 | ;; to SWITCHES (a list of ls option letters of which c and u are recognized). |
| 265 | ;; file-attributes's time is in a braindead format | 214 | ;; file-attributes's time is in a braindead format |
| @@ -268,7 +217,7 @@ SWITCHES default to dired-listing-switches." | |||
| 268 | ;; date "Jan 00 00:00 ". | 217 | ;; date "Jan 00 00:00 ". |
| 269 | (condition-case error-data | 218 | (condition-case error-data |
| 270 | (let* ((time (current-time-string | 219 | (let* ((time (current-time-string |
| 271 | (nth (dired-lisp-time-index switches) file-attr))) | 220 | (nth (ls-lisp-time-index switches) file-attr))) |
| 272 | (date (substring time 4 11)) ; "Apr 30 " | 221 | (date (substring time 4 11)) ; "Apr 30 " |
| 273 | (clock (substring time 11 16)) ; "11:27" | 222 | (clock (substring time 11 16)) ; "11:27" |
| 274 | (year (substring time 19 24)) ; " 1992" | 223 | (year (substring time 19 24)) ; " 1992" |
| @@ -283,6 +232,6 @@ SWITCHES default to dired-listing-switches." | |||
| 283 | (error | 232 | (error |
| 284 | "Jan 00 00:00"))) | 233 | "Jan 00 00:00"))) |
| 285 | 234 | ||
| 286 | (provide 'dired-lisp) | 235 | (provide 'ls-lisp) |
| 287 | 236 | ||
| 288 | ; eof | 237 | ; eof |