stumpwm-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[STUMP] [PATCH] Modify pathname-is-executable-p to work with symlinks in


From: Ben Spencer
Subject: [STUMP] [PATCH] Modify pathname-is-executable-p to work with symlinks in recent SBCLs.
Date: Tue, 24 Nov 2009 18:02:00 +0000
User-agent: Mutt/1.5.20 (2009-06-14)

sb-impl::native-file-kind differentiates between regular files and
symlinks, so symlinks in your path won't be picked up for completion.
This simpler implementation should work for any version of SBCL.
---
 wrappers.lisp |   30 ++++++++++++------------------
 1 files changed, 12 insertions(+), 18 deletions(-)

diff --git a/wrappers.lisp b/wrappers.lisp
index d7f9f99..1017b76 100644
--- a/wrappers.lisp
+++ b/wrappers.lisp
@@ -167,24 +167,18 @@
   #-(or allegro clisp cmu gcl lispworks lucid sbcl scl openmcl ecl)
   (error 'not-implemented))
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  ;; On 20th May 2009, SBCL lost unix-file-kind and replaced it with the
-  ;; internal native-file-kind. Since there's no overlap, we'd better cope with
-  ;; either possibility.
-  (let (#+sbcl (file-kind-fun
-                (or (find-symbol "NATIVE-FILE-KIND" :sb-impl)
-                    (find-symbol "UNIX-FILE-KIND" :sb-unix))))
-    (defun pathname-is-executable-p (pathname)
-      "Return T if the pathname describes an executable file."
-      #+sbcl
-      (let ((filename (coerce (sb-ext:native-namestring pathname) 
'base-string)))
-        (and (eq (funcall file-kind-fun filename) :file)
-             (sb-unix:unix-access filename sb-unix:x_ok)))
-      ;; FIXME: this is not exactly perfect
-      #+clisp
-      (logand (posix:convert-mode (posix:file-stat-mode (posix:file-stat 
pathname)))
-              (posix:convert-mode '(:xusr :xgrp :xoth)))
-      #-(or sbcl clisp) t)))
+(defun pathname-is-executable-p (pathname)
+  "Return T if the pathname describes an executable file."
+  #+sbcl
+  (let ((filename (coerce (sb-ext:native-namestring pathname) 'base-string)))
+    (and (or (pathname-name pathname)
+             (pathname-type pathname))
+         (sb-unix:unix-access filename sb-unix:x_ok)))
+  ;; FIXME: this is not exactly perfect
+  #+clisp
+  (logand (posix:convert-mode (posix:file-stat-mode (posix:file-stat 
pathname)))
+          (posix:convert-mode '(:xusr :xgrp :xoth)))
+  #-(or sbcl clisp) t)
 
 (defun probe-path (path)
   "Return the truename of a supplied path, or nil if it does not exist."
-- 
1.6.5.3





reply via email to

[Prev in Thread] Current Thread [Next in Thread]