filename.el

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