Skip to content

Commit

Permalink
Add text properties to tweets on rendering.
Browse files Browse the repository at this point in the history 
* twittering-mode.el: Add text properties to tweets on rendering.
(twittering-http-get-default-sentinel): do not call
`twittering-make-clickable-status-datum'.
(twittering-make-clickable-status-datum): removed.
(twittering-make-string-with-user-name-property): new function.
(twittering-make-string-with-source-property): new function.
(twittering-make-fontified-tweet-text): new function.
(twittering-generate-format-table): add text properties.
  • Loading branch information
@cvmat
cvmat committed Jan 29, 2011
1 parent 3fd903e commit 8ad8d53
Show file tree
Hide file tree
Showing 2 changed files with 133 additions and 141 deletions.
9 changes: 9 additions & 0 deletions ChangeLog
View file
Expand Up @@ -52,6 +52,15 @@
(twittering-make-clickable-status-datum): do not redefine
`source'.

* twittering-mode.el: Add text properties to tweets on rendering.
(twittering-http-get-default-sentinel): do not call
`twittering-make-clickable-status-datum'.
(twittering-make-clickable-status-datum): removed.
(twittering-make-string-with-user-name-property): new function.
(twittering-make-string-with-source-property): new function.
(twittering-make-fontified-tweet-text): new function.
(twittering-generate-format-table): add text properties.

2011-01-23 Tadashi MATSUO <tad@mymail.twin.jp>

* test/test-twittering-mode.el: Add some tests for the format
Expand Down
265 changes: 124 additions & 141 deletions twittering-mode.el
View file
Expand Up @@ -1981,14 +1981,13 @@ the server when the HTTP status code equals to 400 or 403."
(statuses
(let ((xmltree
(twittering-xml-parse-region (point-min) (point-max))))
(mapcar 'twittering-make-clickable-status-datum
(cond
((null xmltree)
nil)
((eq 'search (car spec))
(twittering-atom-xmltree-to-status xmltree))
(t
(twittering-xmltree-to-status xmltree)))))))
(cond
((null xmltree)
nil)
((eq 'search (car spec))
(twittering-atom-xmltree-to-status xmltree))
(t
(twittering-xmltree-to-status xmltree))))))
(when statuses
(let ((new-statuses
(twittering-add-statuses-to-timeline-data statuses spec))
Expand Down Expand Up @@ -4274,134 +4273,6 @@ If `twittering-password' is nil, read it from the minibuffer."
(user-location location t)
(user-description description t))))))))))

