projects / config.git / blame
| Commit | Line | Data |
|---|---|---|
| 53e6db90 DC |
1 | ;; jabber-search.el - searching by JEP-0055, with x:data support -*- lexical-binding: t; -*- |
| 2 | ||
| 3 | ;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net | |
| 4 | ;; Copyright (C) 2003, 2004 - Magnus Henoch - mange@freemail.hu | |
| 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 'jabber-register) | |
| 23 | ||
| 24 | (add-to-list 'jabber-jid-service-menu | |
| 25 | (cons "Search directory" 'jabber-get-search)) | |
| 26 | (defun jabber-get-search (jc to) | |
| 27 | "Send IQ get request in namespace \"jabber:iq:search\". | |
| 28 | ||
| 29 | JC is the Jabber connection." | |
| 30 | (interactive (list (jabber-read-account) | |
| 31 | (jabber-read-jid-completing "Search what database: "))) | |
| 32 | (jabber-send-iq jc to | |
| 33 | "get" | |
| 34 | '(query ((xmlns . "jabber:iq:search"))) | |
| 35 | #'jabber-process-data #'jabber-process-register-or-search | |
| 36 | #'jabber-report-success "Search field retrieval")) | |
| 37 | ||
| 38 | ;; `jabber-process-register-or-search' logically comes here, rendering the | |
| 39 | ;; search form, but since register and search are so similar, having | |
| 40 | ;; two functions would be serious code duplication. See | |
| 41 | ;; `jabber-register.el'. | |
| 42 | ||
| 43 | ;; `jabber-submit-search' is called when the "submit" button of the search | |
| 44 | ;; form is activated. | |
| 45 | (defun jabber-submit-search (&rest ignore) | |
| 46 | "Submit search. See `jabber-process-register-or-search'." | |
| 47 | ||
| 48 | (let ((text (concat "Search at " jabber-submit-to))) | |
| 49 | (jabber-send-iq jabber-buffer-connection jabber-submit-to | |
| 50 | "set" | |
| 51 | ||
| 52 | (cond | |
| 53 | ((eq jabber-form-type 'register) | |
| 54 | `(query ((xmlns . "jabber:iq:search")) | |
| 55 | ,@(jabber-parse-register-form))) | |
| 56 | ((eq jabber-form-type 'xdata) | |
| 57 | `(query ((xmlns . "jabber:iq:search")) | |
| 58 | ,(jabber-parse-xdata-form))) | |
| 59 | (t | |
| 60 | (error "Unknown form type: %s" jabber-form-type))) | |
| 61 | #'jabber-process-data #'jabber-process-search-result | |
| 62 | #'jabber-report-success text)) | |
| 63 | ||
| 64 | (message "Search sent")) | |
| 65 | ||
| 66 | (defun jabber-process-search-result (jc xml-data) | |
| 67 | "Receive and display search results. | |
| 68 | ||
| 69 | JC is the Jabber connection. | |
| 70 | XML-DATA is the parsed tree data from the stream (stanzas) | |
| 71 | obtained from `xml-parse-region'." | |
| 72 | ||
| 73 | ;; This function assumes that all search results come in one packet, | |
| 74 | ;; which is not necessarily the case. | |
| 75 | (let ((query (jabber-iq-query xml-data)) | |
| 76 | (have-xdata nil) | |
| 77 | xdata fields (jid-fields 0)) | |
| 78 | ||
| 79 | ;; First, check for results in jabber:x:data form. | |
| 80 | (dolist (x (jabber-xml-get-children query 'x)) | |
| 81 | (when (string= (jabber-xml-get-attribute x 'xmlns) "jabber:x:data") | |
| 82 | (setq have-xdata t) | |
| 83 | (setq xdata x))) | |
| 84 | ||
| 85 | (if have-xdata | |
| 86 | (jabber-render-xdata-search-results xdata) | |
| 87 | ||
| 88 | (insert (jabber-propertize "Search results" 'face 'jabber-title-medium) "\n") | |
| 89 | ||
| 90 | (setq fields '((first . (label "First name" column 0)) | |
| 91 | (last . (label "Last name" column 15)) | |
| 92 | (nick . (label "Nickname" column 30)) | |
| 93 | (jid . (label "JID" column 45)) | |
| 94 | (email . (label "E-mail" column 65)))) | |
| 95 | (setq jid-fields 1) | |
| 96 | ||
| 97 | (dolist (field-cons fields) | |
| 98 | (indent-to (plist-get (cdr field-cons) 'column) 1) | |
| 99 | (insert (jabber-propertize (plist-get (cdr field-cons) 'label) 'face 'bold))) | |
| 100 | (insert "\n\n") | |
| 101 | ||
| 102 | ;; Now, the items | |
| 103 | (dolist (item (jabber-xml-get-children query 'item)) | |
| 104 | (let ((start-of-line (point)) | |
| 105 | jid) | |
| 106 | ||
| 107 | (dolist (field-cons fields) | |
| 108 | (let ((field-plist (cdr field-cons)) | |
| 109 | (value (if (eq (car field-cons) 'jid) | |
| 110 | (setq jid (jabber-xml-get-attribute item 'jid)) | |
| 111 | (car (jabber-xml-node-children (car (jabber-xml-get-children item (car field-cons)))))))) | |
| 112 | (indent-to (plist-get field-plist 'column) 1) | |
| 113 | (if value (insert value)))) | |
| 114 | ||
| 115 | (if jid | |
| 116 | (put-text-property start-of-line (point) | |
| 117 | 'jabber-jid jid)) | |
| 118 | (insert "\n")))))) | |
| 119 | ||
| 120 | (provide 'jabber-search) | |
| 121 | ||
| 122 | ;;; arch-tag: c39e9241-ab6f-4ac5-b1ba-7908bbae009c |