Permalink
Browse files

Extract the format from the HTTP response header.

* twittering-mode.el: Extract the format from the HTTP response
header.
(twittering-get-content-subtype-symbol-from-header-info): new
function for extracting the content subtype from a HTTP header.
(twittering-send-http-request): fix docstring.
(twittering-get-error-message): extract the format from the HTTP
response header instead of using `connection-info`.
(twittering-http-get-default-sentinel): likewise.
(twittering-retrieve-single-tweet-sentinel): likewise.
  • Loading branch information...
1 parent 93fe95b commit c692ee9bb5d54208038776ea4429900e9eddcfc5 @cvmat cvmat committed Nov 4, 2012
Showing with 46 additions and 8 deletions.
  1. +10 −0 ChangeLog
  2. +36 −8 twittering-mode.el
View
@@ -14,6 +14,16 @@
(twittering-render-timeline): return a list of tweets newly
rendered.
+ * twittering-mode.el: Extract the format from the HTTP response
+ header.
+ (twittering-get-content-subtype-symbol-from-header-info): new
+ function for extracting the content subtype from a HTTP header.
+ (twittering-send-http-request): fix docstring.
+ (twittering-get-error-message): extract the format from the HTTP
+ response header instead of using `connection-info`.
+ (twittering-http-get-default-sentinel): likewise.
+ (twittering-retrieve-single-tweet-sentinel): likewise.
+
2012-09-17 Tadashi MATSUO <tad@mymail.twin.jp>
* twittering-mode.el: Request a compressed HTTP response when
View
@@ -1528,6 +1528,31 @@ The alist consists of pairs of field-name and field-value, such as
(cons (match-string 1 line) (match-string 2 line))))
header-lines))))))
+(defun twittering-get-content-subtype-symbol-from-header-info (header-info)
+ "Return a symbol corresponding to the subtype of content-type."
+ (let* ((content-type
+ ;; According to RFC2616, field name of a HTTP header is
+ ;; case-insensitive.
+ (car
+ (remove
+ nil
+ (mapcar (lambda (entry)
+ (when (and (stringp (car entry))
+ (let ((case-fold-search t))
+ (string-match "\\`content-type\\'"
+ (car entry))))
+ (cdr entry)))
+ header-info))))
+ (subtype (when (and (stringp content-type)
+ (string-match "\\` *[^/]*/\\([^ ;]*\\)"
+ content-type))
+ (downcase (match-string 1 content-type))))
+ (symbol-alist
+ '(("json" . json)
+ ("atom+xml" . atom)
+ ("xml" . xml))))
+ (cdr (assoc subtype symbol-alist))))
+
(defun twittering-decode-response-body (header-info)
"Decode the current buffer according to the content-type in HEADER-INFO."
(let* ((content-type
@@ -1604,7 +1629,7 @@ It is called with the current buffer containing the HTTP response (without
HTTP headers). FUNC is called with four arguments: the process, a symbol
describing the status of the process, a connection-info generated by
`twittering-make-connection-info', and a header-info generated by
-`twittering-get-response-header'.
+`twittering-get-response-header' and `twittering-make-header-info-alist'.
The connection-info also includes an alist ADDITIONAL-INFO.
If FUNC returns non-nil and `twittering-buffer-related-p' is non-nil, the
returned value is displayed as a message.
@@ -2305,7 +2330,9 @@ the server when the HTTP status code equals to 400 or 403.
If BUFFER is nil, the current buffer is used instead."
(let ((buffer (or buffer (current-buffer)))
(status-line (cdr (assq 'status-line header-info)))
- (status-code (cdr (assq 'status-code header-info))))
+ (status-code (cdr (assq 'status-code header-info)))
+ (format
+ (twittering-get-content-subtype-symbol-from-header-info header-info)))
(cond
((and (buffer-live-p buffer)
(member status-code '("400" "401" "403" "404")))
@@ -2316,8 +2343,7 @@ If BUFFER is nil, the current buffer is used instead."
;;
;; However, Twitter seems to return an error message even when
;; the HTTP status is "401 Unauthorized" or "404 Not Found".
- (let* ((format (cdr (assq 'format connection-info)))
- (error-mes
+ (let* ((error-mes
(cond
((eq format 'xml)
(let ((xmltree
@@ -2356,14 +2382,15 @@ If BUFFER is nil, the current buffer is used instead."
(defun twittering-http-get-default-sentinel (proc status connection-info header-info)
(let ((status-line (cdr (assq 'status-line header-info)))
- (status-code (cdr (assq 'status-code header-info))))
+ (status-code (cdr (assq 'status-code header-info)))
+ (format
+ (twittering-get-content-subtype-symbol-from-header-info header-info)))
(case-string
status-code
(("200")
(debug-printf "connection-info=%s" connection-info)
(let* ((spec (cdr (assq 'timeline-spec connection-info)))
(spec-string (cdr (assq 'timeline-spec-string connection-info)))
- (format (cdr (assq 'format connection-info)))
(statuses
(cond
((eq format 'json)
@@ -2437,13 +2464,14 @@ If BUFFER is nil, the current buffer is used instead."
(defun twittering-retrieve-single-tweet-sentinel (proc status connection-info header-info)
(let ((status-line (cdr (assq 'status-line header-info)))
- (status-code (cdr (assq 'status-code header-info))))
+ (status-code (cdr (assq 'status-code header-info)))
+ (format
+ (twittering-get-content-subtype-symbol-from-header-info header-info)))
(case-string
status-code
(("200" "403" "404")
(debug-printf "connection-info=%s" connection-info)
(let* ((id (cdr (assq 'id connection-info)))
- (format (cdr (assq 'format connection-info)))
(user-screen-name (cdr (assq 'user-screen-name connection-info)))
(status
(cond

0 comments on commit c692ee9

Please sign in to comment.