August 2008 - XEmacs-Patches - XEmacs Mailing List Archives

[PATCH] Add #'only-window-p, like #'one-window-p with explicit window 16 years, 3 months

Aidan Kehoe

# HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1220083463 -7200 # Node ID efdb818642191b13bdb1cebb6188f6ed8823cac1 # Parent b82fdf7305eef16a68a94d48a5b532a589f0e55b Add #'only-window-p, like #'one-window-p but passing the window explicitly. lisp/ChangeLog addition: 2008-08-30 Aidan Kehoe <kehoea(a)parhasard.net> * window.el (only-window-p): New. Check if WINDOW is the only window in some context, normally its frame. (one-window-p): Implemented this in terms of #'only-window-p, calling it on the selected window. diff -r b82fdf7305ee -r efdb81864219 lisp/ChangeLog --- a/lisp/ChangeLog Wed Aug 27 21:47:21 2008 +0200 +++ b/lisp/ChangeLog Sat Aug 30 10:04:23 2008 +0200 ＠＠ -1,3 +1,12 ＠＠ +2008-08-30 Aidan Kehoe <kehoea(a)parhasard.net> + + * window.el (only-window-p): New. + Check if WINDOW is the only window in some context, normally its + frame. + (one-window-p): + Implemented this in terms of #'only-window-p, calling it on the + selected window. + 2008-08-27 Aidan Kehoe <kehoea(a)parhasard.net> * subr.el (skip-chars-quote): diff -r b82fdf7305ee -r efdb81864219 lisp/window.el --- a/lisp/window.el Wed Aug 27 21:47:21 2008 +0200 +++ b/lisp/window.el Sat Aug 30 10:04:23 2008 +0200 ＠＠ -33,16 +33,19 ＠＠ ;;;; Window tree functions. -(defun one-window-p (&optional nomini which-frames which-devices) - "Return non-nil if the selected window is the only window (in its frame). -Optional arg NOMINI non-nil means don't count the minibuffer -even if it is active. +;; XEmacs addition, to expose WINDOW. +(defun only-window-p (&optional window nomini which-frames which-devices) + "Return non-nil if WINDOW is the only window in some context, +normally its frame. Optional arg NOMINI non-nil means don't count the +minibuffer even if it is active. -By default, only the windows in the selected frame are considered. -The optional argument WHICH-FRAMES changes this behavior: -WHICH-FRAMES nil or omitted means count only the selected frame, +The optional argument WHICH-FRAMES changes the frames that are considered: + +WHICH-FRAMES nil or omitted means count only WINDOW's frame, plus the minibuffer it uses (which may be on another frame). -WHICH-FRAMES = `visible' means include windows on all visible frames. +\(But, for all values of WHICH-FRAMES, see the documentation for the +WHICH-DEVICES argument.) +WHICH-FRAMES = `visible' means include windows on all visible frames WHICH-FRAMES = 0 means include windows on all visible and iconified frames. WHICH-FRAMES = t means include windows on all frames including invisible frames. If WHICH-FRAMES is any other value, count only the selected frame. ＠＠ -56,11 +59,19 ＠＠ If a device type, search all devices of that type. If `window-system', search all devices on window-system consoles. Any other non-nil value means search all devices." - (let ((base-window (selected-window))) - (if (and nomini (eq base-window (minibuffer-window))) + (let ((base-window (or window (selected-window)))) + (if (and nomini (eq base-window + (minibuffer-window (window-frame base-window)))) (setq base-window (next-window base-window))) (eq base-window (next-window base-window (if nomini 'arg) which-frames which-devices)))) + +(defun one-window-p (&optional nomini which-frames which-devices) + "Return the result of calling `only-window-p' on the selected window. + +See that function's documentation for the meaning of the NOMINI, +WHICH-FRAMES and WHICH-DEVICES arguments." + (only-window-p (selected-window) nomini which-frames which-devices)) (defun walk-windows (function &optional minibuf which-frames which-devices) "Cycle through all visible windows, calling FUNCTION for each one. -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

1 participants
0 comments

[PATCH] Add window-utils.el with resize-temp-buffer-window to xemacs-base. 16 years, 3 months

Aidan Kehoe

