Mercurial > hg > xemacs-beta
view src/dired.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 07 Feb 2011 12:01:24 +0000 |
parents | 94bbd4792049 |
children | af961911bcb2 0af042a0c116 |
line wrap: on
line source
/* Lisp functions for making directory listings. Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. Copyright (C) 2001, 2002 Ben Wing. This file is part of XEmacs. 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; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /* Synched up with: FSF 19.30. */ #include <config.h> #include "lisp.h" #include "buffer.h" #include "commands.h" #include "elhash.h" #include "opaque.h" #include "regex.h" #include "syntax.h" #include "sysdep.h" #include "sysdir.h" #include "sysfile.h" #include "syspwd.h" #include "systime.h" #ifdef WIN32_NATIVE #include "syswindows.h" #endif Lisp_Object Vcompletion_ignored_extensions; Lisp_Object Qdirectory_files; Lisp_Object Qfile_name_completion; Lisp_Object Qfile_name_all_completions; Lisp_Object Qfile_attributes; Lisp_Object Qfile_system_ignore_case_p; static Lisp_Object close_directory_unwind (Lisp_Object unwind_obj) { DIR *d = (DIR *)get_opaque_ptr (unwind_obj); qxe_closedir (d); free_opaque_ptr (unwind_obj); return Qnil; } DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /* Return a list of names of files in DIRECTORY. There are four optional arguments: If FULL is non-nil, absolute pathnames of the files are returned. If MATCH is non-nil, only pathnames whose basename contain that regexp are returned. 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. If FILES-ONLY is the symbol t, then only the "files" in the directory will be returned; subdirectories will be excluded. If FILES-ONLY is not nil and not t, then only the subdirectories will be returned. Otherwise, if FILES-ONLY is nil (the default) then both files and subdirectories will be returned. */ (directory, full, match, nosort, files_only)) { /* This function can GC */ DIR *d; Lisp_Object list = Qnil; Bytecount directorylen; Lisp_Object handler; struct re_pattern_buffer *bufp = NULL; int speccount = specpdl_depth (); Ibyte *statbuf, *statbuf_tail; struct gcpro gcpro1, gcpro2; GCPRO2 (directory, list); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (directory, Qdirectory_files); if (!NILP (handler)) { UNGCPRO; if (!NILP (files_only)) return call6 (handler, Qdirectory_files, directory, full, match, nosort, files_only); else return call5 (handler, Qdirectory_files, directory, full, match, nosort); } /* #### why do we do Fexpand_file_name after file handlers here, but earlier everywhere else? */ directory = Fexpand_file_name (directory, Qnil); directory = Ffile_name_as_directory (directory); directorylen = XSTRING_LENGTH (directory); statbuf = alloca_ibytes (directorylen + MAXNAMLEN + 1); memcpy (statbuf, XSTRING_DATA (directory), directorylen); statbuf_tail = statbuf + directorylen; /* XEmacs: this should come after Ffile_name_as_directory() to avoid potential regexp cache smashage. It comes before the opendir() because it might signal an error. */ if (!NILP (match)) { CHECK_STRING (match); /* MATCH might be a flawed regular expression. Rather than catching and signalling our own errors, we just call compile_pattern to do the work for us. */ bufp = compile_pattern (match, 0, Qnil, Qnil, 0, 0, ERROR_ME); } /* Now *bufp is the compiled form of MATCH; don't call anything which might compile a new regexp until we're done with the loop! */ /* Do this opendir after anything which might signal an error. NOTE: the above comment is old; previously, there was no unwind-protection in case of error, but now there is. */ d = qxe_opendir (XSTRING_DATA (directory)); if (!d) report_file_error ("Opening directory", directory); record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d)); /* Loop reading blocks */ while (1) { DIRENTRY *dp = qxe_readdir (d); int len; struct syntax_cache scache_struct; struct syntax_cache *scache = &scache_struct; if (!dp) break; len = NAMLEN (dp); if (DIRENTRY_NONEMPTY (dp) && (NILP (match) || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0, Qnil, 0, scache)))) { if (!NILP (files_only)) { struct stat st; int dir_p = 0; memcpy (statbuf_tail, dp->d_name, len); statbuf_tail[len] = 0; if (qxe_stat (statbuf, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR) dir_p = 1; if (EQ (files_only, Qt) && dir_p) continue; else if (!EQ (files_only, Qt) && !dir_p) continue; } { Lisp_Object name = make_string ((Ibyte *)dp->d_name, len); if (!NILP (full)) name = concat2 (directory, name); list = Fcons (name, list); } } } unbind_to (speccount); /* This will close the dir */ if (NILP (nosort)) list = list_sort (Fnreverse (list), check_string_lessp_nokey, Qnil, Qnil); RETURN_UNGCPRO (list); } static Lisp_Object file_name_completion (Lisp_Object file, Lisp_Object directory, int all_flag, int ver_flag); DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /* Complete file name PARTIAL-FILENAME in directory DIRECTORY. Return the longest prefix common to all file names in DIRECTORY that start with PARTIAL-FILENAME. If there is only one and PARTIAL-FILENAME matches it exactly, return t. Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME. File names which end with any member of `completion-ignored-extensions' are not considered as possible completions for PARTIAL-FILENAME unless there is no other possible completion. `completion-ignored-extensions' is not applied to the names of directories. */ (partial_filename, directory)) { /* This function can GC. GC checked 1996.04.06. */ Lisp_Object handler; /* If the directory name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (directory, Qfile_name_completion); if (!NILP (handler)) return call3 (handler, Qfile_name_completion, partial_filename, directory); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (partial_filename, Qfile_name_completion); if (!NILP (handler)) return call3 (handler, Qfile_name_completion, partial_filename, directory); return file_name_completion (partial_filename, directory, 0, 0); } DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /* Return a list of all completions of PARTIAL-FILENAME in DIRECTORY. These are all file names in DIRECTORY which begin with PARTIAL-FILENAME. */ (partial_filename, directory)) { /* This function can GC. GC checked 1997.06.04. */ Lisp_Object handler; struct gcpro gcpro1; GCPRO1 (directory); directory = Fexpand_file_name (directory, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (directory, Qfile_name_all_completions); UNGCPRO; if (!NILP (handler)) return call3 (handler, Qfile_name_all_completions, partial_filename, directory); return file_name_completion (partial_filename, directory, 1, 0); } static int file_name_completion_stat (Lisp_Object directory, DIRENTRY *dp, struct stat *st_addr) { Bytecount len = NAMLEN (dp); Bytecount pos = XSTRING_LENGTH (directory); int value; Ibyte *fullname = alloca_ibytes (len + pos + 2); memcpy (fullname, XSTRING_DATA (directory), pos); if (!IS_DIRECTORY_SEP (fullname[pos - 1])) fullname[pos++] = DIRECTORY_SEP; memcpy (fullname + pos, dp->d_name, len); fullname[pos + len] = 0; #ifdef S_IFLNK /* We want to return success if a link points to a nonexistent file, but we want to return the status for what the link points to, in case it is a directory. */ value = qxe_lstat (fullname, st_addr); if (S_ISLNK (st_addr->st_mode)) qxe_stat (fullname, st_addr); #else value = qxe_stat (fullname, st_addr); #endif return value; } static Lisp_Object file_name_completion_unwind (Lisp_Object locative) { DIR *d; Lisp_Object obj = XCAR (locative); if (!NILP (obj)) { d = (DIR *)get_opaque_ptr (obj); qxe_closedir (d); free_opaque_ptr (obj); } free_cons (locative); return Qnil; } static Lisp_Object file_name_completion (Lisp_Object file, Lisp_Object directory, int all_flag, int UNUSED (ver_flag)) { /* This function can GC */ DIR *d = 0; int matchcount = 0; Lisp_Object bestmatch = Qnil; Charcount bestmatchsize = 0; struct stat st; int passcount; int speccount = specpdl_depth (); Charcount file_name_length; Lisp_Object locative; struct gcpro gcpro1, gcpro2, gcpro3; GCPRO3 (file, directory, bestmatch); CHECK_STRING (file); #ifdef WIN32_NATIVE /* Filename completion on Windows ignores case, since Windows filesystems do. */ specbind (Qcompletion_ignore_case, Qt); #endif /* WIN32_NATIVE */ #ifdef FILE_SYSTEM_CASE file = FILE_SYSTEM_CASE (file); #endif directory = Fexpand_file_name (directory, Qnil); file_name_length = string_char_length (file); /* With passcount = 0, ignore files that end in an ignored extension. If nothing found then try again with passcount = 1, don't ignore them. If looking for all completions, start with passcount = 1, so always take even the ignored ones. ** It would not actually be helpful to the user to ignore any possible completions when making a list of them.** */ /* We cannot use close_directory_unwind() because we change the directory. The old code used to just avoid signaling errors, and call closedir, but it was wrong, because it made sane handling of QUIT impossible and, besides, various utility functions like regexp_ignore_completion_p can signal errors. */ locative = noseeum_cons (Qnil, Qnil); record_unwind_protect (file_name_completion_unwind, locative); for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++) { d = qxe_opendir (XSTRING_DATA (Fdirectory_file_name (directory))); if (!d) report_file_error ("Opening directory", directory); XCAR (locative) = make_opaque_ptr ((void *)d); /* Loop reading blocks */ while (1) { DIRENTRY *dp; Bytecount len; /* scmp() works in characters, not bytes, so we have to compute this value: */ Charcount cclen; int directoryp; int ignored_extension_p = 0; Ibyte *d_name; dp = qxe_readdir (d); if (!dp) break; /* Cast to Ibyte* is OK, as qxe_readdir() Mule-encapsulates. */ d_name = (Ibyte *) dp->d_name; len = NAMLEN (dp); cclen = bytecount_to_charcount (d_name, len); QUIT; if (! DIRENTRY_NONEMPTY (dp) || cclen < file_name_length || 0 <= scmp (d_name, XSTRING_DATA (file), file_name_length)) continue; /* Ignore file-too-large conditions; the mode is still filled in. */ if (file_name_completion_stat (directory, dp, &st) < 0 && errno != EOVERFLOW) continue; directoryp = ((st.st_mode & S_IFMT) == S_IFDIR); if (directoryp) { #ifndef TRIVIAL_DIRECTORY_ENTRY #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, "..")) #endif /* "." and ".." are never interesting as completions, but are actually in the way in a directory containing only one file. */ if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name)) continue; } else { /* Compare extensions-to-be-ignored against end of this file name */ /* if name is not an exact match against specified string. */ if (!passcount && cclen > file_name_length) { /* and exit this for loop if a match is found */ EXTERNAL_LIST_LOOP_2 (elt, Vcompletion_ignored_extensions) { Charcount skip; CHECK_STRING (elt); skip = cclen - string_char_length (elt); if (skip < 0) continue; if (0 > scmp (itext_n_addr (d_name, skip), XSTRING_DATA (elt), string_char_length (elt))) { ignored_extension_p = 1; break; } } } } /* If an ignored-extensions match was found, don't process this name as a completion. */ if (!passcount && ignored_extension_p) continue; if (!passcount && regexp_ignore_completion_p (d_name, Qnil, 0, len)) continue; /* Update computation of how much all possible completions match */ matchcount++; if (all_flag || NILP (bestmatch)) { Lisp_Object name = Qnil; struct gcpro ngcpro1; NGCPRO1 (name); /* This is a possible completion */ name = make_string (d_name, len); if (directoryp) /* Completion is a directory; end it with '/' */ name = Ffile_name_as_directory (name); if (all_flag) { bestmatch = Fcons (name, bestmatch); } else { bestmatch = name; bestmatchsize = string_char_length (name); } NUNGCPRO; } else { Charcount compare = min (bestmatchsize, cclen); Ibyte *p1 = XSTRING_DATA (bestmatch); Ibyte *p2 = d_name; Charcount matchsize = scmp (p1, p2, compare); if (matchsize < 0) matchsize = compare; if (completion_ignore_case) { /* If this is an exact match except for case, use it as the best match rather than one that is not an exact match. This way, we get the case pattern of the actual match. */ if ((matchsize == cclen && matchsize + !!directoryp < string_char_length (bestmatch)) || /* If there is no exact match ignoring case, prefer a match that does not change the case of the input. */ (((matchsize == cclen) == (matchsize + !!directoryp == string_char_length (bestmatch))) /* If there is more than one exact match aside from case, and one of them is exact including case, prefer that one. */ && 0 > scmp_1 (p2, XSTRING_DATA (file), file_name_length, 0) && 0 <= scmp_1 (p1, XSTRING_DATA (file), file_name_length, 0))) { bestmatch = make_string (d_name, len); if (directoryp) bestmatch = Ffile_name_as_directory (bestmatch); } } /* If this directory all matches, see if implicit following slash does too. */ if (directoryp && compare == matchsize && bestmatchsize > matchsize && IS_ANY_SEP (itext_ichar_n (p1, matchsize))) matchsize++; bestmatchsize = matchsize; } } qxe_closedir (d); free_opaque_ptr (XCAR (locative)); XCAR (locative) = Qnil; } unbind_to (speccount); UNGCPRO; if (all_flag || NILP (bestmatch)) return bestmatch; if (matchcount == 1 && bestmatchsize == file_name_length) return Qt; return Fsubseq (bestmatch, Qzero, make_int (bestmatchsize)); } static Lisp_Object user_name_completion (Lisp_Object user, int all_flag, int *uniq); DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /* Complete user name from PARTIAL-USERNAME. Return the longest prefix common to all user names starting with PARTIAL-USERNAME. If there is only one and PARTIAL-USERNAME matches it exactly, returns t. Return nil if there is no user name starting with PARTIAL-USERNAME. */ (partial_username)) { return user_name_completion (partial_username, 0, NULL); } DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /* Complete user name from PARTIAL-USERNAME. This function is identical to `user-name-completion', except that the cons of the completion and an indication of whether the completion was unique is returned. The car of the returned value is the longest prefix common to all user names that start with PARTIAL-USERNAME. If there is only one and PARTIAL-USERNAME matches it exactly, the car is t. The car is nil if there is no user name starting with PARTIAL-USERNAME. The cdr of the result is non-nil if and only if the completion returned in the car was unique. */ (partial_username)) { int uniq; Lisp_Object completed = user_name_completion (partial_username, 0, &uniq); return Fcons (completed, uniq ? Qt : Qnil); } DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /* Return a list of all user name completions from PARTIAL-USERNAME. These are all the user names which begin with PARTIAL-USERNAME. */ (partial_username)) { return user_name_completion (partial_username, 1, NULL); } struct user_name { Ibyte *ptr; Bytecount len; }; struct user_cache { struct user_name *user_names; int length; int size; EMACS_TIME last_rebuild_time; }; static struct user_cache user_cache; static void free_user_cache (struct user_cache *cache) { int i; for (i = 0; i < cache->length; i++) xfree (cache->user_names[i].ptr); xfree (cache->user_names); xzero (*cache); } static Lisp_Object user_name_completion_unwind (Lisp_Object cache_incomplete_p) { #ifndef WIN32_NATIVE endpwent (); speed_up_interrupts (); #endif if (! NILP (XCAR (cache_incomplete_p))) free_user_cache (&user_cache); free_cons (cache_incomplete_p); return Qnil; } #define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */ static Lisp_Object user_name_completion (Lisp_Object user, int all_flag, int *uniq) { /* This function can GC */ int matchcount = 0; Lisp_Object bestmatch = Qnil; Charcount bestmatchsize = 0; Charcount user_name_length; EMACS_TIME t; int i; struct gcpro gcpro1, gcpro2; GCPRO2 (user, bestmatch); CHECK_STRING (user); user_name_length = string_char_length (user); /* Cache user name lookups because it tends to be quite slow. * Rebuild the cache occasionally to catch changes */ EMACS_GET_TIME (t); if (user_cache.user_names && (EMACS_SECS (t) - EMACS_SECS (user_cache.last_rebuild_time) > USER_CACHE_TTL)) free_user_cache (&user_cache); if (!user_cache.user_names) { #ifndef WIN32_NATIVE struct passwd *pwd; #else DWORD entriesread; DWORD totalentries; DWORD resume_handle = 0; #endif Lisp_Object cache_incomplete_p = noseeum_cons (Qt, Qnil); int speccount = specpdl_depth (); record_unwind_protect (user_name_completion_unwind, cache_incomplete_p); #ifndef WIN32_NATIVE slow_down_interrupts (); setpwent (); while ((pwd = qxe_getpwent ())) { QUIT; DO_REALLOC (user_cache.user_names, user_cache.size, user_cache.length + 1, struct user_name); user_cache.user_names[user_cache.length].ptr = (Ibyte *) xstrdup (pwd->pw_name); user_cache.user_names[user_cache.length].len = strlen (pwd->pw_name); user_cache.length++; } #else if (xNetUserEnum) { do { USER_INFO_0 *bufptr; NET_API_STATUS status_status_statui_statum_statu; int i; QUIT; status_status_statui_statum_statu = xNetUserEnum (NULL, 0, 0, (LPBYTE *) &bufptr, 1024, &entriesread, &totalentries, &resume_handle); if (status_status_statui_statum_statu != NERR_Success && status_status_statui_statum_statu != ERROR_MORE_DATA) invalid_operation ("Error enumerating users", make_int (GetLastError ())); for (i = 0; i < (int) entriesread; i++) { DO_REALLOC (user_cache.user_names, user_cache.size, user_cache.length + 1, struct user_name); TO_INTERNAL_FORMAT (C_STRING, bufptr[i].usri0_name, MALLOC, (user_cache. user_names[user_cache.length].ptr, user_cache. user_names[user_cache.length].len), Qmswindows_unicode); user_cache.length++; } xNetApiBufferFree (bufptr); } while (entriesread != totalentries); } else /* Win 9x */ { Extbyte name[2 * (UNLEN + 1)]; DWORD length = sizeof (name); if (qxeGetUserName (name, &length)) { DO_REALLOC (user_cache.user_names, user_cache.size, user_cache.length + 1, struct user_name); TO_INTERNAL_FORMAT (C_STRING, name, MALLOC, (user_cache. user_names[user_cache.length].ptr, user_cache. user_names[user_cache.length].len), Qmswindows_tstr); user_cache.length++; } } #endif XCAR (cache_incomplete_p) = Qnil; unbind_to (speccount); EMACS_GET_TIME (user_cache.last_rebuild_time); } for (i = 0; i < user_cache.length; i++) { Ibyte *u_name = user_cache.user_names[i].ptr; Bytecount len = user_cache.user_names[i].len; /* scmp() works in chars, not bytes, so we have to compute this: */ Charcount cclen = bytecount_to_charcount (u_name, len); QUIT; if (cclen < user_name_length || 0 <= scmp_1 (u_name, XSTRING_DATA (user), user_name_length, 0)) continue; matchcount++; /* count matching completions */ if (all_flag || NILP (bestmatch)) { Lisp_Object name = Qnil; struct gcpro ngcpro1; NGCPRO1 (name); /* This is a possible completion */ name = make_string (u_name, len); if (all_flag) { bestmatch = Fcons (name, bestmatch); } else { bestmatch = name; bestmatchsize = string_char_length (name); } NUNGCPRO; } else { Charcount compare = min (bestmatchsize, cclen); Ibyte *p1 = XSTRING_DATA (bestmatch); Ibyte *p2 = u_name; Charcount matchsize = scmp_1 (p1, p2, compare, 0); if (matchsize < 0) matchsize = compare; bestmatchsize = matchsize; } } UNGCPRO; if (uniq) *uniq = (matchcount == 1); if (all_flag || NILP (bestmatch)) return bestmatch; if (matchcount == 1 && bestmatchsize == user_name_length) return Qt; return Fsubseq (bestmatch, Qzero, make_int (bestmatchsize)); } Lisp_Object make_directory_hash_table (Lisp_Object path) { DIR *d; if ((d = qxe_opendir (XSTRING_DATA (path)))) { Lisp_Object hash_table_test = Qequal, hash = Qnil; DIRENTRY *dp; if (!UNBOUNDP (XSYMBOL_FUNCTION (Qfile_system_ignore_case_p)) && !NILP (call1 (Qfile_system_ignore_case_p, path))) { hash_table_test = Qequalp; } hash = make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, hash_table_test); while ((dp = qxe_readdir (d))) { Bytecount len = NAMLEN (dp); if (DIRENTRY_NONEMPTY (dp)) /* Cast to Ibyte* is OK, as qxe_readdir() Mule-encapsulates. */ Fputhash (make_string ((Ibyte *) dp->d_name, len), Qt, hash); } qxe_closedir (d); return hash; } else return Qnil; } #if 0 /* ... never used ... should use list2 directly anyway ... */ /* NOTE: This function can never return a negative value. */ Lisp_Object wasteful_word_to_lisp (unsigned int item) { /* Compatibility: in other versions, file-attributes returns a LIST of two 16 bit integers... */ Lisp_Object cons = word_to_lisp (item); XCDR (cons) = Fcons (XCDR (cons), Qnil); return cons; } #endif DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /* Return a list of attributes of file FILENAME. Value is nil if specified file cannot be opened. Otherwise, list elements are: 0. t for directory, string (name linked to) for symbolic link, or nil. 1. Number of links to file. 2. File uid. 3. File gid. 4. Last access time, as a list of two integers. First integer has high-order 16 bits of time, second has low 16 bits. 5. Last modification time, likewise. 6. Last status change time, likewise. 7. Size in bytes. (-1, if number out of range and no bignum support.) 8. File modes, as a string of ten letters or dashes as in ls -l. 9. t iff file's gid would change if file were deleted and recreated. 10. inode number. 11. Device number. If file does not exist, returns nil. */ (filename)) { /* This function can GC. GC checked 1997.06.04. */ Lisp_Object values[12]; Lisp_Object directory = Qnil; struct stat s; char modes[10]; Lisp_Object handler; struct gcpro gcpro1, gcpro2; GCPRO2 (filename, directory); filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qfile_attributes); if (!NILP (handler)) { UNGCPRO; return call2 (handler, Qfile_attributes, filename); } if (qxe_lstat (XSTRING_DATA (filename), &s) < 0) { UNGCPRO; return Qnil; } #ifdef BSD4_2 directory = Ffile_name_directory (filename); #endif #if 0 /* #### shouldn't this apply to WIN32_NATIVE and maybe CYGWIN? */ { Ibyte *tmpnam = XSTRING_DATA (Ffile_name_nondirectory (filename)); Bytecount l = qxestrlen (tmpnam); if (l >= 5 && S_ISREG (s.st_mode) && (qxestrcasecmp (&tmpnam[l - 4], ".com") == 0 || qxestrcasecmp (&tmpnam[l - 4], ".exe") == 0 || qxestrcasecmp (&tmpnam[l - 4], ".bat") == 0)) { s.st_mode |= S_IEXEC; } } #endif switch (s.st_mode & S_IFMT) { default: values[0] = Qnil; break; case S_IFDIR: values[0] = Qt; break; #ifdef S_IFLNK case S_IFLNK: values[0] = Ffile_symlink_p (filename); break; #endif } values[1] = make_int (s.st_nlink); values[2] = make_int (s.st_uid); values[3] = make_int (s.st_gid); values[4] = make_time (s.st_atime); values[5] = make_time (s.st_mtime); values[6] = make_time (s.st_ctime); #ifndef HAVE_BIGNUM values[7] = make_integer (NUMBER_FITS_IN_AN_EMACS_INT (s.st_size) ? (EMACS_INT)s.st_size : -1); #else values[7] = make_integer (s.st_size); #endif filemodestring (&s, modes); values[8] = make_string ((Ibyte *) modes, 10); #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */ { struct stat sdir; if (!NILP (directory) && qxe_stat (XSTRING_DATA (directory), &sdir) == 0) values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil; else /* if we can't tell, assume worst */ values[9] = Qt; } #else /* file gid will be egid */ values[9] = (s.st_gid != getegid ()) ? Qt : Qnil; #endif /* BSD4_2 or BSD4_3 */ values[10] = make_int (s.st_ino); values[11] = make_int (s.st_dev); UNGCPRO; return Flist (countof (values), values); } /************************************************************************/ /* initialization */ /************************************************************************/ void syms_of_dired (void) { DEFSYMBOL (Qdirectory_files); DEFSYMBOL (Qfile_name_completion); DEFSYMBOL (Qfile_name_all_completions); DEFSYMBOL (Qfile_attributes); DEFSYMBOL (Qfile_system_ignore_case_p); DEFSUBR (Fdirectory_files); DEFSUBR (Ffile_name_completion); DEFSUBR (Ffile_name_all_completions); DEFSUBR (Fuser_name_completion); DEFSUBR (Fuser_name_completion_1); DEFSUBR (Fuser_name_all_completions); DEFSUBR (Ffile_attributes); } void vars_of_dired (void) { DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /* *Completion ignores filenames ending in any string in this list. This variable does not affect lists of possible completions, but does affect the commands that actually do completions. It is used by the function `file-name-completion'. */ ); Vcompletion_ignored_extensions = Qnil; }