1 ;;; wl-acap.el --- ACAP support for Wanderlust.
3 ;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
32 ;; ((and (not (featurep 'utf-2000))
33 ;; (module-installed-p 'un-define))
34 ;; (require 'un-define))
35 ;; ((and (featurep 'xemacs)
36 ;; (not (featurep 'utf-2000))
37 ;; (module-installed-p 'xemacs-ucs))
38 ;; (require 'xemacs-ucs)))
47 (defconst wl-acap-dataset-class
"vendor.wanderlust")
48 (defconst wl-acap-entry-name
"settings")
50 (defcustom wl-acap-user
(or (getenv "USER")
57 (defcustom wl-acap-server nil
59 If nil, SLP is used to find ACAP server.
60 If nil and SLP is not available, localhost is assumed."
64 (defcustom wl-acap-port nil
66 Only valid when `wl-acap-server' is non-nil.
67 If nil, default acap port is used."
71 (defcustom wl-acap-authenticate-type
'cram-md5
72 "ACAP authenticate type."
76 (defcustom wl-acap-stream-type nil
81 (defcustom wl-acap-extra-options nil
82 "Extra options to be saved on ACAP server."
83 :type
'(repeat symbol
)
86 (defcustom wl-acap-cache-filename
"acap-cache"
87 "ACAP setting cache file."
91 ;; Encoding string as BASE64 is temporal solution.
92 ;; As far as I know, current implementation of ACAP server
93 ;; (cyrus-smlacapd 0.5) does not accept literal argument for STORE.
94 (defvar wl-acap-base64-encode-options
96 wl-draft-config-alist
)
97 "Options which should be encoded with base64 to store ACAP server.")
99 (defcustom wl-acap-coding-system
'utf-8
100 "Coding system for ACAP."
104 (defvar wl-acap-original-msgdb-directory nil
)
106 (defun wl-acap-exit ()
108 (when wl-acap-original-msgdb-directory
109 (setq elmo-msgdb-directory wl-acap-original-msgdb-directory
)))
111 (defun wl-acap-init ()
112 "A candidate for `wl-folder-init-function'."
113 (setq wl-acap-original-msgdb-directory nil
)
114 (condition-case err
; catch error and quit.
115 (let ((service (wl-acap-find-acap-service))
116 proc entries settings folder-top type caches msgdb-dir
)
117 (if (null (car service
))
124 (elmo-localdir-folder-directory-internal
125 (elmo-make-folder dirent
))))
127 (setq dir
(expand-file-name
128 wl-acap-cache-filename
131 (elmo-folder-list-subfolders
132 (elmo-make-folder (concat "+"
135 elmo-msgdb-directory
)))))))
136 (if (y-or-n-p "No ACAP service found. Try cache? ")
137 (let (selected rpath alist
)
141 (setq rpath
(nreverse (split-string dir
"/")))
142 (cons (concat (nth 1 rpath
) "@" (nth 2 rpath
))
148 "Select ACAP cache: " alist nil t
)
150 msgdb-dir
(file-name-directory selected
)
151 entries
(elmo-object-load selected
)))
152 (error "No ACAP service found"))
153 (error "No ACAP service found"))
154 (setq proc
(acap-open (car service
)
157 wl-acap-authenticate-type
))
159 (setq entries
(acap-response-entries
160 (acap-search proc
(concat "/"
161 wl-acap-dataset-class
167 (concat "acap/" (car service
) "/" wl-acap-user
"/"
168 wl-acap-cache-filename
)
169 elmo-msgdb-directory
)
172 (when (string= (acap-response-entry-entry (car entries
))
174 (setq settings
(car (acap-response-entry-return-data-list
177 (setq entries
(cdr entries
)))
182 (let ((sym (wl-acap-symbol (car x
))))
184 ((and sym
(eq sym
'wl-folders
))
186 (setq wl-folder-entity
187 (wl-acap-create-folder-entity (cadr x
)))
189 ((and sym
(boundp sym
))
190 (setq type
(custom-variable-type sym
))
195 ((or (eq (car type
) 'string
)
196 (and (eq (car type
) 'choice
)
197 (memq 'string type
)))
198 (if (memq sym wl-acap-base64-encode-options
)
199 (wl-acap-base64-decode-string (cadr x
))
200 (decode-coding-string
202 wl-acap-coding-system
)))
207 wl-acap-base64-encode-options
)
208 (wl-acap-base64-decode-string
212 (decode-coding-string
214 wl-acap-coding-system
)
217 (t 'wl-acap-ignored
))))
220 (dolist (setting settings
)
221 (set (car setting
) (cdr setting
)))
222 ;; Database directory becomes specific to the ACAP server.
223 (setq wl-acap-original-msgdb-directory elmo-msgdb-directory
)
224 (setq elmo-msgdb-directory
(or msgdb-dir
226 (concat "acap/" (car service
)
228 elmo-msgdb-directory
)))
229 (when proc
(acap-close proc
)))
231 (when wl-acap-original-msgdb-directory
232 (setq elmo-msgdb-directory wl-acap-original-msgdb-directory
))
233 (signal (car err
) (cdr err
)))))
235 (defun wl-acap-create-folder-entity (string)
237 (message "Initializing folder...")
238 (let (folders entity
)
239 (setq string
(elmo-base64-decode-string string
))
240 (setq string
(decode-coding-string string wl-acap-coding-system
))
242 (goto-char (point-min))
243 (while (and (not (eobp))
244 (setq entity
(wl-create-folder-entity-from-buffer)))
245 (unless (eq entity
'ignore
)
246 (wl-append folders
(list entity
))))
247 (message "Initializing folder...done")
248 (list wl-folder-desktop-name
'group folders
))))
250 (defun wl-acap-find-acap-service ()
251 (or (and wl-acap-server
252 (cons wl-acap-server wl-acap-port
))
254 (message "Searching ACAP server...")
255 (prog1 (let ((response (condition-case nil
256 (slp-findsrvs "acap")
260 (if (> (length (slp-response-body response
)) 1)
264 "Select ACAP server: "
265 (mapcar (lambda (body)
268 (slp-response-srv-url-host
270 (when (slp-response-srv-url-port
274 (slp-response-srv-url-port
276 (slp-response-body response
)))
279 (dolist (entry (slp-response-body response
))
282 (slp-response-srv-url-host
285 (slp-response-srv-url-port
289 (slp-response-srv-url-port
292 (throw 'done entry
))))))
293 (setq response
(car (slp-response-body response
))))
294 (cons (slp-response-srv-url-host response
)
295 (slp-response-srv-url-port response
))))
296 (message "Searching ACAP server...done")))
297 (cons "localhost" nil
)))
299 (defun wl-acap-name (option)
300 (let ((name (symbol-name option
))
302 (cond ((string-match "^wl-" name
)
303 (setq name
(substring name
(match-end 0))
305 ((string-match "^elmo-" name
)
306 (setq name
(substring name
(match-end 0))
309 wl-acap-dataset-class
"." prefix
"."
310 (mapconcat 'capitalize
(split-string name
"-") ""))))
312 (defun wl-acap-symbol (name)
313 (let (case-fold-search li
)
314 (when (string-match (concat "^" (regexp-quote wl-acap-dataset-class
)
315 "\\.\\([^\\.]+\\)\\.") name
)
316 (setq li
(list (match-string 1 name
))
317 name
(substring name
(match-end 0)))
318 (while (string-match "^[A-Z][a-z0-9]*" name
)
319 (setq li
(cons (match-string 0 name
) li
))
320 (setq name
(substring name
(match-end 0))))
321 (intern (mapconcat 'downcase
(nreverse li
) "-")))))
323 (defun wl-acap-list-options ()
324 (nconc (mapcar 'car
(append (custom-group-members 'wl-setting nil
)
325 (custom-group-members 'elmo-setting nil
)))
326 wl-acap-extra-options
))
328 (defun wl-acap-store-folders (proc)
330 (insert-file-contents wl-folders-file
)
333 (list (concat "/" wl-acap-dataset-class
"/~/"
335 (concat wl-acap-dataset-class
".wl.Folders")
336 (wl-acap-base64-encode-string (buffer-string))))))
338 (defun wl-acap-base64-encode-string (string)
339 (elmo-base64-encode-string
340 (encode-coding-string string wl-acap-coding-system
)
343 (defun wl-acap-base64-decode-string (string)
344 (decode-coding-string
345 (elmo-base64-decode-string string
)
346 wl-acap-coding-system
))
348 (defun wl-acap-store ()
349 "Store Wanderlust configuration to the ACAP server."
353 (let ((service (wl-acap-find-acap-service))
355 (setq proc
(acap-open (car service
)
357 (upcase (symbol-name wl-acap-authenticate-type
))
359 (dolist (option (wl-acap-list-options))
361 (cons (wl-acap-name option
) settings
)
363 (cons (when (symbol-value option
)
364 (setq type
(custom-variable-type option
))
366 ((or (eq (car type
) 'string
)
367 (and (eq (car type
) 'choice
)
368 (memq 'string type
)))
369 (if (memq option wl-acap-base64-encode-options
)
370 (wl-acap-base64-encode-string
371 (symbol-value option
))
372 (encode-coding-string
373 (symbol-value option
)
374 wl-acap-coding-system
)))
375 (t (if (memq option wl-acap-base64-encode-options
)
376 (wl-acap-base64-encode-string
377 (prin1-to-string (symbol-value option
)))
378 (encode-coding-string
379 (prin1-to-string (symbol-value option
))
380 wl-acap-coding-system
)))))
384 (message "Storing settings...")
389 "/" wl-acap-dataset-class
"/~/" wl-acap-entry-name
))
390 (nreverse settings
)))
391 (message "Storing folders...")
392 (wl-acap-store-folders proc
)
393 ;; Does not work correctly??
394 ;; (acap-setacl proc (list
396 ;; "/" wl-acap-dataset-class "/~/"))
397 ;; "anyone" "") ; protect.
401 (message "Store completed."))))
404 (product-provide (provide 'wl-acap
) (require 'wl-version
))
406 ;;; wl-acap.el ends here