X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=filename.el;h=30d238cf7210cd04cb4b5c3a07d5cabaddbd11b9;hb=2d4ebd42d19069a635adfc70d494ee3f3e111d93;hp=e2a59b4a2eb5ec22d7e98bf9a294c04c3987255b;hpb=619724e7cbf19bcb0631ae176e922dbd6f2ee58a;p=elisp%2Fapel.git

diff --git a/filename.el b/filename.el
index e2a59b4..30d238c 100644
--- a/filename.el
+++ b/filename.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1996,1997 MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: filename.el,v 1.4 1997/03/10 13:53:38 morioka Exp $
+;; Version: $Id: filename.el,v 2.1 1997/11/06 15:50:53 morioka Exp $
 ;; Keywords: file name, string
 
 ;; This file is part of APEL (A Portable Emacs Library).
@@ -25,42 +25,54 @@
 
 ;;; Code:
 
-(require 'emu)
-(require 'cl)
-(require 'file-detect)
+(require 'emu)				; for backward compatibility.
+(require 'poe)				; functionp.
+(require 'poem)				; char-int, and char-length.
+(require 'path-util)
 
-(defsubst poly-funcall (functions arg)
+(defsubst poly-funcall (functions argument)
+  "Apply initial ARGUMENT to sequence of FUNCTIONS.
+FUNCTIONS is list of functions.
+
+(poly-funcall '(f1 f2 .. fn) arg) is as same as
+(fn .. (f2 (f1 arg)) ..).
+
+For example, (poly-funcall '(car number-to-string) '(100)) returns
+\"100\"."
   (while functions
-    (setq arg (funcall (car functions) arg)
-	  functions (cdr functions))
-    )
-  arg)
+    (setq argument (funcall (car functions) argument)
+	  functions (cdr functions)))
+  argument)
 
 
 ;;; @ variables
 ;;;
 
-(defvar filename-limit-length 21)
+(defvar filename-limit-length 21 "Limit size of file-name.")
 
 (defvar filename-replacement-alist
   '(((?\  ?\t) . "_")
     ((?! ?\" ?# ?$ ?% ?& ?' ?\( ?\) ?* ?/
-	 ?: ?; ?< ?> ?? ?\[ ?\\ ?\] ?` ?{ ?| ?}) . "_")
-    (filename-control-p . "")
-    ))
-
-(defvar filename-filters
-  (nconc
-   (and (exec-installed-p "kakasi")
-	'(filename-japanese-to-roman-string)
-	)
-   '(filename-special-filter
-     filename-eliminate-top-low-lines
-     filename-canonicalize-low-lines
-     filename-maybe-truncate-by-size
-     filename-eliminate-bottom-low-lines
-     )))
+	 ?: ?\; ?< ?> ?? ?\[ ?\\ ?\] ?` ?{ ?| ?}) . "_")
+    (filename-control-p . ""))
+  "Alist list of characters vs. string as replacement.
+List of characters represents characters not allowed as file-name.")
+
+(defvar filename-filters nil
+  "List of functions for file-name filter.
+
+Example:
+\(setq filename-filters '\(filename-special-filter
+			 filename-eliminate-top-low-lines
+			 filename-canonicalize-low-lines
+			 filename-maybe-truncate-by-size
+			 filename-eliminate-bottom-low-lines\)\)
+
+Moreover, if you want to convert Japanese filename to roman string by kakasi,
 
+\(if \(exec-installed-p \"kakasi\"\)
+    \(setq file-name-filters
+	  \(append '\(filename-japanese-to-roman-string\) filename-filters\)\)\)")
 
 ;;; @ filters
 ;;;
@@ -70,40 +82,35 @@
     (set-buffer (get-buffer-create " *temp kakasi*"))
     (erase-buffer)
     (insert str)
-    (call-process-region (point-min)(point-max) "kakasi" t t t
-			 "-Ha" "-Ka" "-Ja" "-Ea" "-ka")
-    (buffer-string)
-    ))
+    (call-process-region
+     (point-min)(point-max)
+     "kakasi" t t t "-Ha" "-Ka" "-Ja" "-Ea" "-ka")
+    (buffer-string)))
 
 (defun filename-control-p (character)
   (let ((code (char-int character)))
-    (or (< code 32)(= code 127))
-    ))
+    (or (< code 32)(= code 127))))
 
 (defun filename-special-filter (string)
-  (let (dest
-	(i 0)
-	(len (length string))
-	(b 0)
-	)
+  (let ((len (length string))
+	(b 0)(i 0)
+	(dest ""))
     (while (< i len)
-      (let* ((chr (sref string i))
-	     (ret (assoc-if (function
-			     (lambda (key)
-			       (if (functionp key)
-				   (funcall key chr)
-				 (memq chr key)
-				 )))
-			    filename-replacement-alist))
-	     )
+      (let ((chr (sref string i))
+            (lst filename-replacement-alist)
+            ret)
+        (while (and lst (not ret))
+          (if (if (functionp (car (car lst)))
+                  (setq ret (funcall (car (car lst)) chr))
+                (setq ret (memq chr (car (car lst)))))
+              t                         ; quit this loop.
+            (setq lst (cdr lst))))
 	(if ret
-	    (setq dest (concat dest (substring string b i)(cdr ret))
+	    (setq dest (concat dest (substring string b i)(cdr (car lst)))
 		  i (+ i (char-length chr))
 		  b i)
-	  (setq i (+ i (char-length chr)))
-	  )))
-    (concat dest (substring string b))
-    ))
+	  (setq i (+ i (char-length chr))))))
+    (concat dest (substring string b))))
 
 (defun filename-eliminate-top-low-lines (string)
   (if (string-match "^_+" string)
@@ -111,18 +118,15 @@
     string))
 
 (defun filename-canonicalize-low-lines (string)
-  (let (dest)
+  (let ((dest ""))
     (while (string-match "__+" string)
       (setq dest (concat dest (substring string 0 (1+ (match-beginning 0)))))
-      (setq string (substring string (match-end 0)))
-      )
-    (concat dest string)
-    ))
+      (setq string (substring string (match-end 0))))
+    (concat dest string)))
 
 (defun filename-maybe-truncate-by-size (string)
   (if (and (> (length string) filename-limit-length)
-	   (string-match "_" string filename-limit-length)
-	   )
+	   (string-match "_" string filename-limit-length))
       (substring string 0 (match-beginning 0))
     string))
 
@@ -136,15 +140,17 @@
 ;;;
 
 (defun replace-as-filename (string)
-  "Return safety filename from STRING. [filename.el]"
+  "Return safety filename from STRING.
+It refers variable `filename-filters' and default filters refers
+`filename-limit-length', `filename-replacement-alist'."
   (and string
-       (poly-funcall filename-filters string)
-       ))
+       (poly-funcall filename-filters string)))
 
 
 ;;; @ end
 ;;;
 
-(provide 'filename)
+(require 'product)
+(product-provide (provide 'filename) (require 'apel-ver))
 
 ;;; filename.el ends here