;; -*- coding: utf-8-mcs-er -*- (require 'cwiki-format) (require 'char-db-json) (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 ?<) "<") ;; ((eq c ?>) ">") ((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 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 "%s %s
\n%s %s
\n\n" "
name : %s " (or (www-format-feature-name feature-name) ""))) (unless simple (princ (format " " chise-wiki-edit-url uri-feature-name genre uri-object)) (princ "\n")) (princ "
\n") (when lang (princ "") (princ (www-format-encode-string (format "%s : %s" name@lang (or (char-feature-property feature-name name@lang) "")))) (unless simple (princ (format " " chise-wiki-edit-url uri-feature-name name@lang genre uri-object)) (princ "\n")) (princ "
\n")) (www-html-display-paragraph (format "type : %s" (or (www-feature-type feature-name) ;; (char-feature-property feature-name 'type) 'generic))) (princ (format "value-format : %s " (www-format-value nil 'value-format (or (www-feature-value-format feature-name) 'default) 'default 'without-tags) )) (unless simple (princ (format " " chise-wiki-edit-url uri-feature-name genre uri-object)) (princ "\n")) (princ "
\n") (princ (format "value-presentation-format : %s " (www-format-value nil 'value-presentation-format (or (www-feature-value-format feature-name) 'default) 'default 'without-tags) )) (unless simple (princ (format " " chise-wiki-edit-url uri-feature-name genre uri-object)) (princ "\n")) (princ "
\n") (princ "format : ") (www-html-display-text (decode-coding-string (www-xml-format-list (www-feature-format feature-name)) 'utf-8-mcs-er)) (unless simple (princ (format " " chise-wiki-edit-url uri-feature-name genre uri-object)) (princ "\n")) (princ "
\n") (www-html-display-paragraph (format "description : %s" (or (decode-coding-string (char-feature-property feature-name 'description) 'utf-8-mcs-er) ""))) (when lang (www-html-display-paragraph (format "description@%s : %s" lang (or (char-feature-property feature-name (intern (format "description@%s" lang))) "")))) )) (defun www-batch-view () (setq terminal-coding-system 'binary) (condition-case err (let* ((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) (princ "Content-Type: text/html; charset=UTF-8 ") (cond ((stringp target) (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)) ret)) (list (decode-uri-string cell 'utf-8-mcs-er)))) (split-string target "&"))) (setq ret (car target)) (cond ((eq (car ret) 'char) (www-display-object-desc 'character (cdr ret) (cdr (assq 'feature target)) nil lang nil (eq mode 'simple)) ) ((eq (car ret) 'feature) (www-display-feature-desc (decode-uri-string (cdr ret) 'utf-8-mcs-er) (car (nth 1 target)) (cdr (nth 1 target)) lang (eq mode 'simple)) ) (t (www-display-object-desc (car ret) (cdr ret) (cdr (assq 'feature target)) nil lang nil (eq mode 'simple)) )) )) (princ "\n%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