+ (if simple + (format + (if est-hide-cgi-mode + "

+ + +\n" + "

\n" +\n") + genre rdf-uri-object) + (format "

- + - - +\n" + genre + (if (string-match ":" uri-object) + (concat + (est-uri-encode-feature-name-body + (substring uri-object 0 (match-beginning 0))) + "=" + (est-uri-encode-feature-name-body + (substring uri-object (match-end 0)))))))) + (princ + (format " - +%s

\n") - genre uri-object - genre uri-object)) +

\n" + genre rdf-uri-object + (if (eq genre 'character) + (format " + + +\n" + genre rdf-uri-object) + ""))) (when (setq parents (www-get-feature-value object '<-denotational)) (princ (format "

%s %s

\n" (www-format-value-as-char-list parents) @@ -124,22 +199,150 @@ size=\"64\" maxlength=\"256\" value=\"%s\"> (www-format-feature-name '->subsumptive lang)))) (when (eq genre 'character) (setq GlyphWiki-id (char-GlyphWiki-id object))) - (setq ret (www-format-encode-string - (est-format-object object 'readable))) - (princ (format "%s%s\n" - level - (if uri-feature-name - (format "%s" - (www-uri-make-object-url object uri-object) - ret) - ret) - (if GlyphWiki-id - (format - " $\"%s\"$ " - GlyphWiki-id - GlyphWiki-id GlyphWiki-id) - "") - level)) + (cond + ((eq genre 'image-resource) + (princ + (if (setq ret (concord-object-get object '=location@iiif)) + (if (setq base-image + (car (concord-object-get object '<-image-segment))) + (format " $\"%s\"$ " + (www-uri-encode-object base-image) + (concord-object-get object 'image-offset-x) + (concord-object-get object 'image-offset-y) + (concord-object-get object 'image-width) + (concord-object-get object 'image-height) + ret ret) + (if (and image-selection + (string-match "\$[0-9]+\$,\$[0-9]+\$,\$[0-9]+\$,\$[0-9]+\$" image-selection)) + (progn + (setq x (string-to-int (match-string 1 image-selection)) + y (string-to-int (match-string 2 image-selection)) + w (string-to-int (match-string 3 image-selection)) + h (string-to-int (match-string 4 image-selection))) + (setq width (float + (concord-object-get object 'image-width))) + ;; (setq height (float + ;; (concord-object-get object 'image-height))) + (format "

+ + +" + ret + (/ x width) + (/ y width) + (/ w width) + (/ h width) + )) + (format "

+ + +" + ret))) + (setq ret (concord-object-get object '=location)) + (format " $\"%s\"$ " + ret ret))) + ) + ((and (eq genre 'glyph-image) + (setq image-cobj + (car (concord-object-get object '->image-resource)))) + (if (and (setq ret (concord-object-get image-cobj '=location@iiif)) + (setq base-image + (car (concord-object-get image-cobj '<-image-segment)))) + (princ + (format " $\"%s\"$ " + (www-uri-encode-object base-image) + (concord-object-get image-cobj 'image-offset-x) + (concord-object-get image-cobj 'image-offset-y) + (concord-object-get image-cobj 'image-width) + (concord-object-get image-cobj 'image-height) + ret ret)) + (setq ret (concord-object-get image-cobj '=location)) + (princ (format " $\"%s\"$ " + ret ret))) + ) + ((and (eq genre 'hng-card) + (setq ret (concord-object-get object '=hng-card)) + (setq ret (symbol-name ret)) + (string-match "\$[0-9]+\$-\$[0-9]+\$" ret)) + (princ + (format + " $\"HNG-card:%s\"$ " + ret + (string-to-int (match-string 1 ret)) + (string-to-int (match-string 2 ret)))) + ) + (t + (setq ret (www-format-encode-string + (est-format-object object 'readable))) + (when (string-match + " $\"HNG\$[0-9]+\$-\$[0-9]+\$[a-z]?\""$ %s%s\n" + level + (cond + (uri-feature-name + (format "%s" + ;; (if est-hide-cgi-mode + ;; "%s" + ;; "%s") + (www-uri-make-object-url object uri-object) + ret) + ) + (HNG-card + (format + "%s" + HNG-card ret) + ) + (t ret)) + (if GlyphWiki-id + (format + " $\"%s\"$ " + GlyphWiki-id + GlyphWiki-id GlyphWiki-id) + "") + level)) + )) (if (> level 1) (princ "

- + (if simple + (format + (if est-hide-cgi-mode + "

\n" - "

- - + "

+ + +

\n") - uri-feature-name genre uri-object)) + uri-feature-name genre rdf-uri-object) + (format + "

+ + + +

\n" + uri-feature-name genre uri-object))) (princ (format "

%s

\n" (www-format-encode-string @@ -400,7 +660,9 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (www-html-display-paragraph (format "description : %s" - (or (char-feature-property feature-name 'description) + (or (decode-coding-string + (char-feature-property feature-name 'description) + 'utf-8-mcs-er) ""))) (when lang (www-html-display-paragraph @@ -459,6 +721,7 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (cond ((eq (car ret) 'char) (www-display-object-desc 'character (cdr ret) (cdr (assq 'feature target)) + nil lang nil (eq mode 'simple)) ) @@ -473,6 +736,7 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (t (www-display-object-desc (car ret) (cdr ret) (cdr (assq 'feature target)) + nil lang nil (eq mode 'simple)) )) @@ -493,4 +757,155 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (princ (format "%S" err))) )) +(defun www-batch-view-smart () + (setq debug-on-error t) + (setq terminal-coding-system 'binary) + (condition-case err + (let* ((est-hide-cgi-mode t) + (target (pop command-line-args-left)) + (user (pop command-line-args-left)) + (accept-language (pop command-line-args-left)) + (mode (intern (pop command-line-args-left))) + (lang + (intern + (car (split-string + (car (split-string + (car (split-string accept-language ",")) + ";")) + "-")))) + ret genre feature obj-url json obj) + (cond + ((stringp target) + (when (string-match "/data\\.json$" target) + (setq json t + target (substring target 0 (match-beginning 0)))) + (when (string-match "^char/\$&[^&;]+;\$" target) + (setq ret (match-end 0)) + (setq target + (concat "char/" + (www-uri-encode-object + (www-uri-decode-object + 'character (match-string 1 target))) + (substring target ret)))) + (setq target + (mapcar + (lambda (cell) + (if (string-match "/" cell) + (progn + (setq genre (substring cell 0 (match-beginning 0)) + ret (substring cell (match-end 0))) + (cons + (intern (decode-uri-string genre 'utf-8-mcs-er)) + (cond + ((string-match "/feature=" ret) + (list (substring ret 0 (match-beginning 0)) + (substring ret (match-end 0))) + ) + ((string-match "...$.zoom-xywh=" ret) + (list (substring ret 0 (match-beginning 0)) + nil + (substring ret (match-end 0))) + ) + (t + (list ret))))) + (list (decode-uri-string cell 'utf-8-mcs-er))) + ;; (setq ret (split-string cell "/")) + ;; (cons (intern + ;; (decode-uri-string (car ret) 'utf-8-mcs-er)) + ;; (cdr ret)) + ) + (split-string target "&"))) + (setq ret (car target)) + (if json + (princ "Content-Type: application/json; charset=UTF-8 + +") + (princ "Content-Type: text/html; charset=UTF-8 + + + +") + ) + ;; (princ (format "

%S, %S, %S

" + ;; (car ret)(nth 1 ret)(nth 2 ret))) + ;; (princ (format "// %S %S\n" ret json)) + (cond ((or (eq (car ret) 'char) + (eq (car ret) 'character)) + (if (and json + (setq obj (www-uri-decode-object + (car ret)(nth 1 ret))) + (characterp obj)) + (with-temp-buffer + ;; (princ (encode-coding-string + ;; (format "// %S\n" obj) + ;; char-db-file-coding-system)) + (char-db-json-char-data-with-variant obj 'printable) + (encode-coding-region + (point-min)(point-max) + char-db-file-coding-system) + (princ (buffer-string)) + ) + (www-display-object-desc + 'character (nth 1 ret) (nth 2 ret) + nil + lang nil + (eq mode 'simple))) + ) + ((eq (car ret) 'feature) + (www-display-feature-desc + (decode-uri-string (nth 1 ret) 'utf-8-mcs-er) + (car (nth 1 target)) + (nth 1 (nth 1 target)) + lang + (eq mode 'simple)) + ) + ;; ((eq (car ret) 'image-resource) + ;; ;; (cond + ;; ;; ((string-match "^\\.iiif=" (nth 1 ret)) + ;; ;; (setq obj-url (decode-uri-string + ;; ;; (substring (nth 1 ret) (match-end 0)) + ;; ;; 'utf-8-mcs-er)) + ;; ;; (setq obj (concord-images-add-iiif obj-url)) + ;; ;; (www-display-object-desc + ;; ;; 'image-resource + ;; ;; (www-uri-encode-object obj) + ;; ;; (nth 2 ret) + ;; ;; lang nil + ;; ;; (eq mode 'simple)) + ;; ;; ) + ;; ;; (t + ;; (princ (nth 1 ret)) + ;; (www-display-object-desc + ;; 'image-resource (nth 1 ret) (nth 2 ret) + ;; lang nil + ;; (eq mode 'simple)) + ;; ;; )) + ;; ) + (t + (www-display-object-desc + (car ret) (nth 1 ret) (nth 2 ret) + (nth 3 ret) + lang nil + (eq mode 'simple)) + )) + )) + (unless json + (princ "\n

\n") + (princ (format "mode=%S\n" mode)) + (princ (format "user=%s\n" user)) + ;; (princ (format "local user=%s\n" (user-login-name))) + (princ (format "lang=%S\n" lang)) + (princ (encode-coding-string (emacs-version) 'utf-8-jp-er)) + ;; (princ " CHISE ") + ;; (princ xemacs-chise-version) + (princ " + +") + ) + ) + (error nil + (princ (format "%S" err))) + )) + (provide 'cwiki-view)