apel / filename.el

;;; filename.el --- file name filter

;; Copyright (C) 1996,1997 MORIOKA Tomohiko

;; Author: MORIOKA Tomohiko <>
;; Version: $Id$
;; Keywords: file name, string

;; 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
;; 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
;; 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Code:

(require 'emu)				; for backward compatibility.
(require 'poe)				; functionp.
(require 'poem)				; char-int, and char-length.
(require 'path-util)

(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
  (while functions
    (setq argument (funcall (car functions) argument)
	  functions (cdr functions)))

;;; @ variables

(defvar filename-limit-length 21 "Limit size of file-name.")

(defvar filename-replacement-alist
  '(((?\  ?\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 nil
  "List of functions for file-name filter.

\(setq filename-filters '\(filename-special-filter

Moreover, if you want to convert Japanese filename to roman string by kakasi,

\(if \(exec-installed-p \"kakasi\"\)
    \(setq filename-filters
	  \(append '\(filename-japanese-to-roman-string\) filename-filters\)\)\)")

;;; @ filters

(defun filename-japanese-to-roman-string (str)
    (set-buffer (get-buffer-create " *temp kakasi*"))
    (insert str)
     "kakasi" t t t "-Ha" "-Ka" "-Ja" "-Ea" "-ka")

(defun filename-control-p (character)
  (let ((code (char-int character)))
    (or (< code 32)(= code 127))))

  (defmacro filename-special-filter-1 (string)
    (let (sref inc-i)
      (if (or (not (fboundp 'sref))
	      (>= emacs-major-version 21)
	      (and (= emacs-major-version 20)
		   (>= emacs-minor-version 3)))
	  (setq sref 'aref
		inc-i '(1+ i))
	(setq sref 'aref
	      inc-i '(+ i (char-length chr))))
      (` (let ((len (length (, string)))
	       (b 0)(i 0)
	       (dest ""))
	   (while (< i len)
	     (let ((chr ((, sref) (, string) i))
		   (lst filename-replacement-alist)
	       (while (and lst (not ret))
		 (if (if (functionp (car (car lst)))
			 (setq ret (funcall (car (car lst)) chr))
		       (setq ret (memq chr (car (car lst)))))
		     t			; quit this loop.
		   (setq lst (cdr lst))))
	       (if ret
		   (setq dest (concat dest (substring (, string) b i)
				      (cdr (car lst)))
			 i (, inc-i)
			 b i)
		 (setq i (, inc-i)))))
	   (concat dest (substring (, string) b)))))))

(defun filename-special-filter (string)
  (filename-special-filter-1 string))

(defun filename-eliminate-top-low-lines (string)
  (if (string-match "^_+" string)
      (substring string (match-end 0))

(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))

(defun filename-eliminate-bottom-low-lines (string)
  (if (string-match "_+$" string)
      (substring string 0 (match-beginning 0))

;;; @ interface

(defun replace-as-filename (string)
  "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)))

;;; @ end

(require 'product)
(product-provide (provide 'filename) (require 'apel-ver))

;;; filename.el ends here
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.