Return to dired.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src

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

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