Mercurial > emacs

annotate lisp/ph.el @ 25209:eea9647c8246

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(Fframe_parameters): Swap foreground and background colors returned in frame parameters if the frame has reverse in its parameter alist. (Fmake_terminal_frame): Make a unique copy of face_alist for each frame.
author Eli Zaretskii <eliz@gnu.org>
date Tue, 10 Aug 1999 10:13:05 +0000 (1999-08-10)
parents d2b8e50dd2e0
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1 ;;; ph.el --- Client for the CCSO directory system (aka PH/QI)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; Created: May 1997
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
8 ;; Version: 2.8
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; Keywords: help
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; This file is part of GNU Emacs
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 ;; GNU Emacs is free software; you can redistribute it and/or modify it
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; under the terms of the GNU General Public License as published by
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15 ;; the Free Software Foundation; either version 2, or (at your option)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; any later version.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; GNU Emacs is distributed in the hope that it will be useful, but
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;; General Public License for more details.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23 ;; You should have received a copy of the GNU General Public License
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24 ;; along with GNU Emacs; see the file COPYING. If not, write to
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26 ;; Boston, MA 02111-1307, USA.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;;; Commentary:
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29 ;; This package provides functions to query CCSO PH/QI nameservers
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 ;; through an interactive form or replace inline query strings in
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 ;; buffers with appropriately formatted query results (especially
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
32 ;; used to expand email addresses in message buffers). It also
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 ;; interfaces with the BBDB package to let you register entries of
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34 ;; the CCSO PH/QI directory into your own database. The CCSO PH/QI
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 ;; white pages system was developped at UIUC and is in use in more
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
36 ;; than 300 sites in the world. The distribution can be found at
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 ;; ftp://uiarchive.cso.uiuc.edu/pub/packages/ph Traditionally the
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38 ;; server is called QI while the client is called PH.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 ;;; Installation:
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
41 ;; This package uses the custom and widget libraries. If they are not already
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 ;; installed on your system get them from http://www.dina.kvl.dk/~abraham/custom/
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 ;; Then uncomment and add the following to your .emacs file:
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 ;; (require 'ph)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 ;; (eval-after-load "message"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 ;; '(define-key message-mode-map [(control ?c) (tab)] 'ph-expand-inline))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 ;; (eval-after-load "mail"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 ;; '(define-key mail-mode-map [(control ?c) (tab)] 'ph-expand-inline))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49 ;; See the info file for details
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 ;; This package runs under XEmacs 19.15 or 20 and under Emacs 19.34 and above
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 ;;; Usage:
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 ;; - Provided you did the installation as proposed in the above section,
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 ;; inline expansion will be available when you compose an email
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
56 ;; message. Type the name of somebody recorded in your PH/QI server and hit
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 ;; C-c TAB, this will overwrite the name with the corresponding email
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 ;; address
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 ;; - M-x ph-customize to customize inline expansion and other features to
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 ;; your needs.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 ;; - Look for the Ph submenu in the Tools menu for more.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 ;; See the info file for details.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 ;;; Code:
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65
19918
7b1e019be521 Require cl at compile-time.
Richard M. Stallman <rms@gnu.org>
parents: 19913
diff changeset
66 (eval-when-compile (require 'cl))
7b1e019be521 Require cl at compile-time.
Richard M. Stallman <rms@gnu.org>
parents: 19913
diff changeset
67
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 (require 'wid-edit)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 (if (not (fboundp 'make-overlay))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 (require 'overlay))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 (autoload 'custom-menu-create "cus-edit")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 ;;{{{ Package customization variables
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 (defgroup ph nil
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 "CCSO (PH/QI) directory system client"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 :group 'mail
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 :group 'comm)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 (defcustom ph-server nil
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 "*The name or IP address of the CCSO (PH/QI) server.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 A port number may be specified by appending a colon and a
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 number to the name of the server."
19913
4c82de07281c (ph-server): Fix customize type.
Richard M. Stallman <rms@gnu.org>
parents: 19064
diff changeset
86 :type '(choice (string :tag "Server")
4c82de07281c (ph-server): Fix customize type.
Richard M. Stallman <rms@gnu.org>
parents: 19064
diff changeset
87 (const nil))
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 :group 'ph)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 (defcustom ph-strict-return-matches t
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
91 "*If non-nil, entries not containing all requested return fields are ignored."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92 :type 'boolean
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 :group 'ph)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 (defcustom ph-default-return-fields nil
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 "*A list of the default fields to extract from CCSO entries.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 If it contains `all' then all available fields are returned.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 nil means return the default fields as configured in the server."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 :type '(repeat (symbol :tag "Field name"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 :group 'ph)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 (defcustom ph-multiple-match-handling-method 'select
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
103 "*What to do when multiple entries match an inline expansion query.
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 Possible values are:
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
105 `first' (equivalent to nil) which means consider the first match,
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
106 `select' pop-up a selection buffer,
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
107 `all' use all matches,
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
108 `abort' the operation is aborted, an error is signaled."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 :type '(choice :menu-tag "Method"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110 (const :menu-tag "First" first)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 (const :menu-tag "Select" select)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112 (const :menu-tag "All" all)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113 (const :menu-tag "Abort" abort)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 (const :menu-tag "None" nil))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115 :group 'ph)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
117 (defcustom ph-duplicate-fields-handling-method '((email . duplicate))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 "*A method to handle entries containing duplicate fields.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 This is either an alist (FIELD . METHOD) or a symbol METHOD.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 The alist form of the variable associates a method to an individual field,
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121 the second form specifies a method applicable to all fields.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122 Available methods are:
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
123 `list' or nil lets the value of the field be a list of values,
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124 `first' keeps the first value and discards the others,
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 `concat' concatenates the values into a single multiline string,
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126 `duplicate' duplicates the entire entry into as many instances as
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127 different values."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128 :type '(choice (const :menu-tag "List" list)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129 (const :menu-tag "First" first)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 (const :menu-tag "Concat" concat)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 (const :menu-tag "Duplicate" duplicate)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
132 (repeat :menu-tag "Per Field Specification"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 :tag "Per Field Specification"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134 (cons :tag "Field/Method"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135 :value (nil . list)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136 (symbol :tag "Field name")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137 (choice :tag "Method"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138 :menu-tag "Method"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139 (const :menu-tag "List" list)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140 (const :menu-tag "First" first)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 (const :menu-tag "Concat" concat)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142 (const :menu-tag "Duplicate" duplicate)))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143 :group 'ph
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146 (defcustom ph-inline-query-format-list nil
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 "*Format of an inline expansion query.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 If the inline query string consists of several words, this list specifies
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
149 how these individual words are associated to CCSO database field names.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 If nil all the words will be mapped onto the default CCSO database key."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 :type '(repeat (symbol :tag "Field name"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152 :group 'ph)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
153
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
154 (defcustom ph-expanding-overwrites-query t
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
155 "*If non nil, expanding a query overwrites the query string."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 :type 'boolean
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157 :group 'ph)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
159 (defcustom ph-inline-expansion-format '("%s" email)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160 "*A list specifying the format of the expansion of inline queries.
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
161 This variable controls what `ph-expand-inline' actually inserts in the buffer.
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
162 First element is a string passed to `format'. Remaining elements are symbols
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
163 indicating CCSO database field names, corresponding field values are passed
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
164 as additional arguments to `format'."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 :type '(list (string :tag "Format String")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166 (repeat :inline t
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
167 :tag "Field names"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168 (symbol :tag "")))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
169 :group 'ph)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
170
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171 (defcustom ph-form-fields '(name email phone)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172 "*A list of fields presented in the query form."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 :tag "Default Fields in Query Forms"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174 :type '(repeat (symbol :tag "Field name"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175 :group 'ph)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177 (defcustom ph-fieldname-formstring-alist '((url . "URL")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178 (callsign . "HAM Call Sign")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
179 (id . "ID")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180 (email . "E-Mail")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 (firstname . "First Name"))
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
182 "*Map CCSO database field names into prompt strings for query/response.
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
183 Prompt strings for fields that are not listed here
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
184 are derived by splitting the field name
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 at `_' signs and capitalizing the individual words."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186 :tag "Mapping of Field Names onto Prompt Strings"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187 :type '(repeat (cons :tag "Field"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188 (symbol :tag "Name")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189 (string :tag "Prompt string")))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 :group 'ph)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192 (defcustom ph-bbdb-conversion-alist
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193 '((name . name)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194 (net . email)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195 (address . (ph-bbdbify-address address "Address"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196 (phone . ((ph-bbdbify-phone phone "Phone")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197 (ph-bbdbify-phone office_phone "Office Phone"))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 "*A mapping from BBDB to PH/QI fields.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
199 This is a list of cons cells (BBDB-FIELD . SPEC-OR-LIST) where
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200 BBDB-FIELD is the name of a field that must be defined in your BBDB
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201 environment (standard field names are `name', `company', `net', `phone',
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202 `address' and `notes'). SPEC-OR-LIST is either a single SPEC or a list
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
203 of SPECs. Lists of specs are valid only for the `phone' and `address'
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204 BBDB fields. SPECs are sexps which are evaluated:
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
205 a string evaluates to itself,
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
206 a symbol evaluates to the symbol value. Symbols naming PH/QI fields
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
207 present in the record evaluate to the value of the field in the record,
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
208 a form is evaluated as a function. The argument list may contain PH/QI
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 field names which eval to the corresponding values in the
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
210 record. The form evaluation should return something appropriate for
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
211 the particular BBDB-FIELD (see `bbdb-create-internal').
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
212 `ph-bbdbify-phone' and `ph-bbdbify-address' are provided as convenience
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
213 functions to parse phones and addresses."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
214 :tag "BBDB to CCSO Field Name Mapping"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
215 :type '(repeat (cons :tag "Field Name"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
216 (symbol :tag "BBDB Field")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
217 (sexp :tag "Conversion Spec")))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
218 :group 'ph)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
219
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
220 (defcustom ph-options-file "~/.ph-options"
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
221 "*A file where the PH `servers' hotlist is stored."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
222 :type '(file :Tag "File Name:"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
223
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
224 (defcustom ph-mode-hook nil
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
225 "*Normal hook run on entry to PH mode."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 :type '(repeat (sexp :tag "Hook")))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
228 ;;}}}
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231 ;;{{{ Internal cooking
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
233
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234 (defconst ph-xemacs-p (string-match "XEmacs" emacs-version))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235 (defconst ph-emacs-p (not ph-xemacs-p))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 (defconst ph-xemacs-mule-p (and ph-xemacs-p
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 (featurep 'mule)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238 (defconst ph-emacs-mule-p (and ph-emacs-p
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
239 (featurep 'mule)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241 (defvar ph-server-hotlist nil)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
243 (defconst ph-default-server-port 105
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
244 "Default TCP port for CCSO directory services.")
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
245
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246 (defvar ph-form-widget-list nil)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247 (defvar ph-process-buffer nil)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
248 (defvar ph-read-point)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250 ;;; Load the options file
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
251 (if (and (and (locate-library ph-options-file)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
252 (message "")) ; Remove modeline message
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 (not (featurep 'ph-options-file)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
254 (load ph-options-file))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255
18915
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
256 (defun ph-cadr (obj)
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
257 (car (cadr obj)))
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
258
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
259 (defun ph-cdar (obj)
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
260 (cdr (car obj)))
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
261
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
262 (defun ph-mode ()
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
263 "Major mode used in buffers displaying the results of PH queries.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
264 There is no sense in calling this command from a buffer other than
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
265 one containing the results of a PH query.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
266
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
267 These are the special commands of PH mode:
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
268 q -- kill this buffer.
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
269 f -- Display a form to query the CCSO PH/QI nameserver.
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
270 n -- Move to next record.
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
271 p -- Move to previous record."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
272 (interactive)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
273 (kill-all-local-variables)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
274 (setq major-mode 'ph-mode)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
275 (setq mode-name "PH")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
276 (use-local-map ph-mode-map)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
277 (setq mode-popup-menu (ph-menu))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
278 (run-hooks 'ph-mode-hook)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
279 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
280
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
281 (defun ph-display-records (records &optional raw-field-names)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
282 "Display the record list RECORDS in a formatted buffer.
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
283 If RAW-FIELD-NAMES is non-nil, the raw field names are displayed
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
284 otherwise they are formatted according to `ph-fieldname-formstring-alist'."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
285 (let ((buffer (get-buffer-create "*PH Query Results*"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
286 inhibit-read-only
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
287 precords
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
288 (width 0)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
289 beg field-beg
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
290 field-name)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
291 (switch-to-buffer buffer)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
292 (setq buffer-read-only t)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
293 (setq inhibit-read-only t)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
294 (erase-buffer)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
295 (insert "PH Query Result\n")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
296 (insert "===============\n\n\n")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
297 (if (null records)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
298 (insert "No match found.\n"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
299 (if ph-strict-return-matches
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
300 "Try setting ph-strict-return-matches to nil or change ph-default-return-fields."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
301 ""))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
302 ;; Replace field names with prompt strings, compute prompt max width
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
303 (setq precords
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
304 (mapcar
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
305 (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
306 (lambda (record)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
307 (mapcar
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308 (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309 (lambda (field)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
310 (setq field-name (if raw-field-names
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
311 (symbol-name (car field))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
312 (or (and (assq (car field) ph-fieldname-formstring-alist)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
313 (cdr (assq (car field) ph-fieldname-formstring-alist)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
314 (capitalize (mapconcat '(lambda (char)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
315 (if (eq char ?_)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
316 " "
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
317 (char-to-string char)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
318 (symbol-name (car field))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
319 "")))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
320 (if (> (length field-name) width)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
321 (setq width (length field-name)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
322 (cons field-name (cdr field))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
323 record)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
324 records))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
325 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
326 (lambda (record)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
327 (setq beg (point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
328 ;; Actually insert the field/value pairs
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
329 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
330 (lambda (field)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
331 (setq field-beg (point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
332 (insert (format (concat "%" width "s: ") (car field)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
333 (put-text-property field-beg (point) 'face 'bold)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
334 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
335 (lambda (val)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
336 (indent-to (+ 2 width))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
337 (insert val "\n")))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
338 (if (stringp (cdr field))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
339 (split-string (cdr field) "\n")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
340 (cdr field)))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
341 record)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
342 ;; Store the record internal format in some convenient place
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
343 (overlay-put (make-overlay beg (point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
344 'ph-record
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
345 (car records))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
346 (setq records (cdr records))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
347 (insert "\n")))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
348 precords))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
349 (insert "\n")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
350 (widget-create 'push-button
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
351 :notify (lambda (&rest ignore)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
352 (ph-query-form))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
353 "New query")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
354 (widget-insert " ")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
355 (widget-create 'push-button
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
356 :notify (lambda (&rest ignore)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
357 (kill-this-buffer))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
358 "Quit")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
359 (ph-mode)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
360 (widget-setup)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
361 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
362 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
363
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
364 (defun ph-process-form ()
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
365 "Process the form in current buffer and display the results."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
366 (let (query-alist
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
367 value)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
368 (if (not (and (boundp 'ph-form-widget-list)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
369 ph-form-widget-list))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
370 (error "Not in a PH query form buffer")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
371 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
372 (lambda (wid-field)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
373 (setq value (widget-value (cdr wid-field)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
374 (if (not (string= value ""))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
375 (setq query-alist (cons (cons (car wid-field) value)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
376 query-alist)))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
377 ph-form-widget-list)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
378 (kill-buffer (current-buffer))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
379 (ph-display-records (ph-query-internal query-alist))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
380 )))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
381
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
382
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
383 (defun ph-query-internal (query &optional return-fields)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
384 "Query the PH/QI server with QUERY.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
385 QUERY can be a string NAME or a list made of strings NAME
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
386 and/or cons cells (KEY . VALUE) where KEYs should be valid
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
387 CCSO database keys. NAME is equivalent to (DEFAULT . NAME),
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
388 where DEFAULT is the default key of the database.
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
389 RETURN-FIELDS is a list of database fields to return,
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
390 defaulting to `ph-default-return-fields'."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
391 (let (request)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
392 (if (null return-fields)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
393 (setq return-fields ph-default-return-fields))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
394 (setq request
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
395 (concat "query "
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
396 (if (stringp query)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
397 query
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
398 (mapconcat (function (lambda (elt)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
399 (if (stringp elt) elt)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
400 (format "%s=%s" (car elt) (cdr elt))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
401 query
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
402 " "))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
403 (if return-fields
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
404 (concat " return " (mapconcat 'symbol-name return-fields " ")))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
405 (and (> (length request) 6)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
406 (ph-do-request request)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
407 (ph-parse-query-result return-fields))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
408
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
409 (defun ph-parse-query-result (&optional fields)
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
410 "Return a list of alists of key/values from in `ph-process-buffer'.
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
411 Fields not in FIELDS are discarded."
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
412 (let (record
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
413 records
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
414 line-regexp
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
415 current-key
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
416 key
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
417 value
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
418 ignore)
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
419 (save-excursion
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
420 (message "Parsing results...")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
421 (set-buffer ph-process-buffer)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
422 (goto-char (point-min))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
423 (while (re-search-forward "^\\(-[0-9]+\\):\\([0-9]+\\):" nil t)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
424 (catch 'ignore
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
425 (setq line-regexp (concat "^\\(-[0-9]+\\):" (match-string 2) ":[ \t]*\\([-a-zA-Z_]*\\)?:[ \t]*\\(.*\\)$"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
426 (beginning-of-line)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
427 (setq record nil
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
428 ignore nil
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
429 current-key nil)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
430 (while (re-search-forward line-regexp nil t)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
431 (catch 'skip-line
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
432 (if (string= "-508" (match-string 1))
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
433 ;; A field is missing in this entry. Skip it or skip the
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
434 ;; whole record (see ph-strict-return-matches)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
435 (if (not ph-strict-return-matches)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
436 (throw 'skip-line t)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
437 (while (re-search-forward line-regexp nil t))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
438 (setq ignore t)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
439 (throw 'ignore t)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
440 (setq key (and (not (string= (match-string 2) ""))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
441 (intern (match-string 2)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
442 value (match-string 3))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
443 (if (and current-key
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
444 (eq key current-key))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
445 (setq key nil)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
446 (setq current-key key))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
447 (if (or (null fields)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
448 (memq 'all fields)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
449 (memq current-key fields))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
450 (if key
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
451 (setq record (cons (cons key value) record)) ; New key
18915
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
452 (setcdr (car record) (if (listp (ph-cdar record))
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
453 (append (ph-cdar record) (list value))
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
454 (list (ph-cdar record) value))))))))
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
455 (and (not ignore)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
456 (or (null fields)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
457 (memq 'all fields)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
458 (setq record (nreverse record)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
459 (setq record (if (not (eq 'list ph-duplicate-fields-handling-method))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
460 (ph-filter-duplicate-fields record)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
461 (list record)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
462 (setq records (append record records))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
463 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
464 (message "Done")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
465 records)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
466 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
467
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
468 (defun ph-filter-duplicate-fields (record)
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
469 "Filter RECORD according to `ph-duplicate-fields-handling-method'."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
470 (let ((rec record)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
471 unique
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
472 duplicates
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
473 result)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
474
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
475 ;; Search for multiple records
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
476 (while (and rec
18915
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
477 (not (listp (ph-cdar rec))))
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
478 (setq rec (cdr rec)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
479
18915
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
480 (if (null (ph-cdar rec))
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
481 (list record) ; No duplicate fields in this record
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
482 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
483 (lambda (field)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
484 (if (listp (cdr field))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
485 (setq duplicates (cons field duplicates))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
486 (setq unique (cons field unique)))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
487 record)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
488 (setq result (list unique))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
489 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
490 (lambda (field)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
491 (let ((method (if (consp ph-duplicate-fields-handling-method)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
492 (cdr (assq (car field) ph-duplicate-fields-handling-method))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
493 ph-duplicate-fields-handling-method)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
494 (cond
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
495 ((or (null method) (eq 'list method))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
496 (setq result
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
497 (ph-add-field-to-records field result)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
498 ((eq 'first method)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
499 (setq result
18915
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
500 (ph-add-field-to-records (cons (car field) (ph-cadr field)) result)))
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
501 ((eq 'concat method)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
502 (setq result
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
503 (ph-add-field-to-records (cons (car field)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
504 (mapconcat
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
505 'identity
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
506 (cdr field)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
507 "\n")) result)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
508 ((eq 'duplicate method)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
509 (setq result
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
510 (ph-distribute-field-on-records field result)))))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
511 duplicates)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
512 result)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
513
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
514 (defun ph-add-field-to-records (field records)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
515 "Add FIELD to each individual record in RECORDS and return the resulting list."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
516 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
517 (lambda (r)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
518 (cons field r)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
519 records))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
520
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
521 (defun ph-distribute-field-on-records (field records)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
522 "Duplicate each individual record in RECORDS according to value of FIELD.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
523 Each copy is added a new field containing one of the values of FIELD."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
524 (let (result
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
525 (values (cdr field)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
526 ;; Uniquify values first
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
527 (while values
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
528 (setcdr values (delete (car values) (cdr values)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
529 (setq values (cdr values)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
530 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
531 (lambda (value)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
532 (let ((result-list (copy-sequence records)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
533 (setq result-list (ph-add-field-to-records (cons (car field) value)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
534 result-list))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
535 (setq result (append result-list result))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
536 )))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
537 (cdr field))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
538 result)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
539 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
540
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
541 (defun ph-do-request (request)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
542 "Send REQUEST to the server.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
543 Wait for response and return the buffer containing it."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
544 (let (process
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
545 buffer)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
546 (unwind-protect
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
547 (progn
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
548 (message "Contacting server...")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
549 (setq process (ph-open-session))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
550 (if process
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
551 (save-excursion
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
552 (set-buffer (setq buffer (process-buffer process)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
553 (ph-send-command process request)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
554 (message "Request sent, waiting for reply...")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
555 (ph-read-response process))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
556 (if process
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
557 (ph-close-session process)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
558 buffer))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
559
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
560 (defun ph-open-session (&optional server)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
561 "Open a connection to the given CCSO SERVER.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
562 SERVER is either a string naming the server or a list (NAME PORT)."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
563 (let (process
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
564 host
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
565 port)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
566 (catch 'done
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
567 (if (null server)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
568 (setq server (or ph-server
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
569 (call-interactively 'ph-set-server))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
570 (string-match "\\(.*\\)\\(:\\(.*\\)\\)?" server)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
571 (setq host (match-string 1 server))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
572 (setq port (or (match-string 3 server)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
573 ph-default-server-port))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
574 (setq ph-process-buffer (get-buffer-create (format " *PH-%s*" host)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
575 (save-excursion
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
576 (set-buffer ph-process-buffer)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
577 (erase-buffer)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
578 (setq ph-read-point (point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
579 (and ph-xemacs-mule-p
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
580 (set-buffer-file-coding-system 'binary t)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
581 (setq process (open-network-stream "ph" ph-process-buffer host port))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
582 (if (null process)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
583 (throw 'done nil))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
584 (process-kill-without-query process)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
585 process)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
586
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
587
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
588 (defun ph-close-session (process)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
589 (save-excursion
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
590 (set-buffer (process-buffer process))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
591 (ph-send-command process "quit")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
592 (ph-read-response process)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
593 (if (fboundp 'add-async-timeout)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
594 (add-async-timeout 10 'delete-process process)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
595 (run-at-time 2 nil 'delete-process process))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
596
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
597 (defun ph-send-command (process command)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
598 (goto-char (point-max))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
599 (process-send-string process command)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
600 (process-send-string process "\r\n")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
601 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
602
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
603 (defun ph-read-response (process &optional return-response)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
604 "Read a response from the PH/QI query process PROCESS.
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
605 Returns nil if response starts with an error code. If the
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
606 response is successful the return code or the reponse itself is returned
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
607 depending on RETURN-RESPONSE."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
608 (let ((case-fold-search nil)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
609 return-code
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
610 match-end)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
611 (goto-char ph-read-point)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
612 ;; CCSO protocol : response complete if status >= 200
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
613 (while (not (re-search-forward "^\\(^[2-5].*\\):.*\n" nil t))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
614 (accept-process-output process)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
615 (goto-char ph-read-point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
616 (setq match-end (point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
617 (goto-char ph-read-point)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
618 (if (and (setq return-code (match-string 1))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
619 (setq return-code (string-to-number return-code))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
620 (>= (abs return-code) 300))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
621 (progn (setq ph-read-point match-end) nil)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
622 (setq ph-read-point match-end)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
623 (if return-response
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
624 (buffer-substring (point) match-end)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
625 return-code))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
626
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
627 (defun ph-create-bbdb-record (record)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
628 "Create a BBDB record using the RECORD alist.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
629 RECORD is an alist of (KEY . VALUE) where KEY is a symbol naming a field
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
630 of the PH/QI database and VALUE is the corresponding value for the record."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
631 ;; This function runs in a special context where lisp symbols corresponding
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
632 ;; to field names in record are bound to the corresponding values
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
633 (eval
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
634 `(let* (,@(mapcar '(lambda (c)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
635 (list (car c) (if (listp (cdr c))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
636 (list 'quote (cdr c))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
637 (cdr c))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
638 record)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
639 bbdb-name
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
640 bbdb-company
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
641 bbdb-net
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
642 bbdb-address
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
643 bbdb-phones
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
644 bbdb-notes
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
645 spec
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
646 bbdb-record
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
647 value)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
648
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
649 ;; BBDB standard fields
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
650 (setq bbdb-name (ph-parse-spec (cdr (assq 'name ph-bbdb-conversion-alist)) record nil)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
651 bbdb-company (ph-parse-spec (cdr (assq 'company ph-bbdb-conversion-alist)) record nil)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
652 bbdb-net (ph-parse-spec (cdr (assq 'net ph-bbdb-conversion-alist)) record nil)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
653 bbdb-notes (ph-parse-spec (cdr (assq 'notes ph-bbdb-conversion-alist)) record nil))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
654 (setq spec (cdr (assq 'address ph-bbdb-conversion-alist)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
655 (setq bbdb-address (delq nil (ph-parse-spec (if (listp (car spec))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
656 spec
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
657 (list spec))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
658 record t)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
659 (setq spec (cdr (assq 'phone ph-bbdb-conversion-alist)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
660 (setq bbdb-phones (delq nil (ph-parse-spec (if (listp (car spec))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
661 spec
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
662 (list spec))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
663 record t)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
664 ;; BBDB custom fields
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
665 (setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
666 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
667 (lambda (mapping)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
668 (if (and (not (memq (car mapping)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
669 '(name company net address phone notes)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
670 (setq value (ph-parse-spec (cdr mapping) record nil)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
671 (cons (car mapping) value))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
672 ph-bbdb-conversion-alist)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
673 (setq bbdb-notes (delq nil bbdb-notes))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
674 (setq bbdb-record (bbdb-create-internal bbdb-name
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
675 bbdb-company
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
676 bbdb-net
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
677 bbdb-address
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
678 bbdb-phones
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
679 bbdb-notes))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
680
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
681 (bbdb-display-records (list bbdb-record))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
682 )))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
683
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
684 (defun ph-parse-spec (spec record recurse)
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
685 "Parse the conversion SPEC using RECORD.
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
686 If RECURSE is non-nil then SPEC may be a list of atomic specs."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
687 (cond
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
688 ((or (stringp spec)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
689 (symbolp spec)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
690 (and (listp spec)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
691 (symbolp (car spec))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
692 (fboundp (car spec))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
693 (condition-case nil
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
694 (eval spec)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
695 (void-variable nil)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
696 ((and recurse
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
697 (listp spec))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
698 (mapcar '(lambda (spec-elem)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
699 (ph-parse-spec spec-elem record nil))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
700 spec))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
701 (t
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
702 (error "Invalid specification for `%s' in `ph-bbdb-conversion-alist'" spec))))
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
703
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
704 (defun ph-bbdbify-address (addr location)
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
705 "Parse ADDR into a vector compatible with BBDB.
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
706 ADDR should be an address string of no more than four lines or a
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
707 list of lines.
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
708 The last line is searched for the zip code, city and state name.
18915
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
709 LOCATION is used as the address location for bbdb."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
710 (let* ((addr-components (if (listp addr)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
711 (reverse addr)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
712 (reverse (split-string addr "\n"))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
713 (lastl (pop addr-components))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
714 zip city state)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
715 (setq addr-components (nreverse addr-components))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
716 (cond
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
717 ;; American style
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
718 ((string-match "\\(\\w+\\)\\W*\\([A-Z][A-Z]\\)\\W*\\([0-9]+\\)" lastl)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
719 (setq city (match-string 1 lastl)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
720 state (match-string 2 lastl)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
721 zip (string-to-number (match-string 3 lastl))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
722 ;; European style
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
723 ((string-match "\\([0-9]+\\)[ \t]+\\(.*\\)" lastl)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
724 (setq city (match-string 2 lastl)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
725 zip (string-to-number (match-string 1 lastl))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
726 (t
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
727 (error "Cannot parse the address; see `ph-bbdb-conversion-alist'")))
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
728 (vector location
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
729 (or (nth 0 addr-components) "")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
730 (or (nth 1 addr-components) "")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
731 (or (nth 2 addr-components) "")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
732 (or city "")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
733 (or state "")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
734 zip)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
735
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
736 (defun ph-bbdbify-phone (phone location)
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
737 "Parse PHONE into a vector compatible with BBDB.
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
738 PHONE is either a string supposedly containing a phone number or
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
739 a list of such strings which are concatenated.
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
740 LOCATION is used as the phone location for bbdb."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
741 (cond
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
742 ((stringp phone)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
743 (let (phone-list)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
744 (condition-case err
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
745 (setq phone-list (bbdb-parse-phone-number phone))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
746 (error
18915
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
747 (if (string= "phone number unparsable." (ph-cadr err))
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
748 (if (not (y-or-n-p (format "BBDB claims %S to be unparsable--insert anyway? " phone)))
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
749 (error "Phone number unparsable")
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
750 (setq phone-list (list (bbdb-string-trim phone))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
751 (signal (car err) (cdr err)))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
752 (if (= 3 (length phone-list))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
753 (setq phone-list (append phone-list '(nil))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
754 (apply 'vector location phone-list)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
755 ((listp phone)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
756 (vector location (mapconcat 'identity phone ", ")))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
757 (t
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
758 (error "Invalid phone specification"))))
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
759
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
760 ;;}}}
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
761
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
762 ;;{{{ High-level interfaces (interactive functions)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
763
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
764 (defun ph-customize ()
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
765 "Customize the PH package."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
766 (interactive)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
767 (customize-group 'ph))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
768
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
769 (defun ph-set-server (server)
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
770 "Set the PH server to SERVER."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
771 (interactive "sNew PH/QI Server: ")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
772 (message "Selected PH/QI server is now %s" server)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
773 (setq ph-server server))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
774
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
775 ;;;###autoload
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
776 (defun ph-get-email (name)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
777 "Get the email field of NAME from the PH/QI directory server."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
778 (interactive "sName: ")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
779 (let ((email (cdaar (ph-query-internal name '(email)))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
780 (if (interactive-p)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
781 (if email
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
782 (message "%s" email)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
783 (message "No record matching %s" name)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
784 email))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
785
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
786 ;;;###autoload
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
787 (defun ph-get-phone (name)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
788 "Get the phone field of NAME from the PH/QI directory server."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
789 (interactive "sName: ")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
790 (let ((phone (cdaar (ph-query-internal name '(phone)))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
791 (if (interactive-p)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
792 (if phone
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
793 (message "%s" phone)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
794 (message "No record matching %s" name)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
795 phone))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
796
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
797 (defun ph-get-field-list ()
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
798 "Return a list of valid field names for current server.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
799 When called interactively the list is formatted in a dedicated buffer
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
800 otherwise a list of symbols is returned."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
801 (interactive)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
802 (ph-do-request "fields")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
803 (if (interactive-p)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
804 (let ((ph-duplicate-fields-handling-method 'list))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
805 (ph-display-records (ph-parse-query-result) t))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
806 (mapcar 'caar
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
807 (ph-parse-query-result)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
808 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
809
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
810 ;;;###autoload
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
811 (defun ph-expand-inline (&optional replace)
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
812 "Query the PH server, and expand the query string before point.
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
813 The query string consists of the buffer substring from the point back to
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
814 the preceding comma, colon or beginning of line. If it contains more than
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
815 one word, the variable `ph-inline-query-format-list' controls to map these
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
816 onto CCSO database field names.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
817 After querying the server for the given string, the expansion specified by
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
818 `ph-inline-expansion-format' is inserted in the buffer at point.
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
819 If REPLACE is t, then this expansion replaces the name in the buffer.
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
820 If `ph-expanding-overwrites-query' is t, that inverts the meaning of REPLACE."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
821 (interactive)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
822 (let* ((end (point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
823 (beg (save-excursion
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
824 (if (re-search-backward "[:,][ \t]*"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
825 (save-excursion
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
826 (beginning-of-line)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
827 (point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
828 'move)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
829 (goto-char (match-end 0)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
830 (point)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
831 (words (buffer-substring beg end))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
832 query
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
833 query-alist
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
834 (query-format ph-inline-query-format-list)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
835 response
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
836 response-strings
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
837 key val cell)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
838
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
839 ;; Prepare the query
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
840 (if (or (not query-format)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
841 (not (string-match "[ \t]+" words)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
842 (setq query words)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
843 (setq words (split-string words "[ \t]+"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
844 (while (and words query-format)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
845 (setq query-alist (cons (cons (car query-format) (car words)) query-alist))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
846 (setq words (cdr words)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
847 query-format (cdr query-format)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
848 (if words
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
849 (setcdr (car query-alist)
18915
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
850 (concat (ph-cdar query-alist) " "
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
851 (mapconcat 'identity words " "))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
852 ;; Uniquify query-alist
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
853 (setq query-alist (nreverse query-alist))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
854 (while query-alist
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
855 (setq key (caar query-alist)
18915
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
856 val (ph-cdar query-alist)
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
857 cell (assq key query))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
858 (if cell
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
859 (setcdr cell (concat val " " (cdr cell)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
860 (setq query (cons (car query-alist) query))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
861 (setq query-alist (cdr query-alist)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
862
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
863 (setq response (ph-query-internal query (cdr ph-inline-expansion-format)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
864
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
865 (if (null response)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
866 (error "No match found")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
867
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
868 ;; Process response through ph-inline-expansion-format
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
869 (while response
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
870 (setq response-strings
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
871 (cons (apply 'format
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
872 (car ph-inline-expansion-format)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
873 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
874 (lambda (field)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
875 (or (cdr (assq field (car response)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
876 "")))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
877 (cdr ph-inline-expansion-format)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
878 response-strings))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
879 (setq response (cdr response)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
880
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
881 (if (or
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
882 (and replace (not ph-expanding-overwrites-query))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
883 (and (not replace) ph-expanding-overwrites-query))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
884 (delete-region beg end))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
885 (cond
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
886 ((or (= (length response-strings) 1)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
887 (null ph-multiple-match-handling-method)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
888 (eq ph-multiple-match-handling-method 'first))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
889 (insert (car response-strings)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
890 ((eq ph-multiple-match-handling-method 'select)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
891 (with-output-to-temp-buffer "*Completions*"
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
892 (display-completion-list response-strings)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
893 ((eq ph-multiple-match-handling-method 'all)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
894 (insert (mapconcat 'identity response-strings ", ")))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
895 ((eq ph-multiple-match-handling-method 'abort)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
896 (error "There is more than one match for the query"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
897 ))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
898 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
899 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
900
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
901 ;;;###autoload
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
902 (defun ph-query-form (&optional get-fields-from-server)
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
903 "Display a form to query the CCSO PH/QI nameserver.
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
904 If given a non-nil argument the function first queries the server
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
905 for the existing fields and displays a corresponding form."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
906 (interactive "P")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
907 (let ((fields (or (and get-fields-from-server
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
908 (ph-get-field-list))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
909 ph-form-fields))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
910 (buffer (get-buffer-create "*PH/QI Query Form*"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
911 field-name
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
912 widget
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
913 (width 0)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
914 inhibit-read-only
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
915 pt)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
916 (switch-to-buffer buffer)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
917 (setq inhibit-read-only t)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
918 (erase-buffer)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
919 (kill-all-local-variables)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
920 (make-local-variable 'ph-form-widget-list)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
921 (widget-insert "PH/QI Query Form\n")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
922 (widget-insert "================\n\n")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
923 (widget-insert "Current server is: " (or ph-server
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
924 (call-interactively 'ph-set-server)) "\n")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
925 ;; Loop over prompt strings to find the biggest one
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
926 (setq fields
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
927 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
928 (lambda (field)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
929 (setq field-name (or (and (assq field ph-fieldname-formstring-alist)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
930 (cdr (assq field ph-fieldname-formstring-alist)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
931 (capitalize (symbol-name field))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
932 (if (> (length field-name) width)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
933 (setq width (length field-name)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
934 (cons field field-name)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
935 fields))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
936 ;; Insert the first widget out of the mapcar to leave the cursor
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
937 ;; in the first field
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
938 (widget-insert "\n\n" (format (concat "%" width "s: ") (cdr (car fields))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
939 (setq pt (point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
940 (setq widget (widget-create 'editable-field :size 15))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
941 (setq ph-form-widget-list (cons (cons (car (car fields)) widget)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
942 ph-form-widget-list))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
943 (setq fields (cdr fields))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
944 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
945 (lambda (field)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
946 (widget-insert "\n\n" (format (concat "%" width "s: ") (cdr field)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
947 (setq widget (widget-create 'editable-field
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
948 :size 15))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
949 (setq ph-form-widget-list (cons (cons (car field) widget)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
950 ph-form-widget-list))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
951 fields)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
952 (widget-insert "\n\n")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
953 (widget-create 'push-button
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
954 :notify (lambda (&rest ignore)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
955 (ph-process-form))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
956 "Query Server")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
957 (widget-insert " ")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
958 (widget-create 'push-button
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
959 :notify (lambda (&rest ignore)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
960 (ph-query-form))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
961 "Reset Form")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
962 (widget-insert " ")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
963 (widget-create 'push-button
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
964 :notify (lambda (&rest ignore)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
965 (kill-this-buffer))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
966 "Quit")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
967 (goto-char (1+ pt)) ; 1+ for some extent boundary reason
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
968 (use-local-map widget-keymap)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
969 (widget-setup))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
970 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
971
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
972 (defun ph-bookmark-server (server)
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
973 "Add SERVER to the PH `servers' hotlist."
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
974 (interactive "sPH server: ")
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
975 (if (member server ph-server-hotlist)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
976 (error "%s is already in the hotlist" server)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
977 (setq ph-server-hotlist (cons server ph-server-hotlist))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
978 (ph-install-menu)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
979 (ph-save-options)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
980
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
981 (defun ph-bookmark-current-server ()
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
982 "Add current server to the PH `servers' hotlist."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
983 (interactive)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
984 (ph-bookmark-server ph-server))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
985
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
986 (defun ph-save-options ()
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
987 "Save options (essentially the hotlist) to `ph-options-file'."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
988 (interactive)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
989 (save-excursion
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
990 (set-buffer (find-file-noselect ph-options-file t))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
991 ;; delete the previous setq
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
992 (let ((standard-output (current-buffer))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
993 provide-p
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
994 setq-p)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
995 (catch 'found
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
996 (while t
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
997 (let ((sexp (condition-case nil
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
998 (read (current-buffer))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
999 (end-of-file (throw 'found nil)))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1000 (if (listp sexp)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1001 (progn
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1002 (if (and (eq (car sexp) 'setq)
18915
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
1003 (eq (ph-cadr sexp) 'ph-server-hotlist))
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1004 (progn
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1005 (delete-region (save-excursion
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1006 (backward-sexp)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1007 (point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1008 (point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1009 (setq setq-p t)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1010 (if (and (eq (car sexp) 'provide)
18915
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
1011 (equal (ph-cadr sexp) '(quote ph-options-file)))
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1012 (setq provide-p t))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1013 (if (and provide-p
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1014 setq-p)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1015 (throw 'found t)))))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1016 (if (eq (point-min) (point-max))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1017 (princ ";; This file was automatically generated by ph.el\n\n"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1018 (if (not (bolp))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1019 (princ "\n"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1020 (princ "(setq ph-server-hotlist '")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1021 (prin1 ph-server-hotlist)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1022 (princ ")\n")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1023 (if (not provide-p)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1024 (princ "(provide 'ph-options-file)\n"))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1025 (save-buffer)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1026 )
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1027
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1028 (defun ph-insert-record-at-point-into-bbdb ()
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1029 "Insert record at point into the BBDB database.
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1030 This function can only be called from a PH/QI query result buffer."
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1031 (interactive)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1032 (let ((record (and (overlays-at (point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1033 (overlay-get (car (overlays-at (point))) 'ph-record))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1034 (if (null record)
18915
ea2fb7cfc3f1 Various error messages fixed.
Richard M. Stallman <rms@gnu.org>
parents: 18914
diff changeset
1035 (error "Point is not over a record")
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1036 (ph-create-bbdb-record record))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1037
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1038 (defun ph-try-bbdb-insert ()
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
1039 "Call `ph-insert-record-at-point-into-bbdb' if on a record."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1040 (interactive)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1041 (and (or (featurep 'bbdb)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1042 (prog1 (locate-library "bbdb") (message "")))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1043 (overlays-at (point))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1044 (overlay-get (car (overlays-at (point))) 'ph-record)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1045 (ph-insert-record-at-point-into-bbdb)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1046
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1047 (defun ph-move-to-next-record ()
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
1048 "Move to next record, in a buffer displaying PH query results."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1049 (interactive)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1050 (if (not (eq major-mode 'ph-mode))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1051 (error "Not in a PH buffer")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1052 (let ((pt (next-overlay-change (point))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1053 (if (< pt (point-max))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1054 (goto-char (1+ pt))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1055 (error "No more records after point")))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1056
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1057 (defun ph-move-to-previous-record ()
19064
8906a04da073 Many doc strings and messages changed.
Richard M. Stallman <rms@gnu.org>
parents: 18915
diff changeset
1058 "Move to previous record, in a buffer displaying PH query results."
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1059 (interactive)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1060 (if (not (eq major-mode 'ph-mode))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1061 (error "Not in a PH buffer")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1062 (let ((pt (previous-overlay-change (point))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1063 (if (> pt (point-min))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1064 (goto-char pt)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1065 (error "No more records before point")))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1066
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1067
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1068
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1069 ;;}}}
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1070
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1071 ;;{{{ Menus an keymaps
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1072
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1073 (require 'easymenu)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1074
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1075 (defvar ph-mode-map (let ((map (make-sparse-keymap)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1076 (define-key map "q" 'kill-this-buffer)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1077 (define-key map "x" 'kill-this-buffer)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1078 (define-key map "f" 'ph-query-form)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1079 (define-key map "b" 'ph-try-bbdb-insert)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1080 (define-key map "n" 'ph-move-to-next-record)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1081 (define-key map "p" 'ph-move-to-previous-record)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1082 map))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1083 (set-keymap-parent ph-mode-map widget-keymap)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1084
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1085 (defconst ph-tail-menu
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1086 `(["---" nil nil]
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1087 ["Query Form" ph-query-form t]
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1088 ["Expand Inline" ph-expand-inline t]
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1089 ["---" nil nil]
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1090 ["Get Email" ph-get-email t]
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1091 ["Get Phone" ph-get-phone t]
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1092 ["List Valid Field Names" ph-get-field-list t]
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1093 ["---" nil nil]
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1094 ,(cons "Customize" (cdr (custom-menu-create 'ph)))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1095
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1096 (defconst ph-server-menu
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1097 '(["---" ph-bookmark-server t]
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1098 ["Bookmark Current Server" ph-bookmark-current-server t]
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1099 ["New Server" ph-set-server t]))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1100
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1101
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1102 (defun ph-menu ()
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1103 (let (command)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1104 (append '("Ph")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1105 (list
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1106 (append '("Server")
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1107 (mapcar (function
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1108 (lambda (server)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1109 (setq command (intern (concat "ph-set-server-" server)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1110 (if (not (fboundp command))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1111 (fset command `(lambda ()
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1112 (interactive)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1113 (setq ph-server ,server)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1114 (message "Selected PH/QI server is now %s" ,server))))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1115 (vector server command t)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1116 ph-server-hotlist)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1117 ph-server-menu))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1118 ph-tail-menu)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1119
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1120 (defun ph-install-menu ()
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1121 (cond
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1122 (ph-xemacs-p
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1123 (add-submenu '("Tools") (ph-menu)))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1124 (ph-emacs-p
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1125 (easy-menu-define ph-menu-map ph-mode-map "PH Menu" (ph-menu))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1126 (define-key
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1127 global-map
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1128 [menu-bar tools ph]
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1129 (cons "Ph"
21630
d2b8e50dd2e0 (ph-install-menu): Use easy-menu-create-menu, not
Dave Love <fx@gnu.org>
parents: 19918
diff changeset
1130 (easy-menu-create-menu "Ph" (cdr (ph-menu))))))
18914
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1131 ))
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1132
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1133 (ph-install-menu)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1134
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1135
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1136 ;;}}}
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1137
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1138 (provide 'ph)
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1139
f9d2d84a004c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1140 ;;; ph.el ends here