[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 9191c82 2/2: Don't quote lambdas in net/*.el
|
From: |
Stefan Kangas |
|
Subject: |
master 9191c82 2/2: Don't quote lambdas in net/*.el |
|
Date: |
Mon, 16 Nov 2020 12:52:58 -0500 (EST) |
branch: master
commit 9191c82f6d69340ce231a41c61594e1b9b9b51aa
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>
Don't quote lambdas in net/*.el
* 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.
---
lisp/net/eudc-export.el | 11 +--
lisp/net/eudc.el | 237 +++++++++++++++++++++++-------------------------
lisp/net/eudcb-bbdb.el | 43 ++++-----
lisp/net/mairix.el | 83 ++++++++---------
4 files changed, 176 insertions(+), 198 deletions(-)
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index ba86958..5c96628 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -78,12 +78,11 @@ If SILENT is non-nil then the created BBDB record is not
displayed."
record t)))
;; BBDB custom fields
(setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes)))
- (mapcar (function
- (lambda (mapping)
- (if (and (not (memq (car mapping)
- '(name company
net address phone notes)))
- (setq value (eudc-parse-spec
(cdr mapping) record nil)))
- (cons (car mapping) value))))
+ (mapcar (lambda (mapping)
+ (if (and (not (memq (car mapping)
+ '(name company
net address phone notes)))
+ (setq value (eudc-parse-spec
(cdr mapping) record nil)))
+ (cons (car mapping) value)))
conversion-alist)))
(setq bbdb-notes (delq nil bbdb-notes))
(setq bbdb-record (bbdb-create-internal
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 08cab4f..f4e4c17 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -414,10 +414,9 @@ if any, is called to print the value in cdr of FIELD."
(eval (list (cdr match) val))
(insert "\n"))
(mapc
- (function
- (lambda (val-elem)
- (indent-to col)
- (insert val-elem "\n")))
+ (lambda (val-elem)
+ (indent-to col)
+ (insert val-elem "\n"))
(cond
((listp val) val)
((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
(setq precords
(mapcar
- (function
- (lambda (record)
- (mapcar
- (function
- (lambda (field)
- (setq attribute-name
- (if raw-attr-names
- (symbol-name (car field))
- (eudc-format-attribute-name-for-display (car
field))))
- (if (> (length attribute-name) width)
- (setq width (length attribute-name)))
- (cons attribute-name (cdr field))))
- record)))
+ (lambda (record)
+ (mapcar
+ (lambda (field)
+ (setq attribute-name
+ (if raw-attr-names
+ (symbol-name (car field))
+ (eudc-format-attribute-name-for-display (car
field))))
+ (if (> (length attribute-name) width)
+ (setq width (length attribute-name)))
+ (cons attribute-name (cdr field)))
+ record))
records))
;; Display the records
(setq first-record (point))
(mapc
- (function
- (lambda (record)
- (setq beg (point))
- ;; Map over the record fields to print the attribute/value pairs
- (mapc (function
- (lambda (field)
- (eudc-print-record-field field width)))
- record)
- ;; Store the record internal format in some convenient place
- (overlay-put (make-overlay beg (point))
- 'eudc-record
- (car records))
- (setq records (cdr records))
- (insert "\n")))
+ (lambda (record)
+ (setq beg (point))
+ ;; Map over the record fields to print the attribute/value pairs
+ (mapc (lambda (field)
+ (eudc-print-record-field field width))
+ record)
+ ;; Store the record internal format in some convenient place
+ (overlay-put (make-overlay beg (point))
+ 'eudc-record
+ (car records))
+ (setq records (cdr records))
+ (insert "\n"))
precords))
(insert "\n")
(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)
eudc-form-widget-list))
(error "Not in a directory query form buffer")
- (mapc (function
- (lambda (wid-field)
- (setq value (widget-value (cdr wid-field)))
- (if (not (string= value ""))
- (setq query-alist (cons (cons (car wid-field) value)
- query-alist)))))
+ (mapc (lambda (wid-field)
+ (setq value (widget-value (cdr wid-field)))
+ (if (not (string= value ""))
+ (setq query-alist (cons (cons (car wid-field) value)
+ query-alist))))
eudc-form-widget-list)
(kill-buffer (current-buffer))
(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))
(list record) ; No duplicate attrs in this record
- (mapc (function
- (lambda (field)
- (if (listp (cdr field))
- (setq duplicates (cons field duplicates))
- (setq unique (cons field unique)))))
+ (mapc (lambda (field)
+ (if (listp (cdr field))
+ (setq duplicates (cons field duplicates))
+ (setq unique (cons field unique))))
record)
(setq result (list unique))
;; Map over the record fields that have multiple values
(mapc
- (function
- (lambda (field)
- (let ((method (if (consp eudc-duplicate-attribute-handling-method)
- (cdr
- (assq
- (or
- (car
- (rassq
- (car field)
- (symbol-value
- eudc-protocol-attributes-translation-alist)))
- (car field))
- eudc-duplicate-attribute-handling-method))
- eudc-duplicate-attribute-handling-method)))
- (cond
- ((or (null method) (eq 'list method))
- (setq result
- (eudc-add-field-to-records field result)))
- ((eq 'first method)
- (setq result
- (eudc-add-field-to-records (cons (car field)
- (cadr field))
- result)))
- ((eq 'concat method)
- (setq result
- (eudc-add-field-to-records (cons (car field)
- (mapconcat
- #'identity
- (cdr field)
- "\n"))
- result)))
- ((eq 'duplicate method)
- (setq result
- (eudc-distribute-field-on-records field result)))))))
+ (lambda (field)
+ (let ((method (if (consp eudc-duplicate-attribute-handling-method)
+ (cdr
+ (assq
+ (or
+ (car
+ (rassq
+ (car field)
+ (symbol-value
+ eudc-protocol-attributes-translation-alist)))
+ (car field))
+ eudc-duplicate-attribute-handling-method))
+ eudc-duplicate-attribute-handling-method)))
+ (cond
+ ((or (null method) (eq 'list method))
+ (setq result
+ (eudc-add-field-to-records field result)))
+ ((eq 'first method)
+ (setq result
+ (eudc-add-field-to-records (cons (car field)
+ (cadr field))
+ result)))
+ ((eq 'concat method)
+ (setq result
+ (eudc-add-field-to-records (cons (car field)
+ (mapconcat
+ #'identity
+ (cdr field)
+ "\n"))
+ result)))
+ ((eq 'duplicate method)
+ (setq result
+ (eudc-distribute-field-on-records field result))))))
duplicates)
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."
(delq nil
(mapcar
- (function
- (lambda (rec)
- (if (cl-every (lambda (attr)
- (consp (assq attr rec)))
- attrs)
- rec)))
+ (lambda (rec)
+ (if (cl-every (lambda (attr)
+ (consp (assq attr rec)))
+ attrs)
+ rec))
records)))
(defun eudc-add-field-to-records (field records)
"Add FIELD to each individual record in RECORDS and return the resulting
list."
- (mapcar (function
- (lambda (r)
- (cons field r)))
+ (mapcar (lambda (r)
+ (cons field r))
records))
(defun eudc-distribute-field-on-records (field records)
@@ -886,10 +876,9 @@ see `eudc-inline-expansion-servers'."
(let ((response-string
(apply #'format
(car eudc-inline-expansion-format)
- (mapcar (function
- (lambda (field)
- (or (cdr (assq field r))
- "")))
+ (mapcar (lambda (field)
+ (or (cdr (assq field r))
+ ""))
(eudc-translate-attribute-list
(cdr eudc-inline-expansion-format))))))
(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
(setq prompts (if eudc-use-raw-directory-names
(mapcar #'symbol-name (eudc-translate-attribute-list
fields))
- (mapcar (function
- (lambda (field)
- (or (cdr (assq field
eudc-user-attribute-names-alist))
- (capitalize (symbol-name field)))))
+ (mapcar (lambda (field)
+ (or (cdr (assq field
eudc-user-attribute-names-alist))
+ (capitalize (symbol-name field))))
fields)))
;; Loop over prompt strings to find the longest one
- (mapc (function
- (lambda (prompt)
- (if (> (length prompt) width)
- (setq width (length prompt)))))
+ (mapc (lambda (prompt)
+ (if (> (length prompt) width)
+ (setq width (length prompt))))
prompts)
;; Insert the first widget out of the mapcar to leave the cursor
;; in the first field
@@ -949,14 +936,13 @@ queries the server for the existing fields and displays a
corresponding form."
eudc-form-widget-list))
(setq fields (cdr fields))
(setq prompts (cdr prompts))
- (mapc (function
- (lambda (field)
- (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)
- eudc-form-widget-list))
- (setq prompts (cdr prompts))))
+ (mapc (lambda (field)
+ (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)
+ eudc-form-widget-list))
+ (setq prompts (cdr prompts)))
fields)
(widget-insert "\n\n")
(widget-create 'push-button
@@ -1118,27 +1104,26 @@ queries the server for the existing fields and displays
a corresponding form."
(append
'("Server")
(mapcar
- (function
- (lambda (servspec)
- (let* ((server (car servspec))
- (protocol (cdr servspec))
- (proto-name (symbol-name protocol)))
- (setq command (intern (concat "eudc-set-server-"
- server
- "-"
- proto-name)))
- (if (not (fboundp command))
- (fset command
- `(lambda ()
- (interactive)
- (eudc-set-server ,server (quote ,protocol))
- (message "Selected directory server is now %s
(%s)"
- ,server
- ,proto-name))))
- (vector (format "%s (%s)" server proto-name)
- command
- :style 'radio
- :selected `(equal eudc-server ,server)))))
+ (lambda (servspec)
+ (let* ((server (car servspec))
+ (protocol (cdr servspec))
+ (proto-name (symbol-name protocol)))
+ (setq command (intern (concat "eudc-set-server-"
+ server
+ "-"
+ proto-name)))
+ (if (not (fboundp command))
+ (fset command
+ `(lambda ()
+ (interactive)
+ (eudc-set-server ,server (quote ,protocol))
+ (message "Selected directory server is now %s
(%s)"
+ ,server
+ ,proto-name))))
+ (vector (format "%s (%s)" server proto-name)
+ command
+ :style 'radio
+ :selected `(equal eudc-server ,server))))
eudc-server-hotlist)
eudc-server-menu))
eudc-tail-menu)))
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index 82e58c2..5d6b52a 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -137,18 +137,17 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
(defun eudc-bbdb-extract-phones (record)
(require 'bbdb)
- (mapcar (function
- (lambda (phone)
- (if eudc-bbdb-use-locations-as-attribute-names
- (cons (intern (if (eudc--using-bbdb-3-or-newer-p)
- (bbdb-phone-label phone)
- (bbdb-phone-location phone)))
- (bbdb-phone-string phone))
- (cons 'phones (format "%s: %s"
- (if (eudc--using-bbdb-3-or-newer-p)
- (bbdb-phone-label phone)
- (bbdb-phone-location phone))
- (bbdb-phone-string phone))))))
+ (mapcar (lambda (phone)
+ (if eudc-bbdb-use-locations-as-attribute-names
+ (cons (intern (if (eudc--using-bbdb-3-or-newer-p)
+ (bbdb-phone-label phone)
+ (bbdb-phone-location phone)))
+ (bbdb-phone-string phone))
+ (cons 'phones (format "%s: %s"
+ (if (eudc--using-bbdb-3-or-newer-p)
+ (bbdb-phone-label phone)
+ (bbdb-phone-location phone))
+ (bbdb-phone-string phone)))))
(if (eudc--using-bbdb-3-or-newer-p)
(bbdb-record-phone record)
(bbdb-record-phones record))))
@@ -243,17 +242,15 @@ RETURN-ATTRS is a list of attributes to return,
defaulting to
(if (car query-attrs)
(setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
(setq query-attrs (cdr query-attrs)))
- (mapc (function
- (lambda (record)
- (setq filtered (eudc-filter-duplicate-attributes record))
- ;; If there were duplicate attributes reverse the order of the
- ;; record so the unique attributes appear first
- (if (> (length filtered) 1)
- (setq filtered (mapcar (function
- (lambda (rec)
- (reverse rec)))
- filtered)))
- (setq result (append result filtered))))
+ (mapc (lambda (record)
+ (setq filtered (eudc-filter-duplicate-attributes record))
+ ;; If there were duplicate attributes reverse the order of the
+ ;; record so the unique attributes appear first
+ (if (> (length filtered) 1)
+ (setq filtered (mapcar (lambda (rec)
+ (reverse rec))
+ filtered)))
+ (setq result (append result filtered)))
(delq nil
(mapcar 'eudc-bbdb-format-record-as-result
(delq nil
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index 8218249..5571b2a 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -631,14 +631,13 @@ See %s for details" mairix-output-buffer)))
(when (member 'flags mairix-widget-other)
(setq flag
(mapconcat
- (function
- (lambda (flag)
- (setq temp
- (widget-value (cadr (assoc (car flag) mairix-widgets))))
- (if (string= "yes" temp)
- (cadr flag)
- (if (string= "no" temp)
- (concat "-" (cadr flag))))))
+ (lambda (flag)
+ (setq temp
+ (widget-value (cadr (assoc (car flag) mairix-widgets))))
+ (if (string= "yes" temp)
+ (cadr flag)
+ (if (string= "no" temp)
+ (concat "-" (cadr flag)))))
'(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
(when (not (zerop (length flag)))
(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."
(let ((ret))
(mapc
- (function
- (lambda (field)
- (setq field (car (cddr field)))
- (setq
- ret
- (nconc
- (list
- (list
- (concat "c" field)
- (widget-create 'checkbox
- :tag field
- :notify (lambda (widget &rest ignore)
- (mairix-widget-toggle-activate widget))
- nil)))
- (list
- (list
- (concat "e" field)
- (widget-create 'editable-field
- :size 60
- :format (concat " " field ":"
- (make-string
- (- 11 (length field)) ?\ )
- "%v")
- :value (or (cadr (assoc field values)) ""))))
- ret))
- (widget-insert "\n")
- ;; Deactivate editable field
- (widget-apply (cadr (nth 1 ret)) :deactivate)))
+ (lambda (field)
+ (setq field (car (cddr field)))
+ (setq
+ ret
+ (nconc
+ (list
+ (list
+ (concat "c" field)
+ (widget-create 'checkbox
+ :tag field
+ :notify (lambda (widget &rest ignore)
+ (mairix-widget-toggle-activate widget))
+ nil)))
+ (list
+ (list
+ (concat "e" field)
+ (widget-create 'editable-field
+ :size 60
+ :format (concat " " field ":"
+ (make-string
+ (- 11 (length field)) ?\ )
+ "%v")
+ :value (or (cadr (assoc field values)) ""))))
+ ret))
+ (widget-insert "\n")
+ ;; Deactivate editable field
+ (widget-apply (cadr (nth 1 ret)) :deactivate))
mairix-widget-fields-list)
ret))
@@ -936,13 +934,12 @@ Use cursor keys or C-n,C-p to select next/previous
search.\n\n")
(save-excursion
(save-restriction
(mapcar
- (function
- (lambda (field)
- (list (car (cddr field))
- (if (car field)
- (mairix-replace-invalid-chars
- (funcall get-mail-header (car field)))
- nil))))
+ (lambda (field)
+ (list (car (cddr field))
+ (if (car field)
+ (mairix-replace-invalid-chars
+ (funcall get-mail-header (car field)))
+ nil)))
mairix-widget-fields-list)))
(error "No function for obtaining mail header specified"))))