From: tomo Date: Wed, 24 May 2006 14:06:06 +0000 (+0000) Subject: (www-page-display-page): Fix problem when the specified file is a X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Falbum.git;a=commitdiff_plain;h=585eea66310b3098a1fa44e0c16d8a80df8b87ef (www-page-display-page): Fix problem when the specified file is a reference; fix problem when the specified file's directory does not exist. --- diff --git a/www-page.el b/www-page.el index 9f92a1a..831941d 100644 --- a/www-page.el +++ b/www-page.el @@ -207,147 +207,150 @@ (insert "\n") ;; (insert (format "

%s

\n" file)) - (if (file-exists-p (expand-file-name file image-root)) - (let* ((desc-file (expand-file-name (concat file ".desc") image-root)) - (params - (with-temp-buffer - (when (file-exists-p desc-file) - (insert-file-contents desc-file) - (read (current-buffer))))) - dir-desc-file - image-file image-ref - prev-file next-file - prev-grade next-grade - rest spec ret) - (unless params - (setq dir-desc-file - (expand-file-name "dir.desc" - (expand-file-name (file-name-directory file) - image-root))) - (setq params - (with-temp-buffer - (when (file-exists-p dir-desc-file) - (insert-file-contents dir-desc-file) - (read (current-buffer))))) - (when (setq rest (assq 'files params)) - (setq rest (cdr rest))) - (setq ret (file-name-nondirectory file)) - (while (and rest - (not (string= (car rest) ret))) - (setq prev-file (car rest) - rest (cdr rest))) - (setq next-file (car (cdr rest))) - (if prev-file - (setq params (list (cons 'prev-file prev-file)))) - (if next-file - (setq params (cons (cons 'next-file next-file) - params))) + (let* ((desc-file (expand-file-name (concat file ".desc") image-root)) + (params (with-temp-buffer - (insert (format "%S" params)) - ;; (princ "X-XEmacs-Message: ") - (write-region (point-min)(point-max) desc-file) - ;; (princ "\n") - )) - (if (setq image-ref (assq 'ref params)) - (setq image-ref (cdr image-ref)) - (setq image-file file)) - (if (setq prev-file (assq 'prev-file params)) - (setq prev-file (cdr prev-file))) - (if (setq next-file (assq 'next-file params)) - (setq next-file (cdr next-file))) - (setq rest www-page-size-specs) + (when (file-exists-p desc-file) + (insert-file-contents desc-file) + (read (current-buffer))))) + dir-desc-file + image-file image-ref + prev-file next-file + prev-grade next-grade + rest spec ret) + (unless params + (setq dir-desc-file + (expand-file-name "dir.desc" + (expand-file-name (file-name-directory file) + image-root))) + (setq params + (with-temp-buffer + (when (file-exists-p dir-desc-file) + (insert-file-contents dir-desc-file) + (read (current-buffer))))) + (unless (assq 'refs params) + (when (setq rest (assq 'files params)) + (setq rest (cdr rest))) + (setq ret (file-name-nondirectory file)) (while (and rest - (setq spec (car rest)) - (not (eq (car spec) size))) - (setq prev-grade (car spec) + (not (string= (car rest) ret))) + (setq prev-file (car rest) rest (cdr rest))) - (setq next-grade (car (car (cdr rest)))) - (if prev-file - (insert (format "" - (file-name-directory file) prev-file - (or lang 'en) - size))) - (cond ((eq lang 'ja) - (insert "[前]") - ) - (t - (insert "[Previous]") - )) + (setq next-file (car (cdr rest))) (if prev-file - (insert "")) - (insert "\n") - - (if next-file - (insert (format "" - (file-name-directory file) next-file - (or lang 'en) - size))) - (cond ((eq lang 'ja) - (insert "[次]") - ) - (t - (insert "[Next]") - )) + (setq params (list (cons 'prev-file prev-file)))) (if next-file - (insert "")) - (insert "\n") - - (if prev-grade - (insert (format "" - file - (or lang 'en) - prev-grade))) - (cond ((eq lang 'ja) - (insert "[縮小]") - ) - (t - (insert "[Smaller]") - )) - (if prev-grade - (insert "")) - (insert "\n") - - (if next-grade - (insert (format "" - file - (or lang 'en) - next-grade))) - (cond ((eq lang 'ja) - (insert "[拡大]") - ) - (t - (insert "[Larger]") - )) - (if next-grade - (insert "")) - (insert "\n") - - (insert " + (setq params (cons (cons 'next-file next-file) + params))) + (if (file-directory-p (file-name-directory desc-file)) + (with-temp-buffer + (insert (format "%S" params)) + ;; (princ "X-XEmacs-Message: ") + (write-region (point-min)(point-max) desc-file) + ;; (princ "\n") + )))) + (if (setq image-ref (assq 'ref params)) + (setq image-ref (cdr image-ref)) + (setq image-file file)) + (if (setq prev-file (assq 'prev-file params)) + (setq prev-file (cdr prev-file))) + (if (setq next-file (assq 'next-file params)) + (setq next-file (cdr next-file))) + (setq rest www-page-size-specs) + (while (and rest + (setq spec (car rest)) + (not (eq (car spec) size))) + (setq prev-grade (car spec) + rest (cdr rest))) + (setq next-grade (car (car (cdr rest)))) + (if prev-file + (insert (format "" + (file-name-directory file) prev-file + (or lang 'en) + size))) + (cond ((eq lang 'ja) + (insert "[前]") + ) + (t + (insert "[Previous]") + )) + (if prev-file + (insert "")) + (insert "\n") + + (if next-file + (insert (format "" + (file-name-directory file) next-file + (or lang 'en) + size))) + (cond ((eq lang 'ja) + (insert "[次]") + ) + (t + (insert "[Next]") + )) + (if next-file + (insert "")) + (insert "\n") + + (if prev-grade + (insert (format "" + file + (or lang 'en) + prev-grade))) + (cond ((eq lang 'ja) + (insert "[縮小]") + ) + (t + (insert "[Smaller]") + )) + (if prev-grade + (insert "")) + (insert "\n") + + (if next-grade + (insert (format "" + file + (or lang 'en) + next-grade))) + (cond ((eq lang 'ja) + (insert "[拡大]") + ) + (t + (insert "[Larger]") + )) + (if next-grade + (insert "")) + (insert "\n") + + (insert "

") - (if next-file - (insert (format "" - (file-name-directory file) next-file - (or lang 'en) - size))) - (insert - (if image-ref - (format " $\"%s\"$ " - file image-ref size) - (format " $\"%s\"$ " - file image-file size))) - (if next-file - (insert "")) - ) - (insert "

") - (insert (format - (cond - ((eq lang 'ja) - "画像ファイル %s が見付かりません。\n") - (t - "Image file %s is not found.\n")) - file)) - ) + (if next-file + (insert (format "" + (file-name-directory file) next-file + (or lang 'en) + size))) + (if image-ref + (insert + (format " $\"%s\"$ " + file image-ref size)) + (if (file-exists-p (expand-file-name image-file image-root)) + (insert + (format " $\"%s\"$ " + file image-file size)) + (insert "

") + (insert (format + (cond + ((eq lang 'ja) + "画像ファイル %s が見付かりません。\n") + (t + "Image file %s is not found.\n")) + file)))) + + (if next-file + (insert "")) + ) (insert "