/[gcl]/gcl/o/pathname.d
ViewVC logotype

Diff of /gcl/o/pathname.d

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.23 by camm, Sat Jul 23 08:54:34 2005 UTC revision 1.24 by camm, Wed Sep 7 02:56:38 2005 UTC
# Line 2433  object path; Line 2433  object path;
2433          @(return s)          @(return s)
2434  @)  @)
2435    
2436  @(defun logical_pathname (pathname)  
2437          object s;  @(defun logical_pathname (s)
2438          vs_mark;    enum type tp;
2439  @  @
2440          s = pathname;  
2441          check_type_or_pathname_string_symbol_stream(&s);    vs_mark;
2442          s = coerce_to_pathname(s); vs_push(s);    vs_push(s);
2443    
2444          if ((s->pn.pn_host == Cnil) || (s->pn.pn_host == sKunspecific)) {    tp=type_of(s);
2445              file_type_error("Pathname ~S is not a ~S.",s, sLlogical_pathname);    if (tp!=t_pathname &&
2446              s=Cnil;        tp!=t_string &&
2447          } else        tp!=t_symbol &&
2448          if ((s->pn.pn_device != Cnil) && (s->pn.pn_device != sKunspecific)) {        tp!=t_stream) {
2449              file_type_error("Pathname ~S is not a ~S.",s, sLlogical_pathname);      wrong_type_argument(TSor_pathname_string_symbol_stream, s);
2450              s=Cnil;      s=Cnil;
2451          } else  
2452      } else {
2453    
2454        s = coerce_to_pathname(s);
2455        vs_push(s);
2456        
2457        if ((s->pn.pn_host == Cnil) || (s->pn.pn_host == sKunspecific)) {
2458          file_type_error("Pathname ~S is not a ~S.",s, sLlogical_pathname);
2459          s=Cnil;
2460        } else
2461          if ((s->pn.pn_device != Cnil) && (s->pn.pn_device != sKunspecific)) {
2462            file_type_error("Pathname ~S is not a ~S.",s, sLlogical_pathname);
2463            s=Cnil;
2464          } else
2465          if (pathname_lookup(s->pn.pn_host,sSApathname_logicalA) == Cnil) {          if (pathname_lookup(s->pn.pn_host,sSApathname_logicalA) == Cnil) {
2466              file_type_error("Pathname ~S is not a ~S.",s, sLlogical_pathname);            file_type_error("Pathname ~S is not a ~S.",s, sLlogical_pathname);
2467              s=Cnil;            s=Cnil;
2468          }          } else
2469          s->pn.pn_device = sKunspecific;            s->pn.pn_device = sKunspecific; /*FIXME side effect*/
2470      }
2471    
2472      vs_reset;
2473      @(return s)
2474    
         vs_reset;  
         @(return s)  
2475  @)  @)
2476    
2477    
2478  void  void
2479  gcl_init_pathname(void)  gcl_init_pathname(void)
2480  {  {
# Line 2523  gcl_init_pathname_function() Line 2539  gcl_init_pathname_function()
2539          make_function("TRANSLATE-PATHNAME", Ltranslate_pathname);          make_function("TRANSLATE-PATHNAME", Ltranslate_pathname);
2540          make_function("TRANSLATE-LOGICAL-PATHNAME", Ltranslate_logical_pathname);          make_function("TRANSLATE-LOGICAL-PATHNAME", Ltranslate_logical_pathname);
2541          make_function("LOGICAL-PATHNAME", Llogical_pathname);          make_function("LOGICAL-PATHNAME", Llogical_pathname);
2542    /*      make_function("LOGICAL-PATHNAME-P", Llogical_pathname_p); */
2543    
2544          make_si_function("WRAP-PATHNAME", Lwrap_pathname);          make_si_function("WRAP-PATHNAME", Lwrap_pathname);
2545          make_si_function("SEARCH-LOCAL-PATHNAME", Lsearch_local_pathname);          make_si_function("SEARCH-LOCAL-PATHNAME", Lsearch_local_pathname);

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.24

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26