Rewrite gmm-labels usage to use cl-labels

* lisp/gnus/gmm-utils.el (gmm-tool-bar-style): Remove compat code.
(gmm-labels): Remove.

diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index a18b4c775393b9c8efe200c7b2b390965942070b..30bddef41233784bf9dd562b39c875cd5dc4f753 100644 (file)
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -196,10 +196,9 @@ This is a copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
 (defcustom gmm-tool-bar-style
   (if (and (boundp 'tool-bar-mode)
           tool-bar-mode
-          (and (fboundp 'display-visual-class)
-               (not (memq (display-visual-class)
-                          (list 'static-gray 'gray-scale
-                                'static-color 'pseudo-color)))))
+          (memq (display-visual-class)
+                (list 'static-gray 'gray-scale
+                      'static-color 'pseudo-color)))
       'gnome
     'retro)
   "Preferred tool bar style."
@@ -390,20 +389,6 @@ If mode is nil, use `major-mode' of the current buffer."
                 (string-match "^\\(.+\\)-mode$" mode)
                 (match-string 1 mode))))))
 
-;; `labels' is obsolete since Emacs 24.3.
-(defmacro gmm-labels (bindings &rest body)
-  "Make temporary function bindings.
-The bindings can be recursive and the scoping is lexical, but capturing
-them in closures will only work if `lexical-binding' is in use.  But in
-Emacs 24.2 and older, the lexical scoping is handled via `lexical-let'
-rather than relying on `lexical-binding'.
-
-\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
-  `(,(progn (require 'cl) (if (fboundp 'cl-labels) 'cl-labels 'labels))
-    ,bindings ,@body))
-(put 'gmm-labels 'lisp-indent-function 1)
-(put 'gmm-labels 'edebug-form-spec '((&rest (sexp sexp &rest form)) &rest form))
-
 (defun gmm-format-time-string (format-string &optional time tz)
   "Use FORMAT-STRING to format the time TIME, or now if omitted.
 The optional TZ specifies the time zone in a number of seconds; any

diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 17faac451a6a001b19f84754db1e83978fdb5129..c684007d7f3d98868d07ccbcd2a93a48983b4db3 100644 (file)
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -152,17 +152,19 @@
 (defun gnus-icalendar-event--find-attendee (ical name-or-email)
   (let* ((event (car (icalendar--all-events ical)))
          (event-props (caddr event)))
-    (gmm-labels ((attendee-name (att) (plist-get (cadr att) 'CN))
-                 (attendee-email (att)
-                   (replace-regexp-in-string "^.*MAILTO:" "" (caddr att)))
-                 (attendee-prop-matches-p (prop)
-                   (and (eq (car prop) 'ATTENDEE)
-                        (or (member (attendee-name prop) name-or-email)
-                            (let ((att-email (attendee-email prop)))
-                              (gnus-icalendar-find-if (lambda (email)
-                                                        (string-match email att-email))
-                                                      name-or-email))))))
-
+    (cl-labels ((attendee-name (att) (plist-get (cadr att) 'CN))
+               (attendee-email
+                (att)
+                (replace-regexp-in-string "^.*MAILTO:" "" (caddr att)))
+               (attendee-prop-matches-p
+                (prop)
+                (and (eq (car prop) 'ATTENDEE)
+                     (or (member (attendee-name prop) name-or-email)
+                         (let ((att-email (attendee-email prop)))
+                           (gnus-icalendar-find-if
+                            (lambda (email)
+                              (string-match email att-email))
+                            name-or-email))))))
       (gnus-icalendar-find-if #'attendee-prop-matches-p event-props))))
 
 (defun gnus-icalendar-event--get-attendee-names (ical)
@@ -171,17 +173,19 @@
                           (lambda (p) (eq (car p) 'ATTENDEE))
                           (caddr event))))
 
-    (gmm-labels ((attendee-role (prop) (plist-get (cadr prop) 'ROLE))
-                 (attendee-name (prop)
-                                (or (plist-get (cadr prop) 'CN)
-                                    (replace-regexp-in-string "^.*MAILTO:" "" (caddr prop))))
-                 (attendees-by-type (type)
-                   (gnus-remove-if-not
-                    (lambda (p) (string= (attendee-role p) type))
-                    attendee-props))
-                 (attendee-names-by-type (type)
-                    (mapcar #'attendee-name (attendees-by-type type))))
-
+    (cl-labels
+       ((attendee-role (prop) (plist-get (cadr prop) 'ROLE))
+        (attendee-name
+         (prop)
+         (or (plist-get (cadr prop) 'CN)
+             (replace-regexp-in-string "^.*MAILTO:" "" (caddr prop))))
+        (attendees-by-type (type)
+                           (gnus-remove-if-not
+                            (lambda (p) (string= (attendee-role p) type))
+                            attendee-props))
+        (attendee-names-by-type
+         (type)
+         (mapcar #'attendee-name (attendees-by-type type))))
       (list
        (attendee-names-by-type "REQ-PARTICIPANT")
        (attendee-names-by-type "OPT-PARTICIPANT")))))
@@ -220,23 +224,25 @@
                        ((string= method "REPLY") 'gnus-icalendar-event-reply)
                        (t 'gnus-icalendar-event))))
 
-    (gmm-labels ((map-property (prop)
-                   (let ((value (icalendar--get-event-property event prop)))
-                     (when value
-                       ;; ugly, but cannot get
-                       ;;replace-regexp-in-string work with "\\" as
-                       ;;REP, plus we should also handle "\\;"
-                       (replace-regexp-in-string
-                        "\\\\," ","
-                        (replace-regexp-in-string
-                         "\\\\n" "\n" (substring-no-properties value))))))
-                 (accumulate-args (mapping)
-                   (destructuring-bind (slot . ical-property) mapping
-                     (setq args (append (list
-                                         (intern (concat ":" (symbol-name slot)))
-                                         (map-property ical-property))
-                                        args)))))
-
+    (cl-labels
+       ((map-property
+         (prop)
+         (let ((value (icalendar--get-event-property event prop)))
+           (when value
+             ;; ugly, but cannot get
+             ;;replace-regexp-in-string work with "\\" as
+             ;;REP, plus we should also handle "\\;"
+             (replace-regexp-in-string
+              "\\\\," ","
+              (replace-regexp-in-string
+               "\\\\n" "\n" (substring-no-properties value))))))
+        (accumulate-args
+         (mapping)
+         (destructuring-bind (slot . ical-property) mapping
+           (setq args (append (list
+                               (intern (concat ":" (symbol-name slot)))
+                               (map-property ical-property))
+                              args)))))
       (mapc #'accumulate-args prop-map)
       (apply 'make-instance event-class args))))
 
@@ -264,41 +270,46 @@ status will be retrieved from the first matching attendee record."
   (let ((summary-status (capitalize (symbol-name status)))
         (attendee-status (upcase (symbol-name status)))
         reply-event-lines)
-    (gmm-labels ((update-summary (line)
-                   (if (string-match "^[^:]+:" line)
-                       (replace-match (format "\\&%s: " summary-status) t nil line)
-                     line))
-                 (update-dtstamp ()
-                   (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t))
-                 (attendee-matches-identity (line)
-                   (gnus-icalendar-find-if (lambda (name) (string-match-p name line))
-                                           identities))
-                 (update-attendee-status (line)
-                   (when (and (attendee-matches-identity line)
-                              (string-match "\\(PARTSTAT=\\)[^;]+" line))
-                     (replace-match (format "\\1%s" attendee-status) t nil line)))
-                 (process-event-line (line)
-                   (when (string-match "^\\([^;:]+\\)" line)
-                     (let* ((key (match-string 0 line))
-                            ;; NOTE: not all of the below fields are mandatory,
-                            ;; but they are often present in other clients'
-                            ;; replies. Can be helpful for debugging, too.
-                            (new-line
-                             (cond
-                              ((string= key "ATTENDEE") (update-attendee-status line))
-                              ((string= key "SUMMARY") (update-summary line))
-                              ((string= key "DTSTAMP") (update-dtstamp))
-                              ((member key '("ORGANIZER" "DTSTART" "DTEND"
-                                             "LOCATION" "DURATION" "SEQUENCE"
-                                             "RECURRENCE-ID" "UID")) line)
-                              (t nil))))
-                       (when new-line
-                         (push new-line reply-event-lines))))))
+    (cl-labels
+       ((update-summary
+         (line)
+         (if (string-match "^[^:]+:" line)
+             (replace-match (format "\\&%s: " summary-status) t nil line)
+           line))
+        (update-dtstamp ()
+                        (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t))
+        (attendee-matches-identity
+         (line)
+         (gnus-icalendar-find-if (lambda (name) (string-match-p name line))
+                                 identities))
+        (update-attendee-status
+         (line)
+         (when (and (attendee-matches-identity line)
+                    (string-match "\\(PARTSTAT=\\)[^;]+" line))
+           (replace-match (format "\\1%s" attendee-status) t nil line)))
+        (process-event-line
+         (line)
+         (when (string-match "^\\([^;:]+\\)" line)
+           (let* ((key (match-string 0 line))
+                  ;; NOTE: not all of the below fields are mandatory,
+                  ;; but they are often present in other clients'
+                  ;; replies. Can be helpful for debugging, too.
+                  (new-line
+                   (cond
+                    ((string= key "ATTENDEE") (update-attendee-status line))
+                    ((string= key "SUMMARY") (update-summary line))
+                    ((string= key "DTSTAMP") (update-dtstamp))
+                    ((member key '("ORGANIZER" "DTSTART" "DTEND"
+                                   "LOCATION" "DURATION" "SEQUENCE"
+                                   "RECURRENCE-ID" "UID")) line)
+                    (t nil))))
+             (when new-line
+               (push new-line reply-event-lines))))))
 
       (mapc #'process-event-line (split-string ical-request "\n"))
 
       (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x))
-                          reply-event-lines)
+                                     reply-event-lines)
         (error "Could not find an event attendee matching given identity"))
 
       (mapconcat #'identity `("BEGIN:VEVENT"
@@ -311,16 +322,17 @@ status will be retrieved from the first matching attendee record."
 The reply will have STATUS (`accepted', `tentative' or  `declined').
 The reply will be composed for attendees matching any entry
 on the IDENTITIES list."
-  (gmm-labels ((extract-block (blockname)
-               (save-excursion
-                 (let ((block-start-re (format "^BEGIN:%s" blockname))
-                       (block-end-re (format "^END:%s" blockname))
-                       start)
-                   (when (re-search-forward block-start-re nil t)
-                     (setq start (line-beginning-position))
-                     (re-search-forward block-end-re)
-                     (buffer-substring-no-properties start (line-end-position)))))))
-
+  (cl-labels
+      ((extract-block
+       (blockname)
+       (save-excursion
+         (let ((block-start-re (format "^BEGIN:%s" blockname))
+               (block-end-re (format "^END:%s" blockname))
+               start)
+           (when (re-search-forward block-start-re nil t)
+             (setq start (line-beginning-position))
+             (re-search-forward block-end-re)
+             (buffer-substring-no-properties start (line-end-position)))))))
     (let (zone event)
       (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf))
         (goto-char (point-min))
@@ -497,16 +509,17 @@ the optional ORG-FILE argument is specified, only that one file
 is searched."
   (let ((uid (gnus-icalendar-event:uid event))
         (files (or org-file (org-agenda-files t 'ifmode))))
-    (gmm-labels
-        ((find-event-in (file)
-           (org-check-agenda-file file)
-           (with-current-buffer (find-file-noselect file)
-             (let ((event-pos (org-find-entry-with-id uid)))
-               (when (and event-pos
-                          (string= (cdr (assoc "ICAL_EVENT" (org-entry-properties event-pos)))
-                                   "t"))
-                 (throw 'found file))))))
-
+    (cl-labels
+        ((find-event-in
+         (file)
+         (org-check-agenda-file file)
+         (with-current-buffer (find-file-noselect file)
+           (let ((event-pos (org-find-entry-with-id uid)))
+             (when (and event-pos
+                        (string= (cdr (assoc "ICAL_EVENT"
+                                             (org-entry-properties event-pos)))
+                                 "t"))
+               (throw 'found file))))))
       (gnus-icalendar-find-if #'find-event-in files))))
 
 
@@ -566,22 +579,29 @@ is searched."
                     (fill-region (point-min) (point-max))))
 
                 ;; update entry properties
-                (gmm-labels
-                    ((update-org-entry (position property value)
-                                       (if (or (null value)
-                                               (string= value ""))
-                                           (org-entry-delete position property)
-                                         (org-entry-put position property value))))
+                (cl-labels
+                    ((update-org-entry
+                     (position property value)
+                     (if (or (null value)
+                             (string= value ""))
+                         (org-entry-delete position property)
+                       (org-entry-put position property value))))
 
                   (update-org-entry event-pos "ORGANIZER" organizer)
                   (update-org-entry event-pos "LOCATION" location)
-                  (update-org-entry event-pos "PARTICIPATION_TYPE" (symbol-name participation-type))
-                  (update-org-entry event-pos "REQ_PARTICIPANTS" (gnus-icalendar--format-participant-list req-participants))
-                  (update-org-entry event-pos "OPT_PARTICIPANTS" (gnus-icalendar--format-participant-list opt-participants))
+                  (update-org-entry event-pos "PARTICIPATION_TYPE"
+                                   (symbol-name participation-type))
+                  (update-org-entry event-pos "REQ_PARTICIPANTS"
+                                   (gnus-icalendar--format-participant-list
+                                    req-participants))
+                  (update-org-entry event-pos "OPT_PARTICIPANTS"
+                                   (gnus-icalendar--format-participant-list
+                                    opt-participants))
                   (update-org-entry event-pos "RRULE" recur)
-                  (update-org-entry event-pos "REPLY"
-                                    (if reply-status (capitalize (symbol-name reply-status))
-                                      "Not replied yet")))
+                  (update-org-entry
+                  event-pos "REPLY"
+                  (if reply-status (capitalize (symbol-name reply-status))
+                    "Not replied yet")))
                 (save-buffer)))))))))
 
 
@@ -714,30 +734,31 @@ These will be used to retrieve the RSVP information from ical events."
 ;; TODO: make the template customizable
 (cl-defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event) &optional reply-status)
   "Format an overview of EVENT details."
-  (gmm-labels ((format-header (x)
-            (format "%-12s%s"
-                    (propertize (concat (car x) ":") 'face 'bold)
-                    (cadr x))))
+  (cl-labels
+      ((format-header (x)
+                     (format "%-12s%s"
+                             (propertize (concat (car x) ":") 'face 'bold)
+                             (cadr x))))
 
     (with-slots (organizer summary description location recur uid
                            method rsvp participation-type) event
       (let ((headers `(("Summary" ,summary)
-                      ("Location" ,(or location ""))
-                      ("Time" ,(gnus-icalendar-event:org-timestamp event))
-                      ("Organizer" ,organizer)
-                      ("Attendance" ,(if (eq participation-type 'non-participant)
-                                         "You are not listed as an attendee"
-                                       (capitalize (symbol-name participation-type))))
-                      ("Method" ,method))))
-
-       (when (and (not (gnus-icalendar-event-reply-p event)) rsvp)
-         (setq headers (append headers
-                               `(("Status" ,(or reply-status "Not replied yet"))))))
-
-       (concat
-        (mapconcat #'format-header headers "\n")
-        "\n\n"
-        description)))))
+                      ("Location" ,(or location ""))
+                      ("Time" ,(gnus-icalendar-event:org-timestamp event))
+                      ("Organizer" ,organizer)
+                      ("Attendance" ,(if (eq participation-type 'non-participant)
+                                         "You are not listed as an attendee"
+                                       (capitalize (symbol-name participation-type))))
+                      ("Method" ,method))))
+
+       (when (and (not (gnus-icalendar-event-reply-p event)) rsvp)
+         (setq headers (append headers
+                               `(("Status" ,(or reply-status "Not replied yet"))))))
+
+       (concat
+        (mapconcat #'format-header headers "\n")
+        "\n\n"
+        description)))))
 
 (defmacro gnus-icalendar-with-decoded-handle (handle &rest body)
   "Execute BODY in buffer containing the decoded contents of HANDLE."
@@ -793,11 +814,13 @@ These will be used to retrieve the RSVP information from ical events."
                    (current-buffer) status (gnus-icalendar-identities)))))
 
     (when reply
-      (gmm-labels ((fold-icalendar-buffer ()
-               (goto-char (point-min))
-               (while (re-search-forward "^\\(.\\{72\\}\\)\\(.+\\)$" nil t)
-                 (replace-match "\\1\n \\2")
-                 (goto-char (line-beginning-position)))))
+      (cl-labels
+         ((fold-icalendar-buffer
+           ()
+           (goto-char (point-min))
+           (while (re-search-forward "^\\(.\\{72\\}\\)\\(.+\\)$" nil t)
+             (replace-match "\\1\n \\2")
+             (goto-char (line-beginning-position)))))
         (let ((subject (concat (capitalize (symbol-name status))
                                ": " (gnus-icalendar-event:summary event))))
 
@@ -867,13 +890,15 @@ These will be used to retrieve the RSVP information from ical events."
     (setq gnus-icalendar-reply-status nil)
 
     (when event
-      (gmm-labels ((insert-button-group (buttons)
-                (when buttons
-                  (mapc (lambda (x)
-                          (apply 'gnus-icalendar-insert-button x)
-                          (insert "    "))
-                        buttons)
-                  (insert "\n\n"))))
+      (cl-labels
+         ((insert-button-group
+           (buttons)
+           (when buttons
+             (mapc (lambda (x)
+                     (apply 'gnus-icalendar-insert-button x)
+                     (insert "    "))
+                   buttons)
+             (insert "\n\n"))))
 
         (insert-button-group
         (gnus-icalendar-event:inline-reply-buttons event handle))

diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 1a12a0fc3731724643d9b25638a7bc7b9961880d..22ff7b9eba3d3f8c42912d90bc7901c51ecf33c3 100644 (file)
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1727,7 +1727,7 @@ score in `gnus-newsgroup-scored' by SCORE."
   nil)
 
 (defun gnus-score-decode-text-parts ()
-  (gmm-labels
+  (cl-labels
       ((mm-text-parts
        (handle)
        (cond ((stringp (car handle))
@@ -1751,7 +1751,7 @@ score in `gnus-newsgroup-scored' by SCORE."
            (mm-display-inline handle)
            (goto-char (point-max))))))
 
-    (let (;(mm-text-html-renderer 'w3m-standalone)
+    (let (                   ;(mm-text-html-renderer 'w3m-standalone)
          (handles (mm-dissect-buffer t)))
       (save-excursion
        (article-goto-body)

diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 284f094f7a5e29a11b4b8d7914cea635ca71c4a3..6ca0de3cf5479f848a94348e7b2292de19078028 100644 (file)
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1748,12 +1748,11 @@ Sizes are in pixels."
                    image)))
       image)))
 
-(eval-when-compile (require 'gmm-utils))
 (defun gnus-recursive-directory-files (dir)
   "Return all regular files below DIR.
 The first found will be returned if a file has hard or symbolic links."
   (let (files attr attrs)
-    (gmm-labels
+    (cl-labels
        ((fn (directory)
             (dolist (file (directory-files directory t))
               (setq attr (file-attributes (file-truename file)))