Ar an naoú lá is fiche de mí Lúnasa, scríobh It's me FKtPp ;): > On Thu, Aug 28, 2008 at 01:10:57PM +0200, Aidan Kehoe wrote: > > > > Ar an t-ochtú lá is fiche de mí Lúnasa, scríobh Stephen J. Turnbull: > > > > > How about xemacs-base/window-utils.el? > > > > Sounds good to me! > > > > When will we have this windows-utils.el then? Soon. This is a first draught, with the bug that temp-buffer-show-hook is normally ignored in both 21.4 and 21.5; it seems to be necessary to set a new value for temp-buffer-show-function, probably with the contents ofs #'show-temp-buffer-in-current-frame included. 2008-08-29 Aidan Kehoe <kehoea(a)parhasard.net> * window-utils.el: New. Import some functions from window.el and help.el in GNU. In particular window-buffer-height, count-screen-lines, fit-window-to-buffer, temp-buffer-resize-mode, resize-temp-buffer-window. Also the customizable variable temp-buffer-show-height. * Makefile: Add window-utils.elc. XEmacs Packages source patch: Diff command: cvs -q diff -Nu Files affected: xemacs-packages/xemacs-base/window-utils.el =================================================================== RCS xemacs-packages/xemacs-base/Makefile =================================================================== RCS Index: xemacs-packages/xemacs-base/Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xemacs-base/Makefile,v retrieving revision 1.124 diff -u -u -r1.124 Makefile --- xemacs-packages/xemacs-base/Makefile 2008/07/23 18:12:32 1.124 +++ xemacs-packages/xemacs-base/Makefile 2008/08/28 22:39:58 ＠＠ -38,7 +38,7 ＠＠ helper.elc imenu.elc iso-syntax.elc macros.elc novice.elc outline.elc \ passwd.elc pp.elc regexp-opt.elc regi.elc ring.elc shell.elc \ skeleton.elc sort.elc thing.elc time-stamp.elc timer-funcs.elc \ - timezone.elc tq.elc xbm-button.elc xpm-button.elc + timezone.elc tq.elc xbm-button.elc xpm-button.elc window-utils.elc DATA_FILES = etc/enriched.doc DATA_DEST = . Index: xemacs-packages/xemacs-base/window-utils.el =================================================================== RCS file: window-utils.el diff -N window-utils.el --- /dev/null Fri Aug 29 00:39:56 2008 +++ window-utils.el Fri Aug 29 00:39:58 2008 ＠＠ -0,0 +1,216 ＠＠ +;;; window-util.el + +;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, +;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. + +;; Maintainer: FSF +;; Keywords: help, windows + +;; XEmacs 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. + +;; XEmacs 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 XEmacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Synched up with: help.el revision 1.327 in GNU Emacs, of 2007-03-21, the +;;; last GPLV2 version. The initial defun-when-void functions are from their +;;; window.el, version 1.122, also the last GPLV2 version. + +;;; Commentary: + +;; This is some code that's in help.el in GNU. That file is in core in +;; XEmacs, and this functionality is nothing complex and should be available +;; to both stable and beta XEmacs. + +;; Supporting code is taken from their window.el. + +;;; Code: + +;; XEmacs: from + +(defun-when-void window-buffer-height (window) + "Return the height (in screen lines) of the buffer that WINDOW is displaying." + (with-current-buffer (window-buffer window) + (max 1 + (count-screen-lines (point-min) (point-max) + ;; If buffer ends with a newline, ignore it when + ;; counting height unless point is after it. + (eobp) + window)))) + +(defun-when-void count-screen-lines (&optional beg end count-final-newline + window) + "Return the number of screen lines in the region. +The number of screen lines may be different from the number of actual lines, +due to line breaking, display table, etc. + +Optional arguments BEG and END default to `point-min' and `point-max' +respectively. + +If region ends with a newline, ignore it unless optional third argument +COUNT-FINAL-NEWLINE is non-nil. + +The optional fourth argument WINDOW specifies the window used for obtaining +parameters such as width, horizontal scrolling, and so on. The default is +to use the selected window's parameters. + +Like `vertical-motion', `count-screen-lines' always uses the current buffer, +regardless of which buffer is displayed in WINDOW. This makes possible to use +`count-screen-lines' in any buffer, whether or not it is currently displayed +in some window." + (unless beg + (setq beg (point-min))) + (unless end + (setq end (point-max))) + (if (= beg end) + 0 + (save-excursion + (save-restriction + (widen) + (narrow-to-region (min beg end) + (if (and (not count-final-newline) + (= ?\n (char-before (max beg end)))) + (1- (max beg end)) + (max beg end))) + (goto-char (point-min)) + (1+ (vertical-motion (buffer-size) window)))))) + +(defun-when-void fit-window-to-buffer (&optional window max-height min-height) + "Make WINDOW the right height to display its contents exactly. +If WINDOW is omitted or nil, it defaults to the selected window. +If the optional argument MAX-HEIGHT is supplied, it is the maximum height + the window is allowed to be, defaulting to the frame height. +If the optional argument MIN-HEIGHT is supplied, it is the minimum + height the window is allowed to be, defaulting to `window-min-height'. + +The heights in MAX-HEIGHT and MIN-HEIGHT include the mode-line and/or +header-line." + (interactive) + + (when (null window) + (setq window (selected-window))) + (when (null max-height) + (setq max-height (frame-height (window-frame window)))) + + (let* ((buf + ;; Buffer that is displayed in WINDOW + (window-buffer window)) + (window-height + ;; The current height of WINDOW + (window-height window)) + (desired-height + ;; The height necessary to show the buffer displayed by WINDOW + ;; (`count-screen-lines' always works on the current buffer). + (with-current-buffer buf + (+ (count-screen-lines) + ;; If the buffer is empty, (count-screen-lines) is + ;; zero. But, even in that case, we need one text line + ;; for cursor. + (if (= (point-min) (point-max)) + 1 0) + ;; For non-minibuffers, count the mode-line, if any + (if (and (not (window-minibuffer-p window)) + mode-line-format) + 1 0) + ;; Count the header-line, if any + ;; XEmacs change; we don't have header-line-format. + ;; (if header-line-format 1 0)))) + (if (specifier-instance top-gutter) 1 0)))) + (delta + ;; Calculate how much the window height has to change to show + ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT. + (- (max (min desired-height max-height) + (or min-height window-min-height)) + window-height))) + + ;; Don't try to redisplay with the cursor at the end + ;; on its own line--that would force a scroll and spoil things. + (when (with-current-buffer buf + (and (eobp) (bolp) (not (bobp)))) + (set-window-point window (1- (window-point window)))) + + (save-selected-window + (select-window window) + + ;; Adjust WINDOW to the nominally correct size (which may actually + ;; be slightly off because of variable height text, etc). + (unless (zerop delta) + (enlarge-window delta)) + + ;; Check if the last line is surely fully visible. If not, + ;; enlarge the window. + (let ((end (with-current-buffer buf + (save-excursion + (goto-char (point-max)) + (when (and (bolp) (not (bobp))) + ;; Don't include final newline + (backward-char 1)) + (when truncate-lines + ;; If line-wrapping is turned off, test the + ;; beginning of the last line for visibility + ;; instead of the end, as the end of the line + ;; could be invisible by virtue of extending past + ;; the edge of the window. + (forward-line 0)) + (point)))) + ;; XEmacs change; bind window-pixel-vscroll-increment, we don't + ;; have #'set-window-vscroll. + (window-pixel-scroll-increment 0)) + ; (set-window-vscroll window 0) + (while (and (< desired-height max-height) + (= desired-height (window-height window)) + (not (pos-visible-in-window-p end window))) + (enlarge-window 1) + (setq desired-height (1+ desired-height))))))) + + +;;; Automatic resizing of temporary buffers. + +(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2)) + "Maximum height of a window displaying a temporary buffer. +This is effective only when Temp Buffer Resize mode is enabled. +The value is the maximum height (in lines) which `resize-temp-buffer-window' +will give to a window displaying a temporary buffer. +It can also be a function to be called to choose the height for such a buffer. +It gets one argumemt, the buffer, and should return a positive integer." +:type '(choice integer function) +:group 'help + ;; :version "20.4" + ) + +(define-minor-mode temp-buffer-resize-mode + "Toggle the mode which makes windows smaller for temporary buffers. +With prefix argument ARG, turn the resizing of windows displaying temporary +buffers on if ARG is positive or off otherwise. +This makes the window the right height for its contents, but never +more than `temp-buffer-max-height' nor less than `window-min-height'. +This applies to `help', `apropos' and `completion' buffers, and some others." +:global t :group 'help + (if temp-buffer-resize-mode + ;; `help-make-xrefs' may add a `back' button and thus increase the + ;; text size, so `resize-temp-buffer-window' must be run *after* it. + (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append) + (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window))) + +(defun resize-temp-buffer-window () + "Resize the current window to fit its contents. +Will not make it higher than `temp-buffer-max-height' nor smaller than +`window-min-height'. Do nothing if it is the only window on its frame, if it +is not as wide as the frame or if some of the window's contents are scrolled +out of view." + (unless (or (one-window-p 'nomini) + (not (pos-visible-in-window-p (point-min))) + (/= (frame-width) (window-width))) + (fit-window-to-buffer + (selected-window) + (if (functionp temp-buffer-max-height) + (funcall temp-buffer-max-height (current-buffer)) + temp-buffer-max-height)))) + -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

1 participants
0 comments

Re: [COMMIT] sync up with latest GPLv2 version of eshell-mode (2.4.2) 16 years, 3 months

Aidan Kehoe

Ar an seachtú lá is fiche de mí Lúnasa, scríobh FKtPp: > Since there are more than one package use [#'resize-temp-buffer-window]. > I suggest to add it to fsf-compat package. > > What's your opinion? fsf-compat is for things like overlays and GNU's timers, where we have implemented the functionality ourselves and the GNU approach is slightly different. For things that we haven't implemented at all, it's more appropriate to put it elsewhere--help.el (where the code is in GNU) is in core, though, and there's nothing 21.5-specific about it, it would be better in xemacs-base somewhere. Maybe in a file on its own, none of the current files there seem like an expected home for it to me. -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

1 participants
0 comments

Re: [COMMIT] sync up with latest GPLv2 version of eshell-mode (2.4.2) 16 years, 3 months

Aidan Kehoe

Ar an seachtú lá is fiche de mí Lúnasa, scríobh Aidan Kehoe: > APPROVE COMMIT > > NOTE: This patch has been committed. One thing we should have mentioned somewhere was the #'resize-temp-buffer-window workaround, by the way, which you discuss with Jerry here: http://thread.gmane.org/gmane.emacs.xemacs.beta/27234 Jerry, any progress on this? -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

1 participants
0 comments

[COMMIT] Add a make-temp-file wrapper, comment on some incompatibilities, eshell 16 years, 3 months

Aidan Kehoe

There were some incompatibilities in FKtPp’s merge, indicated in the byte-compile warnings. This changes addresses (or indicates the lack of addressing, but that should be for marginal functionality) them. APPROVE COMMIT NOTE: This patch has been committed. xemacs-packages/eshell/ChangeLog addition: 2008-08-27 Aidan Kehoe <kehoea(a)parhasard.net> * esh-test.el (eshell-test-goto-func): (eshell-show-usage-metrics): * esh-cmd.el (eshell-find-alias-function): Comment on some code that will fail under XEmacs. * esh-var.el (esh-make-temp-file-1): New. Add a #'make-temp-file substitute from GNUs, to use on 21.4 where #'make-temp-file is not available. * esh-var.el (eshell-parse-variable-ref): Use it. XEmacs Packages source patch: Diff command: cvs -q diff -Nu Files affected: xemacs-packages/eshell/esh-var.el =================================================================== RCS xemacs-packages/eshell/esh-test.el =================================================================== RCS xemacs-packages/eshell/esh-cmd.el =================================================================== Index: xemacs-packages/eshell/esh-cmd.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-cmd.el,v retrieving revision 1.2 diff -u -u -r1.2 esh-cmd.el --- xemacs-packages/eshell/esh-cmd.el 2008/08/27 21:26:33 1.2 +++ xemacs-packages/eshell/esh-cmd.el 2008/08/27 21:33:04 ＠＠ -1287,7 +1287,8 ＠＠ (defun eshell-find-alias-function (name) "Check whether a function called `eshell/NAME' exists." (let* ((sym (intern-soft (concat "eshell/" name))) - (file (symbol-file sym 'defun))) + ;;; #### XEmacs; 21.4 doesn't accept the second argument. + (file (symbol-file sym))) ;; 'defun))) ;; If the function exists, but is defined in an eshell module ;; that's not currently enabled, don't report it as found (if (and file Index: xemacs-packages/eshell/esh-test.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-test.el,v retrieving revision 1.2 diff -u -u -r1.2 esh-test.el --- xemacs-packages/eshell/esh-test.el 2008/08/27 21:26:34 1.2 +++ xemacs-packages/eshell/esh-test.el 2008/08/27 21:33:04 ＠＠ -128,6 +128,7 ＠＠ (let ((fsym (get-text-property (point) 'test-func))) (when fsym (let* ((def (symbol-function fsym)) + ;;; #### XEmacs; 21.4 doesn't accept the second argument. (library (locate-library (symbol-file fsym 'defun))) (name (substring (symbol-name fsym) (length "eshell-test--"))) ＠＠ -214,6 +215,7 ＠＠ (lambda () (setq eshell-metric-before-command (if (eq eshell-show-usage-metrics t) + ;;; #### XEmacs; we don't support this. (car (memory-use-counts)) (current-time))))) nil t) Index: xemacs-packages/eshell/esh-var.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-var.el,v retrieving revision 1.2 diff -u -u -r1.2 esh-var.el --- xemacs-packages/eshell/esh-var.el 2008/08/27 21:26:34 1.2 +++ xemacs-packages/eshell/esh-var.el 2008/08/27 21:33:04 ＠＠ -121,6 +121,69 ＠＠ (require 'env) (require 'ring) +;; XEmacs change; taken from Gnus. Remove once support for 21.4 is dropped. +(defun esh-make-temp-file-1 (prefix &optional dir-flag suffix) + "Create a temporary file. +The returned file name (created by appending some random characters at the end +of PREFIX, and expanding against `temporary-file-directory' if necessary), +is guaranteed to point to a newly created empty file. +You can then use `write-region' to write new data into the file. + +If DIR-FLAG is non-nil, create a new empty directory instead of a file. + +If SUFFIX is non-nil, add that at the end of the file name." + (let ((umask (default-file-modes)) + file) + (unwind-protect + (progn + ;; Create temp files with strict access rights. It's easy to + ;; loosen them later, whereas it's impossible to close the + ;; time-window of loose permissions otherwise. + (set-default-file-modes 448) + (while (condition-case err + (progn + (setq file + (make-temp-name + (expand-file-name + prefix + (if (fboundp 'temp-directory) + ;; XEmacs + (temp-directory) + temporary-file-directory)))) + (if suffix + (setq file (concat file suffix))) + (if dir-flag + (make-directory file) + (if (or (featurep 'xemacs) + (= emacs-major-version 20)) + ;; NOTE: This is unsafe if Emacs 20 + ;; users and XEmacs users don't use + ;; a secure temp directory. + (if (file-exists-p file) + (signal 'file-already-exists + (list "File exists" file)) + (write-region "" nil file nil 'silent)) + (write-region "" nil file nil 'silent + nil 'excl))) + nil) + (file-already-exists t) + ;; The Emacs 20 and XEmacs versions of + ;; `make-directory' issue `file-error'. + (file-error (or (and (or (featurep 'xemacs) + (= emacs-major-version 20)) + (file-exists-p file)) + (signal (car err) (cdr err))))) + ;; the file was somehow created by someone else between + ;; `make-temp-name' and `write-region', let's try again. + nil) + file) + ;; Reset the umask. + (set-default-file-modes umask)))) + +(defalias 'esh-make-temp-file + (or (and (fboundp 'make-temp-file) 'make-temp-file) + 'esh-make-temp-file-1)) + ;;; User Variables: (defcustom eshell-var-load-hook '(eshell-var-initialize) ＠＠ -438,7 +501,10 ＠＠ (let ((end (eshell-find-delimiter ?\< ?\>))) (if (not end) (throw 'eshell-incomplete ?\<) - (let* ((temp (make-temp-file temporary-file-directory)) + ;; XEmacs change: + (let* ((temp (esh-make-temp-file + (if (fboundp 'temp-directory) (temp-directory) + temporary-file-directory))) (cmd (concat (buffer-substring (1+ (point)) end) " > " temp))) (prog1 -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

1 participants
0 comments

[COMMIT] sync up with latest GPLv2 version of eshell-mode (2.4.2) 16 years, 3 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed. Ar an t-ochtú lá is fiche de mí Lúnasa, scríobh It's me FKtPp ;): > On Tue, Aug 26, 2008 at 11:25:24PM +0200, Aidan Kehoe wrote: > > > > Hi, FKtPp -- > > > > I get a collection of failures merging whitespace when I apply your patch; > > it’s whitespace problems mostly, where you’ve commented out, for example: > > > > :link '(info-link "(eshell)Command aliases") > > > > I could work around this, but it would be safer (= less likelihood of my > > making mistakes) if you could send the changes as an attachment in a .bz2 > > file, so your mail client doesn’t do its own whitespace transformation. > > I'am sorry for that, please find the attached reworked-patch in gzip > format. In this patch I've reverted the Makefile changes. -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit: Correct the implementation, add a few basic tests for #'skip-chars-quote. 16 years, 3 months

Aidan Kehoe

changeset: 4504:b82fdf7305eef16a68a94d48a5b532a589f0e55b tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net> date: Wed Aug 27 21:47:21 2008 +0200 files: lisp/ChangeLog lisp/subr.el tests/ChangeLog tests/automated/regexp-tests.el description: Correct the implementation, add a few basic tests for #'skip-chars-quote. tests/ChangeLog addition: 2008-08-27 Aidan Kehoe <kehoea(a)parhasard.net> * automated/regexp-tests.el: Add a few basic #'skip-chars-forward, #'skip-chars-backward tests. lisp/ChangeLog addition: 2008-08-27 Aidan Kehoe <kehoea(a)parhasard.net> * subr.el (skip-chars-quote): Correct the implementation, following the docstring of #'skip-char-forward more closely rather than the documentation of character classes in the Lispref. diff -r af95657e0bfdbc887ab4900b5627cbaaf21e112a -r b82fdf7305eef16a68a94d48a5b532a589f0e55b lisp/ChangeLog --- a/lisp/ChangeLog Wed Aug 27 00:39:09 2008 +0200 +++ b/lisp/ChangeLog Wed Aug 27 21:47:21 2008 +0200 ＠＠ -1,3 +1,10 ＠＠ 2008-08-23 Aidan Kehoe <kehoea＠parhasa +2008-08-27 Aidan Kehoe <kehoea(a)parhasard.net> + + * subr.el (skip-chars-quote): + Correct the implementation, following the docstring of + #'skip-char-forward more closely rather than the documentation of + character classes in the Lispref. + 2008-08-23 Aidan Kehoe <kehoea(a)parhasard.net> * custom.el: Move #'custom-variable-p to C, since it's now called diff -r af95657e0bfdbc887ab4900b5627cbaaf21e112a -r b82fdf7305eef16a68a94d48a5b532a589f0e55b lisp/subr.el --- a/lisp/subr.el Wed Aug 27 00:39:09 2008 +0200 +++ b/lisp/subr.el Wed Aug 27 21:47:21 2008 +0200 ＠＠ -1730,17 +1730,15 ＠＠ Ranges and carets are not treated specia Ranges and carets are not treated specially. This implementation is in Lisp; do not use it in performance-critical code." (let ((list (delete-duplicates (string-to-list string) :test #'=))) - (when (equal list '((?- ?\[) (?\[ ?\-))) - (error 'invalid-argument - "Cannot create `skip-chars-forward' arg from string" - string)) - (when (memq ?\] list) - (setq list (cons ?\] (delq ?\] list)))) - (when (eq ?^ (car list)) - (setq list (nconc (cdr list) '(?^)))) - (when (memq ?- list) - (setq list (delq ?- list) - list (nconc list (list (second list) ?- (second list) ?-)))) + (when (/= 1 (length list)) ;; No quoting needed in a string of length 1. + (when (eq ?^ (car list)) + (setq list (nconc (cdr list) '(?^)))) + (when (memq ?\\ list) + (setq list (delq ?\\ list) + list (nconc (list ?\\ ?\\) list))) + (when (memq ?- list) + (setq list (delq ?- list) + list (nconc list '(?\\ ?-))))) (apply #'string list))) ;;; subr.el ends here diff -r af95657e0bfdbc887ab4900b5627cbaaf21e112a -r b82fdf7305eef16a68a94d48a5b532a589f0e55b tests/ChangeLog --- a/tests/ChangeLog Wed Aug 27 00:39:09 2008 +0200 +++ b/tests/ChangeLog Wed Aug 27 21:47:21 2008 +0200 ＠＠ -1,3 +1,9 ＠＠ 2008-08-10 Aidan Kehoe <kehoea＠parhasa +2008-08-27 Aidan Kehoe <kehoea(a)parhasard.net> + + * automated/regexp-tests.el: + Add a few basic #'skip-chars-forward, #'skip-chars-backward + tests. + 2008-08-10 Aidan Kehoe <kehoea(a)parhasard.net> * automated/mule-tests.el (featurep): Update the list of character diff -r af95657e0bfdbc887ab4900b5627cbaaf21e112a -r b82fdf7305eef16a68a94d48a5b532a589f0e55b tests/automated/regexp-tests.el --- a/tests/automated/regexp-tests.el Wed Aug 27 00:39:09 2008 +0200 +++ b/tests/automated/regexp-tests.el Wed Aug 27 21:47:21 2008 +0200 ＠＠ -522,6 +522,22 ＠＠ baaaa 2)) ))) +;; Not very comprehensive tests of skip-chars-forward, skip-chars-background: + +(with-string-as-buffer-contents + "-]-----------------------------][]]------------------------" + (skip-chars-forward (skip-chars-quote "-[]")) + (Assert (= (point) (point-max))) + (skip-chars-backward (skip-chars-quote "-[]")) + (Assert (= (point) (point-min))) + ;; Testing in passing for an old bug in #'skip-chars-forward where I + ;; thought it was impossible to call it with a string containing only ?- + ;; and ?]: + (Assert (= (skip-chars-forward (skip-chars-quote "-]")) + (position ?[ (buffer-string) :test #'=))) + ;; This used to error, incorrectly: + (Assert (skip-chars-quote "[-"))) + ;; replace-match (REPLACEMENT &optional FIXEDCASE LITERAL STRING STRBUFFER) ;; #### Write some tests! Much functionality is implicitly tested above _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit: Use EQ() and !EQ() in symbols.c, thank you Robert Delius Royar. 16 years, 4 months

Aidan Kehoe

changeset: 4503:af95657e0bfdbc887ab4900b5627cbaaf21e112a tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net> date: Wed Aug 27 00:39:09 2008 +0200 files: src/ChangeLog src/symbols.c description: Use EQ() and !EQ() in symbols.c, thank you Robert Delius Royar. 2008-08-27 Aidan Kehoe <kehoea(a)parhasard.net> * symbols.c (Fuser_variable_p): (map_varalias_chain): Use EQ() and !EQ(), don't compare two Lisp_Objects using == and !=. Fixes the union build, thank you Robert Delius Royar. diff -r 8748a3f7ceb4d37b2a73b7fcbd8256a05e0b666c -r af95657e0bfdbc887ab4900b5627cbaaf21e112a src/ChangeLog --- a/src/ChangeLog Sat Aug 23 16:38:51 2008 +0200 +++ b/src/ChangeLog Wed Aug 27 00:39:09 2008 +0200 ＠＠ -1,3 +1,10 ＠＠ 2008-08-23 Aidan Kehoe <kehoea＠parhasa +2008-08-27 Aidan Kehoe <kehoea(a)parhasard.net> + + * symbols.c (Fuser_variable_p): + (map_varalias_chain): + Use EQ() and !EQ(), don't compare two Lisp_Objects using == and + !=. Fixes the union build, thank you Robert Delius Royar. + 2008-08-23 Aidan Kehoe <kehoea(a)parhasard.net> * eval.c (Fuser_variable_p): Moved to symbols.c diff -r 8748a3f7ceb4d37b2a73b7fcbd8256a05e0b666c -r af95657e0bfdbc887ab4900b5627cbaaf21e112a src/symbols.c --- a/src/symbols.c Sat Aug 23 16:38:51 2008 +0200 +++ b/src/symbols.c Wed Aug 27 00:39:09 2008 +0200 ＠＠ -2823,7 +2823,7 ＠＠ this error if you really want to avoid t return Qnil; } - assert (make_int (1) == mapped); + assert (EQ (make_int (1), mapped)); return Qt; } ＠＠ -3247,7 +3247,7 ＠＠ map_varalias_chain (Lisp_Object symbol, count++) { res = (fn) (hare); - if (Qzero != res) + if (!EQ (Qzero, res)) { return res; } _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

1 participants
0 comments

[PATCH] sync up with latest GPLv2 version of eshell-mode (2.4.2) 16 years, 4 months

FKtPp

Hi all, I've merged the latest GPLv2 version of eshell with our one. Here's the result patch. Can you help evaluate and commit to package reporsitory? Note, this sync-up also fixed Issue67 in our tracker. Thanks, FKtPp ChangeLog addition: 2008-08-19 It's me FKtPp ;) <m_pupil(a)yahoo.com.cn> * Upstream version 2.4.2 (the last GPLv2 version avaiable, savannah git version tag: 0fc80a3f6bb3bb59f42e9ff83cc8b89bf90fe658). eshell[Packages] source patch: Diff command: cvs -q diff -u Files affected: eshell.el =================================================================== RCS esh-var.el =================================================================== RCS esh-util.el =================================================================== RCS esh-test.el =================================================================== RCS esh-proc.el =================================================================== RCS esh-opt.el =================================================================== RCS esh-module.el =================================================================== RCS esh-mode.el =================================================================== RCS esh-maint.el =================================================================== RCS esh-io.el =================================================================== RCS esh-ext.el =================================================================== RCS esh-cmd.el =================================================================== RCS esh-arg.el =================================================================== RCS em-xtra.el =================================================================== RCS em-unix.el =================================================================== RCS em-term.el =================================================================== RCS em-smart.el =================================================================== RCS em-script.el =================================================================== RCS em-rebind.el =================================================================== RCS em-prompt.el =================================================================== RCS em-pred.el =================================================================== RCS em-ls.el =================================================================== RCS em-hist.el =================================================================== RCS em-glob.el =================================================================== RCS em-dirs.el =================================================================== RCS em-cmpl.el =================================================================== RCS em-basic.el =================================================================== RCS em-banner.el =================================================================== RCS em-alias.el =================================================================== RCS Makefile =================================================================== RCS Index: Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/Makefile,v retrieving revision 1.22 diff -u -r1.22 Makefile --- Makefile 2008/07/10 21:08:32 1.22 +++ Makefile 2008/08/19 15:54:58 ＠＠ -17,9 +17,9 ＠＠ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. -VERSION = 1.13 +VERSION = 1.14 # eshell is now integrated in GNU Emacs, versioning may need to change -AUTHOR_VERSION = 2.4.1 +AUTHOR_VERSION = 2.4.2 MAINTAINER = XEmacs Dev Team <xemacs-beta(a)xemacs.org> PACKAGE = eshell PKG_TYPE = regular Index: em-alias.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-alias.el,v retrieving revision 1.1 diff -u -r1.1 em-alias.el --- em-alias.el 2001/01/10 02:52:42 1.1 +++ em-alias.el 2008/08/19 15:54:59 ＠＠ -1,6 +1,7 ＠＠ -;;; em-alias --- creation and management of command aliases +;;; em-alias.el --- creation and management of command aliases -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-alias) ＠＠ -28,7 +29,7 ＠＠ (defgroup eshell-alias nil "Command aliases allow for easy definition of alternate commands." :tag "Command aliases" -:link '(info-link "(eshell)Command aliases") + ;; :link '(info-link "(eshell)Command aliases") :group 'eshell-module) ;;; Commentary: ＠＠ -103,7 +104,7 ＠＠ (defcustom eshell-bad-command-tolerance 3 "*The number of failed commands to ignore before creating an alias." :type 'integer -:link '(custom-manual "(eshell)Auto-correction of bad commands") + ;; :link '(custom-manual "(eshell)Auto-correction of bad commands") :group 'eshell-alias) ;;; ＠＠ -147,16 +148,14 ＠＠ (defun eshell-alias-initialize () "Initialize the alias handling code." (make-local-variable 'eshell-failed-commands-alist) - (make-local-hook 'eshell-alternate-command-hook) (add-hook 'eshell-alternate-command-hook 'eshell-fix-bad-commands t t) (eshell-read-aliases-list) - (make-local-hook 'eshell-named-command-hook) (add-hook 'eshell-named-command-hook 'eshell-maybe-replace-by-alias t t) (make-local-variable 'eshell-complex-commands) (add-to-list 'eshell-complex-commands 'eshell-command-aliased-p)) (defun eshell-command-aliased-p (name) - (member name eshell-command-aliases-list)) + (assoc name eshell-command-aliases-list)) (defun eshell/alias (&optional alias &rest definition) "Define an ALIAS in the user's alias list using DEFINITION." Index: em-banner.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-banner.el,v retrieving revision 1.1 diff -u -r1.1 em-banner.el --- em-banner.el 2001/01/10 02:52:43 1.1 +++ em-banner.el 2008/08/19 15:54:59 ＠＠ -1,6 +1,7 ＠＠ -;;; em-banner --- sample module that displays a login banner +;;; em-banner.el --- sample module that displays a login banner -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-banner) ＠＠ -30,7 +31,7 ＠＠ It exists so that others wishing to create their own Eshell extension modules may have a simple template to begin with." :tag "Login banner" -:link '(info-link "(eshell)Login banner") + ;; :link '(info-link "(eshell)Login banner") :group 'eshell-module) ;;; Commentary: Index: em-basic.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-basic.el,v retrieving revision 1.1 diff -u -r1.1 em-basic.el --- em-basic.el 2001/01/10 02:52:43 1.1 +++ em-basic.el 2008/08/19 15:54:59 ＠＠ -1,6 +1,7 ＠＠ -;;; em-basic --- basic shell builtin commands +;;; em-basic.el --- basic shell builtin commands -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-basic) Index: em-cmpl.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-cmpl.el,v retrieving revision 1.1 diff -u -r1.1 em-cmpl.el --- em-cmpl.el 2001/01/10 02:52:44 1.1 +++ em-cmpl.el 2008/08/19 15:54:59 ＠＠ -1,6 +1,7 ＠＠ -;;; em-cmpl --- completion using the TAB key +;;; em-cmpl.el --- completion using the TAB key -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,12 +19,13 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-cmpl) (eval-when-compile (require 'esh-maint)) +(require 'esh-util) (defgroup eshell-cmpl nil "This module provides a programmable completion function bound to ＠＠ -116,8 +118,9 ＠＠ ("CC" . "\\.[Cc]\$[Cc]\\|[Pp][Pp]\$?\\'") ("acc" . "\\.[Cc]\$[Cc]\\|[Pp][Pp]\$?\\'") ("bcc" . "\\.[Cc]\$[Cc]\\|[Pp][Pp]\$?\\'") - ("objdump" . "\$\\`[^.]*\\|\\.[ao]\$\\'") - ("nm" . "\$\\`[^.]*\\|\\.[ao]\$\\'") + ("readelf" . "\$\\`[^.]*\\|\\.\\([ao]\\|so\$\\)\\'") + ("objdump" . "\$\\`[^.]*\\|\\.\\([ao]\\|so\$\\)\\'") + ("nm" . "\$\\`[^.]*\\|\\.\\([ao]\\|so\$\\)\\'") ("gdb" . "\\`\$[^.]*\\|a\\.out\$\\'") ("dbx" . "\\`\$[^.]*\\|a\\.out\$\\'") ("sdb" . "\\`\$[^.]*\\|a\\.out\$\\'") ＠＠ -277,13 +280,11 ＠＠ ;; `pcomplete-arg-quote-list' should only be set after all the ;; load-hooks for any other extension modules have been run, which ;; is true at the time `eshell-mode-hook' is run - (make-local-hook 'eshell-mode-hook) (add-hook 'eshell-mode-hook (function (lambda () (set (make-local-variable 'pcomplete-arg-quote-list) eshell-special-chars-outside-quoting))) nil t) - (make-local-hook 'pcomplete-quote-arg-hook) (add-hook 'pcomplete-quote-arg-hook 'eshell-quote-backslash nil t) (define-key eshell-mode-map [(meta tab)] 'lisp-complete-symbol) (define-key eshell-mode-map [(meta control ?i)] 'lisp-complete-symbol) ＠＠ -306,7 +307,7 ＠＠ "Return the command name, possibly sans globbing." (let ((cmd (file-name-nondirectory (pcomplete-arg 'first)))) (setq cmd (if (and (> (length cmd) 0) - (eq (aref cmd 0) ?*)) + (eq (aref cmd 0) eshell-explicit-command-char)) (substring cmd 1) cmd)) (if (eshell-under-windows-p) ＠＠ -370,7 +371,8 ＠＠ (setq args (nthcdr (1+ l) args) posns (nthcdr (1+ l) posns)))) (assert (= (length args) (length posns))) - (when (and args (eq (char-syntax (char-before end)) ? )) + (when (and args (eq (char-syntax (char-before end)) ? ) + (not (eq (char-before (1- end)) ?\\))) (nconc args (list "")) (nconc posns (list (point)))) (cons (mapcar ＠＠ -396,7 +398,7 ＠＠ (if (file-name-directory filename) (pcomplete-executables) (if (and (> (length filename) 0) - (eq (aref filename 0) ?*)) + (eq (aref filename 0) eshell-explicit-command-char)) (setq filename (substring filename 1) pcomplete-stub filename glob-name t)) Index: em-dirs.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-dirs.el,v retrieving revision 1.1 diff -u -r1.1 em-dirs.el --- em-dirs.el 2001/01/10 02:52:44 1.1 +++ em-dirs.el 2008/08/19 15:54:59 ＠＠ -1,6 +1,7 ＠＠ -;;; em-dirs --- directory navigation commands +;;; em-dirs.el --- directory navigation commands -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-dirs) ＠＠ -172,7 +173,7 ＠＠ :type 'boolean :group 'eshell-dirs) -;;; Internal Variables: +;;; Internal Variables: (defvar eshell-dirstack nil "List of directories saved by pushd in the Eshell buffer. ＠＠ -211,7 +212,6 ＠＠ 'eshell-dirs-substitute-cd) eshell-interpreter-alist))) - (make-local-hook 'eshell-parse-argument-hook) (add-hook 'eshell-parse-argument-hook 'eshell-parse-user-reference nil t) (if (eshell-under-windows-p) ＠＠ -219,7 +219,6 ＠＠ 'eshell-parse-drive-letter nil t)) (when (eshell-using-module 'eshell-cmpl) - (make-local-hook 'pcomplete-try-first-hook) (add-hook 'pcomplete-try-first-hook 'eshell-complete-user-reference nil t)) ＠＠ -231,7 +230,6 ＠＠ (unless eshell-last-dir-ring (setq eshell-last-dir-ring (make-ring eshell-last-dir-ring-size))) - (make-local-hook 'eshell-exit-hook) (add-hook 'eshell-exit-hook 'eshell-write-last-dir-ring nil t) (add-hook 'kill-emacs-hook 'eshell-save-some-last-dir)) ＠＠ -373,7 +371,7 ＠＠ (setq path (ring-remove eshell-last-dir-ring (if index - (string-to-int index) + (string-to-number index) 0))))) ((and path (string-match "^=\$.*\$$" path)) (let ((oldpath (eshell-find-previous-directory ＠＠ -408,6 +406,8 ＠＠ (eshell-parse-command "ls" (cdr args)))) nil)))) +(put 'eshell/cd 'eshell-no-numeric-conversions t) + (defun eshell-add-to-dir-ring (path) "Add PATH to the last-dir-ring, if applicable." (unless (and (not (ring-empty-p eshell-last-dir-ring)) ＠＠ -469,6 +469,8 ＠＠ (eshell/dirs t))))) nil) +(put 'eshell/pushd 'eshell-no-numeric-conversions t) + ;;; popd [+n] (defun eshell/popd (&rest args) "Implementation of popd in Lisp." ＠＠ -496,6 +498,8 ＠＠ (t (error "Couldn't popd")))) nil) + +(put 'eshell/popd 'eshell-no-numeric-conversions t) (defun eshell/dirs (&optional if-verbose) "Implementation of dirs in Lisp." Index: em-glob.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-glob.el,v retrieving revision 1.1 diff -u -r1.1 em-glob.el --- em-glob.el 2001/01/10 02:52:45 1.1 +++ em-glob.el 2008/08/19 15:54:59 ＠＠ -1,6 +1,7 ＠＠ -;;; em-glob --- extended file name globbing +;;; em-glob.el --- extended file name globbing -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,12 +19,15 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;; Code: + (provide 'em-glob) (eval-when-compile (require 'esh-maint)) +(require 'esh-util) (defgroup eshell-glob nil "This module provides extended globbing syntax, similar what is used ＠＠ -93,7 +97,7 ＠＠ :type 'boolean :group 'eshell-glob) -(defcustom eshell-glob-chars-list '(?\] ?\[ ?* ?? ?~ ?$ ?$ ?| ?#) +(defcustom eshell-glob-chars-list '(?\] ?\[ ?* ?? ?~ ?$ ?$ ?| ?# ?^) "*List of additional characters used in extended globbing." :type '(repeat character) :group 'eshell-glob) ＠＠ -101,6 +105,7 ＠＠ (defcustom eshell-glob-translate-alist '((?\] . "]") (?\[ . "[") + (?^ . "^") (?? . ".") (?* . ".*") (?~ . "~") ＠＠ -119,22 +124,15 ＠＠ :type '(repeat (cons character (choice regexp function))) :group 'eshell-glob) -;;; Internal Variables: - -(defvar eshell-glob-chars-regexp nil) - ;;; Functions: (defun eshell-glob-initialize () "Initialize the extended globbing code." ;; it's important that `eshell-glob-chars-list' come first - (set (make-local-variable 'eshell-special-chars-outside-quoting) - (append eshell-glob-chars-list eshell-special-chars-outside-quoting)) - (set (make-local-variable 'eshell-glob-chars-regexp) - (format "[%s]+" (apply 'string eshell-glob-chars-list))) - (make-local-hook 'eshell-parse-argument-hook) + (when (boundp 'eshell-special-chars-outside-quoting) + (set (make-local-variable 'eshell-special-chars-outside-quoting) + (append eshell-glob-chars-list eshell-special-chars-outside-quoting))) (add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars t t) - (make-local-hook 'eshell-pre-rewrite-command-hook) (add-hook 'eshell-pre-rewrite-command-hook 'eshell-no-command-globbing nil t)) ＠＠ -182,6 +180,8 ＠＠ (buffer-substring-no-properties (1- (point)) (1+ end)) (goto-char (1+ end)))))))))) +(defvar eshell-glob-chars-regexp nil) + (defun eshell-glob-regexp (pattern) "Convert glob-pattern PATTERN to a regular expression. The basic syntax is: ＠＠ -202,8 +202,11 ＠＠ resulting regular expression." (let ((matched-in-pattern 0) ; How much of PATTERN handled regexp) - (while (string-match eshell-glob-chars-regexp - pattern matched-in-pattern) + (while (string-match + (or eshell-glob-chars-regexp + (set (make-local-variable 'eshell-glob-chars-regexp) + (format "[%s]+" (apply 'string eshell-glob-chars-list)))) + pattern matched-in-pattern) (let* ((op-begin (match-beginning 0)) (op-char (aref pattern op-begin))) (setq regexp ＠＠ -230,19 +233,19 ＠＠ (defun eshell-extended-glob (glob) "Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY. - This function almost fully supports zsh style filename generation - syntax. Things that are not supported are: +This function almost fully supports zsh style filename generation +syntax. Things that are not supported are: ^foo for matching everything but foo (foo~bar) tilde within a parenthesis group foo<1-10> numeric ranges foo~x(a|b) (a|b) will be interpreted as a predicate/modifier list - Mainly they are not supported because file matching is done with Emacs - regular expressions, and these cannot support the above constructs. +Mainly they are not supported because file matching is done with Emacs +regular expressions, and these cannot support the above constructs. - If this routine fails, it returns nil. Otherwise, it returns a list - the form: +If this routine fails, it returns nil. Otherwise, it returns a list +the form: (INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))" (let ((paths (eshell-split-path glob)) ＠＠ -354,7 +357,5 ＠＠ (while rdirs (eshell-glob-entries (car rdirs) globs recurse-p) (setq rdirs (cdr rdirs))))) - -;;; Code: ;;; em-glob.el ends here Index: em-hist.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-hist.el,v retrieving revision 1.1 diff -u -r1.1 em-hist.el --- em-hist.el 2001/01/10 02:52:45 1.1 +++ em-hist.el 2008/08/19 15:55:00 ＠＠ -1,6 +1,7 ＠＠ -;;; em-hist --- history list management +;;; em-hist.el --- history list management -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-hist) ＠＠ -109,12 +110,12 ＠＠ History is always preserved after sanely exiting an Eshell buffer. However, when Emacs is being shut down, this variable determines whether to prompt the user. -If set to nil, it means never ask whether history should be saved. -If set to t, always ask if any Eshell buffers are open at exit time. -If set to `always', history will always be saved, silently." +If set to nil, it means never save history on termination of Emacs. +If set to `ask', ask if any Eshell buffers are open at exit time. +If set to t, history will always be saved, silently." :type '(choice (const :tag "Never" nil) - (const :tag "Ask" t) - (const :tag "Always save" always)) + (const :tag "Ask" ask) + (const :tag "Always save" t)) :group 'eshell-hist) (defcustom eshell-input-filter ＠＠ -203,34 +204,33 ＠＠ (define-key eshell-isearch-map [(control ?c)] 'eshell-isearch-cancel-map) (define-key eshell-isearch-cancel-map [(control ?c)] 'eshell-isearch-cancel)) +(defvar eshell-rebind-keys-alist) + ;;; Functions: (defun eshell-hist-initialize () "Initialize the history management code for one Eshell buffer." - (make-local-hook 'eshell-expand-input-functions) (add-hook 'eshell-expand-input-functions 'eshell-expand-history-references nil t) (when (eshell-using-module 'eshell-cmpl) - (make-local-hook 'pcomplete-try-first-hook) (add-hook 'pcomplete-try-first-hook 'eshell-complete-history-reference nil t)) - (if (eshell-using-module 'eshell-rebind) - (let ((rebind-alist (symbol-value 'eshell-rebind-keys-alist))) + (if (and (eshell-using-module 'eshell-rebind) + (not eshell-non-interactive-p)) + (let ((rebind-alist eshell-rebind-keys-alist)) (make-local-variable 'eshell-rebind-keys-alist) - (set 'eshell-rebind-keys-alist - (append rebind-alist eshell-hist-rebind-keys-alist)) + (setq eshell-rebind-keys-alist + (append rebind-alist eshell-hist-rebind-keys-alist)) (set (make-local-variable 'search-invisible) t) (set (make-local-variable 'search-exit-option) t) - (make-local-hook 'isearch-mode-hook) (add-hook 'isearch-mode-hook (function (lambda () (if (>= (point) eshell-last-output-end) (setq overriding-terminal-local-map eshell-isearch-map)))) nil t) - (make-local-hook 'isearch-mode-end-hook) (add-hook 'isearch-mode-end-hook (function (lambda () ＠＠ -270,13 +270,18 ＠＠ (make-local-variable 'eshell-history-index) (make-local-variable 'eshell-save-history-index) - (make-local-variable 'eshell-history-ring) - (if eshell-history-file-name - (eshell-read-history nil t)) + + (if (minibuffer-window-active-p (selected-window)) + (set (make-local-variable 'eshell-save-history-on-exit) nil) + (set (make-local-variable 'eshell-history-ring) nil) + (if eshell-history-file-name + (eshell-read-history nil t)) + + (add-hook 'eshell-exit-hook 'eshell-write-history nil t)) + (unless eshell-history-ring (setq eshell-history-ring (make-ring eshell-history-size))) - (make-local-hook 'eshell-exit-hook) (add-hook 'eshell-exit-hook 'eshell-write-history nil t) (add-hook 'kill-emacs-hook 'eshell-save-some-history) ＠＠ -294,8 +299,8 ＠＠ (with-current-buffer buf (if (and eshell-mode eshell-history-file-name - eshell-ask-to-save-history - (or (eq eshell-ask-to-save-history 'always) + eshell-save-history-on-exit + (or (eq eshell-save-history-on-exit t) (y-or-n-p (format "Save input history for Eshell buffer `%s'? " (buffer-name buf))))) ＠＠ -360,22 +365,40 ＠＠ "Get an input line from the history ring." (ring-ref (or ring eshell-history-ring) index)) -(defun eshell-add-to-history () - "Add INPUT to the history ring. -The input is entered into the input history ring, if the value of +(defun eshell-add-input-to-history (input) + "Add the string INPUT to the history ring. +Input is entered into the input history ring, if the value of variable `eshell-input-filter' returns non-nil when called on the input." + (if (and (funcall eshell-input-filter input) + (or (null eshell-hist-ignoredups) + (not (ring-p eshell-history-ring)) + (ring-empty-p eshell-history-ring) + (not (string-equal (eshell-get-history 0) input)))) + (eshell-put-history input)) + (setq eshell-save-history-index eshell-history-index) + (setq eshell-history-index nil)) + +(defun eshell-add-command-to-history () + "Add the command entered at `eshell-command's prompt to the history ring. +The command is added to the input history ring, if the value of +variable `eshell-input-filter' returns non-nil when called on the +command. + +This function is supposed to be called from the minibuffer, presumably +as a minibuffer-exit-hook." + (eshell-add-input-to-history + (buffer-substring (minibuffer-prompt-end) (point-max)))) + +(defun eshell-add-to-history () + "Add last Eshell command to the history ring. +The command is entered into the input history ring, if the value of +variable `eshell-input-filter' returns non-nil when called on the +command." (when (> (1- eshell-last-input-end) eshell-last-input-start) (let ((input (buffer-substring eshell-last-input-start (1- eshell-last-input-end)))) - (if (and (funcall eshell-input-filter input) - (or (null eshell-hist-ignoredups) - (not (ring-p eshell-history-ring)) - (ring-empty-p eshell-history-ring) - (not (string-equal (eshell-get-history 0) input)))) - (eshell-put-history input)) - (setq eshell-save-history-index eshell-history-ring) - (setq eshell-history-index nil)))) + (eshell-add-input-to-history input)))) (defun eshell-read-history (&optional filename silent) "Sets the buffer's `eshell-history-ring' from a history file. ＠＠ -483,7 +506,7 ＠＠ ;; Change "completion" to "history reference" ;; to make the display accurate. (with-output-to-temp-buffer history-buffer - (display-completion-list history) + (display-completion-list history prefix) (set-buffer history-buffer) (forward-line 3) (while (search-backward "completion" nil 'move) ＠＠ -503,7 +526,7 ＠＠ ((string= "^" ref) 1) ((string= "$" ref) nil) ((string= "%" ref) - (error "`%' history word designator not yet implemented")))) + (error "`%%' history word designator not yet implemented")))) (defun eshell-hist-parse-arguments (&optional silent b e) "Parse current command arguments in a history-code-friendly way." ＠＠ -816,9 +839,10 ＠＠ (if (null pos) (error "Not found") (setq eshell-history-index pos) - (message "History item: %d" (- (ring-length eshell-history-ring) pos)) + (unless (minibuffer-window-active-p (selected-window)) + (message "History item: %d" (- (ring-length eshell-history-ring) pos))) ;; Can't use kill-region as it sets this-command - (delete-region (save-excursion (eshell-bol) (point)) (point)) + (delete-region eshell-last-output-end (point)) (insert-and-inherit (eshell-get-history pos))))) (defun eshell-next-matching-input (regexp arg) Index: em-ls.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-ls.el,v retrieving revision 1.1 diff -u -r1.1 em-ls.el --- em-ls.el 2001/01/10 02:52:46 1.1 +++ em-ls.el 2008/08/19 15:55:00 ＠＠ -1,6 +1,7 ＠＠ -;;; em-ls --- implementation of ls in Lisp +;;; em-ls.el --- implementation of ls in Lisp -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-ls) ＠＠ -63,8 +64,14 ＠＠ :type '(repeat :tag "Arguments" string) :group 'eshell-ls) +(defcustom eshell-ls-dired-initial-args nil + "*If non-nil, args is included before any call to `ls' in Dired. +This is useful for enabling human-readable format (-h), for example." +:type '(repeat :tag "Arguments" string) +:group 'eshell-ls) + (defcustom eshell-ls-use-in-dired nil - "*If non-nil, use `eshell-ls' to read directories in dired." + "*If non-nil, use `eshell-ls' to read directories in Dired." :set (lambda (symbol value) (if value (unless (and (boundp 'eshell-ls-use-in-dired) ＠＠ -85,7 +92,7 ＠＠ (defcustom eshell-ls-exclude-regexp nil "*Unless -a is specified, files matching this regexp will not be shown." -:type 'regexp +:type '(choice regexp (const nil)) :group 'eshell-ls) (defcustom eshell-ls-exclude-hidden t ＠＠ -100,48 +107,62 ＠＠ :type 'boolean :group 'eshell-ls) -(defface eshell-ls-directory-face +(defface eshell-ls-directory '((((class color) (background light)) (:foreground "Blue" :bold t)) (((class color) (background dark)) (:foreground "SkyBlue" :bold t)) (t (:bold t))) "*The face used for highlight directories." :group 'eshell-ls) +;; backward-compatibility alias +(put 'eshell-ls-directory-face 'face-alias 'eshell-ls-directory) -(defface eshell-ls-symlink-face +(defface eshell-ls-symlink '((((class color) (background light)) (:foreground "Dark Cyan" :bold t)) (((class color) (background dark)) (:foreground "Cyan" :bold t))) "*The face used for highlight symbolic links." :group 'eshell-ls) +;; backward-compatibility alias +(put 'eshell-ls-symlink-face 'face-alias 'eshell-ls-symlink) -(defface eshell-ls-executable-face +(defface eshell-ls-executable '((((class color) (background light)) (:foreground "ForestGreen" :bold t)) (((class color) (background dark)) (:foreground "Green" :bold t))) "*The face used for highlighting executables (not directories, though)." :group 'eshell-ls) +;; backward-compatibility alias +(put 'eshell-ls-executable-face 'face-alias 'eshell-ls-executable) -(defface eshell-ls-readonly-face +(defface eshell-ls-readonly '((((class color) (background light)) (:foreground "Brown")) (((class color) (background dark)) (:foreground "Pink"))) "*The face used for highlighting read-only files." :group 'eshell-ls) +;; backward-compatibility alias +(put 'eshell-ls-readonly-face 'face-alias 'eshell-ls-readonly) -(defface eshell-ls-unreadable-face +(defface eshell-ls-unreadable '((((class color) (background light)) (:foreground "Grey30")) (((class color) (background dark)) (:foreground "DarkGrey"))) "*The face used for highlighting unreadable files." :group 'eshell-ls) +;; backward-compatibility alias +(put 'eshell-ls-unreadable-face 'face-alias 'eshell-ls-unreadable) -(defface eshell-ls-special-face +(defface eshell-ls-special '((((class color) (background light)) (:foreground "Magenta" :bold t)) (((class color) (background dark)) (:foreground "Magenta" :bold t))) "*The face used for highlighting non-regular files." :group 'eshell-ls) +;; backward-compatibility alias +(put 'eshell-ls-special-face 'face-alias 'eshell-ls-special) -(defface eshell-ls-missing-face +(defface eshell-ls-missing '((((class color) (background light)) (:foreground "Red" :bold t)) (((class color) (background dark)) (:foreground "Red" :bold t))) "*The face used for highlighting non-existant file names." :group 'eshell-ls) +;; backward-compatibility alias +(put 'eshell-ls-missing-face 'face-alias 'eshell-ls-missing) (defcustom eshell-ls-archive-regexp (concat "\\.\$t\\(a[rz]\\|gz\$\\|arj\\|lzh\\|" ＠＠ -152,11 +173,13 ＠＠ :type 'regexp :group 'eshell-ls) -(defface eshell-ls-archive-face +(defface eshell-ls-archive '((((class color) (background light)) (:foreground "Orchid" :bold t)) (((class color) (background dark)) (:foreground "Orchid" :bold t))) "*The face used for highlighting archived and compressed file names." :group 'eshell-ls) +;; backward-compatibility alias +(put 'eshell-ls-archive-face 'face-alias 'eshell-ls-archive) (defcustom eshell-ls-backup-regexp "\$\\`\\.?#\\|\\(\\.bak\\|~\$\\'\\)" ＠＠ -164,25 +187,29 ＠＠ :type 'regexp :group 'eshell-ls) -(defface eshell-ls-backup-face +(defface eshell-ls-backup '((((class color) (background light)) (:foreground "OrangeRed")) (((class color) (background dark)) (:foreground "LightSalmon"))) "*The face used for highlighting backup file names." :group 'eshell-ls) +;; backward-compatibility alias +(put 'eshell-ls-backup-face 'face-alias 'eshell-ls-backup) (defcustom eshell-ls-product-regexp - "\\.\$elc\\|o\\(bj\$?\\|a\\||lib\\|res\\)\\'" + "\\.\$elc\\|o\\(bj\$?\\|a\\|lib\\|res\\)\\'" "*A regular expression that matches names of product files. Products are files that get generated from a source file, and hence ought to be recreatable if they are deleted." :type 'regexp :group 'eshell-ls) -(defface eshell-ls-product-face +(defface eshell-ls-product '((((class color) (background light)) (:foreground "OrangeRed")) (((class color) (background dark)) (:foreground "LightSalmon"))) "*The face used for highlighting files that are build products." :group 'eshell-ls) +;; backward-compatibility alias +(put 'eshell-ls-product-face 'face-alias 'eshell-ls-product) (defcustom eshell-ls-clutter-regexp "\$^texput\\.log\\|^core\$\\'" ＠＠ -192,11 +219,13 ＠＠ :type 'regexp :group 'eshell-ls) -(defface eshell-ls-clutter-face +(defface eshell-ls-clutter '((((class color) (background light)) (:foreground "OrangeRed" :bold t)) (((class color) (background dark)) (:foreground "OrangeRed" :bold t))) "*The face used for highlighting junk file names." :group 'eshell-ls) +;; backward-compatibility alias +(put 'eshell-ls-clutter-face 'face-alias 'eshell-ls-clutter) (defsubst eshell-ls-filetype-p (attrs type) "Test whether ATTRS specifies a directory." ＠＠ -250,11 +279,13 ＠＠ (if (stringp switches) (setq switches (split-string switches))) (let (eshell-current-handles - eshell-current-subjob-p) + eshell-current-subjob-p + font-lock-mode) ;; use the fancy highlighting in `eshell-ls' rather than font-lock (when (and eshell-ls-use-colors (featurep 'font-lock)) (font-lock-mode -1) + (setq font-lock-defaults nil) (if (boundp 'font-lock-buffers) (set 'font-lock-buffers (delq (current-buffer) ＠＠ -262,7 +293,7 ＠＠ (let ((insert-func 'insert) (error-func 'insert) (flush-func 'ignore) - eshell-ls-initial-args) + eshell-ls-dired-initial-args) (eshell-do-ls (append switches (list file)))))))) (defsubst eshell/ls (&rest args) ＠＠ -272,6 +303,8 ＠＠ (flush-func 'eshell-flush)) (eshell-do-ls args))) +(put 'eshell/ls 'eshell-no-numeric-conversions t) + (eval-when-compile (defvar block-size) (defvar dereference-links) ＠＠ -288,7 +321,8 ＠＠ (defvar show-recursive) (defvar show-size) (defvar sort-method) - (defvar ange-cache)) + (defvar ange-cache) + (defvar dired-flag)) (defun eshell-do-ls (&rest args) "Implementation of \"ls\" in Lisp, passing ARGS." ＠＠ -301,7 +335,7 ＠＠ `((?a "all" nil show-all "show all files in directory") (?c nil by-ctime sort-method - "sort by modification time") + "sort by last status change time") (?d "directory" nil dir-literal "list directory entries instead of contents") (?k "kilobytes" 1024 block-size ＠＠ -340,6 +374,8 ＠＠ "sort alphabetically by entry extension") (?1 nil single-column listing-style "list one file per line") + (nil "dired" nil dired-flag + "Here for compatibility with GNU ls.") (nil "help" nil nil "show this usage display") :external "ls" ＠＠ -471,8 +507,8 ＠＠ "")) (let* ((str (eshell-ls-printable-size (nth 7 attrs))) (len (length str))) - (if (< len 8) - (concat (make-string (- 8 len) ? ) str) + (if (< len (or size-width 4)) + (concat (make-string (- (or size-width 4) len) ? ) str) str)) " " (format-time-string (concat ＠＠ -832,47 +868,46 ＠＠ (cons col-widths newfiles))))) (defun eshell-ls-decorated-name (file) - "Return FILE, possibly decorated. -Use TRUENAME for predicate tests, if passed." + "Return FILE, possibly decorated." (if eshell-ls-use-colors (let ((face (cond ((not (cdr file)) - 'eshell-ls-missing-face) + 'eshell-ls-missing) ((stringp (cadr file)) - 'eshell-ls-symlink-face) + 'eshell-ls-symlink) ((eq (cadr file) t) - 'eshell-ls-directory-face) + 'eshell-ls-directory) ((not (eshell-ls-filetype-p (cdr file) ?-)) - 'eshell-ls-special-face) + 'eshell-ls-special) ((and (/= (user-uid) 0) ; root can execute anything (eshell-ls-applicable (cdr file) 3 'file-executable-p (car file))) - 'eshell-ls-executable-face) + 'eshell-ls-executable) ((not (eshell-ls-applicable (cdr file) 1 'file-readable-p (car file))) - 'eshell-ls-unreadable-face) + 'eshell-ls-unreadable) ((string-match eshell-ls-archive-regexp (car file)) - 'eshell-ls-archive-face) + 'eshell-ls-archive) ((string-match eshell-ls-backup-regexp (car file)) - 'eshell-ls-backup-face) + 'eshell-ls-backup) ((string-match eshell-ls-product-regexp (car file)) - 'eshell-ls-product-face) + 'eshell-ls-product) ((string-match eshell-ls-clutter-regexp (car file)) - 'eshell-ls-clutter-face) + 'eshell-ls-clutter) ((not (eshell-ls-applicable (cdr file) 2 'file-writable-p (car file))) - 'eshell-ls-readonly-face) + 'eshell-ls-readonly) (eshell-ls-highlight-alist (let ((tests eshell-ls-highlight-alist) value) Index: em-pred.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-pred.el,v retrieving revision 1.1 diff -u -r1.1 em-pred.el --- em-pred.el 2001/01/10 02:52:46 1.1 +++ em-pred.el 2008/08/19 15:55:00 ＠＠ -1,6 +1,7 ＠＠ -;;; em-pred --- argument predicates and modifiers (ala zsh) +;;; em-pred.el --- argument predicates and modifiers (ala zsh) -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-pred) ＠＠ -58,6 +59,8 ＠＠ ;; See the zsh docs for more on the syntax ([(zsh.info)Filename ;; Generation]). +;;; Code: + ;;; User Variables: (defcustom eshell-pred-load-hook '(eshell-pred-initialize) ＠＠ -111,7 +114,7 ＠＠ (put 'eshell-predicate-alist 'risky-local-variable t) (defcustom eshell-modifier-alist - '((?e . '(lambda (lst) + '((?E . '(lambda (lst) (mapcar (function (lambda (str) ＠＠ -184,12 +187,13 ＠＠ FILE ATTRIBUTES: l[+-]N +/-/= N links - a[Mwhm][+-](N|'FILE') access time +/-/= N mnths/weeks/days/mins - if FILE specified, use as comparison basis; - so a+'file.c' shows files accessed before - file.c was last accessed - m[Mwhm][+-](N|'FILE') modification time... - c[Mwhm][+-](N|'FILE') change time... + a[Mwhms][+-](N|'FILE') access time +/-/= N mnths/weeks/hours/mins/secs + (days if unspecified) if FILE specified, + use as comparison basis; so a+'file.c' + shows files accessed before file.c was + last accessed + m[Mwhms][+-](N|'FILE') modification time... + c[Mwhms][+-](N|'FILE') change time... L[kmp][+-]N file size +/-/= N Kb/Mb/blocks EXAMPLES: ＠＠ -205,7 +209,7 ＠＠ "Eshell modifier quick reference: FOR SINGLE ARGUMENTS, or each argument of a list of strings: - e evaluate again + E evaluate again L lowercase U uppercase C capitalize ＠＠ -216,7 +220,7 ＠＠ q escape special characters S split string at any whitespace character - S/PAT/ split string at each occurance of PAT + S/PAT/ split string at each occurrence of PAT FOR LISTS OF ARGUMENTS: o sort alphabetically ＠＠ -230,7 +234,7 ＠＠ x/PAT/ exclude all members matching PAT s/pat/match/ substitute PAT with MATCH - g/pat/match/ substitute PAT with MATCH for all occurances + g/pat/match/ substitute PAT with MATCH for all occurrences EXAMPLES: *.c(:o) sorted list of .c files") ＠＠ -253,7 +257,6 ＠＠ (defun eshell-pred-initialize () "Initialize the predicate/modifier code." - (make-local-hook 'eshell-parse-argument-hook) (add-hook 'eshell-parse-argument-hook 'eshell-parse-arg-modifier t t) (define-key eshell-command-map [(meta ?q)] 'eshell-display-predicate-help) ＠＠ -408,7 +411,7 ＠＠ "Return a predicate to test whether a file matches a certain time." (let* ((quantum 86400) qual amount when open close end) - (when (memq (char-after) '(?M ?w ?h ?m)) + (when (memq (char-after) '(?M ?w ?h ?m ?s)) (setq quantum (char-after)) (cond ((eq quantum ?M) ＠＠ -598,7 +601,5 ＠＠ (function (lambda (str) (split-string str ,sep))) lst)))) - -;;; Code: ;;; em-pred.el ends here Index: em-prompt.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-prompt.el,v retrieving revision 1.1 diff -u -r1.1 em-prompt.el --- em-prompt.el 2001/01/10 02:52:47 1.1 +++ em-prompt.el 2008/08/19 15:55:00 ＠＠ -1,6 +1,7 ＠＠ -;;; em-prompt --- command prompts +;;; em-prompt.el --- command prompts -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-prompt) ＠＠ -68,7 +69,7 ＠＠ :type 'boolean :group 'eshell-prompt) -(defface eshell-prompt-face +(defface eshell-prompt '((((class color) (background light)) (:foreground "Red" :bold t)) (((class color) (background dark)) (:foreground "Pink" :bold t)) (t (:bold t))) ＠＠ -76,6 +77,8 ＠＠ For highlighting other kinds of strings -- similar to shell mode's behavior -- simply use an output filer which changes text properties." :group 'eshell-prompt) +;; backward-compatibility alias +(put 'eshell-prompt-face 'face-alias 'eshell-prompt) (defcustom eshell-before-prompt-hook nil "*A list of functions to call before outputting the prompt." ＠＠ -98,7 +101,6 ＠＠ (defun eshell-prompt-initialize () "Initialize the prompting code." (unless eshell-non-interactive-p - (make-local-hook 'eshell-post-command-hook) (add-hook 'eshell-post-command-hook 'eshell-emit-prompt nil t) (make-local-variable 'eshell-prompt-regexp) ＠＠ -120,7 +122,7 ＠＠ (and eshell-highlight-prompt (add-text-properties 0 (length prompt) '(read-only t - face eshell-prompt-face + face eshell-prompt rear-nonsticky (face read-only)) prompt)) (eshell-interactive-print prompt))) Index: em-rebind.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-rebind.el,v retrieving revision 1.1 diff -u -r1.1 em-rebind.el --- em-rebind.el 2001/01/10 02:52:47 1.1 +++ em-rebind.el 2008/08/19 15:55:00 ＠＠ -1,6 +1,7 ＠＠ -;;; em-rebind --- rebind keys when point is at current input +;;; em-rebind.el --- rebind keys when point is at current input -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-rebind) ＠＠ -127,7 +128,6 ＠＠ forward-word backward-word forward-line - backward-line previous-line next-line forward-visible-line ＠＠ -148,12 +148,9 ＠＠ (defun eshell-rebind-initialize () "Initialize the inputing code." (unless eshell-non-interactive-p - (make-local-hook 'eshell-mode-hook) (add-hook 'eshell-mode-hook 'eshell-setup-input-keymap nil t) - (make-local-hook 'pre-command-hook) (make-local-variable 'eshell-previous-point) (add-hook 'pre-command-hook 'eshell-save-previous-point nil t) - (make-local-hook 'post-command-hook) (make-local-variable 'overriding-local-map) (add-hook 'post-command-hook 'eshell-rebind-input-map nil t) (set (make-local-variable 'eshell-lock-keymap) nil) Index: em-script.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-script.el,v retrieving revision 1.1 diff -u -r1.1 em-script.el --- em-script.el 2001/01/10 02:52:48 1.1 +++ em-script.el 2008/08/19 15:55:00 ＠＠ -1,6 +1,7 ＠＠ -;;; em-script --- Eshell script files +;;; em-script.el --- Eshell script files -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,9 +19,11 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;; Code: + (provide 'em-script) (eval-when-compile (require 'esh-maint)) ＠＠ -119,6 +122,8 ＠＠ $2, etc.") (eshell-source-file (car args) (cdr args) t))) +(put 'eshell/source 'eshell-no-numeric-conversions t) + (defun eshell/. (&rest args) "Source a file in the current environment." (eshell-eval-using-options ＠＠ -130,6 +135,6 ＠＠ environment, binding ARGS to $1, $2, etc.") (eshell-source-file (car args) (cdr args)))) -;;; Code: +(put 'eshell/. 'eshell-no-numeric-conversions t) ;;; em-script.el ends here Index: em-smart.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-smart.el,v retrieving revision 1.1 diff -u -r1.1 em-smart.el --- em-smart.el 2001/01/10 02:52:49 1.1 +++ em-smart.el 2008/08/19 15:55:00 ＠＠ -1,6 +1,7 ＠＠ -;;; em-smart --- smart display of output +;;; em-smart.el --- smart display of output -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-smart) ＠＠ -33,7 +34,7 ＠＠ Most likely you will have to turn this option on and play around with it to get a real sense of how it works." :tag "Smart display of output" -:link '(info-link "(eshell)Smart display of output") + ;; :link '(info-link "(eshell)Smart display of output") :group 'eshell-module) ;;; Commentary: ＠＠ -172,22 +173,16 ＠＠ (set (make-local-variable 'eshell-scroll-to-bottom-on-input) nil) (set (make-local-variable 'eshell-scroll-show-maximum-output) t) - (make-local-hook 'window-scroll-functions) (add-hook 'window-scroll-functions 'eshell-smart-scroll-window nil t) (add-hook 'window-configuration-change-hook 'eshell-refresh-windows) - (make-local-hook 'eshell-output-filter-functions) (add-hook 'eshell-output-filter-functions 'eshell-refresh-windows t t) - (make-local-hook 'pre-command-hook) - (make-local-hook 'after-change-functions) (add-hook 'after-change-functions 'eshell-disable-after-change nil t) - (make-local-hook 'eshell-input-filter-functions) (add-hook 'eshell-input-filter-functions 'eshell-smart-display-setup nil t) (make-local-variable 'eshell-smart-command-done) - (make-local-hook 'eshell-post-command-hook) (add-hook 'eshell-post-command-hook (function (lambda () ＠＠ -248,7 +243,7 ＠＠ (defun eshell-smart-maybe-jump-to-end () "Jump to the end of the input buffer. -This is done whenever a command exits sucessfully and both the command +This is done whenever a command exits successfully and both the command and the end of the buffer are still visible." (when (and (= eshell-last-command-status 0) (if (eq eshell-review-quick-commands 'not-even-short-output) ＠＠ -262,7 +257,11 ＠＠ (defun eshell-smart-redisplay () "Display as much output as possible, smartly." (if (eobp) - (recenter -1) + (save-excursion + (recenter -1) + ;; trigger the redisplay now, so that we catch any attempted + ;; point motion; this is to cover for a redisplay bug + (eshell-redisplay)) (let ((top-point (point))) (and (memq 'eshell-smart-display-move pre-command-hook) (>= (point) eshell-last-input-start) Index: em-term.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-term.el,v retrieving revision 1.2 diff -u -r1.2 em-term.el --- em-term.el 2005/05/20 14:55:10 1.2 +++ em-term.el 2008/08/19 15:55:00 ＠＠ -1,6 +1,7 ＠＠ -;;; em-term --- running visual commands +;;; em-term.el --- running visual commands -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-term) ＠＠ -161,11 +162,8 ＠＠ ; (interactive) ; ;; Convert `return' to C-m, etc. ; (if (and (symbolp last-input-char) -; (or (get last-input-char 'character-of-keysym) -; (get last-input-char 'ascii-character))) -; (setq last-input-char -; (or (get last-input-char 'character-of-keysym) -; (get last-input-char 'ascii-character)))) +; (get last-input-char 'ascii-character)) +; (setq last-input-char (get last-input-char 'ascii-character))) ; (eshell-term-send-raw-string (make-string 1 last-input-char))) ; (defun eshell-term-send-raw-meta () ＠＠ -177,8 +175,7 ＠＠ ; (setq last-input-char (car tmp))) ; (if (symbolp last-input-char) ; (progn -; (setq tmp (or (get last-input-char 'character-of-keysym) -; (get last-input-char 'ascii-character))) +; (setq tmp (get last-input-char 'ascii-character)) ; (if tmp (setq last-input-char tmp)))))) ; (eshell-term-send-raw-string (if (and (numberp last-input-char) ; (> last-input-char 127) Index: em-unix.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-unix.el,v retrieving revision 1.2 diff -u -r1.2 em-unix.el --- em-unix.el 2003/03/25 17:34:32 1.2 +++ em-unix.el 2008/08/19 15:55:01 ＠＠ -1,6 +1,7 ＠＠ -;;; em-unix --- UNIX command aliases +;;; em-unix.el --- UNIX command aliases -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-unix) ＠＠ -141,9 +142,7 ＠＠ (defun eshell-unix-initialize () "Initialize the UNIX support/emulation code." - (make-local-hook 'eshell-post-command-hook) (when (eshell-using-module 'eshell-cmpl) - (make-local-hook 'pcomplete-try-first-hook) (add-hook 'pcomplete-try-first-hook 'eshell-complete-host-reference nil t)) (make-local-variable 'eshell-complex-commands) ＠＠ -166,6 +165,8 ＠＠ "Invoke man, flattening the arguments appropriately." (funcall 'man (apply 'eshell-flatten-and-stringify args))) +(put 'eshell/man 'eshell-no-numeric-conversions t) + (defun eshell-remove-entries (path files &optional top-level) "From PATH, remove all of the given FILES, perhaps interactively." (while files ＠＠ -276,6 +277,8 ＠＠ (setq args (cdr args))) nil)) +(put 'eshell/rm 'eshell-no-numeric-conversions t) + (defun eshell/mkdir (&rest args) "Implementation of mkdir in Lisp." (eshell-eval-using-options ＠＠ -290,6 +293,8 ＠＠ (setq args (cdr args))) nil)) +(put 'eshell/mkdir 'eshell-no-numeric-conversions t) + (defun eshell/rmdir (&rest args) "Implementation of rmdir in Lisp." (eshell-eval-using-options ＠＠ -304,6 +309,8 ＠＠ (setq args (cdr args))) nil)) +(put 'eshell/rmdir 'eshell-no-numeric-conversions t) + (eval-when-compile (defvar no-dereference) (defvar preview) ＠＠ -334,9 +341,11 ＠＠ (eq system-type 'ms-dos)) (setq attr (eshell-file-attributes (car files))) (nth 10 attr-target) (nth 10 attr) - (= (nth 10 attr-target) (nth 10 attr)) + ;; Use equal, not -, since the inode and the device could + ;; cons cells. + (equal (nth 10 attr-target) (nth 10 attr)) (nth 11 attr-target) (nth 11 attr) - (= (nth 11 attr-target) (nth 11 attr))) + (equal (nth 11 attr-target) (nth 11 attr))) (eshell-error (format "%s: `%s' and `%s' are the same file\n" command (car files) target))) (t ＠＠ -358,12 +367,16 ＠＠ (let (eshell-warn-dot-directories) (if (and (not deep) (eq func 'rename-file) - (= (nth 11 (eshell-file-attributes - (file-name-directory - (expand-file-name source)))) - (nth 11 (eshell-file-attributes - (file-name-directory - (expand-file-name target)))))) + ;; Use equal, since the device might be a + ;; cons cell. + (equal (nth 11 (eshell-file-attributes + (file-name-directory + (directory-file-name + (expand-file-name source))))) + (nth 11 (eshell-file-attributes + (file-name-directory + (directory-file-name + (expand-file-name target))))))) (apply 'eshell-funcalln func source target args) (unless (file-directory-p target) (if verbose ＠＠ -481,6 +494,8 ＠＠ eshell-mv-interactive-query eshell-mv-overwrite-files)))) +(put 'eshell/mv 'eshell-no-numeric-conversions t) + (defun eshell/cp (&rest args) "Implementation of cp in Lisp." (eshell-eval-using-options ＠＠ -514,6 +529,8 ＠＠ eshell-cp-interactive-query eshell-cp-overwrite-files preserve))) +(put 'eshell/cp 'eshell-no-numeric-conversions t) + (defun eshell/ln (&rest args) "Implementation of ln in Lisp." (eshell-eval-using-options ＠＠ -544,6 +561,8 ＠＠ eshell-ln-interactive-query eshell-ln-overwrite-files)))) +(put 'eshell/ln 'eshell-no-numeric-conversions t) + (defun eshell/cat (&rest args) "Implementation of cat in Lisp. If in a pipeline, or the file is not a regular file, directory or ＠＠ -552,9 +571,12 ＠＠ (if (or eshell-in-pipeline-p (catch 'special (eshell-for arg args - (unless (let ((attrs (eshell-file-attributes arg))) - (and attrs (memq (aref (nth 8 attrs) 0) - '(?d ?l ?-)))) + (unless (or (and (stringp arg) + (> (length arg) 0) + (eq (aref arg 0) ?-)) + (let ((attrs (eshell-file-attributes arg))) + (and attrs (memq (aref (nth 8 attrs) 0) + '(?d ?l ?-))))) (throw 'special t))))) (let ((ext-cat (eshell-search-path "cat"))) (if ext-cat ＠＠ -591,6 +613,8 ＠＠ ;; if the file does not end in a newline, do not emit one (setq eshell-ensure-newline-p nil)))) +(put 'eshell/cat 'eshell-no-numeric-conversions t) + ;; special front-end functions for compilation-mode buffers (defun eshell/make (&rest args) ＠＠ -606,6 +630,8 ＠＠ (eshell-parse-command "*make" (eshell-stringify-list (eshell-flatten-list args)))))) +(put 'eshell/make 'eshell-no-numeric-conversions t) + (defun eshell-occur-mode-goto-occurrence () "Go to the occurrence the current line describes." (interactive) ＠＠ -616,13 +642,12 ＠＠ (defun eshell-occur-mode-mouse-goto (event) "In Occur mode, go to the occurrence whose line you click on." (interactive "e") - (let (buffer pos) + (let (pos) (save-excursion (set-buffer (window-buffer (posn-window (event-end event)))) (save-excursion (goto-char (posn-point (event-end event))) - (setq pos (occur-mode-find-occurrence)) - (setq buffer occur-buffer))) + (setq pos (occur-mode-find-occurrence)))) (pop-to-buffer (marker-buffer pos)) (goto-char (marker-position pos)))) ＠＠ -658,7 +683,6 ＠＠ (if string (insert string)) (setq string nil files (cdr files))))) - (setq occur-buffer (current-buffer)) (local-set-key [mouse-2] 'eshell-occur-mode-mouse-goto) (local-set-key [(control ?c) (control ?c)] 'eshell-occur-mode-goto-occurrence) ＠＠ -684,11 +708,7 ＠＠ (eshell-parse-command (concat "*" command) (eshell-stringify-list (eshell-flatten-list args)))) - (let* ((compilation-process-setup-function - (list 'lambda nil - (list 'setq 'process-environment - (list 'quote (eshell-copy-environment))))) - (args (mapconcat 'identity + (let* ((args (mapconcat 'identity (mapcar 'shell-quote-argument (eshell-stringify-list (eshell-flatten-list args))) ＠＠ -857,7 +877,7 ＠＠ (unless by-bytes (setq block-size (or block-size 1024))) (if (and max-depth (stringp max-depth)) - (setq max-depth (string-to-int max-depth))) + (setq max-depth (string-to-number max-depth))) ;; filesystem support means nothing under Windows (if (eshell-under-windows-p) (setq only-one-filesystem nil)) ＠＠ -930,7 +950,7 ＠＠ (not eshell-in-subcommand-p)))) (throw 'eshell-replace-command (eshell-parse-command "*diff" orig-args)) - (setq args (eshell-copy-list orig-args)) + (setq args (copy-sequence orig-args)) (if (< (length args) 2) (throw 'eshell-replace-command (eshell-parse-command "*diff" orig-args))) ＠＠ -947,15 +967,23 ＠＠ (throw 'eshell-replace-command (eshell-parse-command "*diff" orig-args)))) (when (fboundp 'diff-mode) - (diff-mode) - (set (make-local-variable 'eshell-diff-window-config) config) - (local-set-key [?q] 'eshell-diff-quit) - (if (fboundp 'turn-on-font-lock-if-enabled) - (turn-on-font-lock-if-enabled)))) - (other-window 1) - (goto-char (point-min)) - nil)))) + (make-local-variable 'compilation-finish-functions) + (add-hook + 'compilation-finish-functions + `(lambda (buff msg) + (with-current-buffer buff + (diff-mode) + (set (make-local-variable 'eshell-diff-window-config) + ,config) + (local-set-key [?q] 'eshell-diff-quit) + (if (fboundp 'turn-on-font-lock-if-enabled) + (turn-on-font-lock-if-enabled)) + (goto-char (point-min)))))) + (pop-to-buffer (current-buffer)))))) + nil) +(put 'eshell/diff 'eshell-no-numeric-conversions t) + (defun eshell/locate (&rest args) "Alias \"locate\" to call Emacs `locate' function." (if (or eshell-plain-locate-behavior ＠＠ -971,12 +999,16 ＠＠ (let ((locate-history-list (list (car args)))) (locate-with-filter (car args) (cadr args)))))) +(put 'eshell/locate 'eshell-no-numeric-conversions t) + (defun eshell/occur (&rest args) "Alias \"occur\" to call Emacs `occur' function." (let ((inhibit-read-only t)) - (if args - (error "usage: occur: (REGEXP)") - (occur (car args))))) + (if (> (length args) 2) + (error "usage: occur: (REGEXP &optional NLINES)") + (apply 'occur args)))) + +(put 'eshell/occur 'eshell-no-numeric-conversions t) ;;; Code: Index: em-xtra.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/em-xtra.el,v retrieving revision 1.1 diff -u -r1.1 em-xtra.el --- em-xtra.el 2001/01/10 02:52:51 1.1 +++ em-xtra.el 2008/08/19 15:55:04 ＠＠ -1,6 +1,7 ＠＠ -;;; em-xtra --- extra alias functions +;;; em-xtra.el --- extra alias functions -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'em-xtra) Index: esh-arg.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-arg.el,v retrieving revision 1.2 diff -u -r1.2 esh-arg.el --- esh-arg.el 2008/07/10 20:08:20 1.2 +++ esh-arg.el 2008/08/19 15:55:04 ＠＠ -1,6 +1,7 ＠＠ -;;; esh-arg --- argument processing +;;; esh-arg.el --- argument processing -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'esh-arg) ＠＠ -52,7 +53,10 ＠＠ (looking-at eshell-number-regexp) (eshell-arg-delimiter (match-end 0))) (goto-char (match-end 0)) - (string-to-number (match-string 0))))) + (let ((str (match-string 0))) + (if (> (length str) 0) + (add-text-properties 0 1 '(number t) str)) + str)))) ;; parse any non-special characters, based on the current context (function ＠＠ -342,8 +346,10 ＠＠ (save-restriction (forward-char) (narrow-to-region (point) end) - (list 'eshell-escape-arg - (eshell-parse-argument))) + (let ((arg (eshell-parse-argument))) + (if (eq arg nil) + "" + (list 'eshell-escape-arg arg)))) (goto-char (1+ end))))))) (defun eshell-parse-special-reference () Index: esh-cmd.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-cmd.el,v retrieving revision 1.1 diff -u -r1.1 esh-cmd.el --- esh-cmd.el 2001/01/10 02:52:53 1.1 +++ esh-cmd.el 2008/08/19 15:55:04 ＠＠ -1,6 +1,7 ＠＠ -;;; esh-cmd --- command invocation +;;; esh-cmd.el --- command invocation -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'esh-cmd) ＠＠ -30,7 +31,7 ＠＠ pressing <RET>. There are several different kinds of commands, however." :tag "Command invocation" -:link '(info-link "(eshell)Command invocation") + ;; :link '(info-link "(eshell)Command invocation") :group 'eshell) ;;; Commentary: ＠＠ -295,28 +296,24 ＠＠ (set (make-local-variable 'eshell-last-command-name) nil) (set (make-local-variable 'eshell-last-async-proc) nil) - (make-local-hook 'eshell-kill-hook) (add-hook 'eshell-kill-hook 'eshell-resume-command nil t) ;; make sure that if a command is over, and no process is being ;; waited for, that `eshell-current-command' is set to nil. This ;; situation can occur, for example, if a Lisp function results in ;; `debug' being called, and the user then types \\[top-level] - (make-local-hook 'eshell-post-command-hook) (add-hook 'eshell-post-command-hook (function (lambda () (setq eshell-current-command nil eshell-last-async-proc nil))) nil t) - (make-local-hook 'eshell-parse-argument-hook) (add-hook 'eshell-parse-argument-hook 'eshell-parse-subcommand-argument nil t) (add-hook 'eshell-parse-argument-hook 'eshell-parse-lisp-argument nil t) (when (eshell-using-module 'eshell-cmpl) - (make-local-hook 'pcomplete-try-first-hook) (add-hook 'pcomplete-try-first-hook 'eshell-complete-lisp-symbols nil t))) ＠＠ -456,12 +453,14 ＠＠ (defun eshell-rewrite-named-command (terms) "If no other rewriting rule transforms TERMS, assume a named command." - (list (if eshell-in-pipeline-p - 'eshell-named-command* - 'eshell-named-command) - (car terms) - (and (cdr terms) - (append (list 'list) (cdr terms))))) + (let ((sym (if eshell-in-pipeline-p + 'eshell-named-command* + 'eshell-named-command)) + (cmd (car terms)) + (args (cdr terms))) + (if args + (list sym cmd (append (list 'list) (cdr terms))) + (list sym cmd)))) (eshell-deftest cmd named-command "Execute named command" ＠＠ -498,7 +497,7 ＠＠ (defun eshell-rewrite-for-command (terms) "Rewrite a `for' command into its equivalent Eshell command form. Because the implementation of `for' relies upon conditional evaluation -of its argumbent (i.e., use of a Lisp special form), it must be +of its argument (i.e., use of a Lisp special form), it must be implemented via rewriting, rather than as a function." (if (and (stringp (car terms)) (string= (car terms) "for") ＠＠ -613,10 +612,10 ＠＠ (eshell-invokify-arg (cadr terms) nil t) (list 'eshell-protect (eshell-invokify-arg - (if (= (length terms) 5) - (car (last terms 3)) + (if (= (length terms) 4) + (car (last terms 2)) (car (last terms))) t)) - (if (= (length terms) 5) + (if (= (length terms) 4) (list 'eshell-protect (eshell-invokify-arg (car (last terms)))) t)))) ＠＠ -625,7 +624,9 ＠＠ "Return non-nil if the last command was \"successful\". For a bit of Lisp code, this means a return value of non-nil. For an external command, it means an exit code of 0." - (if (string= eshell-last-command-name "#<Lisp>") + (if (save-match-data + (string-match "#<\$Lisp object\\|function .*\$>" + eshell-last-command-name)) eshell-last-command-result (= eshell-last-command-status 0))) ＠＠ -711,7 +712,7 ＠＠ reversed last-terms-sym) "Separate TERMS using SEPARATOR. If REVERSED is non-nil, the list of separated term groups will be -returned in reverse order. If LAST-TERMS-SYM is a symbol, it's value +returned in reverse order. If LAST-TERMS-SYM is a symbol, its value will be set to a list of all the separator operators found (or '(list nil)' if none)." (let ((sub-terms (list t)) ＠＠ -759,7 +760,7 ＠＠ (defmacro eshell-do-subjob (object) "Evaluate a command OBJECT as a subjob. -We indicate thet the process was run in the background by returned it +We indicate that the process was run in the background by returning it ensconced in a list." `(let ((eshell-current-subjob-p t)) ,object)) ＠＠ -1006,11 +1007,12 ＠＠ (setq eshell-current-command command) (let ((delim (catch 'eshell-incomplete (eshell-resume-eval)))) - (if delim - (error "Unmatched delimiter: %c" - (if (listp delim) - (car delim) - delim)))))) + ;; On systems that don't support async subprocesses, eshell-resume + ;; can return t. Don't treat that as an error. + (if (listp delim) + (setq delim (car delim))) + (if (and delim (not (eq delim t))) + (error "Unmatched delimiter: %c" delim))))) (defun eshell-resume-command (proc status) "Resume the current command when a process ends." ＠＠ -1060,7 +1062,7 ＠＠ object) (defconst function-p-func - (if (eshell-under-xemacs-p) + (if (fboundp 'compiled-function-p) 'compiled-function-p 'byte-code-function-p)) ＠＠ -1231,7 +1233,7 ＠＠ "Identify the COMMAND, and where it is located." (eshell-for name (cons command names) (let (program alias direct) - (if (eq (aref name 0) ?*) + (if (eq (aref name 0) eshell-explicit-command-char) (setq name (substring name 1) direct t)) (if (and (not direct) ＠＠ -1246,9 +1248,8 ＠＠ (setq program (eshell-search-path name)) (let* ((esym (eshell-find-alias-function name)) (sym (or esym (intern-soft name)))) - (if (and sym (fboundp sym) - (or esym eshell-prefer-lisp-functions - (not program))) + (if (and (or esym (and sym (fboundp sym))) + (or eshell-prefer-lisp-functions (not direct))) (let ((desc (let ((inhibit-redisplay t)) (save-window-excursion (prog1 ＠＠ -1265,6 +1266,8 ＠＠ name (getenv "PATH"))) (eshell-printn program))))) +(put 'eshell/which 'eshell-no-numeric-conversions t) + (defun eshell-named-command (command &optional args) "Insert output from a plain COMMAND, using ARGS. COMMAND may result in an alias being executed, or a plain command." ＠＠ -1284,20 +1287,23 ＠＠ (defun eshell-find-alias-function (name) "Check whether a function called `eshell/NAME' exists." (let* ((sym (intern-soft (concat "eshell/" name))) - (file (symbol-file sym)) - module-sym) + (file (symbol-file sym 'defun))) + ;; If the function exists, but is defined in an eshell module + ;; that's not currently enabled, don't report it as found (if (and file (string-match "\$em\\|esh\$-\$.*\$\$\\.el\$?\\'" file)) - (setq file (concat "eshell-" (match-string 2 file)))) - (setq module-sym - (and sym file (fboundp 'symbol-file) + (let ((module-sym (intern (file-name-sans-extension - (file-name-nondirectory file))))) - (and sym (functionp sym) - (or (not module-sym) - (eshell-using-module module-sym) - (memq module-sym (eshell-subgroups 'eshell))) - sym))) + (file-name-nondirectory + (concat "eshell-" (match-string 2 file))))))) + (if (and (functionp sym) + (or (null module-sym) + (eshell-using-module module-sym) + (memq module-sym (eshell-subgroups 'eshell)))) + sym)) + ;; Otherwise, if it's bound, return it. + (if (functionp sym) + sym)))) (defun eshell-plain-command (command args) "Insert output from a plain COMMAND, using ARGS. ＠＠ -1380,13 +1386,28 ＠＠ (defun eshell-lisp-command (object &optional args) "Insert Lisp OBJECT, using ARGS if a function." - (setq eshell-last-arguments args - eshell-last-command-name "#<Lisp>") (catch 'eshell-external ; deferred to an external command (let* ((eshell-ensure-newline-p (eshell-interactive-output-p)) (result (if (functionp object) - (eshell-apply object args) + (progn + (setq eshell-last-arguments args + eshell-last-command-name + (concat "#<function " (symbol-name object) ">")) + ;; if any of the arguments are flagged as numbers + ;; waiting for conversion, convert them now + (unless (get object 'eshell-no-numeric-conversions) + (while args + (let ((arg (car args))) + (if (and (stringp arg) + (> (length arg) 0) + (not (text-property-not-all + 0 (length arg) 'number t arg))) + (setcar args (string-to-number arg)))) + (setq args (cdr args)))) + (eshell-apply object eshell-last-arguments)) + (setq eshell-last-arguments args + eshell-last-command-name "#<Lisp object>") (eshell-eval object)))) (if (and eshell-ensure-newline-p (save-excursion Index: esh-ext.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-ext.el,v retrieving revision 1.2 diff -u -r1.2 esh-ext.el --- esh-ext.el 2002/03/24 20:13:49 1.2 +++ esh-ext.el 2008/08/19 15:55:06 ＠＠ -1,6 +1,7 ＠＠ -;;; esh-ext --- commands external to Eshell +;;; esh-ext.el --- commands external to Eshell -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,12 +19,13 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'esh-ext) (eval-when-compile (require 'esh-maint)) +(require 'esh-util) (defgroup eshell-ext nil "External commands are invoked when operating system executables are ＠＠ -48,6 +50,8 ＠＠ :type 'hook :group 'eshell-ext) +;; XEmacs specific, GNU have a 'exec-suffixes implemented in C source +;; code, but XEmacs dont. (defcustom eshell-binary-suffixes (if (eshell-under-windows-p) '(".exe" ".com" ".bat" ".cmd" "") ＠＠ -93,12 +97,12 ＠＠ (if (string-match "\$\\`cmdproxy\\|sh\$\\.\$com\\|exe\$" shell-file-name) (or (eshell-search-path "cmd.exe") - (eshell-search-path "command.exe")) + (eshell-search-path "command.com")) shell-file-name)) "*The name of the shell command to use for DOS/Windows batch files. This defaults to nil on non-Windows systems, where this variable is wholly ignored." -:type 'file +:type '(choice file (const nil)) :group 'eshell-ext) (defsubst eshell-invoke-batch-file (&rest args) ＠＠ -150,18 +154,24 ＠＠ :type 'integer :group 'eshell-ext) +(defcustom eshell-explicit-command-char ?* + "*If this char occurs before a command name, call it externally. +That is, although `vi' may be an alias, `\vi' will always call the +external version." +:type 'character +:group 'eshell-ext) + ;;; Functions: (defun eshell-ext-initialize () "Initialize the external command handling code." - (make-local-hook 'eshell-named-command-hook) (add-hook 'eshell-named-command-hook 'eshell-explicit-command nil t)) (defun eshell-explicit-command (command args) "If a command name begins with `*', call it externally always. This bypasses all Lisp functions and aliases." (when (and (> (length command) 1) - (eq (aref command 0) ?*)) + (eq (aref command 0) eshell-explicit-command-char)) (let ((cmd (eshell-search-path (substring command 1)))) (if cmd (or (eshell-external-command cmd args) ＠＠ -241,6 +251,8 ＠＠ (eshell-printn (car paths)) (setq paths (cdr paths))))))) +(put 'eshell/addpath 'eshell-no-numeric-conversions t) + (defun eshell-script-interpreter (file) "Extract the script to run from FILE, if it has #!<interp> in it. Return nil, or a list of the form: ＠＠ -251,7 +263,7 ＠＠ (file-regular-p file)) (with-temp-buffer (insert-file-contents-literally file nil 0 maxlen) - (if (looking-at "#!\$[^ \t\n]+\$\$[ \t]+\\(.+\$\\)?") + (if (looking-at "#![ \t]*\$[^ \r\t\n]+\$\$[ \t]+\\(.+\$\\)?") (if (match-string 3) (list (match-string 1) (match-string 3) Index: esh-io.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-io.el,v retrieving revision 1.1 diff -u -r1.1 esh-io.el --- esh-io.el 2001/01/10 02:52:54 1.1 +++ esh-io.el 2008/08/19 15:55:06 ＠＠ -1,6 +1,7 ＠＠ -;;; esh-io --- I/O management +;;; esh-io.el --- I/O management -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'esh-io) ＠＠ -169,14 +170,11 ＠＠ (defun eshell-io-initialize () "Initialize the I/O subsystem code." - (make-local-hook 'eshell-parse-argument-hook) (add-hook 'eshell-parse-argument-hook 'eshell-parse-redirection nil t) (make-local-variable 'eshell-current-redirections) - (make-local-hook 'eshell-pre-rewrite-command-hook) (add-hook 'eshell-pre-rewrite-command-hook 'eshell-strip-redirections nil t) - (make-local-hook 'eshell-post-rewrite-command-hook) (add-hook 'eshell-post-rewrite-command-hook 'eshell-apply-redirections nil t)) ＠＠ -195,7 +193,7 ＠＠ (eshell-finish-arg (prog1 (list 'eshell-set-output-handle - (or (and sh (string-to-int sh)) 1) + (or (and sh (string-to-number sh)) 1) (list 'quote (aref [overwrite append insert] (1- (length oper))))) ＠＠ -336,26 +334,28 ＠＠ (cond ((stringp target) (let ((redir (assoc target eshell-virtual-targets))) - (if redir - (if (nth 2 redir) - (funcall (nth 1 redir) mode) - (nth 1 redir)) - (let* ((exists (get-file-buffer target)) - (buf (find-file-noselect target t))) - (with-current-buffer buf - (if buffer-read-only - (error "Cannot write to read-only file `%s'" target)) - (set (make-local-variable 'eshell-output-file-buffer) - (if (eq exists buf) 0 t)) - (cond ((eq mode 'overwrite) - (erase-buffer)) - ((eq mode 'append) - (goto-char (point-max)))) - (point-marker)))))) + (if redir + (if (nth 2 redir) + (funcall (nth 1 redir) mode) + (nth 1 redir)) + (let* ((exists (get-file-buffer target)) + (buf (find-file-noselect target t))) + (with-current-buffer buf + (if buffer-read-only + (error "Cannot write to read-only file `%s'" target)) + (set (make-local-variable 'eshell-output-file-buffer) + (if (eq exists buf) 0 t)) + (cond ((eq mode 'overwrite) + (erase-buffer)) + ((eq mode 'append) + (goto-char (point-max)))) + (point-marker)))))) + ((or (bufferp target) (and (boundp 'eshell-buffer-shorthand) (symbol-value 'eshell-buffer-shorthand) - (symbolp target))) + (symbolp target) + (not (memq target '(t nil))))) (let ((buf (if (bufferp target) target (get-buffer-create ＠＠ -366,17 +366,20 ＠＠ ((eq mode 'append) (goto-char (point-max)))) (point-marker)))) - ((functionp target) - nil) + + ((functionp target) nil) + ((symbolp target) (if (eq mode 'overwrite) (set target nil)) target) + ((or (eshell-processp target) (markerp target)) target) + (t - (error "Illegal redirection target: %s" + (error "Invalid redirection target: %s" (eshell-stringify target))))) (eval-when-compile ＠＠ -399,7 +402,7 ＠＠ (if (and (listp current) (not (member where current))) (setq current (append current (list where))) - (setq current where)) + (setq current (list where))) (if (not (aref eshell-current-handles index)) (aset eshell-current-handles index (cons nil 1))) (setcar (aref eshell-current-handles index) current))))) ＠＠ -484,7 +487,8 ＠＠ (let ((moving (= (point) target))) (save-excursion (goto-char target) - (setq object (eshell-stringify object)) + (unless (stringp object) + (setq object (eshell-stringify object))) (insert-and-inherit object) (set-marker target (point-marker))) (if moving ＠＠ -492,7 +496,8 ＠＠ ((eshell-processp target) (when (eq (process-status target) 'run) - (setq object (eshell-stringify object)) + (unless (stringp object) + (setq object (eshell-stringify object))) (process-send-string target object))) ((consp target) Index: esh-maint.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-maint.el,v retrieving revision 1.1 diff -u -r1.1 esh-maint.el --- esh-maint.el 2001/01/10 02:52:55 1.1 +++ esh-maint.el 2008/08/19 15:55:06 ＠＠ -1,6 +1,7 ＠＠ -;;; esh-maint --- init code for building eshell +;;; esh-maint.el --- init code for building eshell -*- no-byte-compile: t -*- -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ＠＠ -34,8 +35,6 ＠＠ ("(eshell-deftest\\>" . font-lock-keyword-face) ("(eshell-condition-case\\>" . font-lock-keyword-face)))) -(add-to-list 'load-path ".") - (if (file-directory-p "../pcomplete") (add-to-list 'load-path "../pcomplete")) ＠＠ -46,101 +45,101 ＠＠ (require 'cl) (setq cl-optimize-speed 9)) -(defun eshell-generate-autoloads () - (interactive) - (require 'autoload) - (setq generated-autoload-file - (expand-file-name (car command-line-args-left))) - (setq command-line-args-left (cdr command-line-args-left)) - (batch-update-autoloads)) +;; (defun eshell-generate-autoloads () +;; (interactive) +;; (require 'autoload) +;; (setq generated-autoload-file +;; (expand-file-name (car command-line-args-left))) +;; (setq command-line-args-left (cdr command-line-args-left)) +;; (batch-update-autoloads)) (require 'eshell) (require 'esh-mode) ; brings in eshell-util (require 'esh-opt) (require 'esh-test) -(defun eshell-generate-main-menu () - "Create the main menu for the eshell documentation." - (insert "＠menu - * The Emacs shell:: eshell. - - Core Functionality\n") - (eshell-for module - (sort (eshell-subgroups 'eshell) - (function - (lambda (a b) - (string-lessp (symbol-name a) - (symbol-name b))))) - (insert (format "* %-34s" - (concat (get module 'custom-tag) "::")) - (symbol-name module) ".\n")) - (insert "\nOptional Functionality\n") - (eshell-for module - (sort (eshell-subgroups 'eshell-module) - (function - (lambda (a b) - (string-lessp (symbol-name a) - (symbol-name b))))) - (insert (format "* %-34s" - (concat (get module 'custom-tag) "::")) - (symbol-name module) ".\n")) - (insert "＠end menu\n")) - -(defun eshell-make-texi () - "Make the eshell.texi file." - (interactive) - (require 'eshell-auto) - (require 'texidoc) - (require 'pcomplete) - (apply 'texidoc-files 'eshell-generate-main-menu "eshell.doci" - (append - (list "eshell.el") - (sort (mapcar - (function - (lambda (sym) - (let ((name (symbol-name sym))) - (if (string-match "\\`eshell-\$.*\$" name) - (setq name (concat "esh-" (match-string 1 name)))) - (concat name ".el")))) - (eshell-subgroups 'eshell)) - 'string-lessp) - (sort (mapcar - (function - (lambda (sym) - (let ((name (symbol-name sym))) - (if (string-match "\\`eshell-\$.*\$" name) - (setq name (concat "em-" (match-string 1 name)))) - (concat name ".el")))) - (eshell-subgroups 'eshell-module)) - 'string-lessp) - (list "eshell.texi")))) - -(defun eshell-make-readme () - "Make the README file from eshell.el." - (interactive) - (require 'eshell-auto) - (require 'texidoc) - (require 'pcomplete) - (texidoc-files nil "eshell.doci" "eshell.el" "README.texi") - (set-buffer (get-buffer "README.texi")) - (goto-char (point-min)) - (search-forward "＠chapter") - (beginning-of-line) - (forward-line -1) - (kill-line 2) - (re-search-forward "^＠section User Options") - (beginning-of-line) - (delete-region (point) (point-max)) - (insert "＠bye\n") - (save-buffer) - (with-temp-buffer - (call-process "makeinfo" nil t nil "--no-headers" "README.texi") - (goto-char (point-min)) - (search-forward "The Emacs Shell") - (beginning-of-line) - (delete-region (point-min) (point)) - (write-file "README")) - (delete-file "README.texi") - (kill-buffer "README.texi")) +;; (defun eshell-generate-main-menu () +;; "Create the main menu for the eshell documentation." +;; (insert "＠menu +;; * The Emacs shell:: eshell. + +;; Core Functionality\n") +;; (eshell-for module +;; (sort (eshell-subgroups 'eshell) +;; (function +;; (lambda (a b) +;; (string-lessp (symbol-name a) +;; (symbol-name b))))) +;; (insert (format "* %-34s" +;; (concat (get module 'custom-tag) "::")) +;; (symbol-name module) ".\n")) +;; (insert "\nOptional Functionality\n") +;; (eshell-for module +;; (sort (eshell-subgroups 'eshell-module) +;; (function +;; (lambda (a b) +;; (string-lessp (symbol-name a) +;; (symbol-name b))))) +;; (insert (format "* %-34s" +;; (concat (get module 'custom-tag) "::")) +;; (symbol-name module) ".\n")) +;; (insert "＠end menu\n")) + +;; (defun eshell-make-texi () +;; "Make the eshell.texi file." +;; (interactive) +;; (require 'eshell-auto) +;; (require 'texidoc) +;; (require 'pcomplete) +;; (apply 'texidoc-files 'eshell-generate-main-menu "eshell.doci" +;; (append +;; (list "eshell.el") +;; (sort (mapcar +;; (function +;; (lambda (sym) +;; (let ((name (symbol-name sym))) +;; (if (string-match "\\`eshell-\$.*\$" name) +;; (setq name (concat "esh-" (match-string 1 name)))) +;; (concat name ".el")))) +;; (eshell-subgroups 'eshell)) +;; 'string-lessp) +;; (sort (mapcar +;; (function +;; (lambda (sym) +;; (let ((name (symbol-name sym))) +;; (if (string-match "\\`eshell-\$.*\$" name) +;; (setq name (concat "em-" (match-string 1 name)))) +;; (concat name ".el")))) +;; (eshell-subgroups 'eshell-module)) +;; 'string-lessp) +;; (list "eshell.texi")))) + +;; (defun eshell-make-readme () +;; "Make the README file from eshell.el." +;; (interactive) +;; (require 'eshell-auto) +;; (require 'texidoc) +;; (require 'pcomplete) +;; (texidoc-files nil "eshell.doci" "eshell.el" "README.texi") +;; (set-buffer (get-buffer "README.texi")) +;; (goto-char (point-min)) +;; (search-forward "＠chapter") +;; (beginning-of-line) +;; (forward-line -1) +;; (kill-line 2) +;; (re-search-forward "^＠section User Options") +;; (beginning-of-line) +;; (delete-region (point) (point-max)) +;; (insert "＠bye\n") +;; (save-buffer) +;; (with-temp-buffer +;; (call-process "makeinfo" nil t nil "--no-headers" "README.texi") +;; (goto-char (point-min)) +;; (search-forward "The Emacs Shell") +;; (beginning-of-line) +;; (delete-region (point-min) (point)) +;; (write-file "README")) +;; (delete-file "README.texi") +;; (kill-buffer "README.texi")) ;;; esh-maint.el ends here Index: esh-mode.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-mode.el,v retrieving revision 1.3 diff -u -r1.3 esh-mode.el --- esh-mode.el 2005/06/26 19:17:11 1.3 +++ esh-mode.el 2008/08/19 15:55:07 ＠＠ -1,6 +1,7 ＠＠ -;;; esh-mode --- user interface +;;; esh-mode.el --- user interface -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,9 +19,11 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;; Code: + (provide 'esh-mode) (eval-when-compile (require 'esh-maint)) ＠＠ -188,7 +191,7 ＠＠ (defcustom eshell-skip-prompt-function nil "*A function called from beginning of line to skip the prompt." -:type 'function +:type '(choice (const nil) function) :group 'eshell-mode) (defcustom eshell-status-in-modeline t ＠＠ -196,11 +199,6 ＠＠ :type 'boolean :group 'eshell-mode) -(defvar eshell-non-interactive-p nil - "A variable which is non-nil when Eshell is not running interactively. -Modules should use this variable so that they don't clutter non-interactive -sessions, such as when using `eshell-command'.") - (defvar eshell-first-time-p t "A variable which is non-nil the first time Eshell is loaded.") ＠＠ -310,7 +308,7 ＠＠ (when eshell-status-in-modeline (make-local-variable 'eshell-command-running-string) - (let ((fmt (eshell-copy-list mode-line-format))) + (let ((fmt (copy-sequence mode-line-format))) (make-local-variable 'mode-line-format) (setq mode-line-format fmt)) (let ((modeline (memq 'mode-line-modified mode-line-format))) ＠＠ -387,7 +385,7 ＠＠ (set (make-local-variable 'eshell-last-output-end) (point-marker)) (set (make-local-variable 'eshell-last-output-block-begin) (point)) - (let ((modules-list (eshell-copy-list eshell-modules-list))) + (let ((modules-list (copy-sequence eshell-modules-list))) (make-local-variable 'eshell-modules-list) (setq eshell-modules-list modules-list)) ＠＠ -420,8 +418,6 ＠＠ (if (and load-hook (boundp load-hook)) (run-hooks load-hook)))) - (make-local-hook 'pre-command-hook) - (if eshell-send-direct-to-subprocesses (add-hook 'pre-command-hook 'eshell-intercept-commands t t)) ＠＠ -432,12 +428,9 ＠＠ (set (make-local-variable 'scroll-conservatively) 1000)) (when eshell-status-in-modeline - (make-local-hook 'eshell-pre-command-hook) (add-hook 'eshell-pre-command-hook 'eshell-command-started nil t) - (make-local-hook 'eshell-post-command-hook) (add-hook 'eshell-post-command-hook 'eshell-command-finished nil t)) - (make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook (function (lambda () ＠＠ -445,7 +438,7 ＠＠ (if eshell-first-time-p (run-hooks 'eshell-first-time-mode-hook)) - (run-hooks 'eshell-mode-hook) + (run-mode-hooks 'eshell-mode-hook) (run-hooks 'eshell-post-command-hook)) (put 'eshell-mode 'mode-class 'special) ＠＠ -498,9 +491,7 ＠＠ (process-send-string (eshell-interactive-process) (char-to-string (if (symbolp last-command-char) - (if (fboundp 'get-character-of-keysym) - (get-character-of-keysym last-command-char) - (get last-command-char 'ascii-character)) + (get last-command-char 'ascii-character) last-command-char)))) (defun eshell-intercept-commands () ＠＠ -529,7 +520,8 ＠＠ (let ((inhibit-read-only t) (no-default (eobp)) (find-tag-default-function 'ignore)) - (setq tagname (car (find-tag-interactive "Find tag: "))) + (with-no-warnings + (setq tagname (car (find-tag-interactive "Find tag: ")))) (find-tag tagname next-p regexp-p))) (defun eshell-move-argument (limit func property arg) ＠＠ -675,7 +667,7 ＠＠ (eshell-match-result "alpha\n")) (defun eshell-send-input (&optional use-region queue-p no-newline) - "Send the input received to Eshell for parsing and processing.. + "Send the input received to Eshell for parsing and processing. After `eshell-last-output-end', sends all text from that marker to point as input. Before that marker, calls `eshell-get-old-input' to retrieve old input, copies it to the end of the buffer, and sends it. ＠＠ -752,19 +744,19 ＠＠ (run-hooks 'eshell-post-command-hook) (insert-and-inherit input))))))))) -(eshell-deftest proc send-to-subprocess - "Send input to a subprocess" - ;; jww (1999-12-06): what about when bc is unavailable? - (if (not (eshell-search-path "bc")) - t - (eshell-insert-command "bc") - (eshell-insert-command "1 + 2") - (sit-for 1 0) - (forward-line -1) - (prog1 - (looking-at "3\n") - (eshell-insert-command "quit") - (sit-for 1 0)))) +; (eshell-deftest proc send-to-subprocess +; "Send input to a subprocess" +; ;; jww (1999-12-06): what about when bc is unavailable? +; (if (not (eshell-search-path "bc")) +; t +; (eshell-insert-command "bc") +; (eshell-insert-command "1 + 2") +; (sit-for 1 0) +; (forward-line -1) +; (prog1 +; (looking-at "3\n") +; (eshell-insert-command "quit") +; (sit-for 1 0)))) (defsubst eshell-kill-new () "Add the last input text to the kill ring." ＠＠ -829,7 +821,7 ＠＠ "Go to the end of buffer in all windows showing it. Movement occurs if point in the selected window is not after the process mark, and `this-command' is an insertion command. Insertion -commands recognised are `self-insert-command', `yank', and +commands recognized are `self-insert-command', `yank', and `hilit-yank'. Depends on the value of `eshell-scroll-to-bottom-on-input'. ＠＠ -955,10 +947,11 ＠＠ (eshell-bol) (kill-region (point) here)))) -(defun eshell-show-maximum-output () - "Put the end of the buffer at the bottom of the window." - (interactive) - (if (interactive-p) +(defun eshell-show-maximum-output (&optional interactive) + "Put the end of the buffer at the bottom of the window. +When run interactively, widen the buffer first." + (interactive "p") + (if interactive (widen)) (goto-char (point-max)) (recenter -1)) ＠＠ -1014,7 +1007,7 ＠＠ (let ((pos (point))) (if (bobp) (if (interactive-p) - (error "Buffer too short to truncate")) + (message "Buffer too short to truncate")) (delete-region (point-min) (point)) (if (interactive-p) (message "Truncated buffer from %d to %d lines (%.1fk freed)" ＠＠ -1024,12 +1017,12 ＠＠ (custom-add-option 'eshell-output-filter-functions 'eshell-truncate-buffer) -(defun send-invisible (str) +(defun eshell-send-invisible (str) "Read a string without echoing. Then send it to the process running in the current buffer." (interactive "P") ; Defeat snooping via C-x ESC ESC (let ((str (read-passwd - (format "Password: " + (format "%s Password: " (process-name (eshell-interactive-process)))))) (if (stringp str) (process-send-string (eshell-interactive-process) ＠＠ -1038,7 +1031,7 ＠＠ (defun eshell-watch-for-password-prompt () "Prompt in the minibuffer for password and send without echoing. -This function uses `send-invisible' to read and send a password to the +This function uses `eshell-send-invisible' to read and send a password to the buffer's process if STRING contains a password prompt defined by `eshell-password-prompt-regexp'. ＠＠ -1049,7 +1042,7 ＠＠ (beginning-of-line) (if (re-search-forward eshell-password-prompt-regexp eshell-last-output-end t) - (send-invisible nil))))) + (eshell-send-invisible nil))))) (custom-add-option 'eshell-output-filter-functions 'eshell-watch-for-password-prompt) ＠＠ -1087,6 +1080,13 ＠＠ (custom-add-option 'eshell-output-filter-functions 'eshell-handle-control-codes) -;;; Code: +(defun eshell-handle-ansi-color () + "Handle ANSI color codes." + (require 'ansi-color) + (ansi-color-apply-on-region eshell-last-output-start + eshell-last-output-end)) + +(custom-add-option 'eshell-output-filter-functions + 'eshell-handle-ansi-color) ;;; esh-mode.el ends here Index: esh-module.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-module.el,v retrieving revision 1.1 diff -u -r1.1 esh-module.el --- esh-module.el 2001/01/10 02:52:57 1.1 +++ esh-module.el 2008/08/19 15:55:08 ＠＠ -1,6 +1,7 ＠＠ -;;; esh-module --- Eshell modules +;;; esh-module.el --- Eshell modules -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ;; Keywords: processes ＠＠ -19,8 +20,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'esh-module) ＠＠ -41,32 +42,33 ＠＠ (defun eshell-load-defgroups (&optional directory) "Load `defgroup' statements from Eshell's module files." - (with-current-buffer - (find-file-noselect (expand-file-name "esh-groups.el" directory)) - (erase-buffer) - (insert ";;; do not modify this file; it is auto-generated\n\n") - (let ((files (directory-files (or directory - (car command-line-args-left)) - nil "\\`em-.*\\.el\\'"))) - (while files - (message "Loading defgroup from `%s'" (car files)) - (let (defgroup) - (catch 'handled - (with-current-buffer (find-file-noselect (car files)) - (goto-char (point-min)) - (while t - (forward-sexp) - (if (eobp) (throw 'handled t)) - (backward-sexp) - (let ((begin (point)) - (defg (looking-at "(defgroup"))) + (let ((vc-handled-backends nil)) ; avoid VC fucking things up + (with-current-buffer + (find-file-noselect (expand-file-name "esh-groups.el" directory)) + (erase-buffer) + (insert ";;; do not modify this file; it is auto-generated -*- no-byte-compile: t -*-\n\n") + (let ((files (directory-files (or directory + (car command-line-args-left)) + nil "\\`em-.*\\.el\\'"))) + (while files + (message "Loading defgroup from `%s'" (car files)) + (let (defgroup) + (catch 'handled + (with-current-buffer (find-file-noselect (car files)) + (goto-char (point-min)) + (while t (forward-sexp) - (if defg - (setq defgroup (buffer-substring begin (point)))))))) - (if defgroup - (insert defgroup "\n\n"))) - (setq files (cdr files)))) - (save-buffer))) + (if (eobp) (throw 'handled t)) + (backward-sexp) + (let ((begin (point)) + (defg (looking-at "(defgroup"))) + (forward-sexp) + (if defg + (setq defgroup (buffer-substring begin (point)))))))) + (if defgroup + (insert defgroup "\n\n"))) + (setq files (cdr files)))) + (save-buffer)))) ;; load the defgroup's for the standard extension modules, so that ;; documentation can be provided when the user customize's Index: esh-opt.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-opt.el,v retrieving revision 1.1 diff -u -r1.1 esh-opt.el --- esh-opt.el 2001/01/10 02:52:57 1.1 +++ esh-opt.el 2008/08/19 15:55:08 ＠＠ -1,6 +1,7 ＠＠ -;;; esh-opt --- command options processing +;;; esh-opt.el --- command options processing -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'esh-opt) ＠＠ -98,7 +99,7 ＠＠ last-value (eval (append (list 'progn) body-forms))) nil)) - (error usage-msg)))) + (error "%s" usage-msg)))) (throw 'eshell-external (eshell-external-command ext-command args)) last-value)) Index: esh-proc.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-proc.el,v retrieving revision 1.1 diff -u -r1.1 esh-proc.el --- esh-proc.el 2001/01/10 02:52:58 1.1 +++ esh-proc.el 2008/08/19 15:55:09 ＠＠ -1,6 +1,7 ＠＠ -;;; esh-proc --- process management +;;; esh-proc.el --- process management -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'esh-proc) ＠＠ -118,9 +119,9 ＠＠ (define-key eshell-command-map [(control ?c)] 'eshell-interrupt-process) (define-key eshell-command-map [(control ?k)] 'eshell-kill-process) (define-key eshell-command-map [(control ?d)] 'eshell-send-eof-to-process) - (define-key eshell-command-map [(control ?q)] 'eshell-continue-process) +; (define-key eshell-command-map [(control ?q)] 'eshell-continue-process) (define-key eshell-command-map [(control ?s)] 'list-processes) - (define-key eshell-command-map [(control ?z)] 'eshell-stop-process) +; (define-key eshell-command-map [(control ?z)] 'eshell-stop-process) (define-key eshell-command-map [(control ?\\)] 'eshell-quit-process)) (defun eshell-reset-after-proc (proc status) ＠＠ -180,7 +181,7 ＠＠ (setq signum (abs (string-to-number id)))) ((stringp id) (let (case-fold-search) - (if (string-match "^-\$[A-Z]+\$$" id) + (if (string-match "^-\$[A-Z]+[12]?\$$" id) (setq signum (intern (concat "SIG" (match-string 1 id)))) (error "kill: bad signal spec `%s'" id)))) ＠＠ -224,8 +225,8 ＠＠ (if (and (eshell-processp (car entry)) (nth 2 entry) eshell-done-messages-in-minibuffer) - (message (format "[%s]+ Done %s" (process-name (car entry)) - (process-command (car entry))))) + (message "[%s]+ Done %s" (process-name (car entry)) + (process-command (car entry)))) (setq eshell-process-list (delq entry eshell-process-list))) ＠＠ -480,20 +481,20 ＠＠ (unless (eshell-process-interact 'quit-process) (run-hook-with-args 'eshell-kill-hook nil "quit"))) -(defun eshell-stop-process () - "Send STOP signal to process." - (interactive) - (unless (eshell-process-interact 'stop-process) - (run-hook-with-args 'eshell-kill-hook nil "stopped"))) - -(defun eshell-continue-process () - "Send CONTINUE signal to process." - (interactive) - (unless (eshell-process-interact 'continue-process) - ;; jww (1999-09-17): this signal is not dealt with yet. For - ;; example, `eshell-reset' will be called, and so will - ;; `eshell-resume-eval'. - (run-hook-with-args 'eshell-kill-hook nil "continue"))) +;(defun eshell-stop-process () +; "Send STOP signal to process." +; (interactive) +; (unless (eshell-process-interact 'stop-process) +; (run-hook-with-args 'eshell-kill-hook nil "stopped"))) + +;(defun eshell-continue-process () +; "Send CONTINUE signal to process." +; (interactive) +; (unless (eshell-process-interact 'continue-process) +; ;; jww (1999-09-17): this signal is not dealt with yet. For +; ;; example, `eshell-reset' will be called, and so will +; ;; `eshell-resume-eval'. +; (run-hook-with-args 'eshell-kill-hook nil "continue"))) (defun eshell-send-eof-to-process () "Send EOF to process." Index: esh-test.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-test.el,v retrieving revision 1.1 diff -u -r1.1 esh-test.el --- esh-test.el 2001/01/10 02:52:59 1.1 +++ esh-test.el 2008/08/19 15:55:09 ＠＠ -1,6 +1,7 ＠＠ -;;; esh-test --- Eshell test suite +;;; esh-test.el --- Eshell test suite -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'esh-test) ＠＠ -42,18 +43,22 ＠＠ ;;; User Variables: -(defface eshell-test-ok-face +(defface eshell-test-ok '((((class color) (background light)) (:foreground "Green" :bold t)) (((class color) (background dark)) (:foreground "Green" :bold t))) "*The face used to highlight OK result strings." :group 'eshell-test) +;; backward-compatibility alias +(put 'eshell-test-ok-face 'face-alias 'eshell-test-ok) -(defface eshell-test-failed-face +(defface eshell-test-failed '((((class color) (background light)) (:foreground "OrangeRed" :bold t)) (((class color) (background dark)) (:foreground "OrangeRed" :bold t)) (t (:bold t))) "*The face used to highlight FAILED result strings." :group 'eshell-test) +;; backward-compatibility alias +(put 'eshell-test-failed-face 'face-alias 'eshell-test-failed) (defcustom eshell-show-usage-metrics nil "*If non-nil, display different usage metrics for each Eshell command." ＠＠ -108,12 +113,10 ＠＠ (if truth (progn (setq str " OK ") - (put-text-property 0 6 'face - 'eshell-test-ok-face str)) + (put-text-property 0 6 'face 'eshell-test-ok str)) (setq str "FAILED") (setq eshell-test-failures (1+ eshell-test-failures)) - (put-text-property 0 6 'face - 'eshell-test-failed-face str)) + (put-text-property 0 6 'face 'eshell-test-failed str)) str) "]") (add-text-properties (line-beginning-position) (point) (list 'test-func funcsym)) ＠＠ -125,7 +128,7 ＠＠ (let ((fsym (get-text-property (point) 'test-func))) (when fsym (let* ((def (symbol-function fsym)) - (library (locate-library (symbol-file fsym))) + (library (locate-library (symbol-file fsym 'defun))) (name (substring (symbol-name fsym) (length "eshell-test--"))) (inhibit-redisplay t)) ＠＠ -167,13 +170,7 ＠＠ (local-set-key [(control ?m)] 'eshell-test-goto-func) (local-set-key [return] 'eshell-test-goto-func) - (insert "Testing Eshell under " - (format "GNU Emacs %s (%s%s)" - emacs-version - system-configuration - (cond ((featurep 'motif) ", Motif") - ((featurep 'x-toolkit) ", X toolkit") - (t "")))) + (insert "Testing Eshell under " (emacs-version)) (switch-to-buffer test-buffer) (delete-other-windows)) (eshell-for funcname (sort (all-completions "eshell-test--" Index: esh-util.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-util.el,v retrieving revision 1.5 diff -u -r1.5 esh-util.el --- esh-util.el 2007/09/04 09:00:06 1.5 +++ esh-util.el 2008/08/19 15:55:11 ＠＠ -1,6 +1,7 ＠＠ -;;; esh-util --- general utilities +;;; esh-util.el --- general utilities -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'esh-util) ＠＠ -84,11 +85,22 ＠＠ (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'." +`eshell-number-regexp'. + +NOTE: If you find that numeric conversions are intefering with the +specification of filenames (for example, in calling `find-file', or +some other Lisp function that deals with files, not numbers), add the +following in your .emacs file: + + (put 'find-file 'eshell-no-numeric-conversions t) + +Any function with the property `eshell-no-numeric-conversions' set to +a non-nil value, will be passed strings, not numbers, even when an +argument matches `eshell-number-regexp'." :type 'boolean :group 'eshell-util) -(defcustom eshell-number-regexp "\$0\\|-?[1-9][0-9]*\\(\\.[0-9]+\$?\\)" +(defcustom eshell-number-regexp "-?\$[0-9]*\\.\$?[0-9]+\$e[-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 ＠＠ -98,7 +110,7 ＠＠ (defcustom eshell-ange-ls-uids nil "*List of user/host/id strings, used to determine remote ownership." -:type '(repeat (cons :tag "Host/User Pair" +:type '(repeat (cons :tag "Host for User/UID map" (string :tag "Hostname") (repeat (cons :tag "User/UID List" (string :tag "Username") ＠＠ -225,7 +237,7 ＠＠ (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 (eshell-copy-list l)) + (let* ((a (copy-sequence l)) result) (if (and m (consp (nthcdr m a))) (setcdr (nthcdr m a) nil)) ＠＠ -439,8 +451,8 ＠＠ (point) (progn (end-of-line) (point))) ":"))) (if (and (and fields (nth 0 fields) (nth 2 fields)) - (not (assq (string-to-int (nth 2 fields)) names))) - (setq names (cons (cons (string-to-int (nth 2 fields)) + (not (assq (string-to-number (nth 2 fields)) names))) + (setq names (cons (cons (string-to-number (nth 2 fields)) (nth 0 fields)) names)))) (forward-line)))) ＠＠ -577,14 +589,20 ＠＠ 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)) ange-cache) + (defun directory-files-and-attributes (directory &optional full match nosort) + "Return a list of names of files and their attributes in DIRECTORY. +There are three optional arguments: +If FULL is non-nil, return absolute file names. Otherwise return names + that are relative to the specified directory. +If MATCH is non-nil, mention only file names that match the regexp MATCH. +If NOSORT is non-nil, the list is not sorted--its order is unpredictable. + NOSORT is useful if you plan to sort the result yourself." + (let ((directory (expand-file-name directory)) ange-cache) (mapcar (function (lambda (file) - (cons file (eshell-file-attributes (expand-file-name file dir))))) - (directory-files dir full match nosort))))) + (cons file (eshell-file-attributes (expand-file-name file directory))))) + (directory-files directory full match nosort))))) (eval-when-compile (defvar ange-cache)) ＠＠ -699,32 +717,7 ＠＠ (setq entry nil))))))) (or entry (funcall handler 'file-attributes file))))) -(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))) - (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) +(defalias 'eshell-copy-tree 'copy-tree) (defsubst eshell-processp (proc) "If the `processp' function does not exist, PROC is not a process." Index: esh-var.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/esh-var.el,v retrieving revision 1.1 diff -u -r1.1 esh-var.el --- esh-var.el 2001/01/10 02:53:01 1.1 +++ esh-var.el 2008/08/19 15:55:11 ＠＠ -1,6 +1,7 ＠＠ -;;; esh-var --- handling of variables +;;; esh-var.el --- handling of variables -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> ＠＠ -18,8 +19,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'esh-var) ＠＠ -28,7 +29,7 ＠＠ (defgroup eshell-var nil "Variable interpolation is introduced whenever the '$' character appears unquoted in any argument (except when that argument is -surrounded by single quotes) . It may be used to interpolate a +surrounded by single quotes). It may be used to interpolate a variable value, a subcommand, or even the result of a Lisp form." :tag "Variable handling" :group 'eshell) ＠＠ -137,6 +138,11 ＠＠ :type 'boolean :group 'eshell-var) +(defcustom eshell-modify-global-environment nil + "*If non-nil, using `export' changes Emacs's global environment." +:type 'boolean +:group 'eshell-var) + (defcustom eshell-variable-name-regexp "[A-Za-z0-9_-]+" "*A regexp identifying what constitutes a variable name reference. Note that this only applies for '$NAME'. If the syntax '$<NAME>' is ＠＠ -199,7 +205,9 ＠＠ "Initialize the variable handle code." ;; Break the association with our parent's environment. Otherwise, ;; changing a variable will affect all of Emacs. - (set (make-local-variable 'process-environment) (eshell-copy-environment)) + (unless eshell-modify-global-environment + (set (make-local-variable 'process-environment) + (eshell-copy-environment))) (define-key eshell-command-map [(meta ?v)] 'eshell-insert-envvar) ＠＠ -272,7 +280,7 ＠＠ (eshell-parse-variable)))) (defun eshell/define (var-alias definition) - "Define an VAR-ALIAS using DEFINITION." + "Define a VAR-ALIAS using DEFINITION." (if (not definition) (setq eshell-variable-aliases-list (delq (assoc var-alias eshell-variable-aliases-list) ＠＠ -293,7 +301,7 ＠＠ nil) (defun eshell/export (&rest sets) - "This alias allows the 'export' command to act as bash users expect." + "This alias allows the `export' command to act as bash users expect." (while sets (if (and (stringp (car sets)) (string-match "^\$[^=]+\$=\$.*\$" (car sets))) ＠＠ -426,11 +434,11 ＠＠ (eshell-parse-double-quote)))) (if name (list 'eshell-get-variable (eval name) 'indices)))) - ((eq (char-after) ?<) + ((eq (char-after) ?\<) (let ((end (eshell-find-delimiter ?\< ?\>))) (if (not end) (throw 'eshell-incomplete ?\<) - (let* ((temp (make-temp-name temporary-file-directory)) + (let* ((temp (make-temp-file temporary-file-directory)) (cmd (concat (buffer-substring (1+ (point)) end) " > " temp))) (prog1 ＠＠ -564,7 +572,7 ＠＠ (split-string value separator))))) (cond ((< (length refs) 0) - (error "Illegal array variable index: %s" + (error "Invalid array variable index: %s" (eshell-stringify refs))) ((= (length refs) 1) (setq value (eshell-index-value value (car refs)))) Index: eshell.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eshell/eshell.el,v retrieving revision 1.3 diff -u -r1.3 eshell.el --- eshell.el 2004/06/28 21:45:14 1.3 +++ eshell.el 2008/08/19 15:55:13 ＠＠ -1,8 +1,10 ＠＠ -;;; eshell --- the Emacs command shell +;;; eshell.el --- the Emacs command shell -;; Copyright (C) 1999, 2000 Free Software Foundation +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw(a)gnu.org> +;; Version: 2.4.2 ;; Keywords: processes ;; This file is part of GNU Emacs. ＠＠ -19,8 +21,8 ＠＠ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. (provide 'eshell) ＠＠ -33,7 +35,7 ＠＠ bash, zsh, rc, 4dos; since Emacs itself is capable of handling most of the tasks accomplished by such tools." :tag "The Emacs shell" -:link '(info-link "(eshell)The Emacs shell") +:link '(info-link "(eshell)Top") :version "21.1" :group 'applications) ＠＠ -63,7 +65,7 ＠＠ ;; ＠ Command argument completion (tcsh, zsh) ;; ＠ Input history management (bash) ;; ＠ Intelligent output scrolling -;; ＠ Psuedo-devices (such as "/dev/clip" for copying to the clipboard) +;; ＠ Pseudo-devices (such as "/dev/clip" for copying to the clipboard) ;; ＠ Extended globbing (zsh) ;; ＠ Argument and globbing predication (zsh) ;; ＠ I/O redirection to buffers, files, symbols, processes, etc. ＠＠ -85,8 +87,8 ＠＠ ;; ;; You should have received a copy of the GNU General Public License ;; along with Eshell; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +;; MA 02110-1301, USA. ;; ;;;_* How to begin ;; ＠＠ -210,11 +212,63 ＠＠ ;; ＠ 4nt ;; ＠ csh +;;;_* Speeding up load time +;; +;; If you find that Eshell loads too slowly, there is something you +;; can do to speed it up. +;; +;; Create a file, named /tmp/elc, containing this filelist: +;; +;; esh-util.elc +;; eshell.elc +;; esh-module.elc +;; esh-var.elc +;; esh-proc.elc +;; esh-arg.elc +;; esh-io.elc +;; esh-ext.elc +;; esh-cmd.elc +;; esh-mode.elc +;; esh-opt.elc +;; em-alias.elc +;; em-banner.elc +;; em-basic.elc +;; em-cmpl.elc +;; em-dirs.elc +;; em-pred.elc +;; em-glob.elc +;; em-hist.elc +;; em-ls.elc +;; em-prompt.elc +;; em-rebind.elc +;; em-script.elc +;; em-smart.elc +;; em-term.elc +;; em-unix.elc +;; em-xtra.elc +;; +;; The order is very important. Remove from the filelist any features +;; you don't use. These all begin with "em-". If you don't use +;; Eshell's key rebinding module, you can remove "em-rebind.elc" from +;; the filelist. The modules you are currently using are listed in +;; `eshell-modules-list'. +;; +;; Now, concatenating all of the above mentioned .elc files, in that +;; order, to another file. Here is how to do this on UNIX: +;; +;; cat `cat /tmp/elc` > tmp.elc ; mv tmp.elc eshell.elc +;; +;; Now your eshell.elc file contains all of the .elc files that make +;; up Eshell, in the right load order. When you next load Eshell, it +;; will only have to read in this one file, which will greatly speed +;; things up. + ;;;_* User Options ;; ;; The following user options modify the behavior of Eshell overall. -(load "esh-util" nil t) +(unless (featurep 'esh-util) + (load "esh-util" nil t)) (defsubst eshell-add-to-window-buffer-names () "Add `eshell-buffer-name' to `same-window-buffer-names'." ＠＠ -254,7 +308,6 ＠＠ "`eshell-buffer-name' is a member of `same-window-buffer-names'" (member eshell-buffer-name same-window-buffer-names)) -;;;###autoload (defcustom eshell-directory-name (convert-standard-filename "~/.eshell/") "*The directory where Eshell control files should be kept." :type 'directory ＠＠ -270,6 +323,7 ＠＠ (= (file-modes eshell-directory-name) eshell-private-directory-modes))) +;; XEmacs Specific (defcustom eshell-prefer-to-shell nil "*If non-nil, \\[shell-command] will use Eshell instead of shell-mode." :set (lambda (symbol value) ＠＠ -300,13 +354,20 ＠＠ The buffer used for Eshell sessions is determined by the value of `eshell-buffer-name'. If there is already an Eshell session active in that buffer, Emacs will simply switch to it. Otherwise, a new session -will begin. A new session is always created if the the prefix -argument ARG is specified. Returns the buffer selected (or created)." +will begin. A numeric prefix arg (as in `C-u 42 M-x eshell RET') +switches to the session with that number, creating it if necessary. A +nonnumeric prefix arg means to create a new session. Returns the +buffer selected (or created)." (interactive "P") (assert eshell-buffer-name) - (let ((buf (if arg - (generate-new-buffer eshell-buffer-name) - (get-buffer-create eshell-buffer-name)))) + (let ((buf (cond ((numberp arg) + (get-buffer-create (format "%s<%d>" + eshell-buffer-name + arg))) + (arg + (generate-new-buffer eshell-buffer-name)) + (t + (get-buffer-create eshell-buffer-name))))) ;; Simply calling `pop-to-buffer' will not mimic the way that ;; shell-mode buffers appear, since they always reuse the same ;; window that that command was invoked from. To achieve this, ＠＠ -314,11 +375,10 ＠＠ ;; `same-window-buffer-names', which is done when Eshell is loaded (assert (and buf (buffer-live-p buf))) (pop-to-buffer buf) - (unless (fboundp 'eshell-mode) + (if (fboundp 'eshell-mode) + (unless (eq major-mode 'eshell-mode) + (eshell-mode)) (error "`eshell-auto' must be loaded before Eshell can be used")) - (unless (eq major-mode 'eshell-mode) - (eshell-mode)) - (assert (eq major-mode 'eshell-mode)) buf)) (defun eshell-return-exits-minibuffer () ＠＠ -329,19 +389,28 ＠＠ (define-key eshell-mode-map [(meta return)] 'exit-minibuffer) (define-key eshell-mode-map [(meta control ?m)] 'exit-minibuffer)) +(defvar eshell-non-interactive-p nil + "A variable which is non-nil when Eshell is not running interactively. +Modules should use this variable so that they don't clutter +non-interactive sessions, such as when using `eshell-command'.") + ;;;###autoload (defun eshell-command (&optional command arg) "Execute the Eshell command string COMMAND. With prefix ARG, insert output into the current buffer at point." (interactive) (require 'esh-cmd) - (setq arg current-prefix-arg) + (unless arg + (setq arg current-prefix-arg)) (unwind-protect (let ((eshell-non-interactive-p t)) (add-hook 'minibuffer-setup-hook 'eshell-mode) + (add-hook 'minibuffer-exit-hook 'eshell-add-command-to-history) (add-hook 'eshell-mode-hook 'eshell-return-exits-minibuffer) - (setq command (read-from-minibuffer "Emacs shell command: "))) + (unless command + (setq command (read-from-minibuffer "Emacs shell command: ")))) (remove-hook 'eshell-mode-hook 'eshell-return-exits-minibuffer) + (remove-hook 'minibuffer-exit-hook 'eshell-add-command-to-history) (remove-hook 'minibuffer-setup-hook 'eshell-mode)) (unless command (error "No command specified!")) ＠＠ -390,7 +459,7 ＠＠ (message "(There was no command output)") (kill-buffer buf)) ((= len 1) - (message (buffer-string)) + (message "%s" (buffer-string)) (kill-buffer buf)) (t (save-selected-window ＠＠ -446,7 +515,7 ＠＠ ;;;###autoload (defun eshell-report-bug (topic) "Report a bug in Eshell. -Prompts for the TOPIC. Leaves you in a mail buffer. +Prompts for the TOPIC. Leaves you in a mail buffer. Please include any configuration details that might be involved." (interactive "sBug Subject: ") (compose-mail eshell-report-bug-address topic) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

2 participants
1 comments

[PATCH] (revised) Handle varalias chains, custom variables in #'user-variable-p. 16 years, 4 months

Aidan Kehoe

Ar an tríú lá is fiche de mí Lúnasa, scríobh John Paul Wallington: > > +\(defmacro portable-defvaralias (variable aliased &optional docstring) > > + \(if (featurep 'xemacs) > > + `(defvaralias ,variable ,＠(cons aliased (if docstring (list docstring)))) > > + `(defvaralias ,aliased ,＠(cons variable (if docstring (list docstring)))))) > > Are you sure about this? I was, but now that I check again I see that the existing variable I was using to check on GNU wasn’t actually available there, which led me astray, and your description is exactly right. Thanks for the correction, here’s a revised patch. SUPERSEDES 18607.61913.395428.309154(a)parhasard.net # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1219502331 -7200 # Node ID 052eccec3209acf24c8cd4235d770815a0aa3e03 # Parent c4fd85dd95bd72e8c7899ed48075c2fb26e365fa Handle varalias chains, custom variables in #'user-variable-p. src/ChangeLog addition: 2008-08-23 Aidan Kehoe <kehoea(a)parhasard.net> * eval.c (Fuser_variable_p): Moved to symbols.c * symbols.c (Fcustom_variable_p): Moved here from custom.el. (user_variable_alias_check_fun): Mapper function used in `user-variable-p'. (Fuser_variable_p): Moved here from eval.c, to allow it to examine the variable alias chain. Expanded to check each entry in the variable alias chain for signs of being a user variable; documentation updated, noting the differences between GNU's behaviour and ours (ours is a little more sensible) (map_varalias_chain): New. Given a C function, call it at least once for each symbol in a symbol's varalias chain, signalling an error if there's a cycle, and returning immediately if the function returns something other than Qzero. (Fdefvaralias): Correct the use of the word "alias" in the docstring and in the argument name. Motivate this in a comment. Add support for a DOCSTRING argument, something GNU has too, and document this * gc.c (vars_of_gc): Start the docstring of `garbage-collection-messages' with an asterisk, to indicate that it's a user variable. lisp/ChangeLog addition: 2008-08-23 Aidan Kehoe <kehoea(a)parhasard.net> * custom.el: Move #'custom-variable-p to C, since it's now called from #'user-variable-p. diff -r c4fd85dd95bd -r 052eccec3209 lisp/ChangeLog --- a/lisp/ChangeLog Wed Aug 20 17:39:56 2008 +0200 +++ b/lisp/ChangeLog Sat Aug 23 16:38:51 2008 +0200 ＠＠ -1,3 +1,8 ＠＠ +2008-08-23 Aidan Kehoe <kehoea(a)parhasard.net> + + * custom.el: Move #'custom-variable-p to C, since it's now called + from #'user-variable-p. + 2008-08-09 Aidan Kehoe <kehoea(a)parhasard.net> * subr.el (skip-chars-quote): New. diff -r c4fd85dd95bd -r 052eccec3209 lisp/custom.el --- a/lisp/custom.el Wed Aug 20 17:39:56 2008 +0200 +++ b/lisp/custom.el Sat Aug 23 16:38:51 2008 +0200 ＠＠ -514,11 +514,9 ＠＠ (put symbol 'custom-autoload t) (custom-add-load symbol load)) -;; This test is also in the C code of `user-variable-p'. -(defun custom-variable-p (variable) - "Return non-nil if VARIABLE is a custom variable." - (or (get variable 'standard-value) - (get variable 'custom-autoload))) +;; XEmacs; +;; #'custom-variable-p is in symbols.c, since it's called from +;; #'user-variable-p. ;;; Loading files needed to customize a symbol. ;;; This is in custom.el because menu-bar.el needs it for toggle cmds. diff -r c4fd85dd95bd -r 052eccec3209 src/ChangeLog --- a/src/ChangeLog Wed Aug 20 17:39:56 2008 +0200 +++ b/src/ChangeLog Sat Aug 23 16:38:51 2008 +0200 ＠＠ -1,3 +1,27 ＠＠ +2008-08-23 Aidan Kehoe <kehoea(a)parhasard.net> + + * eval.c (Fuser_variable_p): Moved to symbols.c + * symbols.c (Fcustom_variable_p): Moved here from custom.el. + (user_variable_alias_check_fun): Mapper function used in + `user-variable-p'. + (Fuser_variable_p): Moved here from eval.c, to allow it to examine + the variable alias chain. Expanded to check each entry in the + variable alias chain for signs of being a user variable; + documentation updated, noting the differences between GNU's + behaviour and ours (ours is a little more sensible) + (map_varalias_chain): New. + Given a C function, call it at least once for each symbol in a + symbol's varalias chain, signalling an error if there's a cycle, + and returning immediately if the function returns something other + than Qzero. + (Fdefvaralias): Correct the use of the word "alias" in the + docstring and in the argument name. Motivate this in a + comment. Add support for a DOCSTRING argument, something GNU has + too, and document this + * gc.c (vars_of_gc): Start the docstring of + `garbage-collection-messages' with an asterisk, to indicate that + it's a user variable. + 2008-08-09 Aidan Kehoe <kehoea(a)parhasard.net> Integrate Romain Francoise' 2005-09-14 (pre-GPLV3) GNU change, diff -r c4fd85dd95bd -r 052eccec3209 src/eval.c --- a/src/eval.c Wed Aug 20 17:39:56 2008 +0200 +++ b/src/eval.c Sat Aug 23 16:38:51 2008 +0200 ＠＠ -1356,29 +1356,8 ＠＠ return sym; } -DEFUN ("user-variable-p", Fuser_variable_p, 1, 1, 0, /* -Return t if VARIABLE is intended to be set and modified by users. -\(The alternative is a variable used internally in a Lisp program.) -Determined by whether the first character of the documentation -for the variable is `*'. -*/ - (variable)) -{ - Lisp_Object documentation = Fget (variable, Qvariable_documentation, Qnil); - - return - ((INTP (documentation) && XINT (documentation) < 0) || - - (STRINGP (documentation) && - (string_byte (documentation, 0) == '*')) || - - /* If (STRING . INTEGER), a negative integer means a user variable. */ - (CONSP (documentation) - && STRINGP (XCAR (documentation)) - && INTP (XCDR (documentation)) - && XINT (XCDR (documentation)) < 0)) ? - Qt : Qnil; -} +/* XEmacs: user-variable-p is in symbols.c, since it needs to mess around + with the symbol variable aliases. */ DEFUN ("macroexpand-internal", Fmacroexpand_internal, 1, 2, 0, /* Return result of expanding macros at top level of FORM. ＠＠ -6582,7 +6561,6 ＠＠ DEFSUBR (Fdefmacro); DEFSUBR (Fdefvar); DEFSUBR (Fdefconst); - DEFSUBR (Fuser_variable_p); DEFSUBR (Flet); DEFSUBR (FletX); DEFSUBR (Fwhile); diff -r c4fd85dd95bd -r 052eccec3209 src/gc.c --- a/src/gc.c Wed Aug 20 17:39:56 2008 +0200 +++ b/src/gc.c Sat Aug 23 16:38:51 2008 +0200 ＠＠ -2166,7 +2166,7 ＠＠ */ ); DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages /* - Non-nil means display messages at start and end of garbage collection. +*Non-nil means display messages at start and end of garbage collection. */ ); garbage_collection_messages = 0; diff -r c4fd85dd95bd -r 052eccec3209 src/symbols.c --- a/src/symbols.c Wed Aug 20 17:39:56 2008 +0200 +++ b/src/symbols.c Sat Aug 23 16:38:51 2008 +0200 ＠＠ -84,6 +84,9 ＠＠ static Lisp_Object *value_slot_past_magic (Lisp_Object sym); static Lisp_Object follow_varalias_pointers (Lisp_Object symbol, Lisp_Object follow_past_lisp_magic); +static Lisp_Object map_varalias_chain (Lisp_Object symbol, + Lisp_Object follow_past_lisp_magic, + Lisp_Object (*fn) (Lisp_Object arg)); static Lisp_Object ＠＠ -2754,6 +2757,78 ＠＠ else return local_info != 0 ? Qt : Qnil; } + +DEFUN ("custom-variable-p", Fcustom_variable_p, 1, 1, 0, /* +Return non-nil if SYMBOL names a custom variable. +Does not follow the variable alias chain. +*/ + (symbol)) +{ + return (!(NILP (Fget(symbol, intern ("standard-value"), Qnil))) + || !(NILP (Fget(symbol, intern ("custom-autoload"), Qnil)))) ? + Qt: Qnil; +} + +static Lisp_Object +user_variable_alias_check_fun (Lisp_Object symbol) +{ + Lisp_Object documentation = Fget (symbol, Qvariable_documentation, Qnil); + + if ((INTP (documentation) && XINT (documentation) < 0) || + (STRINGP (documentation) && + (string_byte (documentation, 0) == '*')) || + /* If (STRING . INTEGER), a negative integer means a user variable. */ + (CONSP (documentation) + && STRINGP (XCAR (documentation)) + && INTP (XCDR (documentation)) + && XINT (XCDR (documentation)) < 0) || + !NILP (Fcustom_variable_p (symbol))) + { + return make_int(1); + } + + return Qzero; +} + +DEFUN ("user-variable-p", Fuser_variable_p, 1, 1, 0, /* +Return t if SYMBOL names a variable intended to be set and modified by users. +\(The alternative is a variable used internally in a Lisp program.) +A symbol names a user variable if +\(1) the first character of its documentation is `*', or +\(2) it is customizable (`custom-variable-p' gives t), or +\(3) it names a variable alias that eventually resolves to another user variable. + +The GNU Emacs implementation of `user-variable-p' returns nil if there is a +loop in the chain of symbols. Since this is indistinguishable from the case +where a symbol names a non-user variable, XEmacs signals a +`cyclic-variable-indirection' error instead; use `condition-case' to catch +this error if you really want to avoid this. +*/ + (symbol)) +{ + Lisp_Object mapped; + + if (!SYMBOLP (symbol)) + { + return Qnil; + } + + /* Called for its side-effects, we want it to signal if there's a loop. */ + follow_varalias_pointers (symbol, Qt); + + /* Look through the varias aliases. */ + mapped = map_varalias_chain (symbol, Qt, user_variable_alias_check_fun); + if (EQ (Qzero, mapped)) + { + return Qnil; + } + + assert (make_int (1) == mapped); + + return Qt; +} + + /* ＠＠ -3136,20 +3211,98 ＠＠ return hare; } -DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /* +/* Map FN over the chain of variable aliases for SYMBOL. If FN returns + something other than Qzero for some link in the chain, return that + immediately. Otherwise return Qzero (which is not a symbol). + + FN may be called twice on the same symbol if the varalias chain is + cyclic. Prevent this by calling follow_varalias_pointers first for its + side-effects. + + Signals a cyclic-variable-indirection error if a cyclic structure is + detected. */ + +static Lisp_Object +map_varalias_chain (Lisp_Object symbol, + Lisp_Object follow_past_lisp_magic, + Lisp_Object (*fn) (Lisp_Object arg)) +{ +#define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16 + Lisp_Object tortoise, hare, val, res; + int count; + + assert (fn); + + /* quick out just in case */ + if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value)) + { + return (fn)(symbol); + } + + /* Compare implementation of indirect_function(). */ + for (hare = tortoise = symbol, count = 0; + val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic), + SYMBOL_VALUE_VARALIAS_P (val); + hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)), + count++) + { + res = (fn) (hare); + if (Qzero != res) + { + return res; + } + + if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue; + + if (count & 1) + tortoise = symbol_value_varalias_aliasee + (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic + (tortoise, follow_past_lisp_magic))); + if (EQ (hare, tortoise)) + return Fsignal (Qcyclic_variable_indirection, list1 (symbol)); + } + + return (fn) (hare); +} + +/* + +OED entry, 2nd edition, IPA transliterated using Kirshenbaum: + +alias ('eIlI＠s, '&lI＠s), adv. and n. +[...] +B. n. (with pl. aliases.) +1. Another name, an assumed name. +1605 Camden Rem. (1614) 147 An Alias or double name cannot preiudice the honest. +1831 Edin. Rev. LIII. 364 He has been assuming various aliases. +1861 Macaulay Hist. Eng. V. 92 The monk who was sometimes called Harrison +and sometimes went by the alias of Johnson. + +The alias is the fake name. Let's try to follow that usage in our +documentation. + +*/ + +DEFUN ("defvaralias", Fdefvaralias, 2, 3, 0, /* Define a variable as an alias for another variable. Thenceforth, any operations performed on VARIABLE will actually be -performed on ALIAS. Both VARIABLE and ALIAS should be symbols. -If ALIAS is nil, remove any aliases for VARIABLE. -ALIAS can itself be aliased, and the chain of variable aliases +performed on ALIASED. Both VARIABLE and ALIASED should be symbols. +If ALIASED is nil and VARIABLE is an existing alias, remove that alias. +ALIASED can itself be an alias, and the chain of variable aliases will be followed appropriately. If VARIABLE already has a value, this value will be shadowed until the alias is removed, at which point it will be restored. Currently VARIABLE cannot be a built-in variable, a variable that has a buffer-local value in any buffer, or the symbols nil or t. -\(ALIAS, however, can be any type of variable.) +\(ALIASED, however, can be any type of variable.) + +Optional argument DOCSTRING is documentation for VARIABLE in its use as an +alias for ALIASED. The XEmacs help code ignores this documentation, using +the documentation of ALIASED instead, and the docstring, if specified, is +not shadowed in the same way that the value is. Only use it if you know +what you're doing. */ - (variable, alias)) + (variable, aliased, docstring)) { struct symbol_value_varalias *bfwd; Lisp_Object valcontents; ＠＠ -3159,7 +3312,7 ＠＠ valcontents = XSYMBOL (variable)->value; - if (NILP (alias)) + if (NILP (aliased)) { if (SYMBOL_VALUE_VARALIAS_P (valcontents)) { ＠＠ -3170,11 +3323,15 ＠＠ return Qnil; } - CHECK_SYMBOL (alias); + CHECK_SYMBOL (aliased); + + if (!NILP (docstring)) + Fput (variable, Qvariable_documentation, docstring); + if (SYMBOL_VALUE_VARALIAS_P (valcontents)) { /* transmogrify */ - XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias; + XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = aliased; return Qnil; } ＠＠ -3186,7 +3343,7 ＠＠ bfwd = ALLOC_LCRECORD_TYPE (struct symbol_value_varalias, &lrecord_symbol_value_varalias); bfwd->magic.type = SYMVAL_VARALIAS; - bfwd->aliasee = alias; + bfwd->aliasee = aliased; bfwd->shadowed = valcontents; valcontents = wrap_symbol_value_magic (bfwd); ＠＠ -3195,8 +3352,8 ＠＠ } DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /* -If VARIABLE is aliased to another variable, return that variable. -VARIABLE should be a symbol. If VARIABLE is not aliased, return nil. +If VARIABLE is an alias of another variable, return that variable. +VARIABLE should be a symbol. If VARIABLE is not an alias, return nil. Variable aliases are created with `defvaralias'. See also `indirect-variable'. */ ＠＠ -3755,6 +3912,8 ＠＠ DEFSUBR (Fkill_local_variable); DEFSUBR (Fkill_console_local_variable); DEFSUBR (Flocal_variable_p); + DEFSUBR (Fcustom_variable_p); + DEFSUBR (Fuser_variable_p); DEFSUBR (Fdefvaralias); DEFSUBR (Fvariable_alias); DEFSUBR (Findirect_variable); -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

1 participants
1 comments

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

XEmacs-Patches August 2008