------------------------------------------------------------ revno: 117001 committer: Daniel Colascione branch nick: trunk timestamp: Sun 2014-04-20 18:28:55 -0700 message: Fix cl-the test diff: === modified file 'test/ChangeLog' --- test/ChangeLog 2014-04-21 01:03:39 +0000 +++ test/ChangeLog 2014-04-21 01:28:55 +0000 @@ -1,6 +1,7 @@ 2014-04-21 Daniel Colascione * automated/cl-lib.el (cl-loop-destructuring-with): New test. + (cl-the): Fix cl-the test. 2014-04-20 Daniel Colascione === modified file 'test/automated/cl-lib.el' --- test/automated/cl-lib.el 2014-04-21 01:03:39 +0000 +++ test/automated/cl-lib.el 2014-04-21 01:28:55 +0000 @@ -214,11 +214,11 @@ '((cl-tag-slot) (abc :readonly t) (def)))))) (ert-deftest cl-the () - (should (eql (the integer 42) 42)) - (should-error (the integer "abc")) - (let ((sideffect 0)) - (should (= (the integer (incf sideffect)) 1)) - (should (= sideffect 1)))) + (should (eql (cl-the integer 42) 42)) + (should-error (cl-the integer "abc")) + (let ((side-effect 0)) + (should (= (cl-the integer (cl-incf side-effect)) 1)) + (should (= side-effect 1)))) (ert-deftest cl-loop-destructuring-with () (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6))) ------------------------------------------------------------ revno: 117000 committer: Daniel Colascione branch nick: trunk timestamp: Sun 2014-04-20 18:03:39 -0700 message: Fix cl-loop destructuring under `with' clause diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-20 23:24:04 +0000 +++ lisp/ChangeLog 2014-04-21 01:03:39 +0000 @@ -1,3 +1,8 @@ +2014-04-21 Daniel Colascione + + * emacs-lisp/cl-macs.el: + (cl--loop-let): Properly destructure `while' clauses. + 2014-04-20 Daniel Colascione * vc/vc.el (vc-root-dir): New public autoloaded function for === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2014-04-20 14:46:13 +0000 +++ lisp/emacs-lisp/cl-macs.el 2014-04-21 01:03:39 +0000 @@ -1550,7 +1550,7 @@ (if (and (cl--unused-var-p temp) (null expr)) nil ;; Don't bother declaring/setting `temp' since it won't ;; be used when `expr' is nil, anyway. - (when (and (eq body 'setq) (cl--unused-var-p temp)) + (when (cl--unused-var-p temp) ;; Prefer a fresh uninterned symbol over "_to", to avoid ;; warnings that we set an unused variable. (setq temp (make-symbol "--cl-var--")) === modified file 'test/ChangeLog' --- test/ChangeLog 2014-04-20 02:34:22 +0000 +++ test/ChangeLog 2014-04-21 01:03:39 +0000 @@ -1,3 +1,7 @@ +2014-04-21 Daniel Colascione + + * automated/cl-lib.el (cl-loop-destructuring-with): New test. + 2014-04-20 Daniel Colascione * automated/cl-lib.el (cl-lib-struct-accessors,cl-the): New tests. === modified file 'test/automated/cl-lib.el' --- test/automated/cl-lib.el 2014-04-20 02:34:22 +0000 +++ test/automated/cl-lib.el 2014-04-21 01:03:39 +0000 @@ -220,4 +220,7 @@ (should (= (the integer (incf sideffect)) 1)) (should (= sideffect 1)))) +(ert-deftest cl-loop-destructuring-with () + (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6))) + ;;; cl-lib.el ends here ------------------------------------------------------------ revno: 116999 committer: Daniel Colascione branch nick: trunk timestamp: Sun 2014-04-20 16:24:04 -0700 message: Provide function for asking vc about project root diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-20 02:34:22 +0000 +++ lisp/ChangeLog 2014-04-20 23:24:04 +0000 @@ -1,5 +1,13 @@ 2014-04-20 Daniel Colascione + * vc/vc.el (vc-root-dir): New public autoloaded function for + generically finding the current VC root. + * vc/vc-hooks.el (vc-not-supported): New error. + (vc-call-backend): Signal `vc-not-supported' instead of generic + error. + +2014-04-20 Daniel Colascione + * emacs-lisp/cl-macs.el (cl-the): Make `cl-the' assert its type argument. (cl--const-expr-val): cl--const-expr-val should macroexpand its === modified file 'lisp/vc/vc-hooks.el' --- lisp/vc/vc-hooks.el 2014-01-01 07:43:34 +0000 +++ lisp/vc/vc-hooks.el 2014-04-20 23:24:04 +0000 @@ -190,6 +190,11 @@ (make-variable-buffer-local 'vc-mode) (put 'vc-mode 'permanent-local t) +;;; We signal this error when we try to do something a VC backend +;;; doesn't support. Two arguments: the method that's not supported +;;; and the backend +(define-error 'vc-not-supported "VC method not implemented for backend") + (defun vc-mode (&optional _arg) ;; Dummy function for C-h m "Version Control minor mode. @@ -268,10 +273,10 @@ (setq f (vc-find-backend-function backend function-name)) (push (cons function-name f) (get backend 'vc-functions))) (cond - ((null f) - (error "Sorry, %s is not implemented for %s" function-name backend)) - ((consp f) (apply (car f) (cdr f) args)) - (t (apply f args))))) + ((null f) + (signal 'vc-not-supported (list function-name backend))) + ((consp f) (apply (car f) (cdr f) args)) + (t (apply f args))))) (defmacro vc-call (fun file &rest args) "A convenience macro for calling VC backend functions. === modified file 'lisp/vc/vc.el' --- lisp/vc/vc.el 2014-03-23 18:13:35 +0000 +++ lisp/vc/vc.el 2014-04-20 23:24:04 +0000 @@ -1879,6 +1879,19 @@ (called-interactively-p 'interactive)))))) ;;;###autoload +(defun vc-root-dir () + "Return the root directory for the current VC tree. +Return nil if the root directory cannot be identified." + (let ((backend (vc-deduce-backend))) + (if backend + (condition-case err + (vc-call-backend backend 'root default-directory) + (vc-not-supported + (unless (eq (cadr err) 'root) + (signal (car err) (cdr err))) + nil))))) + +;;;###autoload (defun vc-revision-other-window (rev) "Visit revision REV of the current file in another window. If the current file is named `F', the revision is named `F.~REV~'. ------------------------------------------------------------ revno: 116998 committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2014-04-20 22:35:24 +0000 message: lisp/gnus/gnus-icalendar.el: Silence the byte compiler diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2014-04-20 22:10:33 +0000 +++ lisp/gnus/ChangeLog 2014-04-20 22:35:24 +0000 @@ -1,3 +1,7 @@ +2014-04-20 Katsumi Yamaoka + + * gnus-icalendar.el: Require gnus-art. + 2014-04-20 Jan Tatarik * gnus-icalendar.el (gnus-icalendar-event->org-entry) === modified file 'lisp/gnus/gnus-icalendar.el' --- lisp/gnus/gnus-icalendar.el 2014-04-20 22:10:33 +0000 +++ lisp/gnus/gnus-icalendar.el 2014-04-20 22:35:24 +0000 @@ -38,6 +38,7 @@ (require 'gmm-utils) (require 'mm-decode) (require 'gnus-sum) +(require 'gnus-art) (eval-when-compile (require 'cl)) ------------------------------------------------------------ revno: 116997 author: Jan Tatarik committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2014-04-20 22:10:33 +0000 message: * gnus-icalendar.el (gnus-icalendar-event->org-entry) (gnus-icalendar--update-org-event): put event timestamp in the org entry body instead of the drawer. (gnus-icalendar-event--get-attendee-names): list of participants should contain even attendees without common name attribute. (gnus-icalendar--update-org-event): don't generate duplicates of empty property tags in org drawers. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2014-04-15 23:37:21 +0000 +++ lisp/gnus/ChangeLog 2014-04-20 22:10:33 +0000 @@ -1,3 +1,13 @@ +2014-04-20 Jan Tatarik + + * gnus-icalendar.el (gnus-icalendar-event->org-entry) + (gnus-icalendar--update-org-event): put event timestamp in + the org entry body instead of the drawer. + (gnus-icalendar-event--get-attendee-names): list of participants should + contain even attendees without common name attribute. + (gnus-icalendar--update-org-event): don't generate duplicates of empty + property tags in org drawers. + 2014-04-15 Katsumi Yamaoka * gmm-utils.el (gmm-format-time-string): New function. === modified file 'lisp/gnus/gnus-icalendar.el' --- lisp/gnus/gnus-icalendar.el 2014-01-01 07:43:34 +0000 +++ lisp/gnus/gnus-icalendar.el 2014-04-20 22:10:33 +0000 @@ -170,7 +170,9 @@ (caddr event)))) (gmm-labels ((attendee-role (prop) (plist-get (cadr prop) 'ROLE)) - (attendee-name (prop) (plist-get (cadr prop) 'CN)) + (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)) @@ -452,7 +454,6 @@ "Not replied yet")) (props `(("ICAL_EVENT" . "t") ("ID" . ,uid) - ("DT" . ,(gnus-icalendar-event:org-timestamp event)) ("ORGANIZER" . ,(gnus-icalendar-event:organizer event)) ("LOCATION" . ,(gnus-icalendar-event:location event)) ("PARTICIPATION_TYPE" . ,(symbol-name (gnus-icalendar-event:participation-type event))) @@ -470,7 +471,9 @@ (when description (save-restriction (narrow-to-region (point) (point)) - (insert description) + (insert (gnus-icalendar-event:org-timestamp event) + "\n\n" + description) (indent-region (point-min) (point-max) 2) (fill-region (point-min) (point-max)))) @@ -551,20 +554,31 @@ (when description (save-restriction (narrow-to-region (point) (point)) - (insert "\n" (replace-regexp-in-string "[\n]+$" "\n" description) "\n") + (insert "\n" + (gnus-icalendar-event:org-timestamp event) + "\n\n" + (replace-regexp-in-string "[\n]+$" "\n" description) + "\n") (indent-region (point-min) (point-max) (1+ entry-outline-level)) (fill-region (point-min) (point-max)))) ;; update entry properties - (org-entry-put event-pos "DT" (gnus-icalendar-event:org-timestamp event)) - (org-entry-put event-pos "ORGANIZER" organizer) - (org-entry-put event-pos "LOCATION" location) - (org-entry-put event-pos "PARTICIPATION_TYPE" (symbol-name participation-type)) - (org-entry-put event-pos "REQ_PARTICIPANTS" (gnus-icalendar--format-participant-list req-participants)) - (org-entry-put event-pos "OPT_PARTICIPANTS" (gnus-icalendar--format-participant-list opt-participants)) - (org-entry-put event-pos "RRULE" recur) - (when reply-status (org-entry-put event-pos "REPLY" - (capitalize (symbol-name reply-status)))) + (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)))) + + (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 "RRULE" recur) + (update-org-entry event-pos "REPLY" + (if reply-status (capitalize (symbol-name reply-status)) + "Not replied yet"))) (save-buffer))))))))) ------------------------------------------------------------ revno: 116996 committer: Daniel Colascione branch nick: trunk timestamp: Sun 2014-04-20 07:46:13 -0700 message: unbreak the build diff: === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2014-04-20 02:34:22 +0000 +++ lisp/emacs-lisp/cl-macs.el 2014-04-20 14:46:13 +0000 @@ -2624,66 +2624,6 @@ (error "struct %s has no slot %s" struct-type slot-name))) (put 'cl-struct-slot-offset 'side-effect-free t) -(defun cl-struct-slot-value (struct-type slot-name inst) - "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE. -STRUCT and SLOT-NAME are symbols. INST is a structure instance." - (unless (cl-typep inst struct-type) - (signal 'wrong-type-argument (list struct-type inst))) - (elt inst (cl-struct-slot-offset struct-type slot-name))) -(put 'cl-struct-slot-value 'side-effect-free t) - -(defun cl-struct-set-slot-value (struct-type slot-name inst value) - "Set the value of slot SLOT-NAME in INST of STRUCT-TYPE. -STRUCT and SLOT-NAME are symbols. INST is a structure instance. -VALUE is the value to which to set the given slot. Return -VALUE." - (unless (cl-typep inst struct-type) - (signal 'wrong-type-argument (list struct-type inst))) - (setf (elt inst (cl-struct-slot-offset struct-type slot-name)) value)) - -(defsetf cl-struct-slot-value cl-struct-set-slot-value) - -(cl-define-compiler-macro cl-struct-slot-value - (&whole orig struct-type slot-name inst) - (or (let* ((macenv macroexpand-all-environment) - (struct-type (cl--const-expr-val struct-type macenv)) - (slot-name (cl--const-expr-val slot-name macenv))) - (and struct-type (symbolp struct-type) - slot-name (symbolp slot-name) - (assq slot-name (cl-struct-slot-info struct-type)) - (let ((idx (cl-struct-slot-offset struct-type slot-name))) - (cl-ecase (cl-struct-sequence-type struct-type) - (vector `(aref (cl-the ,struct-type ,inst) ,idx)) - (list `(nth ,idx (cl-the ,struct-type ,inst))))))) - orig)) - -(cl-define-compiler-macro cl-struct-set-slot-value - (&whole orig struct-type slot-name inst value) - (or (let* ((macenv macroexpand-all-environment) - (struct-type (cl--const-expr-val struct-type macenv)) - (slot-name (cl--const-expr-val slot-name macenv))) - (and struct-type (symbolp struct-type) - slot-name (symbolp slot-name) - (assq slot-name (cl-struct-slot-info struct-type)) - (let ((idx (cl-struct-slot-offset struct-type slot-name))) - (cl-ecase (cl-struct-sequence-type struct-type) - (vector `(setf (aref (cl-the ,struct-type ,inst) ,idx) - ,value)) - (list `(setf (nth ,idx (cl-the ,struct-type ,inst)) - ,value)))))) - orig)) - -;;; Types and assertions. - -;;;###autoload -(defmacro cl-deftype (name arglist &rest body) - "Define NAME as a new data type. -The type name can then be used in `cl-typecase', `cl-check-type', etc." - (declare (debug cl-defmacro) (doc-string 3)) - `(cl-eval-when (compile load eval) - (put ',name 'cl-deftype-handler - (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) - (defvar byte-compile-function-environment) (defvar byte-compile-macro-environment) @@ -2985,6 +2925,68 @@ '(eql cl-list* cl-subst cl-acons cl-equalp cl-random-state-p copy-tree cl-sublis)) +;;; Types and assertions. + +;;;###autoload +(defmacro cl-deftype (name arglist &rest body) + "Define NAME as a new data type. +The type name can then be used in `cl-typecase', `cl-check-type', etc." + (declare (debug cl-defmacro) (doc-string 3)) + `(cl-eval-when (compile load eval) + (put ',name 'cl-deftype-handler + (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) + +;;; Additional functions that we can now define because we've defined +;;; `cl-define-compiler-macro' and `cl-typep'. + +(defun cl-struct-slot-value (struct-type slot-name inst) + "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE. +STRUCT and SLOT-NAME are symbols. INST is a structure instance." + (unless (cl-typep inst struct-type) + (signal 'wrong-type-argument (list struct-type inst))) + (elt inst (cl-struct-slot-offset struct-type slot-name))) +(put 'cl-struct-slot-value 'side-effect-free t) + +(defun cl-struct-set-slot-value (struct-type slot-name inst value) + "Set the value of slot SLOT-NAME in INST of STRUCT-TYPE. +STRUCT and SLOT-NAME are symbols. INST is a structure instance. +VALUE is the value to which to set the given slot. Return +VALUE." + (unless (cl-typep inst struct-type) + (signal 'wrong-type-argument (list struct-type inst))) + (setf (elt inst (cl-struct-slot-offset struct-type slot-name)) value)) + +(gv-define-simple-setter cl-struct-slot-value cl-struct-set-slot-value) + +(cl-define-compiler-macro cl-struct-slot-value + (&whole orig struct-type slot-name inst) + (or (let* ((macenv macroexpand-all-environment) + (struct-type (cl--const-expr-val struct-type macenv)) + (slot-name (cl--const-expr-val slot-name macenv))) + (and struct-type (symbolp struct-type) + slot-name (symbolp slot-name) + (assq slot-name (cl-struct-slot-info struct-type)) + (let ((idx (cl-struct-slot-offset struct-type slot-name))) + (cl-ecase (cl-struct-sequence-type struct-type) + (vector `(aref (cl-the ,struct-type ,inst) ,idx)) + (list `(nth ,idx (cl-the ,struct-type ,inst))))))) + orig)) + +(cl-define-compiler-macro cl-struct-set-slot-value + (&whole orig struct-type slot-name inst value) + (or (let* ((macenv macroexpand-all-environment) + (struct-type (cl--const-expr-val struct-type macenv)) + (slot-name (cl--const-expr-val slot-name macenv))) + (and struct-type (symbolp struct-type) + slot-name (symbolp slot-name) + (assq slot-name (cl-struct-slot-info struct-type)) + (let ((idx (cl-struct-slot-offset struct-type slot-name))) + (cl-ecase (cl-struct-sequence-type struct-type) + (vector `(setf (aref (cl-the ,struct-type ,inst) ,idx) + ,value)) + (list `(setf (nth ,idx (cl-the ,struct-type ,inst)) + ,value)))))) + orig)) (run-hooks 'cl-macs-load-hook)