Skip to content
Snippets Groups Projects
Commit bd458e130b24 authored by oscarf's avatar oscarf
Browse files

(eudc-display-records): `concat' does not accept ints as arguments anymore.

(eudc-query-form): Ditto.
(eudc-save-options): Also save the current server
(eudc-set-server): New optional argument to save the current server
for future sessions or not
parent fa5d4d9c5123
No related branches found
No related tags found
No related merge requests found
......@@ -5,7 +5,7 @@
;; Author: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
;; Created: Feb 1998
;; Version: 1.18
;; Version: $Revision$
;; Keywords: help
;; This file is part of XEmacs
......@@ -455,7 +455,7 @@
(mapcar (function
(lambda (field)
(setq field-beg (point))
(insert (format (concat "%" width "s: ") (car field)))
(insert (format (concat "%" (int-to-string width) "s: ") (car field)))
(put-text-property field-beg (point) 'face 'bold)
(mapcar (function
(lambda (val)
......@@ -777,10 +777,12 @@
(customize-group 'eudc))
;;;###autoload
(defun eudc-set-server (server protocol)
"Set the directory server to SERVER using PROTOCOL."
(defun eudc-set-server (server protocol &optional no-save)
"Set the directory server to SERVER using PROTOCOL.
If NO-SAVE is nil, the server is saved as the default server
for future sessions."
(interactive "sDirectory Server: \nSProtocol: ")
(unless (eq protocol eudc-protocol)
(eudc-switch-to-protocol protocol))
(setq eudc-server server)
(if (interactive-p)
......@@ -782,9 +784,11 @@
(interactive "sDirectory Server: \nSProtocol: ")
(unless (eq protocol eudc-protocol)
(eudc-switch-to-protocol protocol))
(setq eudc-server server)
(if (interactive-p)
(message "Current directory server is now %s (%s)" eudc-server eudc-protocol)))
(message "Current directory server is now %s (%s)" eudc-server eudc-protocol))
(if (null no-save)
(eudc-save-options)))
;;;###autoload
(defun eudc-get-email (name)
......@@ -973,7 +977,7 @@
prompts)
;; Insert the first widget out of the mapcar to leave the cursor
;; in the first field
(widget-insert "\n\n" (format (concat "%" width "s: ") (car prompts)))
(widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts)))
(setq pt (point))
(setq widget (widget-create 'editable-field :size 15))
(setq eudc-form-widget-list (cons (cons (car fields) widget)
......@@ -982,7 +986,7 @@
(setq prompts (cdr prompts))
(mapcar (function
(lambda (field)
(widget-insert "\n\n" (format (concat "%" width "s: ") (car prompts)))
(widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts)))
(setq widget (widget-create 'editable-field
:size 15))
(setq eudc-form-widget-list (cons (cons field widget)
......@@ -1122,10 +1126,10 @@
(eudc-bookmark-server eudc-server eudc-protocol))
(defun eudc-save-options ()
"Save options (essentially the hotlist) to `eudc-options-file'."
"Save options to `eudc-options-file'."
(interactive)
(save-excursion
(set-buffer (find-file-noselect eudc-options-file t))
;; delete the previous setq
(let ((standard-output (current-buffer))
provide-p
......@@ -1126,10 +1130,11 @@
(interactive)
(save-excursion
(set-buffer (find-file-noselect eudc-options-file t))
;; delete the previous setq
(let ((standard-output (current-buffer))
provide-p
setq-p)
set-hotlist-p
set-server-p)
(catch 'found
(while t
(let ((sexp (condition-case nil
......@@ -1137,6 +1142,13 @@
(end-of-file (throw 'found nil)))))
(if (listp sexp)
(progn
(if (eq (car sexp) 'eudc-set-server)
(progn
(delete-region (save-excursion
(backward-sexp)
(point))
(point))
(setq set-server-p t)))
(if (and (eq (car sexp) 'setq)
(eq (eudc-cadr sexp) 'eudc-server-hotlist))
(progn
......@@ -1144,8 +1156,8 @@
(backward-sexp)
(point))
(point))
(setq setq-p t)))
(setq set-hotlist-p t)))
(if (and (eq (car sexp) 'provide)
(equal (eudc-cadr sexp) '(quote eudc-options-file)))
(setq provide-p t))
(if (and provide-p
......@@ -1148,10 +1160,11 @@
(if (and (eq (car sexp) 'provide)
(equal (eudc-cadr sexp) '(quote eudc-options-file)))
(setq provide-p t))
(if (and provide-p
setq-p)
set-hotlist-p
set-server-p)
(throw 'found t)))))))
(if (eq (point-min) (point-max))
(princ ";; This file was automatically generated by eudc.el\n\n"))
(if (not (bolp))
(princ "\n"))
......@@ -1153,10 +1166,15 @@
(throw 'found t)))))))
(if (eq (point-min) (point-max))
(princ ";; This file was automatically generated by eudc.el\n\n"))
(if (not (bolp))
(princ "\n"))
(princ "(eudc-set-server ")
(prin1 eudc-server)
(princ " '")
(prin1 eudc-protocol)
(princ " t)\n")
(princ "(setq eudc-server-hotlist '")
(prin1 eudc-server-hotlist)
(princ ")\n")
(if (not provide-p)
(princ "(provide 'eudc-options-file)\n"))
......@@ -1158,10 +1176,9 @@
(princ "(setq eudc-server-hotlist '")
(prin1 eudc-server-hotlist)
(princ ")\n")
(if (not provide-p)
(princ "(provide 'eudc-options-file)\n"))
(save-buffer)))
)
(save-buffer))))
(defun eudc-insert-record-at-point-into-bbdb ()
"Insert record at point into the BBDB database.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment