["Toggle inline display" eudc-bob-toggle-inline-display
(eudc-bob-can-display-inline-images)]
,@(cdr (cdr eudc-bob-generic-menu))))
-
+
(defconst eudc-bob-sound-menu
`("EUDC Sound Menu"
["---" nil nil]
["Play sound" eudc-bob-play-sound-at-point
(fboundp 'play-sound)]
,@(cdr (cdr eudc-bob-generic-menu))))
-
+
(defun eudc-jump-to-event (event)
"Jump to the window and point where EVENT occurred."
(if eudc-xemacs-p
(defun eudc-bob-menu ()
"Retrieve the menu attached to a binary object."
(eudc-bob-get-overlay-prop 'menu))
-
+
(defun eudc-bob-popup-menu (event)
"Pop-up a menu of EUDC multimedia commands."
(interactive "@e")
(set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap)
(set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap)
-
(if eudc-emacs-p
(progn
(easy-menu-define eudc-bob-generic-menu
(defun eudc-display-jpeg-as-button (data)
"Display a button for the JPEG DATA."
(eudc-bob-display-jpeg data nil))
-
+
;;; eudc-bob.el ends here
If SILENT is non-nil then the created BBDB record is not displayed."
;; This function runs in a special context where lisp symbols corresponding
;; to field names in record are bound to the corresponding values
- (eval
+ (eval
`(let* (,@(mapcar '(lambda (c)
(list (car c) (if (listp (cdr c))
(list 'quote (cdr c))
(cons (car mapping) value))))
conversion-alist)))
(setq bbdb-notes (delq nil bbdb-notes))
- (setq bbdb-record (bbdb-create-internal bbdb-name
- bbdb-company
+ (setq bbdb-record (bbdb-create-internal bbdb-name
+ bbdb-company
bbdb-net
bbdb-address
bbdb-phones
(defun eudc-parse-spec (spec record recurse)
"Parse the conversion SPEC using RECORD.
If RECURSE is non-nil then SPEC may be a list of atomic specs."
- (cond
+ (cond
((or (stringp spec)
(symbolp spec)
(and (listp spec)
zip (string-to-number (match-string 1 last1))))
(t
(error "Cannot parse the address"))))
- (vector location
+ (vector location
(or (nth 0 addr-components) "")
(or (nth 1 addr-components) "")
(or (nth 2 addr-components) "")
PHONE is either a string supposedly containing a phone number or
a list of such strings which are concatenated.
LOCATION is used as the phone location for BBDB."
- (cond
+ (cond
((stringp phone)
(let (phone-list)
(condition-case err
(vector location (mapconcat 'identity phone ", ")))
(t
(error "Invalid phone specification"))))
-
+
(defun eudc-batch-export-records-to-bbdb ()
"Insert all the records returned by a directory query into BBDB."
(interactive)
(switch-to-buffer (get-buffer-create "*EUDC Servers*"))
(setq buffer-read-only nil)
(erase-buffer)
- (mapcar (function
+ (mapcar (function
(lambda (entry)
(setq proto-col (max (length (car entry)) proto-col))))
eudc-server-hotlist)
(let ((buffer-read-only nil))
(save-excursion
(beginning-of-line)
- (if (and (>= (point) eudc-hotlist-list-beginning)
+ (if (and (>= (point) eudc-hotlist-list-beginning)
(looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))
(kill-line 1)
(error "No server on this line")))))
hotlist))
(forward-line 1))
(if (not (looking-at "^[ \t]*$"))
- (error "Malformed entry in hotlist, discarding edits"))
+ (error "Malformed entry in hotlist, discarding edits"))
(setq eudc-server-hotlist (nreverse hotlist))
(eudc-install-menu)
(eudc-save-options)
(eudc-set-server (match-string 1) (intern (match-string 2)))
(message "Current directory server is %s (%s)" eudc-server eudc-protocol))
(error "No server on this line"))))
-
+
(defun eudc-hotlist-transpose-servers ()
"Swap the order of the server with the previous one in the list."
(interactive)
(beginning-of-line)
(if (and (>= (point) eudc-hotlist-list-beginning)
(looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")
- (progn
+ (progn
(forward-line -1)
(looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")))
(progn
(forward-line 1)
(transpose-lines 1))))))
-
+
(setq eudc-hotlist-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "a" 'eudc-hotlist-add-server)
["Exit without Saving" kill-this-buffer t]))
(if eudc-emacs-p
- (easy-menu-define eudc-hotlist-emacs-menu
+ (easy-menu-define eudc-hotlist-emacs-menu
eudc-hotlist-mode-map
""
eudc-hotlist-menu))
;; Boston, MA 02111-1307, USA.
;;; Commentary:
-;; This library provides an interface to use BBDB as a backend of
+;; This library provides an interface to use BBDB as a backend of
;; the Emacs Unified Directory Client.
;;; Code:
records)))))
result))
-;;}}}
+;;}}}
;;{{{ High-level interfaces (interactive functions)
(eudc-set-server dummy 'bbdb)
(message "BBDB server selected"))
-;;;}}}
+;;}}}
(eudc-register-protocol 'bbdb)
;; Boston, MA 02111-1307, USA.
;;; Commentary:
-;; This library provides specific LDAP protocol support for the
+;; This library provides specific LDAP protocol support for the
;; Emacs Unified Directory Client package
;;; Installation:
(phone . telephonenumber))
"Alist mapping EUDC attribute names to LDAP names.")
-(eudc-protocol-set 'eudc-query-function 'eudc-ldap-simple-query-internal
+(eudc-protocol-set 'eudc-query-function 'eudc-ldap-simple-query-internal
'ldap)
(eudc-protocol-set 'eudc-list-attributes-function 'eudc-ldap-get-field-list
'ldap)
-(eudc-protocol-set 'eudc-protocol-attributes-translation-alist
+(eudc-protocol-set 'eudc-protocol-attributes-translation-alist
'eudc-ldap-attributes-translation-alist 'ldap)
-(eudc-protocol-set 'eudc-bbdb-conversion-alist
- 'eudc-ldap-bbdb-conversion-alist
+(eudc-protocol-set 'eudc-bbdb-conversion-alist
+ 'eudc-ldap-bbdb-conversion-alist
'ldap)
(eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'ldap)
-(eudc-protocol-set 'eudc-attribute-display-method-alist
+(eudc-protocol-set 'eudc-attribute-display-method-alist
'(("jpegphoto" . eudc-display-jpeg-inline)
("labeledurl" . eudc-display-url)
("audio" . eudc-display-sound)
("labeleduri" . eudc-display-url)
- ("url" . eudc-display-url))
+ ("url" . eudc-display-url))
'ldap)
-(eudc-protocol-set 'eudc-switch-to-server-hook
- '(eudc-ldap-check-base)
+(eudc-protocol-set 'eudc-switch-to-server-hook
+ '(eudc-ldap-check-base)
'ldap)
(defun eudc-ldap-cleanup-record-simple (record)
"Do some cleanup in a RECORD to make it suitable for EUDC."
- (mapcar
- (function
+ (mapcar
+ (function
(lambda (field)
(cons (intern (car field))
(if (cdr (cdr field))
;; Make the record a cons-cell instead of a list if the it's single-valued
;; Filter the $ character in addresses into \n if not done by the LDAP lib
(defun eudc-ldap-cleanup-record-filtering-addresses (record)
- (mapcar
- (function
+ (mapcar
+ (function
(lambda (field)
(let ((name (intern (car field)))
(value (cdr field)))
(defun eudc-ldap-simple-query-internal (query &optional return-attrs)
"Query the LDAP server with QUERY.
-QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
-LDAP attribute names.
-RETURN-ATTRS is a list of attributes to return, defaulting to
+QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
+LDAP attribute names.
+RETURN-ATTRS is a list of attributes to return, defaulting to
`eudc-default-return-attributes'."
(let ((result (ldap-search (eudc-ldap-format-query-as-rfc1558 query)
eudc-server
final-result)
(if (or (not (boundp 'ldap-ignore-attribute-codings))
ldap-ignore-attribute-codings)
- (setq result
+ (setq result
(mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
(setq result (mapcar 'eudc-ldap-cleanup-record-simple result)))
(setq result (eudc-filter-partial-records result return-attrs)))
;; Apply eudc-duplicate-attribute-handling-method
(if (not (eq 'list eudc-duplicate-attribute-handling-method))
- (mapcar
+ (mapcar
(function (lambda (record)
- (setq final-result
+ (setq final-result
(append (eudc-filter-duplicate-attributes record)
final-result))))
result))
(interactive)
(or eudc-server
(call-interactively 'eudc-set-server))
- (let ((ldap-host-parameters-alist
+ (let ((ldap-host-parameters-alist
(list (cons eudc-server
'(scope subtree sizelimit 1)))))
(mapcar 'eudc-ldap-cleanup-record
- (ldap-search
- (eudc-ldap-format-query-as-rfc1558
+ (ldap-search
+ (eudc-ldap-format-query-as-rfc1558
(list (cons "objectclass"
(or objectclass
"person"))))
(defun eudc-ldap-escape-query-special-chars (string)
"Value is STRING with characters forbidden in LDAP queries escaped."
-;; Note that * should also be escaped but in most situations I suppose
+;; Note that * should also be escaped but in most situations I suppose
;; the user doesn't want this
(eudc-replace-in-string
(eudc-replace-in-string
(eudc-replace-in-string
- (eudc-replace-in-string
- string
+ (eudc-replace-in-string
+ string
"\\\\" "\\5c")
"(" "\\28")
")" "\\29")
(defun eudc-ldap-format-query-as-rfc1558 (query)
"Format the EUDC QUERY list as a RFC1558 LDAP search filter."
- (format "(&%s)"
- (apply 'concat
+ (format "(&%s)"
+ (apply 'concat
(mapcar '(lambda (item)
- (format "(%s=%s)"
- (car item)
+ (format "(%s=%s)"
+ (car item)
(eudc-ldap-escape-query-special-chars (cdr item))))
query))))
-;;}}}
+;;}}}
;;{{{ High-level interfaces (interactive functions)
;; If the server is not in ldap-host-parameters-alist we add it for the
;; user
(if (null (assoc eudc-server ldap-host-parameters-alist))
- (setq ldap-host-parameters-alist
+ (setq ldap-host-parameters-alist
(cons (list eudc-server) ldap-host-parameters-alist)))
(customize-variable 'ldap-host-parameters-alist)))
-;;;}}}
+;;}}}
(eudc-register-protocol 'ldap)
;; Boston, MA 02111-1307, USA.
;;; Commentary:
-;; This library provides specific CCSO PH/QI protocol support for the
+;; This library provides specific CCSO PH/QI protocol support for the
;; Emacs Unified Directory Client package
;;; Code:
(defun eudc-ph-query-internal (query &optional return-fields)
"Query the PH/QI server with QUERY.
-QUERY can be a string NAME or a list made of strings NAME
-and/or cons cells (KEY . VALUE) where KEYs should be valid
+QUERY can be a string NAME or a list made of strings NAME
+and/or cons cells (KEY . VALUE) where KEYs should be valid
CCSO database keys. NAME is equivalent to (DEFAULT . NAME),
where DEFAULT is the default key of the database.
RETURN-FIELDS is a list of database fields to return,
(setq return-fields eudc-default-return-attributes))
(if (eq 'all return-fields)
(setq return-fields '(all)))
- (setq request
+ (setq request
(concat "query "
(if (stringp query)
query
(defun eudc-ph-parse-query-result (&optional fields)
- "Return a list of alists of key/values from in `eudc-ph-process-buffer'.
+ "Return a list of alists of key/values from in `eudc-ph-process-buffer'.
Fields not in FIELDS are discarded."
- (let (record
+ (let (record
records
line-regexp
current-key
(intern (match-string 2)))
value (match-string 3))
(if (and current-key
- (eq key current-key))
+ (eq key current-key))
(setq key nil)
(setq current-key key))
(if (or (null fields)
(message "Contacting server...")
(setq process (eudc-ph-open-session))
(if process
- (save-excursion
+ (save-excursion
(set-buffer (setq buffer (process-buffer process)))
(eudc-ph-send-command process request)
(message "Request sent, waiting for reply...")
(if process
(eudc-ph-close-session process)))
buffer))
-
+
(defun eudc-ph-open-session (&optional server)
"Open a connection to the given CCSO/QI SERVER.
SERVER is either a string naming the server or a list (NAME PORT)."
(buffer-substring (point) match-end)
return-code))))
-;;}}}
+;;}}}
;;{{{ High-level interfaces (interactive functions)
projects / emacs.git / commitdiff