mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Don't quote lambdas in net/*.el

Browse source 
* lisp/net/eudc-export.el (eudc-create-bbdb-record):
* lisp/net/eudc.el (eudc-print-attribute-value)
(eudc-display-records, eudc-process-form)
(eudc-filter-duplicate-attributes, eudc-filter-partial-records)
(eudc-add-field-to-records, eudc-query-with-words)
(eudc-query-form, eudc-menu):
* lisp/net/eudcb-bbdb.el (eudc-bbdb-extract-phones)
(eudc-bbdb-query-internal):
* lisp/net/mairix.el (mairix-widget-make-query-from-widgets)
(mairix-widget-build-editable-fields, mairix-widget-get-values):
Don't quote lambdas.
This commit is contained in:
Stefan Kangas 2020-11-16 18:52:42 +01:00
parent f0f2c8563b
commit 9191c82f6d
4 changed files with 176 additions and 198 deletions
Download patch file Download diff file Expand all files Collapse all files

11
lisp/net/eudc-export.el
View file

@ -78,12 +78,11 @@ If SILENT is non-nil then the created BBDB record is not displayed."
record t))) record t)))
;; BBDB custom fields ;; BBDB custom fields
(setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes))) (setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes)))
(mapcar (function (mapcar (lambda (mapping)
(lambda (mapping) (if (and (not (memq (car mapping)
(if (and (not (memq (car mapping) '(name company net address phone notes)))
'(name company net address phone notes))) (setq value (eudc-parse-spec (cdr mapping) record nil)))
(setq value (eudc-parse-spec (cdr mapping) record nil))) (cons (car mapping) value)))
(cons (car mapping) value))))
conversion-alist))) conversion-alist)))
(setq bbdb-notes (delq nil bbdb-notes)) (setq bbdb-notes (delq nil bbdb-notes))
(setq bbdb-record (bbdb-create-internal (setq bbdb-record (bbdb-create-internal

237
lisp/net/eudc.el
View file

@ -414,10 +414,9 @@ if any, is called to print the value in cdr of FIELD."
(eval (list (cdr match) val)) (eval (list (cdr match) val))
(insert "\n")) (insert "\n"))
(mapc (mapc
(function (lambda (val-elem)
(lambda (val-elem) (indent-to col)
(indent-to col) (insert val-elem "\n"))
(insert val-elem "\n")))
(cond (cond
((listp val) val) ((listp val) val)
((stringp val) (split-string val "\n")) ((stringp val) (split-string val "\n"))
@ -464,37 +463,33 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
;; Replace field names with user names, compute max width ;; Replace field names with user names, compute max width
(setq precords (setq precords
(mapcar (mapcar
(function (lambda (record)
(lambda (record) (mapcar
(mapcar (lambda (field)
(function (setq attribute-name
(lambda (field) (if raw-attr-names
(setq attribute-name (symbol-name (car field))
(if raw-attr-names (eudc-format-attribute-name-for-display (car field))))
(symbol-name (car field)) (if (> (length attribute-name) width)
(eudc-format-attribute-name-for-display (car field)))) (setq width (length attribute-name)))
(if (> (length attribute-name) width) (cons attribute-name (cdr field)))
(setq width (length attribute-name))) record))
(cons attribute-name (cdr field))))
record)))
records)) records))
;; Display the records ;; Display the records
(setq first-record (point)) (setq first-record (point))
(mapc (mapc
(function (lambda (record)
(lambda (record) (setq beg (point))
(setq beg (point)) ;; Map over the record fields to print the attribute/value pairs
;; Map over the record fields to print the attribute/value pairs (mapc (lambda (field)
(mapc (function (eudc-print-record-field field width))
(lambda (field) record)
(eudc-print-record-field field width))) ;; Store the record internal format in some convenient place
record) (overlay-put (make-overlay beg (point))
;; Store the record internal format in some convenient place 'eudc-record
(overlay-put (make-overlay beg (point)) (car records))
'eudc-record (setq records (cdr records))
(car records)) (insert "\n"))
(setq records (cdr records))
(insert "\n")))
precords)) precords))
(insert "\n") (insert "\n")
(widget-create 'push-button (widget-create 'push-button
@ -518,12 +513,11 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
(if (not (and (boundp 'eudc-form-widget-list) (if (not (and (boundp 'eudc-form-widget-list)
eudc-form-widget-list)) eudc-form-widget-list))
(error "Not in a directory query form buffer") (error "Not in a directory query form buffer")
(mapc (function (mapc (lambda (wid-field)
(lambda (wid-field) (setq value (widget-value (cdr wid-field)))
(setq value (widget-value (cdr wid-field))) (if (not (string= value ""))
(if (not (string= value "")) (setq query-alist (cons (cons (car wid-field) value)
(setq query-alist (cons (cons (car wid-field) value) query-alist))))
query-alist)))))
eudc-form-widget-list) eudc-form-widget-list)
(kill-buffer (current-buffer)) (kill-buffer (current-buffer))
(eudc-display-records (eudc-query query-alist) eudc-use-raw-directory-names)))) (eudc-display-records (eudc-query query-alist) eudc-use-raw-directory-names))))
@ -543,49 +537,47 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
(if (null (cdar rec)) (if (null (cdar rec))
(list record) ; No duplicate attrs in this record (list record) ; No duplicate attrs in this record
(mapc (function (mapc (lambda (field)
(lambda (field) (if (listp (cdr field))
(if (listp (cdr field)) (setq duplicates (cons field duplicates))
(setq duplicates (cons field duplicates)) (setq unique (cons field unique))))
(setq unique (cons field unique)))))
record) record)
(setq result (list unique)) (setq result (list unique))
;; Map over the record fields that have multiple values ;; Map over the record fields that have multiple values
(mapc (mapc
(function (lambda (field)
(lambda (field) (let ((method (if (consp eudc-duplicate-attribute-handling-method)
(let ((method (if (consp eudc-duplicate-attribute-handling-method) (cdr
(cdr (assq
(assq (or
(or (car
(car (rassq
(rassq (car field)
(car field) (symbol-value
(symbol-value eudc-protocol-attributes-translation-alist)))
eudc-protocol-attributes-translation-alist))) (car field))
(car field)) eudc-duplicate-attribute-handling-method))
eudc-duplicate-attribute-handling-method)) eudc-duplicate-attribute-handling-method)))
eudc-duplicate-attribute-handling-method))) (cond
(cond ((or (null method) (eq 'list method))
((or (null method) (eq 'list method)) (setq result
(setq result (eudc-add-field-to-records field result)))
(eudc-add-field-to-records field result))) ((eq 'first method)
((eq 'first method) (setq result
(setq result (eudc-add-field-to-records (cons (car field)
(eudc-add-field-to-records (cons (car field) (cadr field))
(cadr field)) result)))
result))) ((eq 'concat method)
((eq 'concat method) (setq result
(setq result (eudc-add-field-to-records (cons (car field)
(eudc-add-field-to-records (cons (car field) (mapconcat
(mapconcat #'identity
#'identity (cdr field)
(cdr field) "\n"))
"\n")) result)))
result))) ((eq 'duplicate method)
((eq 'duplicate method) (setq result
(setq result (eudc-distribute-field-on-records field result))))))
(eudc-distribute-field-on-records field result)))))))
duplicates) duplicates)
result))) result)))
@ -593,19 +585,17 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
"Eliminate records that do not contain all ATTRS from RECORDS." "Eliminate records that do not contain all ATTRS from RECORDS."
(delq nil (delq nil
(mapcar (mapcar
(function (lambda (rec)
(lambda (rec) (if (cl-every (lambda (attr)
(if (cl-every (lambda (attr) (consp (assq attr rec)))
(consp (assq attr rec))) attrs)
attrs) rec))
rec)))
records))) records)))
(defun eudc-add-field-to-records (field records) (defun eudc-add-field-to-records (field records)
"Add FIELD to each individual record in RECORDS and return the resulting list." "Add FIELD to each individual record in RECORDS and return the resulting list."
(mapcar (function (mapcar (lambda (r)
(lambda (r) (cons field r))
(cons field r)))
records)) records))
(defun eudc-distribute-field-on-records (field records) (defun eudc-distribute-field-on-records (field records)
@ -886,10 +876,9 @@ see `eudc-inline-expansion-servers'."
(let ((response-string (let ((response-string
(apply #'format (apply #'format
(car eudc-inline-expansion-format) (car eudc-inline-expansion-format)
(mapcar (function (mapcar (lambda (field)
(lambda (field) (or (cdr (assq field r))
(or (cdr (assq field r)) ""))
"")))
(eudc-translate-attribute-list (eudc-translate-attribute-list
(cdr eudc-inline-expansion-format)))))) (cdr eudc-inline-expansion-format))))))
(if (> (length response-string) 0) (if (> (length response-string) 0)
@ -929,16 +918,14 @@ queries the server for the existing fields and displays a corresponding form."
;; Build the list of prompts ;; Build the list of prompts
(setq prompts (if eudc-use-raw-directory-names (setq prompts (if eudc-use-raw-directory-names
(mapcar #'symbol-name (eudc-translate-attribute-list fields)) (mapcar #'symbol-name (eudc-translate-attribute-list fields))
(mapcar (function (mapcar (lambda (field)
(lambda (field) (or (cdr (assq field eudc-user-attribute-names-alist))
(or (cdr (assq field eudc-user-attribute-names-alist)) (capitalize (symbol-name field))))
(capitalize (symbol-name field)))))
fields))) fields)))
;; Loop over prompt strings to find the longest one ;; Loop over prompt strings to find the longest one
(mapc (function (mapc (lambda (prompt)
(lambda (prompt) (if (> (length prompt) width)
(if (> (length prompt) width) (setq width (length prompt))))
(setq width (length prompt)))))
prompts) prompts)
;; Insert the first widget out of the mapcar to leave the cursor ;; Insert the first widget out of the mapcar to leave the cursor
;; in the first field ;; in the first field
@ -949,14 +936,13 @@ queries the server for the existing fields and displays a corresponding form."
eudc-form-widget-list)) eudc-form-widget-list))
(setq fields (cdr fields)) (setq fields (cdr fields))
(setq prompts (cdr prompts)) (setq prompts (cdr prompts))
(mapc (function (mapc (lambda (field)
(lambda (field) (widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts)))
(widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts))) (setq widget (widget-create 'editable-field
(setq widget (widget-create 'editable-field :size 15))
:size 15)) (setq eudc-form-widget-list (cons (cons field widget)
(setq eudc-form-widget-list (cons (cons field widget) eudc-form-widget-list))
eudc-form-widget-list)) (setq prompts (cdr prompts)))
(setq prompts (cdr prompts))))
fields) fields)
(widget-insert "\n\n") (widget-insert "\n\n")
(widget-create 'push-button (widget-create 'push-button
@ -1118,27 +1104,26 @@ queries the server for the existing fields and displays a corresponding form."
(append (append
'("Server") '("Server")
(mapcar (mapcar
(function (lambda (servspec)
(lambda (servspec) (let* ((server (car servspec))
(let* ((server (car servspec)) (protocol (cdr servspec))
(protocol (cdr servspec)) (proto-name (symbol-name protocol)))
(proto-name (symbol-name protocol))) (setq command (intern (concat "eudc-set-server-"
(setq command (intern (concat "eudc-set-server-" server
server "-"
"-" proto-name)))
proto-name))) (if (not (fboundp command))
(if (not (fboundp command)) (fset command
(fset command `(lambda ()
`(lambda () (interactive)
(interactive) (eudc-set-server ,server (quote ,protocol))
(eudc-set-server ,server (quote ,protocol)) (message "Selected directory server is now %s (%s)"
(message "Selected directory server is now %s (%s)" ,server
,server ,proto-name))))
,proto-name)))) (vector (format "%s (%s)" server proto-name)
(vector (format "%s (%s)" server proto-name) command
command :style 'radio
:style 'radio :selected `(equal eudc-server ,server))))
:selected `(equal eudc-server ,server)))))
eudc-server-hotlist) eudc-server-hotlist)
eudc-server-menu)) eudc-server-menu))
eudc-tail-menu))) eudc-tail-menu)))

43
lisp/net/eudcb-bbdb.el
View file

@ -137,18 +137,17 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
(defun eudc-bbdb-extract-phones (record) (defun eudc-bbdb-extract-phones (record)
(require 'bbdb) (require 'bbdb)
(mapcar (function (mapcar (lambda (phone)
(lambda (phone) (if eudc-bbdb-use-locations-as-attribute-names
(if eudc-bbdb-use-locations-as-attribute-names (cons (intern (if (eudc--using-bbdb-3-or-newer-p)
(cons (intern (if (eudc--using-bbdb-3-or-newer-p) (bbdb-phone-label phone)
(bbdb-phone-label phone) (bbdb-phone-location phone)))
(bbdb-phone-location phone))) (bbdb-phone-string phone))
(bbdb-phone-string phone)) (cons 'phones (format "%s: %s"
(cons 'phones (format "%s: %s" (if (eudc--using-bbdb-3-or-newer-p)
(if (eudc--using-bbdb-3-or-newer-p) (bbdb-phone-label phone)
(bbdb-phone-label phone) (bbdb-phone-location phone))
(bbdb-phone-location phone)) (bbdb-phone-string phone)))))
(bbdb-phone-string phone))))))
(if (eudc--using-bbdb-3-or-newer-p) (if (eudc--using-bbdb-3-or-newer-p)
(bbdb-record-phone record) (bbdb-record-phone record)
(bbdb-record-phones record)))) (bbdb-record-phones record))))
@ -243,17 +242,15 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
(if (car query-attrs) (if (car query-attrs)
(setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs)))) (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
(setq query-attrs (cdr query-attrs))) (setq query-attrs (cdr query-attrs)))
(mapc (function (mapc (lambda (record)
(lambda (record) (setq filtered (eudc-filter-duplicate-attributes record))
(setq filtered (eudc-filter-duplicate-attributes record)) ;; If there were duplicate attributes reverse the order of the
;; If there were duplicate attributes reverse the order of the ;; record so the unique attributes appear first
;; record so the unique attributes appear first (if (> (length filtered) 1)
(if (> (length filtered) 1) (setq filtered (mapcar (lambda (rec)
(setq filtered (mapcar (function (reverse rec))
(lambda (rec) filtered)))
(reverse rec))) (setq result (append result filtered)))
filtered)))
(setq result (append result filtered))))
(delq nil (delq nil
(mapcar 'eudc-bbdb-format-record-as-result (mapcar 'eudc-bbdb-format-record-as-result
(delq nil (delq nil

83
lisp/net/mairix.el
View file

@ -631,14 +631,13 @@ See %s for details" mairix-output-buffer)))
(when (member 'flags mairix-widget-other) (when (member 'flags mairix-widget-other)
(setq flag (setq flag
(mapconcat (mapconcat
(function (lambda (flag)
(lambda (flag) (setq temp
(setq temp (widget-value (cadr (assoc (car flag) mairix-widgets))))
(widget-value (cadr (assoc (car flag) mairix-widgets)))) (if (string= "yes" temp)
(if (string= "yes" temp) (cadr flag)
(cadr flag) (if (string= "no" temp)
(if (string= "no" temp) (concat "-" (cadr flag)))))
(concat "-" (cadr flag))))))
'(("seen" "s") ("replied" "r") ("flagged" "f")) "")) '(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
(when (not (zerop (length flag))) (when (not (zerop (length flag)))
(push (concat "F:" flag) query))) (push (concat "F:" flag) query)))
@ -694,34 +693,33 @@ Fill in VALUES if based on an article."
VALUES may contain values for editable fields from current article." VALUES may contain values for editable fields from current article."
(let ((ret)) (let ((ret))
(mapc (mapc
(function (lambda (field)
(lambda (field) (setq field (car (cddr field)))
(setq field (car (cddr field))) (setq
(setq ret
ret (nconc
(nconc (list
(list (list
(list (concat "c" field)
(concat "c" field) (widget-create 'checkbox
(widget-create 'checkbox :tag field
:tag field :notify (lambda (widget &rest ignore)
:notify (lambda (widget &rest ignore) (mairix-widget-toggle-activate widget))
(mairix-widget-toggle-activate widget)) nil)))
nil))) (list
(list (list
(list (concat "e" field)
(concat "e" field) (widget-create 'editable-field
(widget-create 'editable-field :size 60
:size 60 :format (concat " " field ":"
:format (concat " " field ":" (make-string
(make-string (- 11 (length field)) ?\ )
(- 11 (length field)) ?\ ) "%v")
"%v") :value (or (cadr (assoc field values)) ""))))
:value (or (cadr (assoc field values)) "")))) ret))
ret)) (widget-insert "\n")
(widget-insert "\n") ;; Deactivate editable field
;; Deactivate editable field (widget-apply (cadr (nth 1 ret)) :deactivate))
(widget-apply (cadr (nth 1 ret)) :deactivate)))
mairix-widget-fields-list) mairix-widget-fields-list)
ret)) ret))
@ -936,13 +934,12 @@ Use cursor keys or C-n,C-p to select next/previous search.\n\n")
(save-excursion (save-excursion
(save-restriction (save-restriction
(mapcar (mapcar
(function (lambda (field)
(lambda (field) (list (car (cddr field))
(list (car (cddr field)) (if (car field)
(if (car field) (mairix-replace-invalid-chars
(mairix-replace-invalid-chars (funcall get-mail-header (car field)))
(funcall get-mail-header (car field))) nil)))
nil))))
mairix-widget-fields-list))) mairix-widget-fields-list)))
(error "No function for obtaining mail header specified")))) (error "No function for obtaining mail header specified"))))