tm 7.97.

diff --git a/ChangeLog b/ChangeLog
index ba979ad..5f60932 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+Mon Dec 16 13:42:44 1996  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * tl: Version 7.61.15 was released.
+
+       * TL-ELS (tl-modules): Add filename.el.
+
+       * filename.el: New module.
+
+       * tl-str.el: Variable `filename-special-char-range' variable
+       `filename-space-char-range' were abolished.
+
+       Function `replace-as-filename' was moved to filename.el.
+
+\f
 Wed Dec  4 04:56:28 1996  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
 
        * tl: Version 7.61.14 was released.

diff --git a/filename.el b/filename.el
new file mode 100644 (file)
index 0000000..34853fb
--- /dev/null
+++ b/filename.el
@@ -0,0 +1,142 @@
+;;; filename.el --- file name filter
+
+;; Copyright (C) 1996 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
+
+;; This file is part of tl (Tiny Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'tl-list)
+(require 'tl-str)
+
+
+;;; @ variables
+;;;
+
+(defvar filename-limit-length 21)
+
+(defvar filename-replacement-alist
+  (list
+   (cons (string-to-char-list " \t") "_")
+   (cons (string-to-char-list (expand-char-ranges "!-*,/:;<>?[-^`{-~")) "_")
+   '(filename-control-p . "")
+   ))
+
+(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
+     )))
+
+
+;;; @ filters
+;;;
+
+(defun filename-japanese-to-roman-string (str)
+  (save-excursion
+    (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)
+    ))
+
+(defun filename-control-p (character)
+  (let ((code (char-int character)))
+    (or (< code 32)(= code 127))
+    ))
+
+(defun filename-special-filter (string)
+  (let (dest
+       (i 0)
+       (len (length string))
+       (b 0)
+       )
+    (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)
+                                   )
+                                 ))))
+            )
+       (if ret
+           (setq dest (concat dest (substring string b i)(cdr ret))
+                 i (+ i (char-length chr))
+                 b i)
+         (setq i (+ i (char-length chr)))
+         )))
+    (concat dest (substring string b))
+    ))
+
+(defun filename-eliminate-top-low-lines (string)
+  (if (string-match "^_+" string)
+      (substring string (match-end 0))
+    string))
+
+(defun filename-canonicalize-low-lines (string)
+  (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)
+    ))
+
+(defun filename-maybe-truncate-by-size (string)
+  (if (and (> (length string) filename-limit-length)
+          (string-match "_" string filename-limit-length)
+          )
+      (substring string 0 (match-beginning 0))
+    string))
+
+(defun filename-eliminate-bottom-low-lines (string)
+  (if (string-match "_+$" string)
+      (substring string 0 (match-beginning 0))
+    string))
+
+
+;;; @ interface
+;;;
+
+(defun replace-as-filename (string)
+  "Return safety filename from STRING. [filename.el]"
+  (poly-funcall filename-filters string)
+  )
+
+
+;;; @ end
+;;;
+
+(provide 'filename)
+
+;;; filename.el ends here