- Timestamp:
- 07/21/08 03:12:25 (16 years ago)
- Location:
- lang/elisp/wassr-mode/trunk
- Files:
-
- 2 modified
Legend:
- Unmodified
- Added
- Removed
-
lang/elisp/wassr-mode/trunk/ChangeLog
r55 r57 1 2008-07-21 Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com> 2 3 * wassr-mode.el: コメント欄整理(一応) 4 (wassr-api-server): 新規定数 5 (wassr-http-get, wassr-http-post): 定数を利用するように調整、多い 6 改行削除、Connection: Keep-Aliveを追加 7 (wassr-status-format): 新フォーマット用に調整(未完) 8 (wassr-format-status): 同上 9 (wassr-status-to-status-datum): 同上 10 (wassr-get-status-url): URL文字列を調整 11 1 12 2008-07-09 Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com> 2 13 -
lang/elisp/wassr-mode/trunk/wassr-mode.el
r54 r57 3 3 ;; Copyright (C) 2008 Tsuyoshi CHO 4 4 5 ;; Author: Y. Hayamizu <y.hayamizu@gmail.com> 6 ;; Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com> 5 ;; Author: Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com> 7 6 ;; Created: Sep 4, 2007 8 7 ;; Version: 0.4 9 8 ;; Keywords: wassr web 10 ;; URL: 9 ;; URL: http://lambdarepos.svnrepository.com/svn/share/lang/elisp/wassr-mode/trunk 11 10 12 11 ;; This file is free software; you can redistribute it and/or modify … … 38 37 (require 'parse-time) 39 38 40 (defconst wassr-mode-version "0. 1")39 (defconst wassr-mode-version "0.2") 41 40 42 41 (defun wassr-mode-version () … … 68 67 69 68 (defvar wassr-status-format nil) 70 (setq wassr-status-format "%i %s, %@:\n %t // from % f%L")69 (setq wassr-status-format "%i %s, %@:\n %t // from %A") 71 70 ;; %s - screen_name 72 ;; %S - name71 ;; %S - user_login_id 73 72 ;; %i - profile_image 74 ;; % d - description75 ;; % l - location76 ;; % L - " [location]"77 ;; % u -url78 ;; % j - user.id79 ;; % p- protected?80 ;; %c - created_at (raw UTC string)81 ;; %C{time-format-str} - created_at(formatted with time-format-str)73 ;; %a - areacode 74 ;; %A - areaname 75 ;; %u - link 76 ;; %p - photo-thumbnail-url 77 ;; %P - photo-url 78 ;; %x - protected? 79 ;; %c - epoch 80 ;; %C{time-format-str} - epoch (formatted with time-format-str) 82 81 ;; %@ - X seconds ago 83 82 ;; %t - text 84 ;; %' - truncated 85 ;; %f - source 83 ;; %T - html 86 84 ;; %# - id 87 85 88 86 (defvar wassr-buffer "*wassr*") 87 (defconst wassr-api-server "api.wassr.jp") 89 88 (defun wassr-buffer () 90 89 (wassr-get-or-generate-buffer wassr-buffer)) … … 334 333 (int-to-string wassr-proxy-port) 335 334 wassr-proxy-port)) 336 (setq server "api.wassr.jp"335 (setq server wassr-api-server 337 336 port "80")) 338 337 (setq proc … … 346 345 request) 347 346 (setq request 348 (concat "GET http:// api.wassr.jp/" method-class "/" method ".xml HTTP/1.1" nl349 "Host: api.wassr.jp"nl347 (concat "GET http://" wassr-api-server "/" method-class "/" method ".xml HTTP/1.1" nl 348 "Host: " wassr-api-server nl 350 349 "User-Agent: " (wassr-user-agent) nl 351 350 "Authorization: Basic " … … 360 359 ",image/png,*/*;q=0.5" nl 361 360 "Accept-Charset: utf-8;q=0.7,*;q=0.7" nl 361 "Connection: Keep-Alive" nl 362 362 (when wassr-proxy-use 363 363 "Proxy-Connection: Keep-Alive" nl … … 369 369 proxy-password)) 370 370 nl))) 371 nl nl))371 nl)) 372 372 (debug-print (concat "GET Request\n" request)) 373 373 request))) … … 458 458 (list-push (attr 'user-screen-name) result)) 459 459 ((?S) ; %S - name 460 (list-push (attr 'user- name) result))460 (list-push (attr 'user-login-id) result)) 461 461 ((?i) ; %i - profile_image 462 462 (list-push (profile-image) result)) 463 ((?d) ; %d - description 464 (list-push (attr 'user-description) result)) 465 ((?l) ; %l - location 466 (list-push (attr 'user-location) result)) 467 ((?L) ; %L - " [location]" 468 (let ((location (attr 'user-location))) 469 (unless (or (null location) (string= "" location)) 470 (list-push (concat " [" location "]") result)) )) 471 ((?u) ; %u - url 472 (list-push (attr 'user-url) result)) 473 ((?j) ; %j - user.id 474 (list-push (format "%d" (attr 'user-id)) result)) 475 ((?p) ; %p - protected? 463 ((?a) ; 464 (list-push (attr 'areacode) result)) 465 ((?A) ; 466 (list-push (attr 'areaname) result)) 467 ((?u) ; %u - link 468 (list-push (attr 'link) result)) 469 ((?p) ; %u - link 470 (list-push (attr 'photo-thumbnail-url) result)) 471 ((?P) ; %u - link 472 (list-push (attr 'photo-url) result)) 473 ((?x) ; %p - protected? 476 474 (let ((protected (attr 'user-protected))) 477 475 (when (string= "true" protected) 478 476 (list-push "[x]" result)))) 479 ((?c) ; %c - created_at (raw UTC string) 480 (list-push (attr 'created-at) result)) 481 ((?C) ; %C{time-format-str} - created_at (formatted with time-format-str) 482 (list-push (wassr-local-strftime 483 (or (match-string-no-properties 2 format-str) "%H:%M:%S") 484 (attr 'created-at)) 485 result)) 477 ((?c) ; %c - epoch (raw UTC string) 478 (list-push (attr 'epoch) result)) 479 ((?C) ; %C{time-format-str} - epoch (formatted with time-format-str) 480 (list-push (attr 'epoch) result));;FIXME 486 481 ((?@) ; %@ - X seconds ago 487 (let ((created-at 488 (apply 489 'encode-time 490 (parse-time-string (attr 'created-at)))) 491 (now (current-time))) 492 (let ((secs (+ (* (- (car now) (car created-at)) 65536) 493 (- (cadr now) (cadr created-at)))) 494 time-string url) 495 (setq time-string 496 (cond ((< secs 5) "less than 5 seconds ago") 497 ((< secs 10) "less than 10 seconds ago") 498 ((< secs 20) "less than 20 seconds ago") 499 ((< secs 30) "half a minute ago") 500 ((< secs 60) "less than a minute ago") 501 ((< secs 150) "1 minute ago") 502 ((< secs 2400) (format "%d minutes ago" 503 (/ (+ secs 30) 60))) 504 ((< secs 5400) "about 1 hour ago") 505 ((< secs 84600) (format "about %d hours ago" 506 (/ (+ secs 1800) 3600))) 507 (t (format-time-string "%I:%M %p %B %d, %Y" created-at)))) 508 (setq url (wassr-get-status-url (attr 'user-screen-name) (attr 'id))) 509 ;; make status url clickable 510 (add-text-properties 511 0 (length time-string) 512 `(mouse-face highlight 513 face wassr-uri-face 514 uri ,url) 515 time-string) 516 (list-push time-string result)))) 482 (list-push (attr 'epoch) result));;FIXME 517 483 ((?t) ; %t - text 518 484 (list-push ;(clickable-text) 519 485 (attr 'text) 520 486 result)) 521 ((?') ; %' - truncated 522 (let ((truncated (attr 'truncated))) 523 (when (string= "true" truncated) 524 (list-push "..." result)))) 525 ((?f) ; %f - source 526 (list-push (attr 'source) result)) 487 ((?T) ; %T - html 488 (list-push ;(clickable-text) 489 (attr 'html) 490 result)) 527 491 ((?#) ; %# - id 528 (list-push ( format "%d" (attr 'id)) result))492 (list-push (attr 'id) result)) 529 493 (t 530 494 (list-push (char-to-string c) result))) … … 540 504 (defun wassr-http-post 541 505 (method-class method &optional parameters contents sentinel) 542 "Send HTTP POST request to api.wassr.jp506 "Send HTTP POST request to `wassr-api-server' 543 507 544 508 METHOD-CLASS must be one of Wassr API method classes(statuses, users or direct_messages). … … 561 525 (int-to-string wassr-proxy-port) 562 526 wassr-proxy-port)) 563 (setq server "api.wassr.jp"527 (setq server wassr-api-server 564 528 port "80")) 565 529 (setq proc … … 573 537 request) 574 538 (setq request 575 (concat "POST http:// api.wassr.jp/" method-class "/" method ".xml?"539 (concat "POST http://" wassr-api-server "/" method-class "/" method ".xml?" 576 540 (if parameters 577 541 (mapconcat … … 583 547 "&")) 584 548 " HTTP/1.1" nl 585 "Host: api.wassr.jp"nl549 "Host: " wassr-api-server nl 586 550 "User-Agent: " (wassr-user-agent) nl 587 551 "Authorization: Basic " … … 591 555 "Content-Type: text/plain" nl 592 556 "Content-Length: 0" nl 557 "Connection: Keep-Alive" nl 593 558 (when wassr-proxy-use 594 559 "Proxy-Connection: Keep-Alive" nl … … 600 565 proxy-password)) 601 566 nl))) 602 nl nl))567 nl)) 603 568 (debug-print (concat "POST Request\n" request)) 604 569 request))))) … … 669 634 (car (cddr (assq item seq))))) 670 635 (let* ((status-data (cddr status)) 671 id text source created-at truncated 636 html 637 text 638 epoch 639 rid 640 id 641 user-login-id ;; user_login_id 642 link 643 photo-url ;; photo_url 644 areacode 645 areaname 646 photo-thumbnail-url ;; photo_thumbnail_url 647 reply-status-url ;; reply_status_url 648 reply-user-login-id ;; reply_user_login_id 649 reply-message ;; reply_message 650 reply-user-nick ;; reply_user_nick 651 slurl 672 652 (user-data (cddr (assq 'user status-data))) 673 user-id user-name 674 user-screen-name 675 user-location 676 user-description 677 user-profile-image-url 678 user-url 679 user-protected 653 user-protected ;; protected 654 user-profile-image-url ;; profile_image_url 655 user-screen-name ;; screen_name 680 656 regex-index) 681 657 682 (setq id (string-to-number (assq-get 'id status-data)))683 658 (setq text (wassr-decode-html-entities 684 659 (assq-get 'text status-data))) 685 (setq source (wassr-decode-html-entities 686 (assq-get 'source status-data))) 687 (setq created-at (assq-get 'created_at status-data)) 688 (setq truncated (assq-get 'truncated status-data)) 689 (setq user-id (string-to-number (assq-get 'id user-data))) 690 (setq user-name (wassr-decode-html-entities 691 (assq-get 'name user-data))) 660 (setq html (wassr-decode-html-entities 661 (assq-get 'html status-data))) 662 (setq epoch (assq-get 'epoch status-data)) 663 (setq rid (assq-get 'rid status-data)) 664 (setq id (assq-get 'id status-data)) 665 (setq user-login-id (assq-get 'user_login_id status-data)) 666 (setq link (assq-get 'link status-data)) 667 (setq photo-url (assq-get 'photo_url status-data)) 668 (setq areacode (assq-get 'areacode status-data)) 669 (setq areaname (assq-get 'areaname status-data)) 670 (setq photo-thumbnail-url (assq-get 'photo_thumbnail_url status-data)) 671 (setq reply-status-url (assq-get 'reply_status_url status-data)) 672 (setq reply-user-login-id (assq-get 'reply_user_login_id status-data)) 673 (setq reply-message (assq-get 'reply_message status-data)) 674 (setq reply-user-nick (assq-get 'reply_user_nick status-data)) 675 (setq slurl (assq-get 'slurl status-data)) 692 676 (setq user-screen-name (wassr-decode-html-entities 693 677 (assq-get 'screen_name user-data))) 694 (setq user-location (wassr-decode-html-entities695 (assq-get 'location user-data)))696 (setq user-description (wassr-decode-html-entities697 (assq-get 'description user-data)))698 678 (setq user-profile-image-url (assq-get 'profile_image_url user-data)) 699 (setq user-url (assq-get 'url user-data))700 679 (setq user-protected (assq-get 'protected user-data)) 701 680 702 681 ;; make username clickable 703 682 (add-text-properties 704 0 (length user- name)683 0 (length user-login-id) 705 684 `(mouse-face highlight 706 uri ,(concat "http:// api.wassr.jp/" user-screen-name)685 uri ,(concat "http://wassr.jp/user/" user-screen-name) 707 686 face wassr-username-face) 708 user- name)687 user-login-id) 709 688 710 689 ;; make screen-name clickable … … 713 692 `(mouse-face highlight 714 693 face wassr-username-face 715 uri ,(concat "http:// api.wassr.jp/" user-screen-name)694 uri ,(concat "http://wassr.jp/user/" user-screen-name) 716 695 face wassr-username-face) 717 696 user-screen-name) … … 737 716 highlight 738 717 face wassr-uri-face 739 uri ,(concat "http:// api.wassr.jp/" screen-name))718 uri ,(concat "http://wassr.jp/user/" screen-name)) 740 719 `(mouse-face highlight 741 720 face wassr-uri-face … … 744 723 (setq regex-index (match-end 0)) )) 745 724 746 747 ;; make source pretty and clickable748 (if (string-match "<a href=\"\\(.*\\)\">\\(.*\\)</a>" source)749 (let ((uri (match-string-no-properties 1 source))750 (caption (match-string-no-properties 2 source)))751 (setq source caption)752 (add-text-properties753 0 (length source)754 `(mouse-face highlight755 uri ,uri756 face wassr-uri-face757 source ,source)758 source)759 ))760 761 725 (mapcar 762 726 (lambda (sym) 763 727 `(,sym . ,(symbol-value sym))) 764 '(id text source created-at truncated 765 user-id user-name user-screen-name user-location 766 user-description 767 user-profile-image-url 768 user-url 769 user-protected))))) 728 '(html text epoch rid id user-login-id 729 link photo-url areacode areaname 730 photo-thumbnail-url 731 reply-status-url 732 reply-user-login-id 733 reply-message 734 reply-user-nick 735 slurl 736 user-protected 737 user-profile-image-url 738 user-screen-name 739 ))))) 770 740 771 741 (defun wassr-xmltree-to-status (xmltree) … … 1037 1007 (defun wassr-get-status-url (username id) 1038 1008 "Generate status URL." 1039 (format "http:// api.wassr.jp/%s/statuses/%d" username id))1009 (format "http://wassr.jp/user/%s/statuses/%" username id)) 1040 1010 1041 1011 ;;;###autoload