[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master d88118d 03/12: Rewrite gmm-labels usage to use cl-l
|
From: |
Lars Ingebrigtsen |
|
Subject: |
[Emacs-diffs] master d88118d 03/12: Rewrite gmm-labels usage to use cl-labels |
|
Date: |
Sat, 13 Feb 2016 06:16:56 +0000 |
branch: master
commit d88118db37dd543536677d7c4212a2c67621fb88
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>
Rewrite gmm-labels usage to use cl-labels
* lisp/gnus/gmm-utils.el (gmm-tool-bar-style): Remove compat code.
(gmm-labels): Remove.
---
lisp/gnus/gmm-utils.el | 21 +---
lisp/gnus/gnus-icalendar.el | 293 +++++++++++++++++++++++--------------------
lisp/gnus/gnus-score.el | 4 +-
lisp/gnus/gnus-util.el | 3 +-
4 files changed, 165 insertions(+), 156 deletions(-)
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index a18b4c7..30bddef 100644
--- 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 17faac4..c684007 100644
--- 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 1a12a0f..22ff7b9 100644
--- 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 284f094..6ca0de3 100644
--- 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)))
- [Emacs-diffs] master updated (8a18bb1 -> 51ed8d5), Lars Ingebrigtsen, 2016/02/13
- [Emacs-diffs] master 97d76d9 01/12: Remove compat code from auth-source, Lars Ingebrigtsen, 2016/02/13
- [Emacs-diffs] master d919f56 02/12: Remove compat code from canlock.el, Lars Ingebrigtsen, 2016/02/13
- [Emacs-diffs] master d88118d 03/12: Rewrite gmm-labels usage to use cl-labels,
Lars Ingebrigtsen <=
- [Emacs-diffs] master c87f4a5 04/12: Remove compat code from gnus-agent.el, Lars Ingebrigtsen, 2016/02/13
- [Emacs-diffs] master 6dc0840 05/12: Remove compat code from gnus-art.el, Lars Ingebrigtsen, 2016/02/13
- [Emacs-diffs] master 95a1925 06/12: Remove compat code from gnus-cache and gnus-bookmark, Lars Ingebrigtsen, 2016/02/13
- [Emacs-diffs] master 983436d 07/12: Define gnus-diary-kill-entire-line unconditionally, Lars Ingebrigtsen, 2016/02/13
- [Emacs-diffs] master 9801227 08/12: Remove compat code from gnus-group.el, Lars Ingebrigtsen, 2016/02/13
- [Emacs-diffs] master fb5406a 09/12: Remove compat functions from gnus-html.el, Lars Ingebrigtsen, 2016/02/13
- [Emacs-diffs] master 8a1143b 10/12: Always use url-queue, Lars Ingebrigtsen, 2016/02/13
- [Emacs-diffs] master 7a42ebd 11/12: Fix compat change in last check-in, Lars Ingebrigtsen, 2016/02/13
- [Emacs-diffs] master 51ed8d5 12/12: Remove compat code from gnus-spec.el, Lars Ingebrigtsen, 2016/02/13