filename.el

   1 ;;; filename.el --- file name filter
   2
   3 ;; Copyright (C) 1996 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Version: $Id: filename.el,v 1.2 1996/12/19 10:06:42 morioka Exp $
   7 ;; Keywords: string, file name
   8
   9 ;; This file is part of tl (Tiny Library).
  10
  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.
  15
  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.
  20
  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.
  25
  26 ;;; Code:
  27
  28 (require 'tl-list)
  29 (require 'tl-str)
  30
  31
  32 ;;; @ variables
  33 ;;;
  34
  35 (defvar filename-limit-length 21)
  36
  37 (defvar filename-replacement-alist
  38   (list
  39    (cons (string-to-char-list " \t") "_")
  40    (cons (string-to-char-list (expand-char-ranges "!-*,/:;<>?[-^`{-~")) "_")
  41    '(filename-control-p . "")
  42    ))
  43
  44 (defvar filename-filters
  45   (nconc
  46    (and (file-installed-p "kakasi" exec-path)
  47         '(filename-japanese-to-roman-string)
  48         )
  49    '(filename-special-filter
  50      filename-eliminate-top-low-lines
  51      filename-canonicalize-low-lines
  52      filename-maybe-truncate-by-size
  53      filename-eliminate-bottom-low-lines
  54      )))
  55
  56
  57 ;;; @ filters
  58 ;;;
  59
  60 (defun filename-japanese-to-roman-string (str)
  61   (save-excursion
  62     (set-buffer (get-buffer-create " *temp kakasi*"))
  63     (erase-buffer)
  64     (insert str)
  65     (call-process-region (point-min)(point-max) "kakasi" t t t
  66                          "-Ha" "-Ka" "-Ja" "-Ea" "-ka")
  67     (buffer-string)
  68     ))
  69
  70 (defun filename-control-p (character)
  71   (let ((code (char-int character)))
  72     (or (< code 32)(= code 127))
  73     ))
  74
  75 (defun filename-special-filter (string)
  76   (let (dest
  77         (i 0)
  78         (len (length string))
  79         (b 0)
  80         )
  81     (while (< i len)
  82       (let* ((chr (sref string i))
  83              (ret (ASSOC chr filename-replacement-alist
  84                          :test (function
  85                                 (lambda (chr key)
  86                                   (if (functionp key)
  87                                       (funcall key chr)
  88                                     (memq chr key)
  89                                     )
  90                                   ))))
  91              )
  92         (if ret
  93             (setq dest (concat dest (substring string b i)(cdr ret))
  94                   i (+ i (char-length chr))
  95                   b i)
  96           (setq i (+ i (char-length chr)))
  97           )))
  98     (concat dest (substring string b))
  99     ))
 100
 101 (defun filename-eliminate-top-low-lines (string)
 102   (if (string-match "^_+" string)
 103       (substring string (match-end 0))
 104     string))
 105
 106 (defun filename-canonicalize-low-lines (string)
 107   (let (dest)
 108     (while (string-match "__+" string)
 109       (setq dest (concat dest (substring string 0 (1+ (match-beginning 0)))))
 110       (setq string (substring string (match-end 0)))
 111       )
 112     (concat dest string)
 113     ))
 114
 115 (defun filename-maybe-truncate-by-size (string)
 116   (if (and (> (length string) filename-limit-length)
 117            (string-match "_" string filename-limit-length)
 118            )
 119       (substring string 0 (match-beginning 0))
 120     string))
 121
 122 (defun filename-eliminate-bottom-low-lines (string)
 123   (if (string-match "_+$" string)
 124       (substring string 0 (match-beginning 0))
 125     string))
 126
 127
 128 ;;; @ interface
 129 ;;;
 130
 131 (defun replace-as-filename (string)
 132   "Return safety filename from STRING. [filename.el]"
 133   (and string
 134        (poly-funcall filename-filters string)
 135        ))
 136
 137
 138 ;;; @ end
 139 ;;;
 140
 141 (provide 'filename)
 142
 143 ;;; filename.el ends here