(defun twittering-make-clickable-status-datum (status)
(flet ((assq-get (item seq)
(cdr (assq item seq))))
(let ((user-name (assq-get 'user-name status))
(id (assq-get 'id status))
(text (assq-get 'text status))
(source (assq-get 'source status))
(source-uri (assq-get 'source-uri status))
(created-at (assq-get 'created-at status))
(truncated (assq-get 'truncated status))
(in-reply-to-status-id (assq-get 'in-reply-to-status-id status))
(in-reply-to-screen-name (assq-get 'in-reply-to-screen-name status))
(user-id (assq-get 'user-id status))
(user-name (assq-get 'user-name status))
(user-screen-name (assq-get 'user-screen-name status))
(user-location (assq-get 'user-location status))
(user-description (assq-get 'user-description status))
(user-profile-image-url (assq-get 'user-profile-image-url status))
(user-url (assq-get 'user-url status))
(user-protected (assq-get 'user-protected status)))

;; make user-name clickable
(add-text-properties
0 (length user-name)
`(mouse-face highlight
keymap ,twittering-mode-on-uri-map
uri ,(twittering-get-status-url user-screen-name)
screen-name-in-text ,user-screen-name
goto-spec ,(twittering-string-to-timeline-spec
user-screen-name)
face twittering-username-face)
user-name)

;; make user-screen-name clickable
(add-text-properties
0 (length user-screen-name)
`(mouse-face highlight
keymap ,twittering-mode-on-uri-map
uri ,(twittering-get-status-url user-screen-name)
screen-name-in-text ,user-screen-name
goto-spec ,(twittering-string-to-timeline-spec
user-screen-name)
face twittering-username-face)
user-screen-name)

;; make hashtag, listname, screenname, and URI in text clickable
(let ((pos 0)
(regexp-str
(concat twittering-regexp-hash
"\\([a-zA-Z0-9_-]+\\)\\|"
twittering-regexp-atmark
"\\([a-zA-Z0-9_-]+/[a-zA-Z0-9_-]+\\)\\|"
twittering-regexp-atmark
"\\([a-zA-Z0-9_-]+\\)\\|"
"\\(https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\\)")))
(while
(and (string-match regexp-str text pos)
(let ((next-pos (match-end 0))
(hashtag (match-string-no-properties 1 text))
(listname (match-string-no-properties 2 text))
(screenname (match-string-no-properties 3 text))
(uri (match-string-no-properties 4 text))
beg end prop)
(if (eq next-pos pos)
nil
(cond
(hashtag
(setq beg (match-beginning 0) ;; XXX: not 1.
end (match-end 1))
(let ((spec (twittering-string-to-timeline-spec
(concat "#" hashtag)))
(url (twittering-get-search-url
(concat "#" hashtag))))
(setq prop
`(mouse-face
highlight
keymap ,twittering-mode-on-uri-map
uri ,url goto-spec ,spec
face twittering-username-face))))
(listname
(setq beg (match-beginning 2)
end (match-end 2)
prop `(mouse-face
highlight
keymap ,twittering-mode-on-uri-map
uri ,(twittering-get-status-url listname)
goto-spec
,(twittering-string-to-timeline-spec
listname)
face twittering-username-face)))
(screenname
(setq beg (match-beginning 3)
end (match-end 3)
prop `(mouse-face
highlight
keymap ,twittering-mode-on-uri-map
uri ,(twittering-get-status-url
screenname)
screen-name-in-text ,screenname
goto-spec
,(twittering-string-to-timeline-spec
screenname)
face twittering-uri-face)))
(uri
(setq beg (match-beginning 4)
end (match-end 4)
prop `(mouse-face
highlight
keymap ,twittering-mode-on-uri-map
uri ,uri
face twittering-uri-face)))
(t
(setq prop nil)))
(when prop
(add-text-properties beg end prop text))
(setq pos next-pos))))))

;; make source pretty and clickable
(add-text-properties
0 (length source)
`(mouse-face highlight
keymap ,twittering-mode-on-uri-map
uri ,source-uri
face twittering-uri-face
source ,source)
source)
status)))

(defun twittering-xmltree-to-status (xmltree)
(setq xmltree
(cond
Expand Down Expand Up @@ -5247,6 +5118,110 @@ following symbols;
(concat result skipped-string))
))

(defun twittering-make-string-with-user-name-property (str status)
(if str
(let* ((user-screen-name (cdr (assq 'user-screen-name status)))
(uri (twittering-get-status-url user-screen-name))
(spec (twittering-string-to-timeline-spec user-screen-name)))
(propertize str
'mouse-face 'highlight
'keymap twittering-mode-on-uri-map
'uri uri
'screen-name-in-text user-screen-name
'goto-spec spec
'face 'twittering-username-face))
""))

(defun twittering-make-string-with-source-property (str status)
(if str
(let ((uri (cdr (assq 'source-uri status))))
(propertize str
'mouse-face 'highlight
'keymap twittering-mode-on-uri-map
'uri uri
'face 'twittering-uri-face
'source str))
""))

(defun twittering-make-fontified-tweet-text (str)
(let* ((regexp-list
`(;; Hashtag
(hashtag . ,(concat twittering-regexp-hash "\\([a-zA-Z0-9_-]+\\)"))
;; @USER/LIST
(list-name . ,(concat twittering-regexp-atmark
"\\([a-zA-Z0-9_-]+/[a-zA-Z0-9_-]+\\)"))
;; @USER
(screen-name
. ,(concat twittering-regexp-atmark "\\([a-zA-Z0-9_-]+\\)"))
;; URI
(uri . "\\(https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\\)")))
(regexp-str (mapconcat 'cdr regexp-list "\\|"))
(pos 0)
(str (copy-sequence str)))
(while (string-match regexp-str str pos)
(let* ((entry
;; Find matched entries.
(let ((rest regexp-list)
(counter 1))
(while (and rest (not (match-string counter str)))
(setq rest (cdr rest))
(setq counter (1+ counter)))
(when rest
(list (caar rest)
(match-beginning counter)
(match-string counter str)))))
(sym (elt entry 0))
(matched-beg (elt entry 1))
(matched-str (elt entry 2))
(beg (if (memq sym '(list-name screen-name))
;; Properties are added to the matched part only.
;; The prefixes `twittering-regexp-atmark' will not
;; be highlighted.
matched-beg
(match-beginning 0)))
(end (match-end 0))
(properties
(cond
((eq sym 'hashtag)
(let* ((hashtag matched-str)
(spec
(twittering-string-to-timeline-spec
(concat "#" hashtag)))
(url (twittering-get-search-url (concat "#" hashtag))))
(list
'mouse-face 'highlight
'keymap twittering-mode-on-uri-map
'uri url
'goto-spec spec
'face 'twittering-username-face)))
((eq sym 'list-name)
(let ((list-name matched-str))
(list
'mouse-face 'highlight
'keymap twittering-mode-on-uri-map
'uri (twittering-get-status-url list-name)
'goto-spec (twittering-string-to-timeline-spec list-name)
'face 'twittering-username-face)))
((eq sym 'screen-name)
(let ((screen-name matched-str))
(list
'mouse-face 'highlight
'keymap twittering-mode-on-uri-map
'uri (twittering-get-status-url screen-name)
'screen-name-in-text screen-name
'goto-spec (twittering-string-to-timeline-spec screen-name)
'face 'twittering-uri-face)))
((eq sym 'uri)
(let ((uri matched-str))
(list
'mouse-face 'highlight
'keymap twittering-mode-on-uri-map
'uri uri
'face 'twittering-uri-face))))))
(add-text-properties beg end properties str)
(setq pos end)))
str))

(defun twittering-generate-format-table (status-sym prefix-sym)
`(("%" . "%")
("}" . "}")
Expand All @@ -5255,7 +5230,9 @@ following symbols;
"..."))
("c" . (cdr (assq 'created-at ,status-sym)))
("d" . (cdr (assq 'user-description ,status-sym)))
("f" . (cdr (assq 'source ,status-sym)))
("f" .
(twittering-make-string-with-source-property
(cdr (assq 'source ,status-sym)) ,status-sym))
("i" .
(when (and twittering-icon-mode window-system)
(let ((url
Expand Down Expand Up @@ -5312,10 +5289,16 @@ following symbols;
(or (cdr (assq 'original-user-screen-name ,status-sym)) "")))
(unless (string= "" retweeted-by)
(concat " (retweeted by " retweeted-by ")"))))
("S" . (cdr (assq 'user-name ,status-sym)))
("s" . (cdr (assq 'user-screen-name ,status-sym)))
("T" . (cdr (assq 'text ,status-sym)))
("t" . (cdr (assq 'text ,status-sym)))
("S" .
(twittering-make-string-with-user-name-property
(cdr (assq 'user-name ,status-sym)) ,status-sym))
("s" .
(twittering-make-string-with-user-name-property
(cdr (assq 'user-screen-name ,status-sym)) ,status-sym))
("T" .
(twittering-make-fontified-tweet-text (cdr (assq 'text ,status-sym))))
("t" .
(twittering-make-fontified-tweet-text (cdr (assq 'text ,status-sym))))
("u" . (cdr (assq 'user-url ,status-sym)))))

(defun twittering-generate-formater-for-first-spec (format-str status-sym prefix-sym)
Expand Down

0 comments on commit 8ad8d53

Please sign in to comment.