;;; 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.2 1996/12/19 10:06:42 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
;;; 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
)
(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))
;;;
(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)
))