Download
(eval-when-compile (require 'cl))
(require 'xml)
(require 'url)
(require 'mm-url)
(require 'eieio)
(defcustom amazon-item-view-separator 2
"How many blank lines to put between displayed items."
:group 'amazon)
(defcustom amazon-associates-id ""
"Amazon Web Services associate id"
:group 'amazon)
(defcustom amazon-subscription-id ""
"Amazon Web Services subscription id"
:group 'amazon)
(defvar amazon-mode-map nil
"Keymap for amazon mode.")
(if amazon-mode-map
()
(setq amazon-mode-map (make-keymap))
(suppress-keymap amazon-mode-map)
(define-key amazon-mode-map "w" 'amazon-browse-url)
(define-key amazon-mode-map "\C-c\C-w" 'amazon-browse-url)
(define-key amazon-mode-map "\C-c\C-o" 'amazon-offers)
(define-key amazon-mode-map "\C-c\C-a" 'amazon-add-to-cart)
(define-key amazon-mode-map "r" 'amazon-show-reviews)
(define-key amazon-mode-map "\C-c\C-t" 'amazon-cart-show)
(define-key amazon-mode-map "q" 'bury-buffer)
(define-key amazon-mode-map "n" 'amazon-next-item)
(define-key amazon-mode-map "p" 'amazon-previous-item)
(define-key amazon-mode-map "i" 'amazon-lookup-isbn)
(define-key amazon-mode-map "l" 'amazon-lookup-isbn)
(define-key amazon-mode-map "\r" 'amazon-lookup-isbn)
)
(defvar amazon-offers-mode-map nil
"Keymap for amazon offers mode.")
(if amazon-offers-mode-map
()
(setq amazon-offers-mode-map (make-keymap))
(suppress-keymap amazon-offers-mode-map)
(define-key amazon-offers-mode-map "\C-c\C-a" 'amazon-add-to-cart)
(define-key amazon-offers-mode-map "\C-c\C-t" 'amazon-cart-show)
(define-key amazon-offers-mode-map "\C-c\C-k" 'amazon-buffer-up)
(define-key amazon-offers-mode-map "q" 'amazon-buffer-up)
(define-key amazon-offers-mode-map "n" 'amazon-next-item)
(define-key amazon-offers-mode-map "p" 'amazon-previous-item)
)
(defvar amazon-reviews-mode-map nil
"Keymap for amazon reviews mode.")
(if amazon-reviews-mode-map
()
(setq amazon-reviews-mode-map (make-keymap))
(suppress-keymap amazon-reviews-mode-map)
(define-key amazon-reviews-mode-map "\C-c\C-t" 'amazon-cart-show)
(define-key amazon-reviews-mode-map "\C-c\C-k" 'amazon-buffer-up)
(define-key amazon-reviews-mode-map "q" 'amazon-buffer-up)
(define-key amazon-reviews-mode-map "n" 'amazon-next-item)
(define-key amazon-reviews-mode-map "p" 'amazon-previous-item)
)
(defvar amazon-buffer-hash (make-hash-table)
"A hash table to keep track of a buffer's 'origin'.")
(defun amazon-buffer-up ()
(interactive)
(let* ((origin (current-buffer))
(ursprung (gethash origin amazon-buffer-hash)))
(delete-windows-on origin)
(kill-buffer origin)
(when ursprung (pop-to-buffer ursprung))))
(defun amazon-mode ()
(setq major-mode 'amazon-mode)
(setq mode-name "Amazon mode")
(use-local-map amazon-mode-map)
(setq buffer-read-only t))
(defun amazon-offers-mode ()
(setq major-mode 'amazon-offers-mode)
(setq mode-name "Amazon offers mode")
(use-local-map amazon-offers-mode-map)
(setq buffer-read-only t))
(defun amazon-reviews-mode ()
(setq major-mode 'amazon-review-mode)
(setq mode-name "Amazon reviews mode")
(use-local-map amazon-reviews-mode-map)
(setq buffer-read-only t))
(defvar amazon-cart-mode-map nil
"Keymap for amazon cart buffer")
(if amazon-cart-mode-map
()
(setq amazon-cart-mode-map (make-keymap))
(suppress-keymap amazon-cart-mode-map)
(define-key amazon-cart-mode-map "\C-c\C-d" 'amazon-cart-remove)
(define-key amazon-cart-mode-map "\C-c\C-r" 'amazon-cart-remove)
(define-key amazon-cart-mode-map "\C-c\C-t" 'amazon-cart-show)
(define-key amazon-cart-mode-map "\C-c\C-c" 'amazon-cart-local-submit)
)
(defun amazon-cart-mode ()
(setq major-mode 'amazon-cart-mode)
(setq mode-name "Amazon cart mode")
(use-local-map amazon-cart-mode-map)
(setq buffer-read-only t))
(defvar amazon-reviews-map nil
"Keymap for amazon reviews buffer")
(defun amazon-buffer-goto-parent ()
(interactive)
(let ((parent (gethash (current-buffer) amazon-buffer-hash)))
(when parent
(progn
(kill-buffer (current-buffer))
(pop-to-buffer parent)))))
(defun amazon-repeat-char (char number)
(let ((out ""))
(dotimes (i number out)
(setq out (concat (char-to-string char) out)))))
(defvar amazon-item-break (amazon-repeat-char ?\n (+ 1 amazon-item-view-separator)))
(if amazon-reviews-map
()
(setq amazon-reviews-map (make-keymap))
(suppress-keymap amazon-reviews-map)
(define-key amazon-reviews-map "q" 'delete-window)
(define-key amazon-reviews-map "a" 'amazon-add-to-cart))
(defcustom amazon-search-limit 10
"Maximum number of pages of results to return."
:type 'number
:group 'amazon)
(defvar amzn-base-url "http://xml.amazon.com/onca/xml")
(defvar *amazon-base-url* "http://xml.amazon.com/onca/xml")
(defvar *amazon-items* nil)
(defvar *amazon-offers* nil)
(defvar amzn-oos-offers nil)
(defvar *amazon-lisp-xml* nil)
(defvar *amazon-local-cart-contents* nil)
(defvar *amazon-purchase-url* nil)
(defvar *amazon-cart* nil)
(defgroup amazon nil "" :group 'tools)
(defvar amazon-response-group "Large,OffersFull"
"see http://docs.amazonwebservices.com/AWSEcommerceService/2005-03-23/ApiReference/ResponseGroupsArticle.html for a description of Response Group options."
)
(defvar amazon-output '()
"amazon-output is an association list of page numbers and lists of results.")
(defvar amazon-total-pages 1)
(defun with-color (string color)
(propertize string 'face `(:foreground ,color)))
(defcustom amazon-item-display-alist
`((author . ,(with-color "Author:" "cyan"))
(Creator . ,(with-color "Editor:" "cyan"))
(title . ,(with-color "Title:" "cyan"))
(Publisher . ,(with-color "Publisher:" "cyan"))
(PublicationDate . ,(with-color "Date:" "cyan"))
(edition . ,(with-color "Edition:" "cyan"))
(binding . ,(with-color "Binding:" "cyan"))
(ListPrice . ,(with-color "List Price:" "cyan"))
(price-lowest-new . ,(with-color "Lowest New Price:" "cyan"))
(price-lowest-used . ,(with-color "Lowest Used Price:" "cyan"))
(AlternateVersions . ,(with-color "Alternate Versions:" "cyan")))
"How to pretty print the slot-names for objects of the Item class."
:group 'amazon)
(defcustom amazon-offer-display-alist
`((Condition . ,(with-color "Condition:" "cyan"))
(SubCondition . ,(with-color "SubCondition:" "cyan"))
(ConditionNote . ,(with-color "Condition Note:" "cyan"))
(formatted-price . ,(with-color "Price:" "cyan"))
(Seller . ,(with-color "Seller:" "cyan"))
(Availability . ,(with-color "Availability:" "cyan")))
"How to pretty print the slot-names for objects of the Offer class."
:group 'amazon)
(defcustom amazon-cartitem-display-alist
`((Title . "Title:")
(Price . "Price:"))
"How to pretty print the slot-names for objects of the CartItem class"
:group 'amazon)
(defcustom amazon-offer-verbose-display-alist
(append `((author . ,(with-color "Author:" "cyan"))
(title . ,(with-color "Title:" "cyan"))
(binding . ,(with-color "Binding:" "cyan")))
amazon-offer-display-alist)
"How to pretty print the slot-names for objects of the Offer class."
:group 'amazon)
(defvar amazon-cartitem-slot-name-length
(apply #'max (mapcar (lambda (x) (length (cdr x))) amazon-cartitem-display-alist)))
(defvar amazon-item-slot-name-length
(apply #'max (mapcar (lambda (x) (length (cdr x))) amazon-item-display-alist)))
(defvar amazon-offer-slot-name-length
(apply #'max (mapcar (lambda (x) (length (cdr x))) amazon-offer-display-alist)))
(defvar *amazon-item-ids* (make-hash-table :test #'equal :size 300)
"A hash table of the form: ItemId => Item, where Item is the corresponding eieio object.")
(defcustom amazon-merchant-id "ATVPDKIKX0DER"
"Amazon's merchant id. Default is Amazon.com -- US locale."
:group 'amazon)
(defcustom amazon-offer-from-amazon
(lambda (x) (with-color x "orange"))
"This function should map a string to a string. It takes the
string that denotes an Offer from Amazon itself (not a third
party seller), and it modifies that string so as to indicate that
its special status. The default is to color the string orange.
But you can do something like concatenate with \"Offer from
Amazon:\\n\". We're all about customizability here."
:group 'amazon)
(defclass aws () () )
(defclass Request (aws)
((operation :initarg :request)))
(defclass ItemSearch (Request)
((operation :initvalue "ItemSearch" :allocation :class)
(keywords :initarg :keywords :accessor keywords)
(search-index :initvalue "Books" :allocation :class)
(response-group :initform "Large,AlternateVersions,OfferFull" :accessor response-group)
(author :initarg :author :accessor author)
(title :initarg :title :accessor title)
(results-page :initform "1" :accessor results-page :initarg :results-page)
(ecs-version :initform "2007-02-22" :accessor get-ecs-version :initarg :ecs-version)
(merchantid :initform "All" :accessor merchantid :initarg :merchantid)
(condition :initform "All" :accessor get-condition :initarg :condition)))
(defclass ItemLookup (Request)
((operation :initform "ItemLookup" :allocation :class)
(response-group :initform "Large,AlternateVersions" :accessor response-group)
(isbn :accessor get-isbn :initarg :isbn)
(condition :initform "All" :accessor get-condition :initarg :condition)
(merchantid :initform "All" :accessor merchantid :initarg :merchantid)
(results-page :initform "1" :accessor results-page :initarg :results-page)
(ecs-version :initform "2007-02-22" :accessor get-ecs-version :initarg :ecs-version)
(merchantid :initform "All" :accessor merchantid :initarg :merchantid)
(condition :initform "All" :accessor get-condition :initarg :condition)))
(defclass CartCreate (Request)
((Items :initarg :Items :accessor get-Items)
(Offers :initarg :Offers :accessor get-Offers)))
(defclass CartAdd (Request)
((asin-list :initarg :asin)
(itemid-list :initarg :itemid)
(hmac :initarg :hmac)))
(defclass CartRemove (Request)
((cartitemid :initarg :cartitemid)
(hmac :initarg :hmac)))
(defclass Response (aws) ())
(defclass ItemSearchResponse (Response)
((OperationRequest :accessor get-OperationRequest :initarg :OperationRequest)
(items :accessor items :initarg :items)))
(defclass OperationRequest (aws)
((Arguments :accessor get-Arguments :initarg :Arguments)))
(defun amazon-get-operationrequest (lxml)
(OperationRequest ""
:Arguments (amazon-xpath "OperationRequest/Arguments/Argument" (car lxml))))
(defun amazon-request-argument (list attribute)
(let ((tail (member-if #'(lambda (x) (equal (xml-get-attribute x 'Name) attribute)) list)))
(if tail (xml-get-attribute (car tail) 'Value))))
(defmethod amazon-show-search-args ((x ItemSearchResponse))
(let* ((op-req (get-OperationRequest x))
(arguments (get-Arguments op-req))
(author (amazon-request-argument arguments "Author"))
(title (amazon-request-argument arguments "Title"))
(keywords (amazon-request-argument arguments "Keywords"))
(out ""))
(when author (setq out (concat ":A " author out)))
(when title (setq out (concat ":T " title out)))
(when keywords (setq out (concat ":K " keywords out)))
out))
(defclass ItemLookupResponse (Response)
((items :accessor items :initarg :items :initform '())))
(defclass CartCreateResponse (Response)
((CartId :accessor get-cartid :initarg :cartid)
(HMAC :accessor get-hmac :initarg :hmac)
(PurchaseURL :accessor get-purchaseurl :initarg :purchaseurl)
(Subtotal :accessor get-subtotal :initarg :subtotal)
(CartItems :accessor get-cartitems :initarg :cartitems)))
(defclass CartAddResponse (Response) ())
(defclass CartRemoveResponse (Response) ())
(defclass Cart (CartCreateResponse CartAddResponse CartRemoveResponse)
((cartid :initarg :cartid :accessor cartid)
(hmac :initarg :hmac :accessor hmac)
(urlencodedhmac :initarg :urlencodedhmac :accessor urlencodedhmac)
(purchaseurl :initarg :purchaseurl :accessor purchaseurl)
(subtotal :initarg :subtotal :accessor subtotal)
(cartitems :initarg :cartitems :accessor cartitems)
))
(defclass Item (aws)
((asin :initarg :asin :accessor get-asin :initform "")
(title :initarg :title :accessor get-title :initform "")
(author :initarg :author :accessor get-author :initform "")
(url :initarg :url :accessor get-url :initform "")
(binding :initarg :binding :accessor get-binding :initform "")
(edition :initarg :edition :accessor get-edition :initform "")
(ListPrice :initarg :ListPrice :accessor get-ListPrice)
(price-lowest-new :initarg :new-price :accessor get-new-price :initform "")
(price-lowest-used :initarg :used-price :accessor get-used-price :initform "")
(offers :initarg :offers :accessor get-Offers :initform '())
(editorialreviews :initarg :editorial-reviews :accessor get-editorial-reviews :initform "No editorial reviews for this item.")
(customerreviews :initarg :customer-reviews :accessor get-customer-reviews :initform "No customer reviews for this item.")
(AlternateVersions :initarg :AlternateVersions :accessor get-AlternateVersions)
(Publisher :initarg :Publisher :accessor get-Publisher)
(PublicationDate :initarg :PublicationDate :accessor get-PublicationDate)
(Creator :initarg :Creator :accessor get-Creator)
))
(defclass AlternateVersion (aws)
((ASIN :initarg :ASIN :accessor get-ASIN)
(Binding :initarg :Binding :accessor get-Binding)
(Title :initarg :Title :accessor get-Title)))
(defclass Merchant (aws)
((MerchantId :initarg :MerchantId :accessor get-MerchantId)
(Name :initarg :Name :accessor get-Name)
(GlancePage :initarg :GlancePage :accessor get-GlancePage)))
(defclass Seller (aws)
((SellerId :initarg :SellerId :accessor get-SellerId)
(SellerName :initarg :SellerName :accessor get-SellerName)
(Nickname :initarg :Nickname :accessor get-Nickname)
(GlancePage :initarg :GlancePage :accessor get-GlancePage)
(About :initarg :About :accessor get-About)
(MoreAbout :initarg :MoreAbout :accessor get-MoreAbout)
(Location :initarg :Location :accessor get-Location)
(AverageFeedbackRating :initarg :AverageFeedbackRating :accessor get-AverageFeedbackRating)
(TotalFeedback :initarg :TotalFeedback :accessor get-TotalFeedback)))
(defclass Offer (aws)
((Condition :initarg :Condition :accessor get-Condition)
(SubCondition :initarg :SubCondition :accessor get-SubCondition)
(ConditionNote :initarg :ConditionNote :accessor get-ConditionNote)
(listingid :initarg :listingid :initform "" :accessor get-listingid)
(formatted-price :initarg :formatted-price :initform "" :accessor get-formatted-price)
(Merchant :initarg :Merchant :accessor get-Merchant)
(Seller :initarg :Seller :accessor get-Seller)
(price :initarg :price :initform "" :accessor get-price)
(asin :initarg :asin :initform "" :accessor get-asin)
(Availability :initarg :Availability :accessor get-Availability)))
(defmethod amazon-merchant-is-amazon ((x Offer))
(string= (get-MerchantId (get-Merchant x)) amazon-merchant-id))
(defun amazon-get-merchant (lxml)
(Merchant ""
:MerchantId (amazon-node-text (amazon-xpath "MerchantId" lxml))
:Name (amazon-node-text (amazon-xpath "Name" lxml))
:GlancePage (amazon-node-text (amazon-xpath "GlancePage" lxml))))
(defun amazon-get-seller (lxml)
(Seller ""
:SellerId (amazon-node-text (amazon-xpath "SellerId" lxml))
:SellerName (amazon-node-text (amazon-xpath "SellerName" lxml))
:Nickname (amazon-node-text (amazon-xpath "Nickname" lxml))
:GlancePage (amazon-node-text (amazon-xpath "GlancePage" lxml))
:About (amazon-node-text (amazon-xpath "About" lxml))
:MoreAbout (amazon-node-text (amazon-xpath "MoreAbout" lxml))
:Location (amazon-node-text (amazon-xpath "Location" lxml))
:AverageFeedbackRating (amazon-node-text (amazon-xpath "AverageFeedbackRating" lxml))
:TotalFeedback (amazon-node-text (amazon-xpath "TotalFeedback" lxml))))
(defun amzn-get-offer (lisp-xml &optional asin)
(Offer ""
:listingid (amazon-node-text (amazon-xpath "OfferListing/OfferListingId" lisp-xml))
:Availability (amazon-node-text (amazon-xpath "OfferListing/Availability" lisp-xml))
:Condition (amazon-node-text (amazon-xpath "OfferAttributes/Condition" lisp-xml))
:SubCondition (amazon-node-text (amazon-xpath "OfferAttributes/SubCondition" lisp-xml))
:ConditionNote (amazon-node-text (amazon-xpath "OfferAttributes/ConditionNote" lisp-xml))
:formatted-price (amazon-node-text (amazon-xpath "OfferListing/Price/FormattedPrice" lisp-xml))
:price (amazon-node-text (amazon-xpath "OfferListing/Price/Amount" lisp-xml))
:Seller (amazon-get-seller (car (amazon-xpath "Seller" lisp-xml)))
:Merchant (amazon-get-merchant (car (amazon-xpath "Merchant" lisp-xml)))
:asin asin))
(defgeneric amazon-url ((x Request)) )
(defvar amzn-request-base-url
(let* ((pairs `(("SubscriptionId" . ,amazon-subscription-id)
("type" . "heavy")
("f" . "xml")
("mode" . "books")
("Service" . "AWSECommerceService"))))
(concat amzn-base-url "?" (mm-url-encode-www-form-urlencoded pairs))))
(defmethod amazon-url ((x ItemLookup))
(let* ((pairs `(("Operation" . "ItemLookup")
("ItemId" . ,(get-isbn x))
("ResponseGroup" . ,(response-group x))
("MerchantId" . ,(merchantid x))
("Condition" . ,(get-condition x)))))
(concat amzn-request-base-url "&" (mm-url-encode-www-form-urlencoded pairs))))
(defmethod amazon-url ((x ItemSearch))
(let* ((pairs `(("Operation" . "ItemSearch")
("SearchIndex" . "Books")
("MerchantId" . ,(merchantid x))
("Version" . ,(get-ecs-version x))
("Condition" . ,(get-condition x))
("ResponseGroup" . ,(response-group x))
("ItemPage" . ,(results-page x)))))
(when (and (slot-boundp x 'author) (author x)) (push `("Author" . ,(author x)) pairs))
(when (and (slot-boundp x 'title) (title x)) (push `("Title" . ,(title x)) pairs))
(when (and (slot-boundp x 'keywords) (keywords x)) (push `("Keywords" . ,(keywords x)) pairs))
(concat amzn-request-base-url "&" (mm-url-encode-www-form-urlencoded pairs))))
(defgeneric amazon-send ()
"Send some object -- viz. a request -- to the AWS server.
Specialize on the various types of requests.")
(defmethod amazon-send ((x ItemLookup))
(setq amazon-output '())
(url-retrieve (amazon-url x)
(lambda (y)
(setf amazon-output (xml-parse-region (point-min) (point-max)))
(message "Finished getting results"))
nil)
(while (not amazon-output)
(progn (message "Getting results")
(sleep-for 0.1)))
(ItemLookupResponse "" :items (mapcar #'amzn-get-item (amzn-xml-items (car amazon-output)))))
(defmethod show ((x ItemLookupResponse))
(pop-to-buffer (generate-new-buffer "*amazon-item-lookup-results*"))
(insert (mapconcat #'show (items x) amazon-item-break))
(goto-char (point-min))
(amazon-mode)
(setq buffer-read-only t)
(delete-other-windows))
(defun amzn-xml-total-pages (lxml)
(string-to-number
(amazon-node-text (amazon-xpath "Items/TotalPages" (car lxml)))))
(defgeneric amazon-search-recursive (x) )
(defvar amazon-operation-request nil)
(defmethod amazon-search-recursive ((obj ItemSearch))
(setq amazon-output '())
(setq amazon-total-pages nil)
(url-retrieve (amazon-url obj)
(lambda (y)
(let ((lxml (xml-parse-region (point-min) (point-max))))
(setf amazon-total-pages (amzn-xml-total-pages lxml))
(setf amazon-operation-request (amazon-get-operationrequest lxml))
(setf amazon-output (list (cons 1 (amzn-xml-items (car lxml)))))
(message "Finished processing the first page")))
nil)
(message "Processing the first page of results")
(while (not amazon-total-pages)
(progn (message "Please wait ... getting information about how many pages to fetch")
(sleep-for 0.1)))
(let ((tots (min amazon-search-limit amazon-total-pages)))
(message "There are %s pages of results, of which I will retrieve %s"
amazon-total-pages tots)
(loop for x from 2 to (min amazon-total-pages amazon-search-limit)
do (lexical-let ((x x))
(let ((new-obj (clone obj :results-page (number-to-string x))))
(url-retrieve (amazon-url new-obj)
(lambda (y)
(let ((lxml (xml-parse-region (point-min) (point-max))))
(push (cons x (amzn-xml-items (car lxml))) amazon-output)
(message "Finished processing page %s" x)))
nil))))
(let ((mout '()))
(loop for x from 1 to tots
do (while (not (assoc x amazon-output)) (sleep-for 0.2))
do (setq mout (append (cdr (assoc x amazon-output)) mout)))
(ItemSearchResponse "" :OperationRequest amazon-operation-request :items (mapcar #'amzn-get-item mout)))))
(defun amzn-xml-attrib (attrib item)
(caddar (xml-get-children (car (xml-get-children item 'ItemAttributes)) attrib)))
(defclass EditorialReview (aws)
((Source :initarg :Source :accessor get-Source)
(Content :initarg :Content :accessor get-Content)))
(defmethod show ((x EditorialReview))
(insert (concat
(with-color (format "< Review | %s >" (get-Source x)) "cyan")
" "
(get-Content x))))
(defun amazon-show-reviews (point)
(interactive "d")
(let* ((item (reconstruct-object point))
(edrev (get-editorial-reviews item))
(curev (get-customer-reviews item))
(faux (get-title item))
(parent-buffer (current-buffer))
(child-buffer (pop-to-buffer (generate-new-buffer (format "*amazon reviews for %s*" faux)))))
(puthash child-buffer parent-buffer amazon-buffer-hash)
(loop for x in edrev
do (show x)
do (insert "\n\n"))
(loop for x in curev
do (show x)
do (insert "\n\n"))
(text-mode)
(fill-region (point-min) (point-max))
(goto-char (point-min))
(amazon-reviews-mode)))
(defclass CustomerReview (Item)
((AverageRating :initarg :AverageRating :accessor get-AverageRating)
(Reviews :initarg :Reviews :accessor get-Reviews)
))
(defclass Review (CustomerReview)
((ASIN :initarg :ASIN :accessor get-ASIN)
(Content :initarg :Content :accessor get-Content)
(Date :initarg :Date :accessor get-Date)
(Rating :initarg :Rating :accessor get-Rating)
(HelpfulVotes :initarg :HelpfulVotes :accessor get-HelpfulVotes)
(Summary :initarg :Summary :accessor get-Summary)
(TotalVotes :initarg :TotalVotes :accessor get-TotalVotes)
(Reviewer :initarg :Reviewer :accessor get-Reviewer))
)
(defclass Price ()
((Amount :initarg :Amount :accessor get-Amount)
(CurrencyCode :initarg :CurrencyCode :accessor get-CurrencyCode)
(FormattedPrice :initarg :FormattedPrice :accessor get-FormattedPrice)))
(defclass CartItem (aws)
((CartItemId :initarg :CartItemId :accessor get-CartItemId)
(ASIN :initarg :ASIN :accessor get-ASIN)
(Price :initarg :Price :accessor get-Price)
(ProductGroup :initarg :ProductGroup :accessor get-ProductGroup)
(MerchantId :initarg :MerchantId :accessor get-MerchantId)
(SellerId :initarg :SellerId :accessor get-SellerId)
(ExchangeId :initarg :ExchangeId :accessor get-ExchangeId)
(Quantity :initarg :Quantity :accessor get-Quantity)
(Title :initarg :Title :accessor get-Title)))
(defvar amazon-html-replace
'(("<p>" . "\n\n")
("<P>" . "\n\n")
("</ BR>" . "\n\n")
("<br>" . "\n\n"))
"Regular expresssion replacements for converting html fragments
to text.")
(defun amazon-clean (html)
(loop for x in amazon-html-replace
do (setq html (replace-regexp-in-string (car x) (cdr x) html))
finally return html))
(defmethod show ((x Review))
(insert
(concat (with-color (format "< Review by %s | Rating %s | %s >"
(get-Name (get-Reviewer x))
(get-Rating x)
(get-Date x)) "cyan")
(format " %s"
(amazon-clean (get-Content x))))))
(defun amzn-get-item (item)
(lexical-let* ((asin (amazon-node-text (amazon-xpath "ASIN" item)))
(foo (Item ""
:author (amazon-node-text (amazon-xpath "ItemAttributes/Author" item))
:Creator (amazon-node-text (amazon-xpath "ItemAttributes/Creator" item))
:title (amazon-node-text (amazon-xpath "ItemAttributes/Title" item))
:ListPrice (amazon-get-price (car (amazon-xpath "ItemAttributes/ListPrice" item)))
:new-price (amazon-node-text (amazon-xpath "OfferSummary/LowestNewPrice/FormattedPrice" item))
:used-price (amazon-node-text (amazon-xpath "OfferSummary/LowestUsedPrice/FormattedPrice" item))
:url (concat "http://www.amazon.com/dp/" asin)
:binding (amazon-node-text (amazon-xpath "ItemAttributes/Binding" item))
:edition (amazon-node-text (amazon-xpath "ItemAttributes/Edition" item))
:editorial-reviews (mapcar #'amazon-get-editorialreview
(amazon-xpath "EditorialReviews/EditorialReview" item))
:customer-reviews (mapcar #'amazon-get-review (amazon-xpath "CustomerReviews/Review" item))
:asin asin
:offers (mapcar (lambda (x) (amzn-get-offer x asin)) (amzn-xml-offers item))
:Publisher (amazon-node-text (amazon-xpath "ItemAttributes/Publisher" item))
:PublicationDate (amazon-node-text (amazon-xpath "ItemAttributes/PublicationDate" item))
:AlternateVersions (mapcar #'amzn-get-alt-version
(amazon-xpath "AlternateVersions/AlternateVersion" item)))))
(puthash asin foo *amazon-item-ids*)))
(defun amzn-get-alt-version (alt)
(AlternateVersion ""
:ASIN (amazon-node-text (amazon-xpath "ASIN" alt))
:Binding (amazon-node-text (amazon-xpath "Binding" alt))
:Title (amazon-node-text (amazon-xpath "Title" alt))))
(defun amazon-get-editorialreview (editorialreview)
(EditorialReview ""
:Source (amazon-node-text (amazon-xpath "Source" editorialreview))
:Content (amazon-node-text (amazon-xpath "Content" editorialreview))))
(defclass Reviewer (aws)
((Name :initarg :Name :accessor get-Name)
(CustomerId :initarg :CustomerId :accessor get-CustomerId)
(Nickname :initarg :Nickname :accessor get-Nickname)
(Location :initarg :Location :accessor get-Location)))
(defun amazon-get-review (review)
(Review ""
:ASIN (amazon-node-text (amazon-xpath "ASIN" review))
:Content (amazon-node-text (amazon-xpath "Content" review))
:Date (amazon-node-text (amazon-xpath "Date" review))
:Rating (amazon-node-text (amazon-xpath "Rating" review))
:HelpfulVotes (amazon-node-text (amazon-xpath "HelpfulVotes" review))
:Summary (amazon-node-text (amazon-xpath "Summary" review))
:TotalVotes (amazon-node-text (amazon-xpath "TotalVotes" review))
:Reviewer (amazon-get-reviewer (car (amazon-xpath "Reviewer" review)))))
(defun amazon-get-reviewer (lxml)
(Reviewer ""
:Name (amazon-node-text (amazon-xpath "Name" lxml))
:CustomerId (amazon-node-text (amazon-xpath "CustomerId" lxml))
:Nickname (amazon-node-text (amazon-xpath "Nickname" lxml))
:Location (amazon-node-text (amazon-xpath "Location" lxml))))
(defvar amazon-key-regexp ":\\w+\\( \\)*")
(defun amzn-helper (string)
"Transforms a string of keywords and content into a plist."
(cond
((zerop (length string)) '())
((and (string-match amazon-key-regexp string) (= (match-beginning 0) 0))
(let* ((keyword (intern (substring string 0 (- (match-end 0) 1))))
(begin-content (match-end 0))
(end-content (or (string-match amazon-key-regexp string 1) (length string)))
(content (substring string begin-content end-content)))
(append (list keyword content) (amzn-helper (substring string end-content)))))
(t (error "Mangled input"))))
(defun amzn-expand-searchwords (list)
(mapcar
(lambda (x)
(cond ((equal x :t) :title)
((equal x :k) :keywords)
((equal x :a) :author)
((equal x :i) :isbn)
(t x)))
list))
(defun amazon (&rest rest)
(interactive "sAmazon search terms: ")
(let* ((string (car rest))
(reduced-string (replace-regexp-in-string " [ ]+" " " string))
(plist (amzn-expand-searchwords (amzn-helper reduced-string)))
(obj (apply ItemSearch (cons "" plist))))
(show (amazon-search-recursive obj))))
(defun amzn-assoc (key list)
(cdr (assoc key list)))
(defun amazon-split (string)
(let ((split (position ?\/ string)))
(cond
((not split) (list string))
(t (cons (substring string 0 split) (amazon-split (substring string (+ 1 split))))))))
(defun amazon-descend (list lxml)
(cond
((= (length list) 1) (xml-get-children lxml (intern (car list))))
(t (xml-get-children (car (amazon-descend (cdr list) lxml)) (intern (car list))))))
(defun amazon-xpath (string lxml)
(let ((list (reverse (amazon-split string))))
(amazon-descend list lxml)))
(defun amazon-node-text (lxml)
(car (reverse (car lxml))))
(defun amzn-xml-items (lisp-xml)
"starting within lisp-xml, returns a *list* of the Item nodes.
Each element of the list is itself of lisp-xml form, and so we
can get its children, etc.."
(amazon-xpath "Items/Item" lisp-xml))
(defun amzn-xml-list-price (item)
(amazon-node-text (amazon-xpath "ItemAttributes/ListPrice/FormattedPrice" item)))
(defun amzn-xml-asin (item)
(amazon-node-text (amazon-xpath "ASIN" item)))
(defun amzn-xml-url (item)
(concat "http://www.amazon.com/dp/" (amzn-xml-asin item)))
(defun amzn-xml-new-price (item)
(amazon-node-text (amazon-xpath "OfferSummary/LowestNewPrice/FormattedPrice" item)))
(defun amzn-xml-used-price (item)
(amazon-node-text (amazon-xpath "OfferSummary/LowestUsedPrice/FormattedPrice" item)))
(defun amzn-xml-offers (item)
"returns a list of OFFERS (lisp xml format) for ITEM (list xml format)."
(amazon-xpath "Offers/Offer" item) )
(defvar *amazon-buf-hash* (make-hash-table)
"Associates points in a buffer with objects.")
(make-variable-buffer-local '*amazon-buf-hash*)
(defgeneric show () "Display the object in human-readable format.")
(defgeneric show ((x Response)) "Display the response from amazon.")
(defmethod show ((x ItemSearchResponse))
(pop-to-buffer (generate-new-buffer (concat "*amazon search results for " (amazon-show-search-args x) "*")))
(insert (mapconcat #'show (items x) "\n\n\n"))
(goto-char (point-min))
(amazon-mode)
(setq buffer-read-only t)
(delete-other-windows))
(defun amazon-spaces (number)
(cond
((zerop number) "")
(t (concat " " (amazon-spaces (- number 1))))))
(defgeneric amazon-print-slot (obj) )
(defun amazon-wrap-string (string text-width indent)
(let ((list (amzn-break-string string text-width)))
(mapconcat (lambda (x) x) list (concat "\n" (amazon-spaces indent)))))
(defcustom amazon-field-display-width 80
"How wide do you want the text of displayed fields, such as
book titles? This variable controls text wrapping in results
buffers."
:group 'amazon)
(defmethod show ((x AlternateVersion))
(concat (slot-value x 'Binding) " " (slot-value x 'ASIN)))
(defmethod amazon-print-slot ((obj Item) slot)
(let* ((slot-name (cdr (assoc slot amazon-item-display-alist)))
(stretch (- (+ 3 amazon-item-slot-name-length) (length slot-name)))
(value (show-generic (slot-value obj slot))))
(cond
((not (slot-boundp obj slot)) "")
((not value) "")
((equal slot 'AlternateVersions)
(concat slot-name
(amazon-spaces stretch)
(mapconcat #'show (slot-value obj 'AlternateVersions) " / ")))
((and (stringp value) (zerop (length value))) "")
((zerop (length value)) "")
(t (concat slot-name
(amazon-spaces stretch)
(amazon-wrap-string value amazon-field-display-width (+ 3 amazon-item-slot-name-length)))))))
(defmethod show ((x Price))
(get-FormattedPrice x))
(defmethod amazon-print-slot ((obj CartItem) slot)
(let* ((slot-name (cdr (assoc slot amazon-cartitem-display-alist)))
(stretch (- (+ 2 amazon-cartitem-slot-name-length) (length slot-name)))
(value (show-generic (slot-value obj slot))))
(concat slot-name (amazon-spaces stretch)
(amazon-wrap-string value
amazon-field-display-width (+ 3 amazon-cartitem-slot-name-length)))))
(defmethod amazon-print-slot ((obj Offer) slot)
(let* ((asin (get-asin obj))
(item (gethash asin *amazon-item-ids*)))
(cond
((member slot '(author title binding))
(amazon-print-slot item slot))
(t
(let* ((slot-name (cdr (assoc slot amazon-offer-display-alist)))
(stretch (- (+ 3 amazon-offer-slot-name-length) (length slot-name)))
(value (show-generic (slot-value obj slot))))
(cond
((not (slot-boundp obj slot)) "")
((zerop (length value)) "")
(t (concat slot-name
(amazon-spaces stretch)
(amazon-wrap-string value amazon-field-display-width (+ 3 amazon-offer-slot-name-length))))))))))
(defmethod show ((x Item))
(propertize
(mapconcat (lambda (w) w)
(remove-if (lambda (z) (zerop (length z)))
(mapcar (lambda (y) (amazon-print-slot x y))
(mapcar #'car amazon-item-display-alist))) "\n")
'noumenon x))
(defmethod show ((x Offer))
(let ((output (propertize
(mapconcat (lambda (w) w)
(remove-if (lambda (z) (zerop (length z)))
(mapcar (lambda (y) (amazon-print-slot x y))
(mapcar #'car amazon-offer-display-alist))) "\n")
'noumenon x)))
(if (amazon-merchant-is-amazon x)
(funcall amazon-offer-from-amazon output)
output)))
(defun amazon-show (obj slot-list)
(propertize
(mapconcat (lambda (w) w)
(remove-if (lambda (z) (zerop (length z)))
(mapcar (lambda (slot) (amazon-print-slot obj slot)) slot-list)) "\n")
'noumenon obj))
(defgeneric show-verbose (x) )
(defmethod show-verbose ((x Item))
(show x))
(defmethod show-verbose ((x Offer))
(propertize
(mapconcat (lambda (w) w)
(remove-if (lambda (z) (zerop (length z)))
(mapcar (lambda (y) (amazon-print-slot x y))
(mapcar #'car amazon-offer-verbose-display-alist))) "\n")
'noumenon x))
(defmethod show ((x Seller))
(concat (get-Nickname x) (format " -- average feedback %s (from %s total)" (get-AverageFeedbackRating x) (get-TotalFeedback x))))
(defun reconstruct-object (point)
(interactive "d")
(get-text-property point 'noumenon))
(defun amazon-offers (point)
(interactive "d")
(let* ((parent-buffer (current-buffer))
(item (reconstruct-object point))
(offers (get-Offers item))
(child-buffer (pop-to-buffer (generate-new-buffer (format "*amazon offers for %s*" (get-title item))))))
(puthash child-buffer parent-buffer amazon-buffer-hash)
(insert (mapconcat #'show offers "\n\n\n"))
(goto-char (point-min))
(amazon-offers-mode)))
(defun amazon-browse-url (point)
(interactive "d")
(browse-url-firefox (get-url (reconstruct-object point))))
(defun amazon-cart-add (point)
"Add the offer at point to the local cart."
)
(defun amzn-break-string (string number)
"Break string into strings of length less than number; only break on spaces."
(cond ((zerop (length string)) '())
((< (length string) number) (list string))
(t
(let* ((first-substring (subseq string 0 number))
(break-point (position ?\s first-substring :from-end t))
(head (subseq string 0 break-point))
(tail (subseq string (+ 1 break-point))))
(append (list head) (amzn-break-string tail number))))))
(defun amazon-string-wrap (string number)
"Map string to a new string that is appropriately wrapped")
(defvar *amazon-cart-local* (CartCreate "" :Items '() :Offers '())
"*amazon-cart-local* is a CartCreate object whose slots are initially empty.")
(defun amazon-cart-clear ()
(interactive)
(when (yes-or-no-p "Do you really want to clear your local Amazon purchase list?")
(oset *amazon-cart-local* :Items '())
(oset *amazon-cart-local* :Offers '())
(message "Your purchase list is now empty.")))
(defun amazon-cart-empty ()
(interactive)
(amazon-cart-clear))
(defgeneric amazon-push-cart ()
"Push an ITEM or an OFFER into *amazon-cart-local*.")
(defmethod amazon-push-cart ((x Item))
(oset *amazon-cart-local* :Items (cons x (get-Items *amazon-cart-local*))))
(defmethod amazon-push-cart ((x Offer))
(oset *amazon-cart-local* :Offers (cons x (get-Offers *amazon-cart-local*))))
(defun amazon-add-to-cart (point)
(interactive "d")
(amazon-push-cart (reconstruct-object point))
(message "item added to local cart"))
(defmethod show ((x CartCreate))
(let* ((stuff (append (get-Items x) (get-Offers x)))
(num (length stuff)))
(pop-to-buffer (format "*amazon local cart; %s items*" num))
(setq buffer-read-only nil)
(erase-buffer)
(goto-char (point-min))
(insert (mapconcat #'amazon-show-as-cart-element stuff "\n\n"))
(setq buffer-read-only t)
(goto-char (point-min))
(amazon-cart-mode)))
(defgeneric amazon-show-as-cart-element (obj) )
(defmethod amazon-show-as-cart-element ((x Item))
(amazon-show x '(author title price-lowest-new)))
(defmethod amazon-offer-item ((x Offer))
(gethash (get-asin x) *amazon-item-ids*))
(defmethod amazon-show-as-cart-element ((x Offer))
(let ((item (amazon-offer-item x)))
(propertize (concat
(amazon-show item '(author title)) "\n"
(amazon-show x '(formatted-price))) 'noumenon x)))
(defun amazon-cart-show ()
(interactive)
(if (and (not (get-Items *amazon-cart-local*))
(not (get-Offers *amazon-cart-local*)))
(message "No cart contents to show")
(show *amazon-cart-local*)
(use-local-map amazon-cart-mode-map)))
(defgeneric amazon-cart-local-remove (x) )
(defun amazon-cart-remove (point)
(interactive "d")
(amazon-cart-local-remove (reconstruct-object point))
(kill-buffer (current-buffer))
(amazon-cart-show))
(defmethod amazon-cart-local-remove ((x Item))
(interactive "d")
(oset *amazon-cart-local* :Items (remove x (get-Items *amazon-cart-local*))))
(defmethod amazon-cart-local-remove ((x Offer))
(interactive "d")
(oset *amazon-cart-local* :Offers (remove x (get-Offers *amazon-cart-local*))))
(defun amazon-cart-local-subtotal ()
(apply #'+ (mapcar (lambda (x) (string-to-number x))
(mapcar (lambda (x) (substring x 1))))))
(defun amazon-cart-upload ()
(interactive)
(when (yes-or-no-p (format "Upload Amazon purchase list with %s items? " (length *amazon-cart-local*)))
(let ((x (CartCreate "" :itemid (mapcar #'get-listingid (remove-if-not #'Offer-p *amazon-cart-local*))
:asin (mapcar #'asin (remove-if-not #'Item-p *amazon-cart-local*)))))
(print x))))
(defgeneric amazon-url-helper (x) )
(defmethod amazon-url-helper ((x Item))
(concat "ASIN=" (get-asin x)))
(defmethod amazon-url-helper ((x Offer))
(concat "OfferListingId=" (get-listingid x)))
(defmethod amazon-url ((x CartCreate))
(let ((stuff (append (get-Items x) (get-Offers x))))
(concat amzn-request-base-url "&Operation=CartCreate"
(labels ((foo (object-list counter)
(cond
((not object-list) (values "" 0))
(t (progn
(incf counter)
(values (concat (format "&Item.%s." counter)
(amazon-url-helper (car object-list))
(format "&Item.%s.Quantity=1" counter)
(car (foo (cdr object-list) counter)))
counter))))))
(car (foo stuff 0))))))
(defun amazon-get-price (lxml)
(Price ""
:Amount (amazon-node-text (amazon-xpath "Amount" lxml))
:CurrencyCode (amazon-node-text (amazon-xpath "CurrencyCode" lxml))
:FormattedPrice (amazon-node-text (amazon-xpath "FormattedPrice" lxml))))
(defun show-generic (x)
(cond
((stringp x) x)
((listp x) x)
(t (show x))))
(defun amazon-get-cartitem (lxml)
(CartItem ""
:CartItemId (amazon-node-text (amazon-xpath "CartItemId" lxml))
:ASIN (amazon-node-text (amazon-xpath "ASIN" lxml))
:Price (car (mapcar #'amazon-get-price (amazon-xpath "Price" lxml)))
:Title (amazon-node-text (amazon-xpath "Title" lxml))))
(defmethod show ((x CartItem))
(propertize
(mapconcat (lambda (w) w)
(remove-if (lambda (z) (zerop (length z)))
(mapcar (lambda (y) (amazon-print-slot x y))
(mapcar #'car amazon-cartitem-display-alist))) "\n")))
(defun amazon-get-cartresponse (lisp-xml)
(CartCreateResponse ""
:cartid (amazon-node-text (amazon-xpath "Cart/CartId" lisp-xml))
:purchaseurl (amazon-node-text (amazon-xpath "Cart/PurchaseURL" lisp-xml))
:hmac (amazon-node-text (amazon-xpath "Cart/HMAC" lisp-xml))
:subtotal (amazon-node-text (amazon-xpath "Cart/CartItems/SubTotal/FormattedPrice" lisp-xml))
:cartitems (mapcar #'amazon-get-cartitem (amazon-xpath "Cart/CartItems/CartItem" lisp-xml))))
(defmethod amazon-send ((x CartCreate))
(if *amazon-cart* (setq *amazon-cart* nil))
(url-retrieve (amazon-url x)
(lambda (y)
(setq *amazon-cart* (amazon-get-cartresponse (car (xml-parse-region (point-min) (point-max))))))
nil)
(while (not *amazon-cart*)
(progn (message "Waiting for response ... ")
(sleep-for 0.1)))
*amazon-cart*)
(defun amazon-cart-local-submit ()
(interactive)
(show (amazon-send *amazon-cart-local*)))
(defun amazon-cart-submit ()
(interactive)
(show (amazon-send *amazon-cart-local*)))
(defmethod show ((x CartCreateResponse))
(pop-to-buffer (generate-new-buffer "*CartCreate response from amazon*"))
(insert (concat "Subtotal: " (get-subtotal x) "\n"
"Purchase URL: "))
(let ((beg (point)))
(insert (get-purchaseurl x))
(copy-region-as-kill beg (point)))
(insert "\n\nCart Contents:")
(loop for cartitem in (get-cartitems x)
for i from 1
do (insert (format "\n\nItem #%s\n%s" i (show cartitem))))
(setq buffer-read-only t)
(goto-char (point-min))
(amazon-cart-mode))
(defun amzn-xml-offer-print (offer)
(car (xml-get-children (car (xml-get-children offer 'OfferListing)) 'OfferListingId)))
(defgeneric amzn-satisfactory (x) "Is this satisfactory?")
(defun amzn-remove-offers (list)
"Remove those offers that do not meet my criteria, as set in 'amzn-satisfactory'"
(remove-if-not 'amzn-satisfactory list))
(defmethod amzn-get-slot ((x Offer))
(let* ((string (completing-read "Show object slot: " (mapcar #'symbol-name (object-slots x))))
(foo (intern (concat "get-" string))))
(print (funcall foo x))))
(defmethod amzn-get-slot ((x Item))
(let* ((string (completing-read "Show object slot: " (mapcar #'symbol-name (object-slots x))))
(foo (intern (concat "get-" string))))
(print (funcall foo x))))
(defun amazon-next-item ()
(interactive)
(forward-paragraph)
(forward-line (- amazon-item-view-separator 1))
(next-line))
(defun amazon-previous-item ()
(interactive)
(forward-paragraph (- 0 amazon-item-view-separator))
(next-line))
(defun amazon-lookup-isbn ()
(interactive)
(let ((isbn (current-word)))
(if isbn (show (amazon-send (ItemLookup "" :isbn isbn)))
(message "No isbn at point."))))
(provide 'amazon)