diff options
author | Gerd Moellmann <gerd@gnu.org> | 2000-06-23 04:39:18 +0000 |
---|---|---|
committer | Gerd Moellmann <gerd@gnu.org> | 2000-06-23 04:39:18 +0000 |
commit | 26b4dc849fc474ff9f1c6cc0a9f33f3c2cf086ba (patch) | |
tree | 862f408c0c6eedefc366004596424e5647b5d2fd /lisp/eshell/esh-util.el | |
parent | 0908a1e3192261cfc94abc95ae48f2d54380d576 (diff) | |
download | emacs-26b4dc849fc474ff9f1c6cc0a9f33f3c2cf086ba.tar.gz |
*** empty log message ***
Diffstat (limited to 'lisp/eshell/esh-util.el')
-rw-r--r-- | lisp/eshell/esh-util.el | 676 |
1 files changed, 676 insertions, 0 deletions
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el new file mode 100644 index 00000000000..eb69e5e0f98 --- /dev/null +++ b/lisp/eshell/esh-util.el @@ -0,0 +1,676 @@ +;;; esh-util --- general utilities + +;; Copyright (C) 1999, 2000 Free Sofware Foundation + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +(provide 'esh-util) + +(eval-when-compile (require 'esh-maint)) + +(defgroup eshell-util nil + "This is general utility code, meant for use by Eshell itself." + :tag "General utilities" + :group 'eshell) + +;;; Commentary: + +(require 'pp) + +;;; User Variables: + +(defcustom eshell-group-file "/etc/group" + "*If non-nil, the name of the group file on your system." + :type '(choice (const :tag "No group file" nil) file) + :group 'eshell-util) + +(defcustom eshell-passwd-file "/etc/passwd" + "*If non-nil, the name of the passwd file on your system." + :type '(choice (const :tag "No passwd file" nil) file) + :group 'eshell-util) + +(defcustom eshell-hosts-file "/etc/hosts" + "*The name of the /etc/hosts file." + :type '(choice (const :tag "No hosts file" nil) file) + :group 'eshell-util) + +(defcustom eshell-handle-errors t + "*If non-nil, Eshell will handle errors itself. +Setting this to nil is offered as an aid to debugging only." + :type 'boolean + :group 'eshell-util) + +(defcustom eshell-private-file-modes 384 ; umask 177 + "*The file-modes value to use for creating \"private\" files." + :type 'integer + :group 'eshell-util) + +(defcustom eshell-private-directory-modes 448 ; umask 077 + "*The file-modes value to use for creating \"private\" directories." + :type 'integer + :group 'eshell-util) + +(defcustom eshell-tar-regexp + "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'" + "*Regular expression used to match tar file names." + :type 'regexp + :group 'eshell-util) + +(defcustom eshell-convert-numeric-arguments t + "*If non-nil, converting arguments of numeric form to Lisp numbers. +Numeric form is tested using the regular expression +`eshell-number-regexp'." + :type 'boolean + :group 'eshell-util) + +(defcustom eshell-number-regexp "\\(0\\|-?[1-9][0-9]*\\(\\.[0-9]+\\)?\\)" + "*Regular expression used to match numeric arguments. +If `eshell-convert-numeric-arguments' is non-nil, and an argument +matches this regexp, it will be converted to a Lisp number, using the +function `string-to-number'." + :type 'regexp + :group 'eshell-util) + +;;; Internal Variables: + +(defvar eshell-group-names nil + "A cache to hold the names of groups.") + +(defvar eshell-group-timestamp nil + "A timestamp of when the group file was read.") + +(defvar eshell-user-names nil + "A cache to hold the names of users.") + +(defvar eshell-user-timestamp nil + "A timestamp of when the user file was read.") + +(defvar eshell-host-names nil + "A cache the names of frequently accessed hosts.") + +(defvar eshell-host-timestamp nil + "A timestamp of when the hosts file was read.") + +;;; Functions: + +(defsubst eshell-under-xemacs-p () + "Return non-nil if we are running under XEmacs." + (boundp 'xemacs-logo)) + +(defsubst eshell-under-windows-p () + "Return non-nil if we are running under MS-DOS/Windows." + (memq system-type '(ms-dos windows-nt))) + +(defmacro eshell-condition-case (tag form &rest handlers) + "Like `condition-case', but only if `eshell-pass-through-errors' is nil." + (if eshell-handle-errors + `(condition-case ,tag + ,form + ,@handlers) + form)) + +(put 'eshell-condition-case 'lisp-indent-function 2) + +(defmacro eshell-deftest (module name label &rest forms) + (if (and (fboundp 'cl-compiling-file) (cl-compiling-file)) + nil + (let ((fsym (intern (concat "eshell-test--" (symbol-name name))))) + `(eval-when-compile + (ignore + (defun ,fsym () ,label + (eshell-run-test (quote ,module) (quote ,fsym) ,label + (quote (progn ,@forms))))))))) + +(put 'eshell-deftest 'lisp-indent-function 2) + +(defun eshell-find-delimiter + (open close &optional bound reverse-p backslash-p) + "From point, find the CLOSE delimiter corresponding to OPEN. +The matching is bounded by BOUND. +If REVERSE-P is non-nil, process the region backwards. +If BACKSLASH-P is non-nil, and OPEN and CLOSE are the same character, +then quoting is done by a backslash, rather than a doubled delimiter." + (save-excursion + (let ((depth 1) + (bound (or bound (point-max)))) + (if (if reverse-p + (eq (char-before) close) + (eq (char-after) open)) + (forward-char (if reverse-p -1 1))) + (while (and (> depth 0) + (funcall (if reverse-p '> '<) (point) bound)) + (let ((c (if reverse-p (char-before) (char-after))) nc) + (cond ((and (not reverse-p) + (or (not (eq open close)) + backslash-p) + (eq c ?\\) + (setq nc (char-after (1+ (point)))) + (or (eq nc open) (eq nc close))) + (forward-char 1)) + ((and reverse-p + (or (not (eq open close)) + backslash-p) + (or (eq c open) (eq c close)) + (eq (char-before (1- (point))) + ?\\)) + (forward-char -1)) + ((eq open close) + (if (eq c open) + (if (and (not backslash-p) + (eq (if reverse-p + (char-before (1- (point))) + (char-after (1+ (point)))) open)) + (forward-char (if reverse-p -1 1)) + (setq depth (1- depth))))) + ((= c open) + (setq depth (+ depth (if reverse-p -1 1)))) + ((= c close) + (setq depth (+ depth (if reverse-p 1 -1)))))) + (forward-char (if reverse-p -1 1))) + (if (= depth 0) + (if reverse-p (point) (1- (point))))))) + +(defun eshell-convert (string) + "Convert STRING into a more native looking Lisp object." + (if (not (stringp string)) + string + (let ((len (length string))) + (if (= len 0) + string + (if (eq (aref string (1- len)) ?\n) + (setq string (substring string 0 (1- len)))) + (if (string-match "\n" string) + (split-string string "\n") + (if (and eshell-convert-numeric-arguments + (string-match + (concat "\\`\\s-*" eshell-number-regexp + "\\s-*\\'") string)) + (string-to-number string) + string)))))) + +(defun eshell-sublist (l &optional n m) + "Return from LIST the N to M elements. +If N or M is nil, it means the end of the list." + (let* ((a (copy-list l)) + result) + (if (and m (consp (nthcdr m a))) + (setcdr (nthcdr m a) nil)) + (if n + (setq a (nthcdr n a)) + (setq n (1- (length a)) + a (last a))) + a)) + +(defun eshell-split-path (path) + "Split a path into multiple subparts." + (let ((len (length path)) + (i 0) (li 0) + parts) + (if (and (eshell-under-windows-p) + (> len 2) + (eq (aref path 0) directory-sep-char) + (eq (aref path 1) directory-sep-char)) + (setq i 2)) + (while (< i len) + (if (and (eq (aref path i) directory-sep-char) + (not (get-text-property i 'escaped path))) + (setq parts (cons (if (= li i) + (char-to-string directory-sep-char) + (substring path li (1+ i))) parts) + li (1+ i))) + (setq i (1+ i))) + (if (< li i) + (setq parts (cons (substring path li i) parts))) + (if (and (eshell-under-windows-p) + (string-match "\\`[A-Za-z]:\\'" (car (last parts)))) + (setcar (last parts) + (concat (car (last parts)) + (char-to-string directory-sep-char)))) + (nreverse parts))) + +(defun eshell-to-flat-string (value) + "Make value a string. If separated by newlines change them to spaces." + (let ((text (eshell-stringify value))) + (if (string-match "\n+\\'" text) + (setq text (replace-match "" t t text))) + (while (string-match "\n+" text) + (setq text (replace-match " " t t text))) + text)) + +(defmacro eshell-for (for-var for-list &rest forms) + "Iterate through a list" + `(let ((list-iter ,for-list)) + (while list-iter + (let ((,for-var (car list-iter))) + ,@forms) + (setq list-iter (cdr list-iter))))) + +(put 'eshell-for 'lisp-indent-function 2) + +(defun eshell-flatten-list (args) + "Flatten any lists within ARGS, so that there are no sublists." + (let ((new-list (list t))) + (eshell-for a args + (if (and (listp a) + (listp (cdr a))) + (nconc new-list (eshell-flatten-list a)) + (nconc new-list (list a)))) + (cdr new-list))) + +(defun eshell-uniqify-list (l) + "Remove occurring multiples in L. You probably want to sort first." + (let ((m l)) + (while m + (while (and (cdr m) + (string= (car m) + (cadr m))) + (setcdr m (cddr m))) + (setq m (cdr m)))) + l) + +(defun eshell-stringify (object) + "Convert OBJECT into a string value." + (cond + ((stringp object) object) + ((and (listp object) + (not (eq object nil))) + (let ((string (pp-to-string object))) + (substring string 0 (1- (length string))))) + ((numberp object) + (number-to-string object)) + (t + (pp-to-string object)))) + +(defsubst eshell-stringify-list (args) + "Convert each element of ARGS into a string value." + (mapcar 'eshell-stringify args)) + +(defsubst eshell-flatten-and-stringify (&rest args) + "Flatten and stringify all of the ARGS into a single string." + (mapconcat 'eshell-stringify (eshell-flatten-list args) " ")) + +;; the next two are from GNUS, and really should be made part of Emacs +;; some day +(defsubst eshell-time-less-p (t1 t2) + "Say whether time T1 is less than time T2." + (or (< (car t1) (car t2)) + (and (= (car t1) (car t2)) + (< (nth 1 t1) (nth 1 t2))))) + +(defsubst eshell-time-to-seconds (time) + "Convert TIME to a floating point number." + (+ (* (car time) 65536.0) + (cadr time) + (/ (or (car (cdr (cdr time))) 0) 1000000.0))) + +(defsubst eshell-directory-files (regexp &optional directory) + "Return a list of files in the given DIRECTORY matching REGEXP." + (directory-files (or directory default-directory) + directory regexp)) + +(defun eshell-regexp-arg (prompt) + "Return list of regexp and prefix arg using PROMPT." + (let* (;; Don't clobber this. + (last-command last-command) + (regexp (read-from-minibuffer prompt nil nil nil + 'minibuffer-history-search-history))) + (list (if (string-equal regexp "") + (setcar minibuffer-history-search-history + (nth 1 minibuffer-history-search-history)) + regexp) + (prefix-numeric-value current-prefix-arg)))) + +(defun eshell-printable-size (filesize &optional human-readable + block-size use-colors) + "Return a printable FILESIZE." + (let ((size (float (or filesize 0)))) + (if human-readable + (if (< size human-readable) + (if (= (round size) 0) + "0" + (if block-size + "1.0k" + (format "%.0f" size))) + (setq size (/ size human-readable)) + (if (< size human-readable) + (if (<= size 9.94) + (format "%.1fk" size) + (format "%.0fk" size)) + (setq size (/ size human-readable)) + (if (< size human-readable) + (let ((str (if (<= size 9.94) + (format "%.1fM" size) + (format "%.0fM" size)))) + (if use-colors + (put-text-property 0 (length str) + 'face 'bold str)) + str) + (setq size (/ size human-readable)) + (if (< size human-readable) + (let ((str (if (<= size 9.94) + (format "%.1fG" size) + (format "%.0fG" size)))) + (if use-colors + (put-text-property 0 (length str) + 'face 'bold-italic str)) + str))))) + (if block-size + (setq size (/ size block-size))) + (format "%.0f" size)))) + +(defun eshell-winnow-list (entries exclude &optional predicates) + "Pare down the ENTRIES list using the EXCLUDE regexp, and PREDICATES. +The original list is not affected. If the result is only one element +long, it will be returned itself, rather than returning a one-element +list." + (let ((flist (list t)) + valid p listified) + (unless (listp entries) + (setq entries (list entries) + listified t)) + (eshell-for entry entries + (unless (and exclude (string-match exclude entry)) + (setq p predicates valid (null p)) + (while p + (if (funcall (car p) entry) + (setq valid t) + (setq p nil valid nil)) + (setq p (cdr p))) + (when valid + (nconc flist (list entry))))) + (if listified + (cadr flist) + (cdr flist)))) + +(defsubst eshell-redisplay () + "Allow Emacs to redisplay buffers." + ;; for some strange reason, Emacs 21 is prone to trigger an + ;; "args out of range" error in `sit-for', if this function + ;; runs while point is in the minibuffer and the users attempt + ;; to use completion. Don't ask me. + (ignore-errors (sit-for 0 0))) + +(defun eshell-read-passwd-file (file) + "Return an alist correlating gids to group names in FILE." + (let (names) + (when (file-readable-p file) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (while (not (eobp)) + (let* ((fields + (split-string (buffer-substring + (point) (progn (end-of-line) + (point))) ":"))) + (if (and fields (nth 0 fields) (nth 2 fields)) + (setq names (cons (cons (string-to-int (nth 2 fields)) + (nth 0 fields)) + names)))) + (forward-line)))) + names)) + +(defun eshell-read-passwd (file result-var timestamp-var) + "Read the contents of /etc/passwd for user names." + (if (or (not (symbol-value result-var)) + (not (symbol-value timestamp-var)) + (eshell-time-less-p + (symbol-value timestamp-var) + (nth 5 (file-attributes file)))) + (progn + (set result-var (eshell-read-passwd-file file)) + (set timestamp-var (current-time)))) + (symbol-value result-var)) + +(defun eshell-read-group-names () + "Read the contents of /etc/group for group names." + (if eshell-group-file + (eshell-read-passwd eshell-group-file 'eshell-group-names + 'eshell-group-timestamp))) + +(defsubst eshell-group-id (name) + "Return the user id for user NAME." + (car (rassoc name (eshell-read-group-names)))) + +(defsubst eshell-group-name (gid) + "Return the group name for the given GID." + (cdr (assoc gid (eshell-read-group-names)))) + +(defun eshell-read-user-names () + "Read the contents of /etc/passwd for user names." + (if eshell-passwd-file + (eshell-read-passwd eshell-passwd-file 'eshell-user-names + 'eshell-user-timestamp))) + +(defsubst eshell-user-id (name) + "Return the user id for user NAME." + (car (rassoc name (eshell-read-user-names)))) + +(defalias 'eshell-user-name 'user-login-name) + +(defun eshell-read-hosts-file (filename) + "Read in the hosts from the /etc/hosts file." + (let (hosts) + (with-temp-buffer + (insert-file-contents eshell-hosts-file) + (goto-char (point-min)) + (while (re-search-forward + "^\\(\\S-+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t) + (if (match-string 1) + (add-to-list 'hosts (match-string 1))) + (if (match-string 2) + (add-to-list 'hosts (match-string 2))) + (if (match-string 4) + (add-to-list 'hosts (match-string 4))))) + (sort hosts 'string-lessp))) + +(defun eshell-read-hosts (file result-var timestamp-var) + "Read the contents of /etc/passwd for user names." + (if (or (not (symbol-value result-var)) + (not (symbol-value timestamp-var)) + (eshell-time-less-p + (symbol-value timestamp-var) + (nth 5 (file-attributes file)))) + (progn + (set result-var (eshell-read-hosts-file file)) + (set timestamp-var (current-time)))) + (symbol-value result-var)) + +(defun eshell-read-host-names () + "Read the contents of /etc/hosts for host names." + (if eshell-hosts-file + (eshell-read-hosts eshell-hosts-file 'eshell-host-names + 'eshell-host-timestamp))) + +(unless (fboundp 'line-end-position) + (defsubst line-end-position (&optional N) + (save-excursion (end-of-line N) (point)))) + +(unless (fboundp 'line-beginning-position) + (defsubst line-beginning-position (&optional N) + (save-excursion (beginning-of-line N) (point)))) + +(unless (fboundp 'subst-char-in-string) + (defun subst-char-in-string (fromchar tochar string &optional inplace) + "Replace FROMCHAR with TOCHAR in STRING each time it occurs. +Unless optional argument INPLACE is non-nil, return a new string." + (let ((i (length string)) + (newstr (if inplace string (copy-sequence string)))) + (while (> i 0) + (setq i (1- i)) + (if (eq (aref newstr i) fromchar) + (aset newstr i tochar))) + newstr))) + +(defsubst eshell-copy-environment () + "Return an unrelated copy of `process-environment'." + (mapcar 'concat process-environment)) + +(defun eshell-subgroups (groupsym) + "Return all of the subgroups of GROUPSYM." + (let ((subgroups (get groupsym 'custom-group)) + (subg (list t))) + (while subgroups + (if (eq (cadr (car subgroups)) 'custom-group) + (nconc subg (list (caar subgroups)))) + (setq subgroups (cdr subgroups))) + (cdr subg))) + +(defmacro eshell-with-file-modes (modes &rest forms) + "Evaluate, with file-modes set to MODES, the given FORMS." + `(let ((modes (default-file-modes))) + (set-default-file-modes ,modes) + (unwind-protect + (progn ,@forms) + (set-default-file-modes modes)))) + +(defmacro eshell-with-private-file-modes (&rest forms) + "Evaluate FORMS with private file modes set." + `(eshell-with-file-modes ,eshell-private-file-modes ,@forms)) + +(defsubst eshell-make-private-directory (dir &optional parents) + "Make DIR with file-modes set to `eshell-private-directory-modes'." + (eshell-with-file-modes eshell-private-directory-modes + (make-directory dir parents))) + +(defsubst eshell-substring (string sublen) + "Return the beginning of STRING, up to SUBLEN bytes." + (if string + (if (> (length string) sublen) + (substring string 0 sublen) + string))) + +(unless (fboundp 'directory-files-and-attributes) + (defun directory-files-and-attributes (dir &optional full match nosort) + (documentation 'directory-files) + (let* ((dir (expand-file-name dir)) + (default-directory dir)) + (mapcar + (function + (lambda (file) + (cons file (file-attributes file)))) + (directory-files dir full match nosort))))) + +(defun eshell-directory-files-and-attributes (dir &optional full match nosort) + "Make sure to use the handler for `directory-file-and-attributes'." + (let ((dfh (find-file-name-handler dir 'directory-files))) + (if (not dfh) + (directory-files-and-attributes dir full match nosort) + (let* ((files (funcall dfh 'directory-files dir full match nosort)) + (fah (find-file-name-handler dir 'file-attributes)) + (default-directory (expand-file-name dir))) + (mapcar + (function + (lambda (file) + (cons file (funcall fah 'file-attributes file)))) + files))))) + +(defun eshell-copy-list (list) + "Return a copy of a list, which may be a dotted list. +The elements of the list are not copied, just the list structure itself." + (if (consp list) + (let ((res nil)) + (while (consp list) (push (pop list) res)) + (prog1 (nreverse res) (setcdr res list))) + (car list))) + +(defun eshell-copy-tree (tree &optional vecp) + "Make a copy of TREE. +If TREE is a cons cell, this recursively copies both its car and its cdr. +Contrast to copy-sequence, which copies only along the cdrs. With second +argument VECP, this copies vectors as well as conses." + (if (consp tree) + (let ((p (setq tree (eshell-copy-list tree)))) + (while (consp p) + (if (or (consp (car p)) (and vecp (vectorp (car p)))) + (setcar p (eshell-copy-tree (car p) vecp))) + (or (listp (cdr p)) (setcdr p (eshell-copy-tree (cdr p) vecp))) + (cl-pop p))) + (if (and vecp (vectorp tree)) + (let ((i (length (setq tree (copy-sequence tree))))) + (while (>= (setq i (1- i)) 0) + (aset tree i (eshell-copy-tree (aref tree i) vecp)))))) + tree) + +; (defun eshell-copy-file +; (file newname &optional ok-if-already-exists keep-date) +; "Copy FILE to NEWNAME. See docs for `copy-file'." +; (let (copied) +; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file) +; (let ((front (match-string 1 file)) +; (back (match-string 2 file)) +; buffer) +; (if (and front (string-match eshell-tar-regexp front) +; (setq buffer (find-file-noselect front))) +; (with-current-buffer buffer +; (goto-char (point-min)) +; (if (re-search-forward (concat " " (regexp-quote back) +; "$") nil t) +; (progn +; (tar-copy (if (file-directory-p newname) +; (expand-file-name +; (file-name-nondirectory back) newname) +; newname)) +; (setq copied t)) +; (error "%s not found in tar file %s" back front)))))) +; (unless copied +; (copy-file file newname ok-if-already-exists keep-date)))) + +; (defun eshell-file-attributes (filename) +; "Return a list of attributes of file FILENAME. +; See the documentation for `file-attributes'." +; (let (result) +; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename) +; (let ((front (match-string 1 filename)) +; (back (match-string 2 filename)) +; buffer) +; (when (and front (string-match eshell-tar-regexp front) +; (setq buffer (find-file-noselect front))) +; (with-current-buffer buffer +; (goto-char (point-min)) +; (when (re-search-forward (concat " " (regexp-quote back) +; "\\s-*$") nil t) +; (let* ((descrip (tar-current-descriptor)) +; (tokens (tar-desc-tokens descrip))) +; (setq result +; (list +; (cond +; ((eq (tar-header-link-type tokens) 5) +; t) +; ((eq (tar-header-link-type tokens) t) +; (tar-header-link-name tokens))) +; 1 +; (tar-header-uid tokens) +; (tar-header-gid tokens) +; (tar-header-date tokens) +; (tar-header-date tokens) +; (tar-header-date tokens) +; (tar-header-size tokens) +; (concat +; (cond +; ((eq (tar-header-link-type tokens) 5) "d") +; ((eq (tar-header-link-type tokens) t) "l") +; (t "-")) +; (tar-grind-file-mode (tar-header-mode tokens) +; (make-string 9 ? ) 0)) +; nil nil nil)))))))) +; (or result +; (file-attributes filename)))) + +;;; Code: + +;;; esh-util.el ends here |