[config.git] / djavu-asus / elpa / jabber-20230715.456 / jabber-widget.el

;; jabber-widget.el - display various kinds of forms  -*- lexical-binding: t; -*-

;; Copyright (C) 2003, 2004, 2007 - Magnus Henoch - mange@freemail.hu
;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net

;; This file is a part of jabber.el.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

(require 'widget)
(require 'wid-edit)
(require 'jabber-util)
(require 'jabber-disco)

(defvar jabber-widget-alist nil
  "Alist of widgets currently used.")

(defvar jabber-form-type nil
  "Type of form.
One of:
'x-data, jabber:x:data
'register, as used in jabber:iq:register and jabber:iq:search.")

(defvar jabber-submit-to nil
  "JID of the entity to which form data is to be sent.")

(jabber-disco-advertise-feature "jabber:x:data")

(define-widget 'jid 'string
  "JID widget."
  :value-to-internal (lambda (widget value)
		       (let ((displayname (jabber-jid-rostername value)))
			 (if displayname
			     (format "%s <%s>" displayname value)
			   value)))
  :value-to-external (lambda (widget value)
		       (if (string-match "<\\([^>]+\\)>[ \t]*$" value)
			   (match-string 1 value)
			 value))
  :complete-function 'jid-complete)

(defun jid-complete ()
  "Perform completion on JID preceding point."
  (interactive)
  ;; mostly stolen from widget-color-complete
  (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
						 (point)))
	 (list (append (mapcar #'symbol-name *jabber-roster*)
		       (delq nil
			     (mapcar #'(lambda (item)
					 (when (jabber-jid-rostername item)
					   (format "%s <%s>" (jabber-jid-rostername item)
						   (symbol-name item))))
				     *jabber-roster*))))
	 (completion (try-completion prefix list)))
    (cond ((eq completion t)
	   (message "Exact match."))
	  ((null completion)
	   (error "Can't find completion for \"%s\"" prefix))
	  ((not (string-equal prefix completion))
	   (insert-and-inherit (substring completion (length prefix))))
	  (t
	   (message "Making completion list...")
	   (with-output-to-temp-buffer "*Completions*"
	     (display-completion-list (all-completions prefix list nil)))
	   (message "Making completion list...done")))))

(defun jabber-init-widget-buffer (submit-to)
  "Setup buffer-local variables for widgets."
  (make-local-variable 'jabber-widget-alist)
  (make-local-variable 'jabber-submit-to)
  (setq jabber-widget-alist nil)
  (setq jabber-submit-to submit-to)
  (setq buffer-read-only nil)
  ;; XXX: This is because data from other queries would otherwise be
  ;; appended to this buffer, which would fail since widget buffers
  ;; are read-only... or something like that.  Maybe there's a
  ;; better way.
  (rename-uniquely))

(defun jabber-render-register-form (query &optional default-username)
  "Display widgets from <query/> element in IQ register or search namespace.
Display widgets from <query/> element in jabber:iq:{register,search} namespace.
DEFAULT-USERNAME is the default value for the username field."
  (make-local-variable 'jabber-widget-alist)
  (setq jabber-widget-alist nil)
  (make-local-variable 'jabber-form-type)
  (setq jabber-form-type 'register)

  (if (jabber-xml-get-children query 'instructions)
      (widget-insert "Instructions: " (car (jabber-xml-node-children (car (jabber-xml-get-children query 'instructions)))) "\n"))
  (if (jabber-xml-get-children query 'registered)
      (widget-insert "You are already registered.  You can change your details here.\n"))
  (widget-insert "\n")

  (let ((possible-fields
	 ;; taken from XEP-0077
	 '((username . "Username")
	   (nick . "Nickname")
	   (password . "Password")
	   (name . "Full name")
	   (first . "First name")
	   (last . "Last name")
	   (email . "E-mail")
	   (address . "Address")
	   (city . "City")
	   (state . "State")
	   (zip . "Zip")
	   (phone . "Telephone")
	   (url . "Web page")
	   (date . "Birth date"))))
    (dolist (field (jabber-xml-node-children query))
      (let ((entry (assq (jabber-xml-node-name field) possible-fields)))
	(when entry
	  (widget-insert (cdr entry) "\t")
	  ;; Special case: when registering a new account, the default
	  ;; username is the one specified in jabber-username.  Things
	  ;; will break if the user changes that name, though...
	  (let ((default-value (or (when (eq (jabber-xml-node-name field) 'username)
				     default-username)
				   "")))
	    (setq jabber-widget-alist
		  (cons
		   (cons (car entry)
			 (widget-create 'editable-field
					:secret  (if (eq (car entry) 'password)
						     ?* nil)
					(or (car (jabber-xml-node-children
						  field)) default-value)))
		   jabber-widget-alist)))
	  (widget-insert "\n"))))))

(defun jabber-parse-register-form ()
  "Return children of a <query/> tag containing information entered.
Return children of a <query/> tag containing information entered in the
widgets of the current buffer."
  (mapcar
   (lambda (widget-cons)
     (list (car widget-cons)
	   nil
	   (widget-value (cdr widget-cons))))
   jabber-widget-alist))

(defun jabber-render-xdata-form (x &optional defaults)
  "Display widgets from <x/> element in jabber:x:data namespace.
DEFAULTS is an alist associating variable names with default values.
DEFAULTS takes precedence over values specified in the form."
  (make-local-variable 'jabber-widget-alist)
  (setq jabber-widget-alist nil)
  (make-local-variable 'jabber-form-type)
  (setq jabber-form-type 'xdata)

  (let ((title (car (jabber-xml-node-children (car (jabber-xml-get-children x 'title))))))
    (if (stringp title)
	(widget-insert (jabber-propertize title 'face 'jabber-title-medium) "\n\n")))
  (let ((instructions (car (jabber-xml-node-children (car (jabber-xml-get-children x 'instructions))))))
    (if (stringp instructions)
	(widget-insert "Instructions: " instructions "\n\n")))

  (dolist (field (jabber-xml-get-children x 'field))
    (let* ((var (jabber-xml-get-attribute field 'var))
	   (label (jabber-xml-get-attribute field 'label))
	   (type (jabber-xml-get-attribute field 'type))
	   (required (jabber-xml-get-children field 'required))
	   (values (jabber-xml-get-children field 'value))
	   (options (jabber-xml-get-children field 'option))
	   (desc (car (jabber-xml-get-children field 'desc)))
	   (default-value (assoc var defaults)))
      ;; "required" not implemented yet

      (cond
       ((string= type "fixed")
	(widget-insert (car (jabber-xml-node-children (car values)))))

       ((string= type "text-multi")
	(if (or label var)
	    (widget-insert (or label var) ":\n"))
	(push (cons (cons var type)
		    (widget-create 'text (or (cdr default-value)
					      (mapconcat #'(lambda (val)
							     (car (jabber-xml-node-children val)))
							 values "\n")
					     "")))
	      jabber-widget-alist))

       ((string= type "list-single")
	(if (or label var)
	    (widget-insert (or label var) ":\n"))
	(push (cons (cons var type)
		    (apply 'widget-create
			   'radio-button-choice
			   :value (or (cdr default-value)
				      (car (xml-node-children (car values))))
			   (mapcar (lambda (option)
				     `(item :tag ,(jabber-xml-get-attribute option 'label)
					    :value ,(car (jabber-xml-node-children (car (jabber-xml-get-children option 'value))))))
				   options)))
	      jabber-widget-alist))

       ((string= type "boolean")
	(push (cons (cons var type)
		    (widget-create 'checkbox
				   :tag (or label var)
				   :value (if default-value
					      (cdr default-value)
					    (not (null
						  (member (car (xml-node-children (car values))) '("1" "true")))))))
	      jabber-widget-alist)
	(if (or label var)
	    (widget-insert " " (or label var) "\n")))

       (t	; in particular including text-single and text-private
	(if (or label var)
	    (widget-insert (or label var) ": "))
	(setq jabber-widget-alist
	      (cons
	       (cons (cons var type)
		     (widget-create 'editable-field
				    :secret (if (string= type "text-private") ?* nil)
				    (or (cdr default-value)
					(car (jabber-xml-node-children (car values)))
					"")))
	       jabber-widget-alist))))
      (when (and desc (car (jabber-xml-node-children desc)))
	(widget-insert "\n" (car (jabber-xml-node-children desc))))
      (widget-insert "\n"))))

(defun jabber-parse-xdata-form ()
  "Return an <x/> tag containing information entered in the widgets.
Return an <x/> tag containing information entered in the widgets of the current
buffer."
  `(x ((xmlns . "jabber:x:data")
       (type . "submit"))
      ,@(mapcar
	 (lambda (widget-cons)
	   (let ((values (jabber-xdata-value-convert (widget-value (cdr widget-cons)) (cdar widget-cons))))
	     ;; empty fields are not included
	     (when values
	       `(field ((var . ,(caar widget-cons)))
		       ,@(mapcar
			  (lambda (value)
			    (list 'value nil value))
			  values)))))
	 jabber-widget-alist)))

(defun jabber-xdata-value-convert (value type)
  "Convert VALUE from form used by widget library to form required by XEP-0004.
Return a list of strings, each of which to be included as cdata in a
<value/> tag."
  (cond
   ((string= type "boolean")
    (if value (list "1") (list "0")))
   ((string= type "text-multi")
    (split-string value "[\n\r]"))
   (t					; in particular including text-single, text-private and list-single
    (if (zerop (length value))
	nil
      (list value)))))

(defun jabber-render-xdata-search-results (xdata)
  "Render search results in x:data form."
  (let ((title (car (jabber-xml-get-children xdata 'title))))
    (when title
      (insert (jabber-propertize (car (jabber-xml-node-children title)) 'face 'jabber-title-medium) "\n")))
  (if (jabber-xml-get-children xdata 'reported)
      (jabber-render-xdata-search-results-multi xdata)
    (jabber-render-xdata-search-results-single xdata)))

(defun jabber-render-xdata-search-results-multi (xdata)
  "Render multi-record search results."
  (let (fields
	(jid-fields 0))
    (let ((reported (car (jabber-xml-get-children xdata 'reported)))
	  (column 0))
      (dolist (field (jabber-xml-get-children reported 'field))
	(let (width)
	  ;; Clever algorithm for estimating width based on field type goes here.
	  (setq width 20)

	  (setq fields
		(append
		 fields
		 (list (cons (jabber-xml-get-attribute field 'var)
			     (list 'label (jabber-xml-get-attribute field 'label)
				   'type (jabber-xml-get-attribute field 'type)
				   'column column)))))
	  (setq column (+ column width))
	  (if (string= (jabber-xml-get-attribute field 'type) "jid-single")
	      (setq jid-fields (1+ jid-fields))))))

    (dolist (field-cons fields)
      (indent-to (plist-get (cdr field-cons) 'column) 1)
      (insert (jabber-propertize (plist-get (cdr field-cons) 'label) 'face 'bold)))
    (insert "\n\n")

    ;; Now, the items
    (dolist (item (jabber-xml-get-children xdata 'item))

      (let ((start-of-line (point))
	    jid)

	;; The following code assumes that the order of the <field/>s in each
	;; <item/> is the same as in the <reported/> tag.
	(dolist (field (jabber-xml-get-children item 'field))
	  (let ((field-plist (cdr (assoc (jabber-xml-get-attribute field 'var) fields)))
		(value (car (jabber-xml-node-children (car (jabber-xml-get-children field 'value))))))

	    (indent-to (plist-get field-plist 'column) 1)

	    ;; Absent values are sometimes "", sometimes nil.  insert
	    ;; doesn't like nil.
	    (when value
	      ;; If there is only one JID field, let the whole row
	      ;; have the jabber-jid property.  If there are many JID
	      ;; fields, the string belonging to each field has that
	      ;; property.
	      (if (string= (plist-get field-plist 'type) "jid-single")
		  (if (not (eq jid-fields 1))
		      (insert (jabber-propertize value 'jabber-jid value))
		    (setq jid value)
		    (insert value))
		(insert value)))))

	(if jid
	    (put-text-property start-of-line (point)
			       'jabber-jid jid))
	(insert "\n")))))

(defun jabber-render-xdata-search-results-single (xdata)
  "Render single-record search results."
  (dolist (field (jabber-xml-get-children xdata 'field))
    (let ((label (jabber-xml-get-attribute field 'label))
	  (type (jabber-xml-get-attribute field 'type))
	  (values (mapcar #'(lambda (val)
			      (car (jabber-xml-node-children val)))
			  (jabber-xml-get-children field 'value))))
      ;; XXX: consider type
      (insert (jabber-propertize (concat label ": ") 'face 'bold))
      (indent-to 30)
      (insert (apply #'concat values) "\n"))))

(defun jabber-xdata-formtype (x)
  "Return the form type of the xdata form in X, by XEP-0068.
Return nil if no form type is specified."
  (catch 'found-formtype
    (dolist (field (jabber-xml-get-children x 'field))
      (when (and (string= (jabber-xml-get-attribute field 'var) "FORM_TYPE")
		 (string= (jabber-xml-get-attribute field 'type) "hidden"))
	(throw 'found-formtype (car (jabber-xml-node-children
				     (car (jabber-xml-get-children field 'value)))))))))

(provide 'jabber-widget)

;;; arch-tag: da3312f3-1970-41d5-a974-14b8d76156b8
Commit	Line	Data
53e6db90 DC	1	;; jabber-widget.el - display various kinds of forms -- lexical-binding: t; --
	2
	3	;; Copyright (C) 2003, 2004, 2007 - Magnus Henoch - mange@freemail.hu
	4	;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
	5
	6	;; This file is a part of jabber.el.
	7
	8	;; This program is free software; you can redistribute it and/or modify
	9	;; it under the terms of the GNU General Public License as published by
	10	;; the Free Software Foundation; either version 2 of the License, or
	11	;; (at your option) any later version.
	12
	13	;; This program is distributed in the hope that it will be useful,
	14	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	15	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	;; GNU General Public License for more details.
	17
	18	;; You should have received a copy of the GNU General Public License
	19	;; along with this program; if not, write to the Free Software
	20	;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	21
	22	(require 'widget)
	23	(require 'wid-edit)
	24	(require 'jabber-util)
	25	(require 'jabber-disco)
	26
	27	(defvar jabber-widget-alist nil
	28	"Alist of widgets currently used.")
	29
	30	(defvar jabber-form-type nil
	31	"Type of form.
	32	One of:
	33	'x-data, jabber:x:data
	34	'register, as used in jabber:iq:register and jabber:iq:search.")
	35
	36	(defvar jabber-submit-to nil
	37	"JID of the entity to which form data is to be sent.")
	38
	39	(jabber-disco-advertise-feature "jabber:x:data")
	40
	41	(define-widget 'jid 'string
	42	"JID widget."
	43	:value-to-internal (lambda (widget value)
	44	(let ((displayname (jabber-jid-rostername value)))
	45	(if displayname
	46	(format "%s <%s>" displayname value)
	47	value)))
	48	:value-to-external (lambda (widget value)
	49	(if (string-match "<\\([^>]+\\)>[ \t]*$" value)
	50	(match-string 1 value)
	51	value))
	52	:complete-function 'jid-complete)
	53
	54	(defun jid-complete ()
	55	"Perform completion on JID preceding point."
	56	(interactive)
	57	;; mostly stolen from widget-color-complete
	58	(let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
	59	(point)))
	60	(list (append (mapcar #'symbol-name jabber-roster)
	61	(delq nil
	62	(mapcar #'(lambda (item)
	63	(when (jabber-jid-rostername item)
	64	(format "%s <%s>" (jabber-jid-rostername item)
65	(symbol-name item))))
66	jabber-roster))))
67	(completion (try-completion prefix list)))
68	(cond ((eq completion t)
69	(message "Exact match."))
70	((null completion)
71	(error "Can't find completion for \"%s\"" prefix))
72	((not (string-equal prefix completion))
73	(insert-and-inherit (substring completion (length prefix))))
74	(t
75	(message "Making completion list...")
76	(with-output-to-temp-buffer "Completions"
77	(display-completion-list (all-completions prefix list nil)))
78	(message "Making completion list...done")))))
79
80	(defun jabber-init-widget-buffer (submit-to)
81	"Setup buffer-local variables for widgets."
82	(make-local-variable 'jabber-widget-alist)
83	(make-local-variable 'jabber-submit-to)
84	(setq jabber-widget-alist nil)
85	(setq jabber-submit-to submit-to)
86	(setq buffer-read-only nil)
87	;; XXX: This is because data from other queries would otherwise be
88	;; appended to this buffer, which would fail since widget buffers
89	;; are read-only... or something like that. Maybe there's a
90	;; better way.
91	(rename-uniquely))
92
93	(defun jabber-render-register-form (query &optional default-username)
94	"Display widgets from <query/> element in IQ register or search namespace.
95	Display widgets from <query/> element in jabber:iq:{register,search} namespace.
96	DEFAULT-USERNAME is the default value for the username field."
97	(make-local-variable 'jabber-widget-alist)
98	(setq jabber-widget-alist nil)
99	(make-local-variable 'jabber-form-type)
100	(setq jabber-form-type 'register)
101
102	(if (jabber-xml-get-children query 'instructions)
103	(widget-insert "Instructions: " (car (jabber-xml-node-children (car (jabber-xml-get-children query 'instructions)))) "\n"))
104	(if (jabber-xml-get-children query 'registered)
105	(widget-insert "You are already registered. You can change your details here.\n"))
106	(widget-insert "\n")
107
108	(let ((possible-fields
109	;; taken from XEP-0077
110	'((username . "Username")
111	(nick . "Nickname")
112	(password . "Password")
113	(name . "Full name")
114	(first . "First name")
115	(last . "Last name")
116	(email . "E-mail")
117	(address . "Address")
118	(city . "City")
119	(state . "State")
120	(zip . "Zip")
121	(phone . "Telephone")
122	(url . "Web page")
123	(date . "Birth date"))))
124	(dolist (field (jabber-xml-node-children query))
125	(let ((entry (assq (jabber-xml-node-name field) possible-fields)))
126	(when entry
127	(widget-insert (cdr entry) "\t")
128	;; Special case: when registering a new account, the default
129	;; username is the one specified in jabber-username. Things
130	;; will break if the user changes that name, though...
131	(let ((default-value (or (when (eq (jabber-xml-node-name field) 'username)
132	default-username)
133	"")))
134	(setq jabber-widget-alist
135	(cons
136	(cons (car entry)
137	(widget-create 'editable-field
138	:secret (if (eq (car entry) 'password)
139	?* nil)
140	(or (car (jabber-xml-node-children
141	field)) default-value)))
142	jabber-widget-alist)))
143	(widget-insert "\n"))))))
144
145	(defun jabber-parse-register-form ()
146	"Return children of a <query/> tag containing information entered.
147	Return children of a <query/> tag containing information entered in the
148	widgets of the current buffer."
149	(mapcar
150	(lambda (widget-cons)
151	(list (car widget-cons)
152	nil
153	(widget-value (cdr widget-cons))))
154	jabber-widget-alist))
155
156	(defun jabber-render-xdata-form (x &optional defaults)
157	"Display widgets from <x/> element in jabber:x:data namespace.
158	DEFAULTS is an alist associating variable names with default values.
159	DEFAULTS takes precedence over values specified in the form."
160	(make-local-variable 'jabber-widget-alist)
161	(setq jabber-widget-alist nil)
162	(make-local-variable 'jabber-form-type)
163	(setq jabber-form-type 'xdata)
164
165	(let ((title (car (jabber-xml-node-children (car (jabber-xml-get-children x 'title))))))
166	(if (stringp title)
167	(widget-insert (jabber-propertize title 'face 'jabber-title-medium) "\n\n")))
168	(let ((instructions (car (jabber-xml-node-children (car (jabber-xml-get-children x 'instructions))))))
169	(if (stringp instructions)
170	(widget-insert "Instructions: " instructions "\n\n")))
171
172	(dolist (field (jabber-xml-get-children x 'field))
173	(let* ((var (jabber-xml-get-attribute field 'var))
174	(label (jabber-xml-get-attribute field 'label))
175	(type (jabber-xml-get-attribute field 'type))
176	(required (jabber-xml-get-children field 'required))
177	(values (jabber-xml-get-children field 'value))
178	(options (jabber-xml-get-children field 'option))
179	(desc (car (jabber-xml-get-children field 'desc)))
180	(default-value (assoc var defaults)))
181	;; "required" not implemented yet
182
183	(cond
184	((string= type "fixed")
185	(widget-insert (car (jabber-xml-node-children (car values)))))
186
187	((string= type "text-multi")
188	(if (or label var)
189	(widget-insert (or label var) ":\n"))
190	(push (cons (cons var type)
191	(widget-create 'text (or (cdr default-value)
192	(mapconcat #'(lambda (val)
193	(car (jabber-xml-node-children val)))
194	values "\n")
195	"")))
196	jabber-widget-alist))
197
198	((string= type "list-single")
199	(if (or label var)
200	(widget-insert (or label var) ":\n"))
201	(push (cons (cons var type)
202	(apply 'widget-create
203	'radio-button-choice
204	:value (or (cdr default-value)
205	(car (xml-node-children (car values))))
206	(mapcar (lambda (option)
207	`(item :tag ,(jabber-xml-get-attribute option 'label)
208	:value ,(car (jabber-xml-node-children (car (jabber-xml-get-children option 'value))))))
209	options)))
210	jabber-widget-alist))
211
212	((string= type "boolean")
213	(push (cons (cons var type)
214	(widget-create 'checkbox
215	:tag (or label var)
216	:value (if default-value
217	(cdr default-value)
218	(not (null
219	(member (car (xml-node-children (car values))) '("1" "true")))))))
220	jabber-widget-alist)
221	(if (or label var)
222	(widget-insert " " (or label var) "\n")))
223
224	(t ; in particular including text-single and text-private
225	(if (or label var)
226	(widget-insert (or label var) ": "))
227	(setq jabber-widget-alist
228	(cons
229	(cons (cons var type)
230	(widget-create 'editable-field
231	:secret (if (string= type "text-private") ?* nil)
232	(or (cdr default-value)
233	(car (jabber-xml-node-children (car values)))
234	"")))
235	jabber-widget-alist))))
236	(when (and desc (car (jabber-xml-node-children desc)))
237	(widget-insert "\n" (car (jabber-xml-node-children desc))))
238	(widget-insert "\n"))))
239
240	(defun jabber-parse-xdata-form ()
241	"Return an <x/> tag containing information entered in the widgets.
242	Return an <x/> tag containing information entered in the widgets of the current
243	buffer."
244	`(x ((xmlns . "jabber:x:data")
245	(type . "submit"))
246	,@(mapcar
247	(lambda (widget-cons)
248	(let ((values (jabber-xdata-value-convert (widget-value (cdr widget-cons)) (cdar widget-cons))))
249	;; empty fields are not included
250	(when values
251	`(field ((var . ,(caar widget-cons)))
252	,@(mapcar
253	(lambda (value)
254	(list 'value nil value))
255	values)))))
256	jabber-widget-alist)))
257
258	(defun jabber-xdata-value-convert (value type)
259	"Convert VALUE from form used by widget library to form required by XEP-0004.
260	Return a list of strings, each of which to be included as cdata in a
261	<value/> tag."
262	(cond
263	((string= type "boolean")
264	(if value (list "1") (list "0")))
265	((string= type "text-multi")
266	(split-string value "[\n\r]"))
267	(t ; in particular including text-single, text-private and list-single
268	(if (zerop (length value))
269	nil
270	(list value)))))
271
272	(defun jabber-render-xdata-search-results (xdata)
273	"Render search results in x:data form."
274	(let ((title (car (jabber-xml-get-children xdata 'title))))
275	(when title
276	(insert (jabber-propertize (car (jabber-xml-node-children title)) 'face 'jabber-title-medium) "\n")))
277	(if (jabber-xml-get-children xdata 'reported)
278	(jabber-render-xdata-search-results-multi xdata)
279	(jabber-render-xdata-search-results-single xdata)))
280
281	(defun jabber-render-xdata-search-results-multi (xdata)
282	"Render multi-record search results."
283	(let (fields
284	(jid-fields 0))
285	(let ((reported (car (jabber-xml-get-children xdata 'reported)))
286	(column 0))
287	(dolist (field (jabber-xml-get-children reported 'field))
288	(let (width)
289	;; Clever algorithm for estimating width based on field type goes here.
290	(setq width 20)
291
292	(setq fields
293	(append
294	fields
295	(list (cons (jabber-xml-get-attribute field 'var)
296	(list 'label (jabber-xml-get-attribute field 'label)
297	'type (jabber-xml-get-attribute field 'type)
298	'column column)))))
299	(setq column (+ column width))
300	(if (string= (jabber-xml-get-attribute field 'type) "jid-single")
301	(setq jid-fields (1+ jid-fields))))))
302
303	(dolist (field-cons fields)
304	(indent-to (plist-get (cdr field-cons) 'column) 1)
305	(insert (jabber-propertize (plist-get (cdr field-cons) 'label) 'face 'bold)))
306	(insert "\n\n")
307
308	;; Now, the items
309	(dolist (item (jabber-xml-get-children xdata 'item))
310
311	(let ((start-of-line (point))
312	jid)
313
314	;; The following code assumes that the order of the <field/>s in each
315	;; <item/> is the same as in the <reported/> tag.
316	(dolist (field (jabber-xml-get-children item 'field))
317	(let ((field-plist (cdr (assoc (jabber-xml-get-attribute field 'var) fields)))
318	(value (car (jabber-xml-node-children (car (jabber-xml-get-children field 'value))))))
319
320	(indent-to (plist-get field-plist 'column) 1)
321
322	;; Absent values are sometimes "", sometimes nil. insert
323	;; doesn't like nil.
324	(when value
325	;; If there is only one JID field, let the whole row
326	;; have the jabber-jid property. If there are many JID
327	;; fields, the string belonging to each field has that
328	;; property.
329	(if (string= (plist-get field-plist 'type) "jid-single")
330	(if (not (eq jid-fields 1))
331	(insert (jabber-propertize value 'jabber-jid value))
332	(setq jid value)
333	(insert value))
334	(insert value)))))
335
336	(if jid
337	(put-text-property start-of-line (point)
338	'jabber-jid jid))
339	(insert "\n")))))
340
341	(defun jabber-render-xdata-search-results-single (xdata)
342	"Render single-record search results."
343	(dolist (field (jabber-xml-get-children xdata 'field))
344	(let ((label (jabber-xml-get-attribute field 'label))
345	(type (jabber-xml-get-attribute field 'type))
346	(values (mapcar #'(lambda (val)
347	(car (jabber-xml-node-children val)))
348	(jabber-xml-get-children field 'value))))
349	;; XXX: consider type
350	(insert (jabber-propertize (concat label ": ") 'face 'bold))
351	(indent-to 30)
352	(insert (apply #'concat values) "\n"))))
353
354	(defun jabber-xdata-formtype (x)
355	"Return the form type of the xdata form in X, by XEP-0068.
356	Return nil if no form type is specified."
357	(catch 'found-formtype
358	(dolist (field (jabber-xml-get-children x 'field))
359	(when (and (string= (jabber-xml-get-attribute field 'var) "FORM_TYPE")
360	(string= (jabber-xml-get-attribute field 'type) "hidden"))
361	(throw 'found-formtype (car (jabber-xml-node-children
362	(car (jabber-xml-get-children field 'value)))))))))
363
364	(provide 'jabber-widget)
365
366	;;; arch-tag: da3312f3-1970-41d5-a974-14b8d76156b8