APEL 7.1.

[elisp/apel.git] / filename.el

diff --git a/filename.el b/filename.el
index 34853fb..ba7ffe1 100644 (file)
--- a/filename.el
+++ b/filename.el
@@ -1,12 +1,12 @@
 ;;; filename.el --- file name filter
 
-;; Copyright (C) 1996 MORIOKA Tomohiko
+;; Copyright (C) 1996,1997 MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: filename.el,v 1.1 1996/12/16 13:42:14 morioka Exp $
-;; Keywords: string, file name
+;; Version: $Id: filename.el,v 2.1 1997/11/06 15:50:53 morioka Exp $
+;; Keywords: file name, string
 
-;; This file is part of tl (Tiny Library).
+;; This file is part of APEL (A Portable Emacs Library).
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -25,33 +25,51 @@
 
 ;;; Code:
 
-(require 'tl-list)
-(require 'tl-str)
+(require 'emu)
+(require 'cl)
+
+(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 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
-  (list
-   (cons (string-to-char-list " \t") "_")
-   (cons (string-to-char-list (expand-char-ranges "!-*,/:;<>?[-^`{-~")) "_")
-   '(filename-control-p . "")
-   ))
+  '(((?\  ?\t) . "_")
+    ((?! ?\" ?# ?$ ?% ?& ?' ?\( ?\) ?* ?/
+        ?: ?\; ?< ?> ?? ?\[ ?\\ ?\] ?` ?{ ?| ?}) . "_")
+    (filename-control-p . "")
+    )
+  "Alist list of characters vs. string as replacement.
+List of characters represents characters not allowed as file-name.")
 
 (defvar filename-filters
-  (nconc
-   (and (file-installed-p "kakasi" exec-path)
-       '(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
-     )))
+  (let ((filters '(filename-special-filter
+                  filename-eliminate-top-low-lines
+                  filename-canonicalize-low-lines
+                  filename-maybe-truncate-by-size
+                  filename-eliminate-bottom-low-lines
+                  )))
+    (require 'path-util)
+    (if (exec-installed-p "kakasi")
+       (cons 'filename-japanese-to-roman-string filters)
+      filters))
+  "List of functions for file-name filter.")
 
 
 ;;; @ filters
@@ -80,14 +98,13 @@
        )
     (while (< i len)
       (let* ((chr (sref string i))
-            (ret (ASSOC chr filename-replacement-alist
-                        :test (function
-                               (lambda (chr key)
-                                 (if (functionp key)
-                                     (funcall key chr)
-                                   (memq chr key)
-                                   )
-                                 ))))
+            (ret (assoc-if (function
+                            (lambda (key)
+                              (if (functionp key)
+                                  (funcall key chr)
+                                (memq chr key)
+                                )))
+                           filename-replacement-alist))
             )
        (if ret
            (setq dest (concat dest (substring string b i)(cdr ret))
@@ -129,9 +146,12 @@
 ;;;
 
 (defun replace-as-filename (string)
-  "Return safety filename from STRING. [filename.el]"
-  (poly-funcall filename-filters string)
-  )
+  "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)
+       ))
 
 
 ;;; @ end