Mercurial > emacs

comparison lisp/eshell/esh-util.el @ 32446:aab90b31807c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Added better remote directory support to Eshell, as well as a few bug fixes. See the ChangeLog.
author John Wiegley <johnw@newartisans.com>
date Fri, 13 Oct 2000 09:02:39 +0000
parents 3099993cba0f
children b338a85bdffc
comparison
equal deleted inserted replaced
32445:05513a882886 32446:aab90b31807c
82 "*Regular expression used to match numeric arguments. 82 "*Regular expression used to match numeric arguments.
83 If `eshell-convert-numeric-arguments' is non-nil, and an argument 83 If `eshell-convert-numeric-arguments' is non-nil, and an argument
84 matches this regexp, it will be converted to a Lisp number, using the 84 matches this regexp, it will be converted to a Lisp number, using the
85 function `string-to-number'." 85 function `string-to-number'."
86 :type 'regexp 86 :type 'regexp
87 :group 'eshell-util)
88
89 (defcustom eshell-ange-ls-uids nil
90 "*List of user/host/id strings, used to determine remote ownership."
91 :type '(list (cons :tag "Host/User Pair"
92 (string :tag "Hostname")
93 (repeat (cons :tag "User/UID List"
94 (string :tag "Username")
95 (repeat :tag "UIDs" string)))))
87 :group 'eshell-util) 96 :group 'eshell-util)
88 97
89 ;;; Internal Variables: 98 ;;; Internal Variables:
90 99
91 (defvar eshell-group-names nil 100 (defvar eshell-group-names nil
556 string))) 565 string)))
557 566
558 (unless (fboundp 'directory-files-and-attributes) 567 (unless (fboundp 'directory-files-and-attributes)
559 (defun directory-files-and-attributes (dir &optional full match nosort) 568 (defun directory-files-and-attributes (dir &optional full match nosort)
560 (documentation 'directory-files) 569 (documentation 'directory-files)
561 (let* ((dir (expand-file-name dir)) 570 (let ((dir (expand-file-name dir)) ange-cache)
562 (default-directory dir))
563 (mapcar 571 (mapcar
564 (function 572 (function
565 (lambda (file) 573 (lambda (file)
566 (cons file (file-attributes file)))) 574 (cons file (eshell-file-attributes (expand-file-name file dir)))))
567 (directory-files dir full match nosort))))) 575 (directory-files dir full match nosort)))))
576
577 (eval-when-compile
578 (defvar ange-cache))
568 579
569 (defun eshell-directory-files-and-attributes (dir &optional full match nosort) 580 (defun eshell-directory-files-and-attributes (dir &optional full match nosort)
570 "Make sure to use the handler for `directory-file-and-attributes'." 581 "Make sure to use the handler for `directory-file-and-attributes'."
571 (let ((dfh (find-file-name-handler dir 'directory-files))) 582 (let* ((dir (expand-file-name dir))
583 (dfh (find-file-name-handler dir 'directory-files)))
572 (if (not dfh) 584 (if (not dfh)
573 (directory-files-and-attributes dir full match nosort) 585 (directory-files-and-attributes dir full match nosort)
574 (let* ((files (funcall dfh 'directory-files dir full match nosort)) 586 (let ((files (funcall dfh 'directory-files dir full match nosort))
575 (fah (find-file-name-handler dir 'file-attributes)) 587 (fah (find-file-name-handler dir 'file-attributes)))
576 (default-directory (expand-file-name dir)))
577 (mapcar 588 (mapcar
578 (function 589 (function
579 (lambda (file) 590 (lambda (file)
580 (cons file (funcall fah 'file-attributes file)))) 591 (cons file (if fah
592 (eshell-file-attributes
593 (expand-file-name file dir))
594 (file-attributes (expand-file-name file dir))))))
581 files))))) 595 files)))))
596
597 (defun eshell-current-ange-uids ()
598 (if (string-match "/\\([^@]+\\)@\\([^:]+\\):" default-directory)
599 (let* ((host (match-string 2 default-directory))
600 (user (match-string 1 default-directory))
601 (host-users (assoc host eshell-ange-ls-uids)))
602 (when host-users
603 (setq host-users (cdr host-users))
604 (cdr (assoc user host-users))))))
605
606 ;; Add an autoload for parse-time-string
607 (if (and (not (fboundp 'parse-time-string))
608 (locate-library "parse-time"))
609 (autoload 'parse-time-string "parse-time"))
610
611 (defun eshell-parse-ange-ls (dir)
612 (let (entry)
613 (with-temp-buffer
614 (insert (ange-ftp-ls dir "-la" nil))
615 (goto-char (point-min))
616 (if (looking-at "^total [0-9]+$")
617 (forward-line 1))
618 ;; Some systems put in a blank line here.
619 (if (eolp) (forward-line 1))
620 (while (looking-at
621 `,(concat "\\([dlscb-][rwxst-]+\\)"
622 "\\s-*" "\\([0-9]+\\)" "\\s-+"
623 "\\(\\S-+\\)" "\\s-+"
624 "\\(\\S-+\\)" "\\s-+"
625 "\\([0-9]+\\)" "\\s-+" "\\(.*\\)"))
626 (let* ((perms (match-string 1))
627 (links (string-to-number (match-string 2)))
628 (user (match-string 3))
629 (group (match-string 4))
630 (size (string-to-number (match-string 5)))
631 (mtime
632 (if (fboundp 'parse-time-string)
633 (let ((moment (parse-time-string
634 (match-string 6))))
635 (if (nth 0 moment)
636 (setcar (nthcdr 5 moment)
637 (nth 5 (decode-time (current-time))))
638 (setcar (nthcdr 0 moment) 0)
639 (setcar (nthcdr 1 moment) 0)
640 (setcar (nthcdr 2 moment) 0))
641 (apply 'encode-time moment))
642 (ange-ftp-file-modtime (expand-file-name name dir))))
643 (name (ange-ftp-parse-filename))
644 symlink)
645 (if (string-match "\\(.+\\) -> \\(.+\\)" name)
646 (setq symlink (match-string 2 name)
647 name (match-string 1 name)))
648 (setq entry
649 (cons
650 (cons name
651 (list (if (eq (aref perms 0) ?d)
652 t
653 symlink)
654 links user group
655 nil mtime nil
656 size perms nil nil)) entry)))
657 (forward-line)))
658 entry))
659
660 (defun eshell-file-attributes (file)
661 "Return the attributes of FILE, playing tricks if it's over ange-ftp."
662 (let* ((file (expand-file-name file))
663 (handler (find-file-name-handler file 'file-attributes))
664 entry)
665 (if (not handler)
666 (file-attributes file)
667 (if (eq (find-file-name-handler (file-name-directory file)
668 'directory-files)
669 'ange-ftp-hook-function)
670 (let ((base (file-name-nondirectory file))
671 (dir (file-name-directory file)))
672 (if (boundp 'ange-cache)
673 (setq entry (cdr (assoc base (cdr (assoc dir ange-cache))))))
674 (unless entry
675 (setq entry (eshell-parse-ange-ls dir))
676 (if (boundp 'ange-cache)
677 (setq ange-cache
678 (cons (cons dir entry)
679 ange-cache)))
680 (if entry
681 (let ((fentry (assoc base (cdr entry))))
682 (if fentry
683 (setq entry (cdr fentry))
684 (setq entry nil)))))))
685 (or entry (funcall handler 'file-attributes file)))))
582 686
583 (defun eshell-copy-list (list) 687 (defun eshell-copy-list (list)
584 "Return a copy of a list, which may be a dotted list. 688 "Return a copy of a list, which may be a dotted list.
585 The elements of the list are not copied, just the list structure itself." 689 The elements of the list are not copied, just the list structure itself."
586 (if (consp list) 690 (if (consp list)