1 ;;; esh-util --- general utilities
3 ;; Copyright (C) 1999, 2000 Free Software Foundation
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 ;; Boston, MA 02111-1307, USA.
24 (eval-when-compile (require 'esh-maint
))
26 (defgroup eshell-util nil
27 "This is general utility code, meant for use by Eshell itself."
28 :tag
"General utilities"
37 (defcustom eshell-group-file
"/etc/group"
38 "*If non-nil, the name of the group file on your system."
39 :type
'(choice (const :tag
"No group file" nil
) file
)
42 (defcustom eshell-passwd-file
"/etc/passwd"
43 "*If non-nil, the name of the passwd file on your system."
44 :type
'(choice (const :tag
"No passwd file" nil
) file
)
47 (defcustom eshell-hosts-file
"/etc/hosts"
48 "*The name of the /etc/hosts file."
49 :type
'(choice (const :tag
"No hosts file" nil
) file
)
52 (defcustom eshell-handle-errors t
53 "*If non-nil, Eshell will handle errors itself.
54 Setting this to nil is offered as an aid to debugging only."
58 (defcustom eshell-private-file-modes
384 ; umask 177
59 "*The file-modes value to use for creating \"private\" files."
63 (defcustom eshell-private-directory-modes
448 ; umask 077
64 "*The file-modes value to use for creating \"private\" directories."
68 (defcustom eshell-tar-regexp
69 "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
70 "*Regular expression used to match tar file names."
74 (defcustom eshell-convert-numeric-arguments t
75 "*If non-nil, converting arguments of numeric form to Lisp numbers.
76 Numeric form is tested using the regular expression
77 `eshell-number-regexp'."
81 (defcustom eshell-number-regexp
"\\(0\\|-?[1-9][0-9]*\\(\\.[0-9]+\\)?\\)"
82 "*Regular expression used to match numeric arguments.
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
85 function `string-to-number'."
89 ;;; Internal Variables:
91 (defvar eshell-group-names nil
92 "A cache to hold the names of groups.")
94 (defvar eshell-group-timestamp nil
95 "A timestamp of when the group file was read.")
97 (defvar eshell-user-names nil
98 "A cache to hold the names of users.")
100 (defvar eshell-user-timestamp nil
101 "A timestamp of when the user file was read.")
103 (defvar eshell-host-names nil
104 "A cache the names of frequently accessed hosts.")
106 (defvar eshell-host-timestamp nil
107 "A timestamp of when the hosts file was read.")
111 (defsubst eshell-under-xemacs-p
()
112 "Return non-nil if we are running under XEmacs."
113 (boundp 'xemacs-logo
))
115 (defsubst eshell-under-windows-p
()
116 "Return non-nil if we are running under MS-DOS/Windows."
117 (memq system-type
'(ms-dos windows-nt
)))
119 (defmacro eshell-condition-case
(tag form
&rest handlers
)
120 "Like `condition-case', but only if `eshell-pass-through-errors' is nil."
121 (if eshell-handle-errors
122 `(condition-case ,tag
127 (put 'eshell-condition-case
'lisp-indent-function
2)
129 (defmacro eshell-deftest
(module name label
&rest forms
)
130 (if (and (fboundp 'cl-compiling-file
) (cl-compiling-file))
132 (let ((fsym (intern (concat "eshell-test--" (symbol-name name
)))))
135 (defun ,fsym
() ,label
136 (eshell-run-test (quote ,module
) (quote ,fsym
) ,label
137 (quote (progn ,@forms
)))))))))
139 (put 'eshell-deftest
'lisp-indent-function
2)
141 (defun eshell-find-delimiter
142 (open close
&optional bound reverse-p backslash-p
)
143 "From point, find the CLOSE delimiter corresponding to OPEN.
144 The matching is bounded by BOUND.
145 If REVERSE-P is non-nil, process the region backwards.
146 If BACKSLASH-P is non-nil, and OPEN and CLOSE are the same character,
147 then quoting is done by a backslash, rather than a doubled delimiter."
150 (bound (or bound
(point-max))))
152 (eq (char-before) close
)
153 (eq (char-after) open
))
154 (forward-char (if reverse-p -
1 1)))
155 (while (and (> depth
0)
156 (funcall (if reverse-p
'> '<) (point) bound
))
157 (let ((c (if reverse-p
(char-before) (char-after))) nc
)
158 (cond ((and (not reverse-p
)
159 (or (not (eq open close
))
162 (setq nc
(char-after (1+ (point))))
163 (or (eq nc open
) (eq nc close
)))
166 (or (not (eq open close
))
168 (or (eq c open
) (eq c close
))
169 (eq (char-before (1- (point)))
174 (if (and (not backslash-p
)
176 (char-before (1- (point)))
177 (char-after (1+ (point)))) open
))
178 (forward-char (if reverse-p -
1 1))
179 (setq depth
(1- depth
)))))
181 (setq depth
(+ depth
(if reverse-p -
1 1))))
183 (setq depth
(+ depth
(if reverse-p
1 -
1))))))
184 (forward-char (if reverse-p -
1 1)))
186 (if reverse-p
(point) (1- (point)))))))
188 (defun eshell-convert (string)
189 "Convert STRING into a more native looking Lisp object."
190 (if (not (stringp string
))
192 (let ((len (length string
)))
195 (if (eq (aref string
(1- len
)) ?
\n)
196 (setq string
(substring string
0 (1- len
))))
197 (if (string-match "\n" string
)
198 (split-string string
"\n")
199 (if (and eshell-convert-numeric-arguments
201 (concat "\\`\\s-*" eshell-number-regexp
203 (string-to-number string
)
206 (defun eshell-sublist (l &optional n m
)
207 "Return from LIST the N to M elements.
208 If N or M is nil, it means the end of the list."
209 (let* ((a (eshell-copy-list l
))
211 (if (and m
(consp (nthcdr m a
)))
212 (setcdr (nthcdr m a
) nil
))
214 (setq a
(nthcdr n a
))
215 (setq n
(1- (length a
))
219 (defun eshell-split-path (path)
220 "Split a path into multiple subparts."
221 (let ((len (length path
))
224 (if (and (eshell-under-windows-p)
226 (eq (aref path
0) directory-sep-char
)
227 (eq (aref path
1) directory-sep-char
))
230 (if (and (eq (aref path i
) directory-sep-char
)
231 (not (get-text-property i
'escaped path
)))
232 (setq parts
(cons (if (= li i
)
233 (char-to-string directory-sep-char
)
234 (substring path li
(1+ i
))) parts
)
238 (setq parts
(cons (substring path li i
) parts
)))
239 (if (and (eshell-under-windows-p)
240 (string-match "\\`[A-Za-z]:\\'" (car (last parts
))))
242 (concat (car (last parts
))
243 (char-to-string directory-sep-char
))))
246 (defun eshell-to-flat-string (value)
247 "Make value a string. If separated by newlines change them to spaces."
248 (let ((text (eshell-stringify value
)))
249 (if (string-match "\n+\\'" text
)
250 (setq text
(replace-match "" t t text
)))
251 (while (string-match "\n+" text
)
252 (setq text
(replace-match " " t t text
)))
255 (defmacro eshell-for
(for-var for-list
&rest forms
)
256 "Iterate through a list"
257 `(let ((list-iter ,for-list
))
259 (let ((,for-var
(car list-iter
)))
261 (setq list-iter
(cdr list-iter
)))))
263 (put 'eshell-for
'lisp-indent-function
2)
265 (defun eshell-flatten-list (args)
266 "Flatten any lists within ARGS, so that there are no sublists."
267 (let ((new-list (list t
)))
271 (nconc new-list
(eshell-flatten-list a
))
272 (nconc new-list
(list a
))))
275 (defun eshell-uniqify-list (l)
276 "Remove occurring multiples in L. You probably want to sort first."
286 (defun eshell-stringify (object)
287 "Convert OBJECT into a string value."
289 ((stringp object
) object
)
291 (not (eq object nil
)))
292 (let ((string (pp-to-string object
)))
293 (substring string
0 (1- (length string
)))))
295 (number-to-string object
))
297 (pp-to-string object
))))
299 (defsubst eshell-stringify-list
(args)
300 "Convert each element of ARGS into a string value."
301 (mapcar 'eshell-stringify args
))
303 (defsubst eshell-flatten-and-stringify
(&rest args
)
304 "Flatten and stringify all of the ARGS into a single string."
305 (mapconcat 'eshell-stringify
(eshell-flatten-list args
) " "))
307 ;; the next two are from GNUS, and really should be made part of Emacs
309 (defsubst eshell-time-less-p
(t1 t2
)
310 "Say whether time T1 is less than time T2."
311 (or (< (car t1
) (car t2
))
312 (and (= (car t1
) (car t2
))
313 (< (nth 1 t1
) (nth 1 t2
)))))
315 (defsubst eshell-time-to-seconds
(time)
316 "Convert TIME to a floating point number."
317 (+ (* (car time
) 65536.0)
319 (/ (or (car (cdr (cdr time
))) 0) 1000000.0)))
321 (defsubst eshell-directory-files
(regexp &optional directory
)
322 "Return a list of files in the given DIRECTORY matching REGEXP."
323 (directory-files (or directory default-directory
)
326 (defun eshell-regexp-arg (prompt)
327 "Return list of regexp and prefix arg using PROMPT."
328 (let* (;; Don't clobber this.
329 (last-command last-command
)
330 (regexp (read-from-minibuffer prompt nil nil nil
331 'minibuffer-history-search-history
)))
332 (list (if (string-equal regexp
"")
333 (setcar minibuffer-history-search-history
334 (nth 1 minibuffer-history-search-history
))
336 (prefix-numeric-value current-prefix-arg
))))
338 (defun eshell-printable-size (filesize &optional human-readable
339 block-size use-colors
)
340 "Return a printable FILESIZE."
341 (let ((size (float (or filesize
0))))
343 (if (< size human-readable
)
344 (if (= (round size
) 0)
348 (format "%.0f" size
)))
349 (setq size
(/ size human-readable
))
350 (if (< size human-readable
)
352 (format "%.1fk" size
)
353 (format "%.0fk" size
))
354 (setq size
(/ size human-readable
))
355 (if (< size human-readable
)
356 (let ((str (if (<= size
9.94)
357 (format "%.1fM" size
)
358 (format "%.0fM" size
))))
360 (put-text-property 0 (length str
)
363 (setq size
(/ size human-readable
))
364 (if (< size human-readable
)
365 (let ((str (if (<= size
9.94)
366 (format "%.1fG" size
)
367 (format "%.0fG" size
))))
369 (put-text-property 0 (length str
)
370 'face
'bold-italic str
))
373 (setq size
(/ size block-size
)))
374 (format "%.0f" size
))))
376 (defun eshell-winnow-list (entries exclude
&optional predicates
)
377 "Pare down the ENTRIES list using the EXCLUDE regexp, and PREDICATES.
378 The original list is not affected. If the result is only one element
379 long, it will be returned itself, rather than returning a one-element
381 (let ((flist (list t
))
383 (unless (listp entries
)
384 (setq entries
(list entries
)
386 (eshell-for entry entries
387 (unless (and exclude
(string-match exclude entry
))
388 (setq p predicates valid
(null p
))
390 (if (funcall (car p
) entry
)
392 (setq p nil valid nil
))
395 (nconc flist
(list entry
)))))
400 (defsubst eshell-redisplay
()
401 "Allow Emacs to redisplay buffers."
402 ;; for some strange reason, Emacs 21 is prone to trigger an
403 ;; "args out of range" error in `sit-for', if this function
404 ;; runs while point is in the minibuffer and the users attempt
405 ;; to use completion. Don't ask me.
406 (ignore-errors (sit-for 0 0)))
408 (defun eshell-read-passwd-file (file)
409 "Return an alist correlating gids to group names in FILE."
411 (when (file-readable-p file
)
413 (insert-file-contents file
)
414 (goto-char (point-min))
417 (split-string (buffer-substring
418 (point) (progn (end-of-line)
420 (if (and (and fields
(nth 0 fields
) (nth 2 fields
))
421 (not (assq (string-to-int (nth 2 fields
)) names
)))
422 (setq names
(cons (cons (string-to-int (nth 2 fields
))
428 (defun eshell-read-passwd (file result-var timestamp-var
)
429 "Read the contents of /etc/passwd for user names."
430 (if (or (not (symbol-value result-var
))
431 (not (symbol-value timestamp-var
))
433 (symbol-value timestamp-var
)
434 (nth 5 (file-attributes file
))))
436 (set result-var
(eshell-read-passwd-file file
))
437 (set timestamp-var
(current-time))))
438 (symbol-value result-var
))
440 (defun eshell-read-group-names ()
441 "Read the contents of /etc/group for group names."
442 (if eshell-group-file
443 (eshell-read-passwd eshell-group-file
'eshell-group-names
444 'eshell-group-timestamp
)))
446 (defsubst eshell-group-id
(name)
447 "Return the user id for user NAME."
448 (car (rassoc name
(eshell-read-group-names))))
450 (defsubst eshell-group-name
(gid)
451 "Return the group name for the given GID."
452 (cdr (assoc gid
(eshell-read-group-names))))
454 (defun eshell-read-user-names ()
455 "Read the contents of /etc/passwd for user names."
456 (if eshell-passwd-file
457 (eshell-read-passwd eshell-passwd-file
'eshell-user-names
458 'eshell-user-timestamp
)))
460 (defsubst eshell-user-id
(name)
461 "Return the user id for user NAME."
462 (car (rassoc name
(eshell-read-user-names))))
464 (defalias 'eshell-user-name
'user-login-name
)
466 (defun eshell-read-hosts-file (filename)
467 "Read in the hosts from the /etc/hosts file."
470 (insert-file-contents eshell-hosts-file
)
471 (goto-char (point-min))
472 (while (re-search-forward
473 "^\\(\\S-+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t
)
475 (add-to-list 'hosts
(match-string 1)))
477 (add-to-list 'hosts
(match-string 2)))
479 (add-to-list 'hosts
(match-string 4)))))
480 (sort hosts
'string-lessp
)))
482 (defun eshell-read-hosts (file result-var timestamp-var
)
483 "Read the contents of /etc/passwd for user names."
484 (if (or (not (symbol-value result-var
))
485 (not (symbol-value timestamp-var
))
487 (symbol-value timestamp-var
)
488 (nth 5 (file-attributes file
))))
490 (set result-var
(eshell-read-hosts-file file
))
491 (set timestamp-var
(current-time))))
492 (symbol-value result-var
))
494 (defun eshell-read-host-names ()
495 "Read the contents of /etc/hosts for host names."
496 (if eshell-hosts-file
497 (eshell-read-hosts eshell-hosts-file
'eshell-host-names
498 'eshell-host-timestamp
)))
500 (unless (fboundp 'line-end-position
)
501 (defsubst line-end-position
(&optional N
)
502 (save-excursion (end-of-line N
) (point))))
504 (unless (fboundp 'line-beginning-position
)
505 (defsubst line-beginning-position
(&optional N
)
506 (save-excursion (beginning-of-line N
) (point))))
508 (unless (fboundp 'subst-char-in-string
)
509 (defun subst-char-in-string (fromchar tochar string
&optional inplace
)
510 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
511 Unless optional argument INPLACE is non-nil, return a new string."
512 (let ((i (length string
))
513 (newstr (if inplace string
(copy-sequence string
))))
516 (if (eq (aref newstr i
) fromchar
)
517 (aset newstr i tochar
)))
520 (defsubst eshell-copy-environment
()
521 "Return an unrelated copy of `process-environment'."
522 (mapcar 'concat process-environment
))
524 (defun eshell-subgroups (groupsym)
525 "Return all of the subgroups of GROUPSYM."
526 (let ((subgroups (get groupsym
'custom-group
))
529 (if (eq (cadr (car subgroups
)) 'custom-group
)
530 (nconc subg
(list (caar subgroups
))))
531 (setq subgroups
(cdr subgroups
)))
534 (defmacro eshell-with-file-modes
(modes &rest forms
)
535 "Evaluate, with file-modes set to MODES, the given FORMS."
536 `(let ((modes (default-file-modes)))
537 (set-default-file-modes ,modes
)
540 (set-default-file-modes modes
))))
542 (defmacro eshell-with-private-file-modes
(&rest forms
)
543 "Evaluate FORMS with private file modes set."
544 `(eshell-with-file-modes ,eshell-private-file-modes
,@forms
))
546 (defsubst eshell-make-private-directory
(dir &optional parents
)
547 "Make DIR with file-modes set to `eshell-private-directory-modes'."
548 (eshell-with-file-modes eshell-private-directory-modes
549 (make-directory dir parents
)))
551 (defsubst eshell-substring
(string sublen
)
552 "Return the beginning of STRING, up to SUBLEN bytes."
554 (if (> (length string
) sublen
)
555 (substring string
0 sublen
)
558 (unless (fboundp 'directory-files-and-attributes
)
559 (defun directory-files-and-attributes (dir &optional full match nosort
)
560 (documentation 'directory-files
)
561 (let* ((dir (expand-file-name dir
))
562 (default-directory dir
))
566 (cons file
(file-attributes file
))))
567 (directory-files dir full match nosort
)))))
569 (defun eshell-directory-files-and-attributes (dir &optional full match nosort
)
570 "Make sure to use the handler for `directory-file-and-attributes'."
571 (let ((dfh (find-file-name-handler dir
'directory-files
)))
573 (directory-files-and-attributes dir full match nosort
)
574 (let* ((files (funcall dfh
'directory-files dir full match nosort
))
575 (fah (find-file-name-handler dir
'file-attributes
))
576 (default-directory (expand-file-name dir
)))
580 (cons file
(funcall fah
'file-attributes file
))))
583 (defun eshell-copy-list (list)
584 "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."
588 (while (consp list
) (push (pop list
) res
))
589 (prog1 (nreverse res
) (setcdr res list
)))
592 (defun eshell-copy-tree (tree &optional vecp
)
593 "Make a copy of TREE.
594 If TREE is a cons cell, this recursively copies both its car and its cdr.
595 Contrast to copy-sequence, which copies only along the cdrs. With second
596 argument VECP, this copies vectors as well as conses."
598 (let ((p (setq tree
(eshell-copy-list tree
))))
600 (if (or (consp (car p
)) (and vecp
(vectorp (car p
))))
601 (setcar p
(eshell-copy-tree (car p
) vecp
)))
602 (or (listp (cdr p
)) (setcdr p
(eshell-copy-tree (cdr p
) vecp
)))
604 (if (and vecp
(vectorp tree
))
605 (let ((i (length (setq tree
(copy-sequence tree
)))))
606 (while (>= (setq i
(1- i
)) 0)
607 (aset tree i
(eshell-copy-tree (aref tree i
) vecp
))))))
610 (defsubst eshell-processp
(proc)
611 "If the `processp' function does not exist, PROC is not a process."
612 (and (fboundp 'processp
) (processp proc
)))
614 ; (defun eshell-copy-file
615 ; (file newname &optional ok-if-already-exists keep-date)
616 ; "Copy FILE to NEWNAME. See docs for `copy-file'."
618 ; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
619 ; (let ((front (match-string 1 file))
620 ; (back (match-string 2 file))
622 ; (if (and front (string-match eshell-tar-regexp front)
623 ; (setq buffer (find-file-noselect front)))
624 ; (with-current-buffer buffer
625 ; (goto-char (point-min))
626 ; (if (re-search-forward (concat " " (regexp-quote back)
629 ; (tar-copy (if (file-directory-p newname)
631 ; (file-name-nondirectory back) newname)
634 ; (error "%s not found in tar file %s" back front))))))
636 ; (copy-file file newname ok-if-already-exists keep-date))))
638 ; (defun eshell-file-attributes (filename)
639 ; "Return a list of attributes of file FILENAME.
640 ; See the documentation for `file-attributes'."
642 ; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
643 ; (let ((front (match-string 1 filename))
644 ; (back (match-string 2 filename))
646 ; (when (and front (string-match eshell-tar-regexp front)
647 ; (setq buffer (find-file-noselect front)))
648 ; (with-current-buffer buffer
649 ; (goto-char (point-min))
650 ; (when (re-search-forward (concat " " (regexp-quote back)
652 ; (let* ((descrip (tar-current-descriptor))
653 ; (tokens (tar-desc-tokens descrip)))
657 ; ((eq (tar-header-link-type tokens) 5)
659 ; ((eq (tar-header-link-type tokens) t)
660 ; (tar-header-link-name tokens)))
662 ; (tar-header-uid tokens)
663 ; (tar-header-gid tokens)
664 ; (tar-header-date tokens)
665 ; (tar-header-date tokens)
666 ; (tar-header-date tokens)
667 ; (tar-header-size tokens)
670 ; ((eq (tar-header-link-type tokens) 5) "d")
671 ; ((eq (tar-header-link-type tokens) t) "l")
673 ; (tar-grind-file-mode (tar-header-mode tokens)
674 ; (make-string 9 ? ) 0))
675 ; nil nil nil))))))))
677 ; (file-attributes filename))))
681 ;;; esh-util.el ends here