[uim-commit] r428 - in trunk: scm uim

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-01-31 08:09:46 -0800 (Mon, 31 Jan 2005)
New Revision: 428

Modified:
   trunk/scm/util.scm
   trunk/uim/slib.c
   trunk/uim/uim-custom.c
   trunk/uim/uim-util.c
Log:
* scm/util.scm
  - (make-scm-pathname): New procedure
  - (try-load, try-require): Suppress file not found error message
* uim/uim-util.c
  - (file_stat_mode, file_readablep, file_writablep, file_executablep,
    file_regularp, file_directoryp): New function
  - (uim_init_util_subrs): Add initialization of file-readable?,
    file-writable?, file-executable?, file-regular? and file-directory?
* uim/slib.c
  - (siod_lib_path): New function
  - (init_subrs): Add initialization of load-path procedure

* uim/uim-custom.c
  - Add #include <sys/types.h>


Modified: trunk/scm/util.scm
===================================================================
--- trunk/scm/util.scm	2005-01-31 15:38:10 UTC (rev 427)
+++ trunk/scm/util.scm	2005-01-31 16:09:46 UTC (rev 428)
@@ -424,18 +424,29 @@
 ;; uim-specific utilities
 ;;
 
-;; TODO: suppress error messages
+;; TODO: write test
+(define make-scm-pathname
+  (lambda (file)
+    (or (and (= (string->charcode file)
+		(string->charcode "/"))
+	     file)
+	(string-append (load-path) "/" file))))
+
+;; TODO: write test
 ;; returns succeeded or not
 (define try-load
   (lambda (file)
-    (not (*catch 'errobj (load file)))))
+    (and (file-readable? (make-scm-pathname file))
+	 (not (*catch 'errobj (begin (load file)
+				     #f))))))
 
-;; TODO: suppress error messages
+;; TODO: write test
 ;; returns succeeded or not
 (define try-require
   (lambda (file)
-    (eq? (symbolconc '* (string->symbol file) '-loaded*)
-	 (*catch 'errobj (require file)))))
+    (and (file-readable? (make-scm-pathname file))
+	 (eq? (symbolconc '* (string->symbol file) '-loaded*)
+	      (*catch 'errobj (require file))))))
 
 ;; for eval
 (define toplevel-env ())

Modified: trunk/uim/slib.c
===================================================================
--- trunk/uim/slib.c	2005-01-31 15:38:10 UTC (rev 427)
+++ trunk/uim/slib.c	2005-01-31 16:09:46 UTC (rev 428)
@@ -3991,6 +3991,12 @@
 }
 
 static LISP
+siod_lib_path (void)
+{
+  return (strcons (-1, siod_lib));
+}
+
+static LISP
 lruntime (void)
 {
   return (cons (intcons (myruntime ()),
@@ -4643,6 +4649,7 @@
   init_fsubr ("quote", leval_quote);
   init_lsubr ("apropos", apropos);
   init_lsubr ("verbose", siod_verbose);
+  init_subr_0 ("load-path", siod_lib_path);
   init_subr_1 ("copy-list", copy_list);
   init_lsubr ("gc-status", gc_status);
   init_lsubr ("gc", user_gc);

Modified: trunk/uim/uim-custom.c
===================================================================
--- trunk/uim/uim-custom.c	2005-01-31 15:38:10 UTC (rev 427)
+++ trunk/uim/uim-custom.c	2005-01-31 16:09:46 UTC (rev 428)
@@ -43,6 +43,7 @@
 
 #include "config.h"
 
+#include <sys/types.h>
 #include <sys/stat.h>
 #include <unistd.h>
 #include <stdlib.h>

Modified: trunk/uim/uim-util.c
===================================================================
--- trunk/uim/uim-util.c	2005-01-31 15:38:10 UTC (rev 427)
+++ trunk/uim/uim-util.c	2005-01-31 16:09:46 UTC (rev 428)
@@ -33,6 +33,8 @@
 
 #include "config.h"
 
+#include <sys/types.h>
+#include <sys/stat.h>
 #include <stdlib.h>
 #include <string.h>
 #include <locale.h>
@@ -78,6 +80,53 @@
 }
 
 static uim_lisp
+file_stat_mode(uim_lisp filename, mode_t mode)
+{
+  struct stat st;
+  const char *c_filename;
+
+  if (!uim_scm_stringp(filename))
+    return uim_scm_f();
+
+  c_filename = uim_scm_refer_c_str(filename);
+  if (stat(c_filename, &st) < 0) {
+    return uim_scm_f();
+  } else {
+    return ((st.st_mode & mode) == mode) ? uim_scm_t() : uim_scm_f();
+  }
+}
+
+static uim_lisp
+file_readablep(uim_lisp filename)
+{
+  return file_stat_mode(filename, S_IRUSR);
+}
+
+static uim_lisp
+file_writablep(uim_lisp filename)
+{
+  return file_stat_mode(filename, S_IWUSR);
+}
+
+static uim_lisp
+file_executablep(uim_lisp filename)
+{
+  return file_stat_mode(filename, S_IXUSR);
+}
+
+static uim_lisp
+file_regularp(uim_lisp filename)
+{
+  return file_stat_mode(filename, S_IFREG);
+}
+
+static uim_lisp
+file_directoryp(uim_lisp filename)
+{
+  return file_stat_mode(filename, S_IFDIR);
+}
+
+static uim_lisp
 charcode2string(uim_lisp x)
 {
   char buf[2];
@@ -442,6 +491,11 @@
   uim_scm_init_subr_0("sys-pkglibdir", sys_pkglibdir);
   uim_scm_init_subr_0("sys-datadir", sys_datadir);
   uim_scm_init_subr_0("sys-pkgdatadir", sys_pkgdatadir);
+  uim_scm_init_subr_1("file-readable?", file_readablep);
+  uim_scm_init_subr_1("file-writable?", file_writablep);
+  uim_scm_init_subr_1("file-executable?", file_executablep);
+  uim_scm_init_subr_1("file-regular?", file_regularp);
+  uim_scm_init_subr_1("file-directory?", file_directoryp);
   uim_scm_init_subr_2("nthcdr", nthcdr);
   uim_scm_init_subr_1("charcode->string", charcode2string);
   uim_scm_init_subr_1("string->charcode", string2charcode);