Return to dired.c CVS log

Up to [Apple XNU] / GNUtools / emacs / src

Annotation of GNUtools/emacs/src/dired.c, revision 1.1

1.1     ! root        1: /* Lisp functions for making directory listings.
        !             2:    Copyright (C) 1985, 1986 Free Software Foundation, Inc.
        !             3: 
        !             4: This file is part of GNU Emacs.
        !             5: 
        !             6: GNU Emacs is free software; you can redistribute it and/or modify
        !             7: it under the terms of the GNU General Public License as published by
        !             8: the Free Software Foundation; either version 1, or (at your option)
        !             9: any later version.
        !            10: 
        !            11: GNU Emacs is distributed in the hope that it will be useful,
        !            12: but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            13: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            14: GNU General Public License for more details.
        !            15: 
        !            16: You should have received a copy of the GNU General Public License
        !            17: along with GNU Emacs; see the file COPYING.  If not, write to
        !            18: the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
        !            19: 
        !            20: 
        !            21: #include <stdio.h>
        !            22: #include <sys/types.h>
        !            23: #include <sys/stat.h>
        !            24: 
        !            25: #include "config.h"
        !            26: 
        !            27: #ifdef SYSV_SYSTEM_DIR
        !            28: 
        !            29: #include <dirent.h>
        !            30: #define DIRENTRY struct dirent
        !            31: #define NAMLEN(p) strlen (p->d_name)
        !            32: 
        !            33: #else
        !            34: 
        !            35: #ifdef NONSYSTEM_DIR_LIBRARY
        !            36: #include "ndir.h"
        !            37: #else /* not NONSYSTEM_DIR_LIBRARY */
        !            38: #include <sys/dir.h>
        !            39: #endif /* not NONSYSTEM_DIR_LIBRARY */
        !            40: 
        !            41: #define DIRENTRY struct direct
        !            42: #define NAMLEN(p) p->d_namlen
        !            43: 
        !            44: extern DIR *opendir ();
        !            45: extern struct direct *readdir ();
        !            46: 
        !            47: #endif
        !            48: 
        !            49: #undef NULL
        !            50: 
        !            51: #include "lisp.h"
        !            52: #include "buffer.h"
        !            53: #include "commands.h"
        !            54: 
        !            55: #include "regex.h"
        !            56: #include "filetypes.h"
        !            57: 
        !            58: #define min(a, b) ((a) < (b) ? (a) : (b))
        !            59: 
        !            60: /* if system does not have symbolic links, it does not have lstat.
        !            61:    In that case, use ordinary stat instead.  */
        !            62: 
        !            63: #ifndef S_IFLNK
        !            64: #define lstat stat
        !            65: #endif
        !            66: 
        !            67: extern int completion_ignore_case;
        !            68: 
        !            69: Lisp_Object Vcompletion_ignored_extensions;
        !            70: 
        !            71: Lisp_Object Qcompletion_ignore_case;
        !            72: 
        !            73: DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 3, 0,
        !            74:   "Return a list of names of files in DIRECTORY.\n\
        !            75: If FULL is non-NIL, absolute pathnames of the files are returned.\n\
        !            76: If MATCH is non-NIL, only pathnames containing that regexp are returned.")
        !            77:   (dirname, full, match)
        !            78:      Lisp_Object dirname, full, match;
        !            79: {
        !            80:   DIR *d;
        !            81:   char slashfilename[MAXNAMLEN+2];
        !            82:   char *filename = slashfilename;
        !            83:   int length;
        !            84:   Lisp_Object list, name;
        !            85: 
        !            86:   /* In search.c */
        !            87:   extern struct re_pattern_buffer searchbuf;
        !            88: 
        !            89:   if (!NULL (match))
        !            90:     {
        !            91:       CHECK_STRING (match, 3);
        !            92:       /* Compile it now so we don't get an error after opendir */
        !            93: #ifdef VMS
        !            94:       compile_pattern (match, &searchbuf, (char *) downcase_table);
        !            95: #else
        !            96:       compile_pattern (match, &searchbuf, 0);
        !            97: #endif
        !            98:     }
        !            99: 
        !           100:   dirname = Fexpand_file_name (dirname, Qnil);
        !           101:   if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
        !           102:     report_file_error ("Opening directory", Fcons (dirname, Qnil));
        !           103: 
        !           104:   list = Qnil;
        !           105:   length = XSTRING (dirname)->size;
        !           106: #ifndef VMS
        !           107:   if (length == 0   ||  XSTRING (dirname)->data[length - 1] != '/')
        !           108:     *filename++ = '/';
        !           109: #endif /* VMS */
        !           110: 
        !           111:   /* Loop reading blocks */
        !           112:   while (1)
        !           113:     {
        !           114:       DIRENTRY *dp = readdir (d);
        !           115:       int len;
        !           116: 
        !           117:       if (!dp) break;
        !           118:       len = NAMLEN (dp);
        !           119:       if (dp->d_ino)
        !           120:        {
        !           121:          strncpy (filename, dp->d_name, len);
        !           122:          filename[len] = 0;
        !           123:          if (NULL (match) ||
        !           124:              (0 <= re_search (&searchbuf, filename, len, 0, len, 0)))
        !           125:            {
        !           126:              if (!NULL (full))
        !           127:                name = concat2 (dirname, build_string (slashfilename));
        !           128:              else
        !           129:                name = build_string (filename);
        !           130:              list = Fcons (name, list);
        !           131:            }
        !           132:        }
        !           133:     }
        !           134:   closedir (d);
        !           135:   return Fsort (Fnreverse (list), Qstring_lessp);
        !           136: }
        !           137: 
        !           138: Lisp_Object file_name_completion ();
        !           139: 
        !           140: DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
        !           141:   2, 2, 0,
        !           142:   "Complete file name FILE in directory DIR.\n\
        !           143: Returns the longest string common to all filenames in DIR\n\
        !           144: that start with FILE.\n\
        !           145: If there is only one and FILE matches it exactly, returns t.\n\
        !           146: Returns nil if DIR contains no name starting with FILE.")
        !           147:   (file, dirname)
        !           148:      Lisp_Object file, dirname;
        !           149: {
        !           150:   /* Don't waste time trying to complete a null string.
        !           151:      Besides, this case happens when user is being asked for
        !           152:      a directory name and has supplied one ending in a /.
        !           153:      We would not want to add anything in that case
        !           154:      even if there are some unique characters in that directory.  */
        !           155:   if (XTYPE (file) == Lisp_String && XSTRING (file)->size == 0)
        !           156:     return file;
        !           157:   return file_name_completion (file, dirname, 0, 0);
        !           158: }
        !           159: 
        !           160: DEFUN ("file-name-all-completions", Ffile_name_all_completions,
        !           161:   Sfile_name_all_completions, 2, 2, 0,
        !           162:   "Return a list of all completions of file name FILE in directory DIR.")
        !           163:   (file, dirname)
        !           164:      Lisp_Object file, dirname;
        !           165: {
        !           166:   return file_name_completion (file, dirname, 1, 0);
        !           167: }
        !           168: 
        !           169: #ifdef VMS
        !           170: 
        !           171: DEFUN ("file-name-all-versions", Ffile_name_all_versions,
        !           172:   Sfile_name_all_versions, 2, 2, 0,
        !           173:   "Return a list of all versions of file name FILE in directory DIR.")
        !           174:   (file, dirname)
        !           175:      Lisp_Object file, dirname;
        !           176: {
        !           177:   return file_name_completion (file, dirname, 1, 1);
        !           178: }
        !           179: 
        !           180: #endif /* VMS */
        !           181: 
        !           182: Lisp_Object
        !           183: file_name_completion (file, dirname, all_flag, ver_flag)
        !           184:      Lisp_Object file, dirname;
        !           185:      int all_flag, ver_flag;
        !           186: {
        !           187:   DIR *d;
        !           188:   int bestmatchsize, skip;
        !           189:   register int compare, matchsize;
        !           190:   unsigned char *p1, *p2;
        !           191:   int matchcount = 0;
        !           192:   Lisp_Object bestmatch, tem, elt, name;
        !           193:   struct stat st;
        !           194:   int directoryp;
        !           195:   int passcount;
        !           196:   int count = specpdl_ptr - specpdl;
        !           197: #ifdef VMS
        !           198:   extern DIRENTRY * readdirver ();
        !           199: 
        !           200:   DIRENTRY *((* readfunc) ());
        !           201: 
        !           202:   /* Filename completion on VMS ignores case, since VMS filesys does.  */
        !           203:   specbind (Qcompletion_ignore_case, Qt);
        !           204: 
        !           205:   readfunc = readdir;
        !           206:   if (ver_flag)
        !           207:     readfunc = readdirver;
        !           208:   file = Fupcase (file);
        !           209: #endif /* VMS */
        !           210: 
        !           211:   CHECK_STRING (file, 0);
        !           212: 
        !           213:   dirname = Fexpand_file_name (dirname, Qnil);
        !           214:   bestmatch = Qnil;
        !           215: 
        !           216:   /* passcount = 0, ignore files that end in an ignored extension.
        !           217:      If nothing found then try again with passcount = 1, don't ignore them.
        !           218:      If looking for all completions, start with passcount = 1,
        !           219:      so always take even the ignored ones.  */
        !           220:   for (passcount = !!all_flag; NULL (bestmatch) && passcount < 2; passcount++)
        !           221:     {
        !           222:       if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
        !           223:        report_file_error ("Opening directory", Fcons (dirname, Qnil));
        !           224: 
        !           225:       /* Loop reading blocks */
        !           226:       /* (att3b compiler bug requires do a null comparison this way) */
        !           227:       while (1)
        !           228:        {
        !           229:          DIRENTRY *dp;
        !           230:          int len;
        !           231: 
        !           232: #ifdef VMS
        !           233:          dp = (*readfunc) (d);
        !           234: #else
        !           235:          dp = readdir (d);
        !           236: #endif
        !           237:          if (!dp) break;
        !           238: 
        !           239:          len = NAMLEN (dp);
        !           240: 
        !           241:          if (!NULL (Vquit_flag) && NULL (Vinhibit_quit))
        !           242:            goto quit;
        !           243:          if (!dp->d_ino
        !           244:              || len < XSTRING (file)->size
        !           245:              || 0 <= scmp (dp->d_name, XSTRING (file)->data,
        !           246:                            XSTRING (file)->size))
        !           247:            continue;
        !           248: 
        !           249:           if (file_name_completion_stat (dirname, dp, &st) < 0)
        !           250:             continue;
        !           251: 
        !           252:           directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
        !           253:          tem = Qnil;
        !           254:           if (!directoryp)
        !           255:             {
        !           256:              /* Compare extensions-to-be-ignored against end of this file name */
        !           257:              /* if name is not an exact match against specified string */
        !           258:              if (!passcount && len > XSTRING (file)->size)
        !           259:                /* and exit this for loop if a match is found */
        !           260:                for (tem = Vcompletion_ignored_extensions;
        !           261:                     CONSP (tem); tem = XCONS (tem)->cdr)
        !           262:                  {
        !           263:                    elt = XCONS (tem)->car;
        !           264:                    if (XTYPE (elt) != Lisp_String) continue;
        !           265:                    skip = len - XSTRING (elt)->size;
        !           266:                    if (skip < 0) continue;
        !           267: 
        !           268:                    if (0 <= scmp (dp->d_name + skip,
        !           269:                                   XSTRING (elt)->data,
        !           270:                                   XSTRING (elt)->size))
        !           271:                      continue;
        !           272:                    break;
        !           273:                  }
        !           274:            }
        !           275: 
        !           276:          /* Unless an ignored-extensions match was found,
        !           277:              process this name as a completion */
        !           278:          if (passcount || !CONSP (tem))
        !           279:            {
        !           280:              /* Update computation of how much all possible completions match */
        !           281: 
        !           282:              matchcount++;
        !           283: 
        !           284:              if (all_flag || NULL (bestmatch))
        !           285:                {
        !           286:                  /* This is a possible completion */
        !           287:                  if (directoryp)
        !           288:                    {
        !           289:                      /* This completion is a directory; make it end with '/' */
        !           290:                      name = Ffile_name_as_directory (make_string (dp->d_name, len));
        !           291:                    }
        !           292:                  else
        !           293:                    name = make_string (dp->d_name, len);
        !           294:                  if (all_flag)
        !           295:                    {
        !           296:                      bestmatch = Fcons (name, bestmatch);
        !           297:                    }
        !           298:                  else
        !           299:                    {
        !           300:                      bestmatch = name;
        !           301:                      bestmatchsize = XSTRING (name)->size;
        !           302:                    }
        !           303:                }
        !           304:              else
        !           305:                {
        !           306:                  compare = min (bestmatchsize, len);
        !           307:                  p1 = XSTRING (bestmatch)->data;
        !           308:                  p2 = (unsigned char *) dp->d_name;
        !           309:                  matchsize = scmp(p1, p2, compare);
        !           310:                  if (matchsize < 0)
        !           311:                    matchsize = compare;
        !           312:                  if (completion_ignore_case)
        !           313:                    {
        !           314:                      /* If this is an exact match except for case,
        !           315:                         use it as the best match rather than one that is not
        !           316:                         an exact match.  This way, we get the case pattern
        !           317:                         of the actual match.  */
        !           318:                      if ((matchsize == len
        !           319:                           && matchsize < XSTRING (bestmatch)->size)
        !           320:                          ||
        !           321:                          /* If there is no exact match ignoring case,
        !           322:                             prefer a match that does not change the case
        !           323:                             of the input.  */
        !           324:                          (((matchsize == len)
        !           325:                            ==
        !           326:                            (matchsize == XSTRING (bestmatch)->size))
        !           327:                           /* If there is more than one exact match aside from
        !           328:                              case, and one of them is exact including case,
        !           329:                              prefer that one.  */
        !           330:                           && !bcmp (p2, XSTRING (file)->data, XSTRING (file)->size)
        !           331:                           && bcmp (p1, XSTRING (file)->data, XSTRING (file)->size)))
        !           332:                        {
        !           333:                          bestmatch = make_string (dp->d_name, len);
        !           334:                          if (directoryp)
        !           335:                            bestmatch = Ffile_name_as_directory (bestmatch);
        !           336:                        }
        !           337:                    }
        !           338:                  /* If this dirname all matches,
        !           339:                     see if implicit following slash does too.  */
        !           340:                  if (directoryp
        !           341:                      && compare == matchsize
        !           342:                      && bestmatchsize > matchsize
        !           343:                      && p1[matchsize] == '/')
        !           344:                    matchsize++;
        !           345:                  bestmatchsize = matchsize;
        !           346:                }
        !           347:            }
        !           348:        }
        !           349:       closedir (d);
        !           350:     }
        !           351: 
        !           352:   unbind_to (count);
        !           353: 
        !           354:   if (all_flag || NULL (bestmatch))
        !           355:     return bestmatch;
        !           356: 
        !           357:   /* If we are ignoring case, and there is no exact match,
        !           358:      and no additional text was supplied,
        !           359:      don't change the case of what the user typed.  */
        !           360:   if (completion_ignore_case && bestmatchsize == XSTRING (file)->size
        !           361:       && XSTRING (bestmatch)->size > bestmatchsize)
        !           362:     return file;
        !           363: 
        !           364:   /* Return t if the supplied string is an exact match (counting case);
        !           365:      it does not require any change to be made.  */
        !           366:   if (matchcount == 1 && bestmatchsize == XSTRING (file)->size
        !           367:       && !bcmp (XSTRING (bestmatch)->data, XSTRING (file)->data,
        !           368:                bestmatchsize))
        !           369:     return Qt;
        !           370:   return Fsubstring (bestmatch, make_number (0), make_number (bestmatchsize));
        !           371:  quit:
        !           372:   if (d) closedir (d);
        !           373:   Vquit_flag = Qnil;
        !           374:   return Fsignal (Qquit, Qnil);
        !           375: }
        !           376: 
        !           377: file_name_completion_stat (dirname, dp, st_addr)
        !           378:      Lisp_Object dirname;
        !           379:      DIRENTRY *dp;
        !           380:      struct stat *st_addr;
        !           381: {
        !           382:   int len = NAMLEN (dp);
        !           383:   int pos = XSTRING (dirname)->size;
        !           384:   char *fullname = (char *) alloca (len + pos + 2);
        !           385: 
        !           386:   bcopy (XSTRING (dirname)->data, fullname, pos);
        !           387: #ifndef VMS
        !           388:   if (fullname[pos - 1] != '/')
        !           389:     fullname[pos++] = '/';
        !           390: #endif
        !           391: 
        !           392:   bcopy (dp->d_name, fullname + pos, len);
        !           393:   fullname[pos + len] = 0;
        !           394: 
        !           395: #ifdef S_IFLNK
        !           396:   /* Use ordinary stat first, if that succeeds,
        !           397:      so that a symlink pointing to a directory is considered a directory.
        !           398:      Afterward, use lstat, so that a link pointing to nowhere
        !           399:      at least seems to exist.  */
        !           400:   if (stat (fullname, st_addr) >= 0)
        !           401:     return 0;
        !           402:   return lstat (fullname, st_addr);
        !           403: #else
        !           404:   return stat (fullname, st_addr);
        !           405: #endif
        !           406: }
        !           407: 
        !           408: Lisp_Object
        !           409: make_time (time)
        !           410:      int time;
        !           411: {
        !           412:   return Fcons (make_number (time >> 16),
        !           413:                Fcons (make_number (time & 0177777), Qnil));
        !           414: }
        !           415: 
        !           416: DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
        !           417:   "Return a list of attributes of file FILENAME.\n\
        !           418: Value is nil if specified file cannot be opened.\n\
        !           419: Otherwise, list elements are:\n\
        !           420:  0. t for directory, string (name linked to) for symbolic link, or nil.\n\
        !           421:  1. Number of links to file.\n\
        !           422:  2. File uid.\n\
        !           423:  3. File gid.\n\
        !           424:  4. Last access time, as a list of two integers.\n\
        !           425:   First integer has high-order 16 bits of time, second has low 16 bits.\n\
        !           426:  5. Last modification time, likewise.\n\
        !           427:  6. Last status change time, likewise.\n\
        !           428:  7. Size in bytes.\n\
        !           429:  8. File modes, as a string of ten letters or dashes as in ls -l.\n\
        !           430:  9. t iff file's gid would change if file were deleted and recreated.\n\
        !           431: 10. inode number.\n\
        !           432: \n\
        !           433: If file does not exists, returns nil.")
        !           434:   (filename)
        !           435:      Lisp_Object filename;
        !           436: {
        !           437:   Lisp_Object values[11];
        !           438:   Lisp_Object dirname;
        !           439:   struct stat s;
        !           440:   struct stat sdir;
        !           441:   char modes[10];
        !           442: 
        !           443:   filename = Fexpand_file_name (filename, Qnil);
        !           444:   if (lstat (XSTRING (filename)->data, &s) < 0)
        !           445:     return Qnil;
        !           446: 
        !           447:   switch (s.st_mode & S_IFMT)
        !           448:     {
        !           449:     default:
        !           450:       values[0] = Qnil; break;
        !           451:     case S_IFDIR:
        !           452:       values[0] = Qt; break;
        !           453: #ifdef S_IFLNK
        !           454:     case S_IFLNK:
        !           455:       values[0] = Ffile_symlink_p (filename); break;
        !           456: #endif
        !           457:     }
        !           458:   values[1] = make_number (s.st_nlink);
        !           459:   values[2] = make_number (s.st_uid);
        !           460:   values[3] = make_number (s.st_gid);
        !           461:   values[4] = make_time (s.st_atime);
        !           462:   values[5] = make_time (s.st_mtime);
        !           463:   values[6] = make_time (s.st_ctime);
        !           464:   /* perhaps we should set this to most-positive-fixnum if it is too large? */
        !           465:   values[7] = make_number (s.st_size);
        !           466:   filemodestring (&s, modes);
        !           467:   values[8] = make_string (modes, 10);
        !           468: #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
        !           469: #define BSD4_2 /* A new meaning to the term `backwards compatability' */
        !           470: #endif
        !           471: #ifdef BSD4_2                  /* file gid will be dir gid */
        !           472:   dirname = Ffile_name_directory (filename);
        !           473:   if (dirname != Qnil && stat (XSTRING (dirname)->data, &sdir) == 0)
        !           474:     values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
        !           475:   else                                 /* if we can't tell, assume worst */
        !           476:     values[9] = Qt;
        !           477: #else                                  /* file gid will be egid */
        !           478:   values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
        !           479: #endif /* BSD4_2 (or BSD4_3) */
        !           480: #ifdef BSD4_3
        !           481: #undef BSD4_2 /* ok, you can look again without throwing up */
        !           482: #endif
        !           483:   values[10] = make_number (s.st_ino);
        !           484:   return Flist (11, values);
        !           485: }
        !           486: 
        !           487: syms_of_dired ()
        !           488: {
        !           489:   defsubr (&Sdirectory_files);
        !           490:   defsubr (&Sfile_name_completion);
        !           491: #ifdef VMS
        !           492:   defsubr (&Sfile_name_all_versions);
        !           493: #endif /* VMS */
        !           494:   defsubr (&Sfile_name_all_completions);
        !           495:   defsubr (&Sfile_attributes);
        !           496: 
        !           497: #ifdef VMS
        !           498:   Qcompletion_ignore_case = intern ("completion-ignore-case");
        !           499:   staticpro (&Qcompletion_ignore_case);
        !           500: #endif /* VMS */
        !           501: 
        !           502:   DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
        !           503:     "*Completion ignores filenames ending in any string in this list.");
        !           504:   Vcompletion_ignored_extensions = Qnil;
        !           505: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.