Mercurial > hg > xemacs-beta

comparison lisp/files.el @ 2671:5402bf7d11a5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-03-17 09:26:07 by michaels] 2005-03-17 Mike Sperber <mike@xemacs.org> * files.el: Merge the following changes from GNU Emacs: 2005-01-04 Andreas Schwab <schwab@suse.de> * files.el (insert-directory): Only look for error lines in inserted text. Don't move too far after processing --dired markers. 2004-12-27 Richard M. Stallman <rms@gnu.org> * files.el (insert-directory-ls-version): New variable. (insert-directory): When ls returns an error, test the version number to decide what the return code means. With --dired output format, detect and distinguish lines that are really error messages. (insert-directory-adj-pos): New function. 2004-09-25 Stefan Monnier <monnier@iro.umontreal.ca> * files.el (insert-directory): Obey --dired even with symlinks. 2004-05-25 Luc Teirlinck <teirllm@auburn.edu> (insert-directory): Check that lines were really inserted by the --dired switch, before erasing them. 2004-04-17 Richard M. Stallman <rms@gnu.org> * files.el (insert-directory): Delete any error msg output by the `insert-directory-program'.
author michaels
date Thu, 17 Mar 2005 09:26:09 +0000
parents ba1cb56059fb
children 54fd042e254c
comparison
equal deleted inserted replaced
2670:a7412c3275d9 2671:5402bf7d11a5
4083 ;; Filename handlers might have to remove this switch if their 4083 ;; Filename handlers might have to remove this switch if their
4084 ;; "ls" command does not support it. 4084 ;; "ls" command does not support it.
4085 4085
4086 ;; END SYNC WITH FSF 21.2. 4086 ;; END SYNC WITH FSF 21.2.
4087 4087
4088 (defvar insert-directory-ls-version 'unknown)
4089
4088 (defun insert-directory (file switches &optional wildcard full-directory-p) 4090 (defun insert-directory (file switches &optional wildcard full-directory-p)
4089 "Insert directory listing for FILE, formatted according to SWITCHES. 4091 "Insert directory listing for FILE, formatted according to SWITCHES.
4090 Leaves point after the inserted text. 4092 Leaves point after the inserted text.
4091 SWITCHES may be a string of options, or a list of strings. 4093 SWITCHES may be a string of options, or a list of strings.
4092 Optional third arg WILDCARD means treat FILE as shell wildcard. 4094 Optional third arg WILDCARD means treat FILE as shell wildcard.
4163 (if full-directory-p 4165 (if full-directory-p
4164 (concat (file-name-as-directory file) 4166 (concat (file-name-as-directory file)
4165 ;;#### Unix-specific 4167 ;;#### Unix-specific
4166 ".") 4168 ".")
4167 file)))))))) 4169 file))))))))
4170
4171 ;; If we got "//DIRED//" in the output, it means we got a real
4172 ;; directory listing, even if `ls' returned nonzero.
4173 ;; So ignore any errors.
4174 (when (if (stringp switches)
4175 (string-match "--dired\\>" switches)
4176 (member "--dired" switches))
4177 (save-excursion
4178 (forward-line -2)
4179 (when (looking-at "//SUBDIRED//")
4180 (forward-line -1))
4181 (if (looking-at "//DIRED//")
4182 (setq result 0))))
4183
4184 (when (and (not (eq 0 result))
4185 (eq insert-directory-ls-version 'unknown))
4186 ;; The first time ls returns an error,
4187 ;; find the version numbers of ls,
4188 ;; and set insert-directory-ls-version
4189 ;; to > if it is more than 5.2.1, < if it is less, nil if it
4190 ;; is equal or if the info cannot be obtained.
4191 ;; (That can mean it isn't GNU ls.)
4192 (let ((version-out
4193 (with-temp-buffer
4194 (call-process "ls" nil t nil "--version")
4195 (buffer-string))))
4196 (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out)
4197 (let* ((version (match-string 1 version-out))
4198 (split (split-string version "[.]"))
4199 (numbers (mapcar 'string-to-int split))
4200 (min '(5 2 1))
4201 comparison)
4202 (while (and (not comparison) (or numbers min))
4203 (cond ((null min)
4204 (setq comparison '>))
4205 ((null numbers)
4206 (setq comparison '<))
4207 ((> (car numbers) (car min))
4208 (setq comparison '>))
4209 ((< (car numbers) (car min))
4210 (setq comparison '<))
4211 (t
4212 (setq numbers (cdr numbers)
4213 min (cdr min)))))
4214 (setq insert-directory-ls-version (or comparison '=)))
4215 (setq insert-directory-ls-version nil))))
4216
4217 ;; For GNU ls versions 5.2.2 and up, ignore minor errors.
4218 (when (and (eq 1 result) (eq insert-directory-ls-version '>))
4219 (setq result 0))
4220
4168 ;; If `insert-directory-program' failed, signal an error. 4221 ;; If `insert-directory-program' failed, signal an error.
4169 (if (/= result 0) 4222 (unless (eq 0 result)
4170 ;; On non-Posix systems, we cannot open a directory, so 4223 ;; Delete the error message it may have output.
4171 ;; don't even try, because that will always result in 4224 (delete-region beg (point))
4172 ;; the ubiquitous "Access denied". Instead, show the 4225 ;; On non-Posix systems, we cannot open a directory, so
4173 ;; command line so the user can try to guess what went wrong. 4226 ;; don't even try, because that will always result in
4174 (error "Listing directory failed.")) 4227 ;; the ubiquitous "Access denied". Instead, show the
4228 ;; command line so the user can try to guess what went wrong.
4229 (if (and (file-directory-p file)
4230 (memq system-type '(ms-dos windows-nt)))
4231 (error
4232 "Reading directory: \"%s %s -- %s\" exited with status %s"
4233 insert-directory-program
4234 (if (listp switches) (concat switches) switches)
4235 file result)
4236 (error "Listing directory failed")))
4175 4237
4176 (when (or (and (listp switches) 4238 (when (or (and (listp switches)
4177 (member "--dired" switches)) 4239 (member "--dired" switches))
4178 (string-match "--dired\\>" switches)) 4240 (string-match "--dired\\>" switches))
4179 (forward-line -2) 4241 (forward-line -2)
4180 (when (looking-at "//SUBDIRED//") 4242 (when (looking-at "//SUBDIRED//")
4181 (delete-region (point) (progn (forward-line 1) (point))) 4243 (delete-region (point) (progn (forward-line 1) (point)))
4182 (forward-line -1)) 4244 (forward-line -1))
4183 (let ((end (line-end-position))) 4245 (if (looking-at "//DIRED//")
4184 (forward-word 1) 4246 (let ((end (line-end-position))
4185 (forward-char 3) 4247 (linebeg (point))
4186 (while (< (point) end) 4248 error-lines)
4187 (let ((start (+ beg (read (current-buffer)))) 4249 ;; Find all the lines that are error messages,
4188 (end (+ beg (read (current-buffer))))) 4250 ;; and record the bounds of each one.
4189 (if (= (char-after end) ?\n) 4251 (goto-char beg)
4190 (let ((filename-extent (make-extent start end))) 4252 (while (< (point) linebeg)
4191 (set-extent-property filename-extent 'dired-file-name t) 4253 (or (eql (following-char) ?\s)
4192 (set-extent-property filename-extent 'start-open t) 4254 (push (list (point) (line-end-position)) error-lines))
4193 (set-extent-property filename-extent 'end-open t)) 4255 (forward-line 1))
4194 ;; It seems that we can't trust ls's output as to 4256 (setq error-lines (nreverse error-lines))
4195 ;; byte positions of filenames. 4257 ;; Now read the numeric positions of file names.
4196 (map-extents 4258 (goto-char linebeg)
4197 #'(lambda (extent maparg) 4259 (forward-word 1)
4198 (delete-extent extent) 4260 (forward-char 3)
4199 nil) 4261 (while (< (point) end)
4200 nil beg (point) nil nil 'dired-file-name) 4262 (let ((start (insert-directory-adj-pos
4201 (end-of-line)))) 4263 (+ beg (read (current-buffer)))
4202 (goto-char end) 4264 error-lines))
4203 (beginning-of-line) 4265 (end (insert-directory-adj-pos
4204 (delete-region (point) (progn (forward-line 2) (point)))))))))) 4266 (+ beg (read (current-buffer)))
4267 error-lines)))
4268 (if (memq (char-after end) '(?\n ?\ ))
4269 ;; End is followed by \n or by " -> ".
4270 (let ((filename-extent (make-extent start end)))
4271 (set-extent-property filename-extent 'dired-file-name t)
4272 (set-extent-property filename-extent 'start-open t)
4273 (set-extent-property filename-extent 'end-open t))
4274 ;; It seems that we can't trust ls's output as to
4275 ;; byte positions of filenames.
4276 (map-extents
4277 #'(lambda (extent maparg)
4278 (delete-extent extent)
4279 nil)
4280 nil beg (point) nil nil 'dired-file-name)
4281 (end-of-line))))
4282 (goto-char end)
4283 (beginning-of-line)
4284 (delete-region (point) (progn (forward-line 1) (point))))
4285 ;; Take care of the case where the ls output contains a
4286 ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
4287 ;; and we went one line too far back (see above).
4288 (forward-line 1))
4289 (if (looking-at "//DIRED-OPTIONS//")
4290 (delete-region (point) (progn (forward-line 1) (point))))))))))
4291
4292 (defun insert-directory-adj-pos (pos error-lines)
4293 "Convert `ls --dired' file name position value POS to a buffer position.
4294 File name position values returned in ls --dired output
4295 count only stdout; they don't count the error messages sent to stderr.
4296 So this function converts to them to real buffer positions.
4297 ERROR-LINES is a list of buffer positions of error message lines,
4298 of the form (START END)."
4299 (while (and error-lines (< (caar error-lines) pos))
4300 (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines)))))
4301 (pop error-lines))
4302 pos)
4205 4303
4206 ;; BEGIN SYNC WITH FSF 21.2. 4304 ;; BEGIN SYNC WITH FSF 21.2.
4207 4305
4208 (defun insert-directory-safely (file switches 4306 (defun insert-directory-safely (file switches
4209 &optional wildcard full-directory-p) 4307 &optional wildcard full-directory-p)