1 ;;; filename.el --- file name filter
3 ;; Copyright (C) 1996,1997 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Version: $Id: filename.el,v 2.1 1997/11/06 15:50:53 morioka Exp $
7 ;; Keywords: file name, string
9 ;; This file is part of APEL (A Portable Emacs Library).
11 ;; This program is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as
13 ;; published by the Free Software Foundation; either version 2, or (at
14 ;; your option) any later version.
16 ;; This program is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
31 (defsubst poly-funcall (functions argument)
32 "Apply initial ARGUMENT to sequence of FUNCTIONS.
33 FUNCTIONS is list of functions.
35 (poly-funcall '(f1 f2 .. fn) arg) is as same as
36 (fn .. (f2 (f1 arg)) ..).
38 For example, (poly-funcall '(car number-to-string) '(100)) returns
41 (setq argument (funcall (car functions) argument)
42 functions (cdr functions))
50 (defvar filename-limit-length 21 "Limit size of file-name.")
52 (defvar filename-replacement-alist
54 ((?! ?\" ?# ?$ ?% ?& ?' ?\( ?\) ?* ?/
55 ?: ?\; ?< ?> ?? ?\[ ?\\ ?\] ?` ?{ ?| ?}) . "_")
56 (filename-control-p . "")
58 "Alist list of characters vs. string as replacement.
59 List of characters represents characters not allowed as file-name.")
61 (defvar filename-filters
62 (let ((filters '(filename-special-filter
63 filename-eliminate-top-low-lines
64 filename-canonicalize-low-lines
65 filename-maybe-truncate-by-size
66 filename-eliminate-bottom-low-lines
69 (if (exec-installed-p "kakasi")
70 (cons 'filename-japanese-to-roman-string filters)
72 "List of functions for file-name filter.")
78 (defun filename-japanese-to-roman-string (str)
80 (set-buffer (get-buffer-create " *temp kakasi*"))
83 (call-process-region (point-min)(point-max) "kakasi" t t t
84 "-Ha" "-Ka" "-Ja" "-Ea" "-ka")
88 (defun filename-control-p (character)
89 (let ((code (char-int character)))
90 (or (< code 32)(= code 127))
93 (defun filename-special-filter (string)
100 (let* ((chr (sref string i))
101 (ret (assoc-if (function
107 filename-replacement-alist))
110 (setq dest (concat dest (substring string b i)(cdr ret))
111 i (+ i (char-length chr))
113 (setq i (+ i (char-length chr)))
115 (concat dest (substring string b))
118 (defun filename-eliminate-top-low-lines (string)
119 (if (string-match "^_+" string)
120 (substring string (match-end 0))
123 (defun filename-canonicalize-low-lines (string)
125 (while (string-match "__+" string)
126 (setq dest (concat dest (substring string 0 (1+ (match-beginning 0)))))
127 (setq string (substring string (match-end 0)))
132 (defun filename-maybe-truncate-by-size (string)
133 (if (and (> (length string) filename-limit-length)
134 (string-match "_" string filename-limit-length)
136 (substring string 0 (match-beginning 0))
139 (defun filename-eliminate-bottom-low-lines (string)
140 (if (string-match "_+$" string)
141 (substring string 0 (match-beginning 0))
148 (defun replace-as-filename (string)
149 "Return safety filename from STRING.
150 It refers variable `filename-filters' and default filters refers
151 `filename-limit-length', `filename-replacement-alist'."
153 (poly-funcall filename-filters string)
162 ;;; filename.el ends here