;; -*- coding: utf-8-mcs-er -*- (require 'cwiki-format) (require 'char-db-json) (require 'concord-turtle-dump) (defvar chise-wiki-view-url "view.cgi") (defvar chise-wiki-edit-url "edit.cgi") (defvar chise-wiki-add-url "add.cgi") (defun www-edit-display-feature-input-box (char feature-name &optional format value) (if (symbolp char) (setq char (or (concord-decode-object '=id char 'feature) (concord-make-object 'feature char)))) (unless format (setq format 'default)) (unless value (setq value (www-get-feature-value char feature-name))) (if (and (symbolp value) (eq format 'wiki-text)) (setq value (list (list value)))) (princ (format "

" feature-name)) (princ (encode-coding-string " \u2190 " 'utf-8-mcs-er)) (princ (format "%s

" (if (or (eq format 'HEX)(eq format 'hex)) "0x" "") format (mapconcat (lambda (c) (cond ;; ((eq c ?<) "&lt;") ;; ((eq c ?>) "&gt;") ((eq c ?\u0022) """) (t (char-to-string c)))) (est-format-list value format nil nil " ") ""))) ) (defun www-display-object-desc (genre uri-object &optional uri-feature-name image-selection lang level simple uri-feature-name-to-edit editing-format) (unless level (setq level 0)) (let ((object (www-uri-decode-object genre uri-object)) (est-eval-list-feature-items-limit est-eval-list-feature-items-limit) (est-view-url-prefix (if uri-feature-name "../.." "..")) (rdf-uri-object (if est-hide-cgi-mode (if (string-match "=" uri-object) (concat (est-uri-decode-feature-name-body (substring uri-object 0 (match-beginning 0))) ":" (est-uri-decode-feature-name-body (substring uri-object (match-end 0)))) uri-object))) feature-name-to-display feature-name-to-edit base-name-to-edit metadata-name-to-edit without-header logical-feature chise-wiki-displayed-features parents GlyphWiki-id HNG-card HNG-card-id HNG-card-cobj ret object-spec item-code page char-num glyph-image-id width height image-cobj base-image x y w h) (if (eq level 0) (setq level 1 without-header nil) (setq without-header t)) (when object (when uri-feature-name-to-edit (setq feature-name-to-edit (www-uri-decode-feature-name uri-feature-name-to-edit)) (setq ret (symbol-name feature-name-to-edit)) (if (string-match "\\*" ret) (setq base-name-to-edit (intern (substring ret 0 (match-beginning 0))) metadata-name-to-edit (intern (substring ret (match-end 0)))) (setq base-name-to-edit feature-name-to-edit)) (when (stringp editing-format) (setq editing-format (intern editing-format)))) (when (and (eq genre 'character) (= (length uri-object) 1)) (setq uri-object (www-uri-encode-object object))) (when (= level 1) (princ (encode-coding-string (format " EsT %s = %s \n" genre (decode-uri-string uri-object 'utf-8-mcs-er)) 'utf-8-mcs-er)) (princ "\n")) (when (eq genre 'character) (dolist (feature (char-feature-property '$object 'additional-features)) (mount-char-attribute-table (char-feature-name-at-domain feature '$rev=latest)))) (princ (if simple (format (if est-hide-cgi-mode "
\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" rdf-uri-object genre rdf-uri-object (if (eq genre 'character) (format " \n" genre rdf-uri-object) ""))) (when (setq parents (www-get-feature-value object '<-denotational)) (if (characterp parents) (setq parents (list parents))) (princ (format "

%s %s

\n
\n" (www-format-value-as-char-list parents) (www-format-feature-name '->denotational lang)))) (when (setq parents (www-get-feature-value object '<-subsumptive)) (if (characterp parents) (setq parents (list parents))) (princ (format "

%s %s

\n
\n" (www-format-value-as-char-list parents) (www-format-feature-name '->subsumptive lang)))) (when (eq genre 'character) (setq GlyphWiki-id (char-GlyphWiki-id object))) (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))) ) ((or (and (eq genre 'glyph-image) (setq image-cobj (car (concord-object-get object '->image-resource)))) (and (eq genre 'character) (setq ret (www-format-encode-string (est-format-object object 'readable))) (string-match "\"SW-JIGUGE\\([45]\\)-\\([0-9][0-9][0-9]\\)\\([0-9][0-9]\\)"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 "