From: MORIOKA Tomohiko <tomo.git@chise.org>
Date: Sun, 7 Apr 2019 11:43:21 +0000 (+0900)
Subject: (concord-images-encode-url-as-id): Add optional argument `base'.
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=c429383aa8542104b5ab642bcda64078257e0024;p=chise%2Fconcord-images.git

(concord-images-encode-url-as-id): Add optional argument `base'.
(concord-images-add-url): Likewise.
(concord-images-add-iiif): Likewise.
---

diff --git a/concord-images.el b/concord-images.el
index e51775d..7597b07 100644
--- a/concord-images.el
+++ b/concord-images.el
@@ -1,8 +1,15 @@
 (concord-assign-genre 'image-resource "/usr/local/var/photo/db")
 
-(defun concord-images-encode-url-as-id (url)
+(defun concord-images-encode-url-as-id (url &optional base)
   (let (ret)
     (cond
+     ((and base
+	   (string-match (concat "^" (regexp-quote base)) url))
+      (setq ret (substring url (match-end 0)))
+      (if (string-match "\\.[a-zA-Z0-9]+$" ret)
+	  (substring ret 0 (match-beginning 0))
+	ret)
+      )
      ((string-match "^http://\\(hng\\|image\\)\\.\\(chise\\.org\\|kanji\\.zinbun\\.kyoto-u\\.ac\\.jp\\)/images/iiif/" url)
       (setq ret (substring url (match-end 0)))
       (if (string-match "\\.[a-zA-Z0-9]+$" ret)
@@ -21,11 +28,11 @@
      (t
       url))))
 
-(defun concord-images-add-url (url &optional iiif iip)
+(defun concord-images-add-url (url &optional iiif iip base)
   (let (img-id img-cobj)
     (unless (setq img-cobj (concord-decode-object '=location url
 						  'image-resource))
-      (setq img-id (intern (concord-images-encode-url-as-id url)))
+      (setq img-id (intern (concord-images-encode-url-as-id url base)))
       (setq img-cobj (concord-make-object 'image-resource img-id))
       (concord-object-put img-cobj '=location url)
       (when iiif
@@ -50,11 +57,11 @@
       )
     img-cobj))
 
-(defun concord-images-add-iiif (url)
+(defun concord-images-add-iiif (url &optional base)
   (let (img-id img-cobj)
     (unless (setq img-cobj (concord-decode-object '=location url
 						  'image-resource))
-      (setq img-id (intern (concord-images-encode-url-as-id url)))
+      (setq img-id (intern (concord-images-encode-url-as-id url base)))
       (setq img-cobj (concord-make-object 'image-resource img-id))
       (concord-object-put img-cobj '=location@iiif url))
     img-cobj))