(MAKEIT.BAT): Modify for apel-ja@lists.chise.org.

[elisp/apel.git] / filename.el

diff --git a/filename.el b/filename.el
index 66272d2..6aa4edd 100644 (file)
--- a/filename.el
+++ b/filename.el
@@ -20,8 +20,8 @@
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Code:
 
@@ -34,8 +34,8 @@
   "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)) ..).
+\(poly-funcall '(f1 f2 .. fn) arg) is as same as
+\(fn .. (f2 (f1 arg)) ..).
 
 For example, (poly-funcall '(car number-to-string) '(100)) returns
 \"100\"."
@@ -91,26 +91,40 @@ Moreover, if you want to convert Japanese filename to roman string by kakasi,
   (let ((code (char-int character)))
     (or (< code 32)(= code 127))))
 
+(eval-when-compile
+  (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)
+                  ret)
+              (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)
-  (let ((len (length string))
-       (b 0)(i 0)
-       (dest ""))
-    (while (< i len)
-      (let ((chr (sref string i))
-            (lst filename-replacement-alist)
-            ret)
-        (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 (+ i (char-length chr))
-                 b i)
-         (setq i (+ i (char-length chr))))))
-    (concat dest (substring string b))))
+  (filename-special-filter-1 string))
 
 (defun filename-eliminate-top-low-lines (string)
   (if (string-match "^_+" string)