diff options
Diffstat (limited to '.emacs.d/identica-mode-1.1/identica-mode.el')
| -rw-r--r-- | .emacs.d/identica-mode-1.1/identica-mode.el | 1853 |
1 files changed, 0 insertions, 1853 deletions
diff --git a/.emacs.d/identica-mode-1.1/identica-mode.el b/.emacs.d/identica-mode-1.1/identica-mode.el deleted file mode 100644 index 86ff386..0000000 --- a/.emacs.d/identica-mode-1.1/identica-mode.el +++ /dev/null @@ -1,1853 +0,0 @@ -;;; identica-mode.el --- Major mode for Identica - -;; Copyright (C) 2008, 2009, 2010 Gabriel Saldana -;; Copyright (C) 2009 Bradley M. Kuhn - -;; Author: Gabriel Saldana <gsaldana@gmail.com> -;; Last update: 2010-11-26 -;; Version: 1.1 -;; Keywords: identica web -;; URL: http://blog.nethazard.net/identica-mode-for-emacs/ -;; Contributors: -;; Jason McBrayer <jmcbray@carcosa.net> (minor updates for working under Emacs 23) -;; Alex Schröder <kensanata@gmail.com> (mode map patches) -;; Christian Cheng (fixed long standing xml parsing bug) -;; Carlos A. Perilla from denting-mode -;; Alberto Garcia <agarcia@igalia.com> (integrated patch from twittering-mode for retrieving multiplemethods) -;; Bradley M. Kuhn <bkuhn@ebb.org> (editing status from edit-buffer rather than minibuffer) -;; Jason McBrayer <jmcbray@carcosa.net> (replace group tags with hashtags on redents, longlines use) -;; Sean Neakums (patches of bugs flagged by byte-compiler) -;; Shyam Karanatt <shyam@swathanthran.in> (several patches and code cleanup, new http backend based on url.el) -;; Tezcatl Franco <tzk@riseup.net> (ur1.ca support) -;; Anthony Garcia <lagg@lavabit.com> (fix for icon-mode) - -;; Identica Mode is a major mode to check friends timeline, and update your -;; status on Emacs. - -;; identica-mode.el is a major mode for Identica. Based on the twittering mode -;; version 0.6 by Y. Hayamizu and Tsuyoshi CHO found at -;; <http://hayamin.com/wiliki.cgi?twittering-mode-en&l=en> - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth floor, -;; Boston, MA 02110-1301, USA. - -;; Requirements -;; if using Emacs22 or previous, you'll need json.el -;; get it from http://edward.oconnor.cx/2006/03/json.el -;; json.el is part of Emacs23 - -;; Installation - -;; You can use M-x customize-group identica-mode to setup all settings or simply -;; add the following to your .emacs or your prefered customizations file - -;; (require 'identica-mode) -;; (setq identica-username "yourusername") -;; (setq identica-password "yourpassword") - -;; If you want to post from the minibufer without having identica buffer active, add the following global keybinding. -;; Add this to send status updates -;; (global-set-key "\C-cip" 'identica-update-status-interactive) -;; Add this to send direct messages -;; (global-set-key "\C-cid" 'identica-direct-message-interactive) - -;; If you want to connect to a custom statusnet server add this and change -;; identi.ca with your server's doman name. - -;; (setq statusnet-server "identi.ca") - -;; Start using with M-x identica - -;; Follow me on identica: http://identi.ca/gabrielsaldana - -(require 'cl) -(require 'xml) -(require 'parse-time) -(require 'longlines) -(require 'url) -(require 'url-http) -(require 'json) - -(defconst identica-mode-version "1.1") - -;;url-basepath fix for emacs22 -(unless (fboundp 'url-basepath) - (defalias 'url-basepath 'url-file-directory)) - -(defgroup identica-mode nil - "Identica Mode for microblogging" - :tag "Microblogging" - :link '(url-link http://blog.nethazard.net/identica-mode-for-emacs/) - :group 'applications ) - -(defun identica-mode-version () - "Display a message for identica-mode version." - (interactive) - (let ((version-string - (format "identica-mode-v%s" identica-mode-version))) - (if (interactive-p) - (message "%s" version-string) - version-string))) - -(defvar identica-mode-map (make-sparse-keymap "Identi.ca")) -(defvar menu-bar-identica-mode-menu nil) -(defvar identica-timer nil "Timer object for timeline refreshing will be stored here. DO NOT SET VALUE MANUALLY.") -(defvar identica-last-timeline-retrieved nil) - -(defvar identica-urlshortening-services-map - '((tinyurl . "http://tinyurl.com/api-create.php?url=") - (toly . "http://to.ly/api.php?longurl=") - (google . "http://ggl-shortener.appspot.com/?url=") - (ur1ca . "http://ur1.ca") - (tighturl . "http://2tu.us")) - "Alist of tinyfy services") - -(defvar identica-new-dents-count 0 - "Number of new tweets when `identica-new-dents-hook' is run") - -(defvar identica-new-dents-hook nil - "Hook run when new twits are received. - -You can read `identica-new-dents-count' to get the number of new -tweets received when this hook is run.") - -(defvar identica-display-max-dents nil - "How many dents to keep on the displayed timeline. - -If non-nil, dents over this amount will bre removed.") - -;; Menu -(unless menu-bar-identica-mode-menu - (easy-menu-define - menu-bar-identica-mode-menu identica-mode-map "" - '("Identi.ca" - ["Send an update" identica-update-status-interactive t] - ["Send a direct message" identica-direct-message-interactive t] - ["Re-dent someone's update" identica-redent t] - ["Repeat someone's update" identica-repeat t] - ["Add as favorite" identica-favorite t] - ["Follow user" identica-follow] - ["Unfollow user" identica-unfollow] - ["--" nil nil] - ["Friends timeline" identica-friends-timeline t] - ["Public timeline" identica-public-timeline t] - ["Replies timeline" identica-replies-timeline t] - ["User timeline" identica-user-timeline t] - ["Group timeline" identica-group-timeline t] - ["Tag timeline" identica-tag-timeline t] -))) - -(defcustom identica-idle-time 20 - "Idle time" - :type 'integer - :group 'identica-mode) - -(defcustom identica-timer-interval 90 - "Timer interval to refresh the timeline" - :type 'integer - :group 'identica-mode) - -(defcustom identica-username nil - "Your identi.ca username. If nil, you will be prompted" - :type '(choice (const :tag "Ask" nil) (string)) - :group 'identica-mode) - -(defcustom identica-password nil - "Your identi.ca password. If nil, you will be prompted" - :type '(choice (const :tag "Ask" nil) (string)) - :group 'identica-mode) - -(defcustom statusnet-server "identi.ca" - "Statusnet instance url" - :type 'string - :group 'identica-mode) - -(defcustom statusnet-port 80 - "Port on which StatusNet instance listens" - :type 'integer - :group 'identica-mode) - -(defcustom identica-default-timeline "friends_timeline" - "Default timeline to retrieve" - :type 'string - :options '("friends_timeline" "public_timeline" "replies") - :group 'identica-mode) - -(defcustom identica-display-success-messages nil - "Display messages when the timeline is successfully retrieved" - :type 'boolean - :group 'identica-mode) - -(defcustom identica-oldest-first nil - "If t, display older messages before newer ones" - :type 'boolean - :group 'identica-mode) - -(defcustom identica-update-status-edit-confirm-cancellation nil - "If t, ask user if they are sure when aborting editing of an - identica status update when using an edit-buffer" - :type 'boolean - :group 'identica-mode) - -(defcustom identica-soft-wrap-status nil - "If non-nil, don't fill status messages in the timeline as - paragraphs. Instead, use visual-line-mode or longlines-mode if - available to wrap messages. This may work better for narrow - timeline windows." - :type 'boolean - :group 'identica-mode) - -(defcustom identica-update-status-method 'minibuffer - "Method for performaing status updates. - -The available choices are: - - 'minibuffer - edit the status update in the minibuffer. - 'edit-buffer - edit the status update in an independent buffer." - :type '(choice (const :tag "Edit status in minibuffer" minibuffer) - (const :tag "Edit status in independent buffer" edit-buffer)) - :group 'identica-mode) - -(defcustom identica-http-get-timeout 10 - "Controls how long to wait for a response from the server." - :type 'integer - :group 'identica-mode) - -;; Initialize with default timeline -(defvar identica-method identica-default-timeline) -(defvar identica-method-class "statuses") - -(defvar identica-scroll-mode nil) -(make-variable-buffer-local 'identica-scroll-mode) - -(defvar identica-source "identica-mode") - -(defcustom identica-redent-format "♻" - "The format/symbol to represent redents" - :type 'string - :group 'identica-mode) - -(defcustom identica-status-format "%i %s, %@:\n %t // from %f%L%r" - "The format used to display the status updates" - :type 'string - :group 'identica-mode) -;; %s - screen_name -;; %S - name -;; %i - profile_image -;; %d - description -;; %l - location -;; %L - " [location]" -;; %r - in reply to status -;; %u - url -;; %j - user.id -;; %p - protected? -;; %c - created_at (raw UTC string) -;; %C{time-format-str} - created_at (formatted with time-format-str) -;; %@ - X seconds ago -;; %t - text -;; %' - truncated -;; %f - source -;; %# - id - -(defcustom identica-urlshortening-service 'ur1ca - "The service to use for URL shortening. Values understood are -ur1ca, tighturl, tinyurl, toly, and google" - :type 'symbol - :group 'identica-mode) - -(defvar identica-buffer "*identica*") -(defun identica-buffer (&optional method) - (unless method - (setq method "friends_timeline")) - (identica-get-or-generate-buffer identica-buffer)) - -(defvar identica-http-buffer nil - "Pointer to the current http response buffer.") - -(defvar identica-timeline-data nil) -(defvar identica-timeline-last-update nil) - -(defvar identica-username-face 'identica-username-face) -(defvar identica-uri-face 'identica-uri-face) -(defvar identica-reply-face 'identica-reply-face) - -(defun identica-get-or-generate-buffer (buffer) - (if (bufferp buffer) - (if (buffer-live-p buffer) - buffer - (generate-new-buffer (buffer-name buffer))) - (if (stringp buffer) - (or (get-buffer buffer) - (generate-new-buffer buffer))))) - -(defun assocref (item alist) - (cdr (assoc item alist))) -(defmacro list-push (value listvar) - `(setq ,listvar (cons ,value ,listvar))) - -;;; Proxy -(defvar identica-proxy-use nil) -(defvar identica-proxy-server nil) -(defvar identica-proxy-port 8080) -(defvar identica-proxy-user nil) -(defvar identica-proxy-password nil) - -(defun identica-toggle-proxy () "" - (interactive) - (setq identica-proxy-use - (not identica-proxy-use)) - (message "%s %s" - "Use Proxy:" - (if identica-proxy-use - "on" "off"))) - -(defun identica-user-agent-default-function () - "Identica mode default User-Agent function." - (concat "Emacs/" - (int-to-string emacs-major-version) "." (int-to-string - emacs-minor-version) - " " - "Identica-mode/" - identica-mode-version)) - -(defvar identica-user-agent-function 'identica-user-agent-default-function) - -(defun identica-user-agent () - "Return User-Agent header string." - (funcall identica-user-agent-function)) - -;;; to show image files - -(defvar identica-tmp-dir - (expand-file-name (concat "identicamode-images-" (user-login-name)) - temporary-file-directory)) - -(defvar identica-icon-mode nil "You MUST NOT CHANGE this variable directory. You should change through function'identica-icon-mode'") -(make-variable-buffer-local 'identica-icon-mode) -(defun identica-icon-mode (&optional arg) - (interactive) - (setq identica-icon-mode - (if identica-icon-mode - (if (null arg) - nil - (> (prefix-numeric-value arg) 0)) - (when (or (null arg) - (and arg (> (prefix-numeric-value arg) 0))) - (when (file-writable-p identica-tmp-dir) - (progn - (if (not (file-directory-p identica-tmp-dir)) - (make-directory identica-tmp-dir)) - t))))) - (identica-get-timeline)) - -(defun identica-scroll-mode (&optional arg) - (interactive) - (setq identica-scroll-mode - (if (null arg) - (not identica-scroll-mode) - (> (prefix-numeric-value arg) 0)))) - -(defvar identica-image-stack nil) - -(defun identica-image-type (file-name) - (cond - ((string-match "\\.jpe?g" file-name) 'jpeg) - ((string-match "\\.png" file-name) 'png) - ((string-match "\\.gif" file-name) 'gif) - (t nil))) - -(defun identica-setftime (fmt string uni) - (format-time-string fmt ; like "%Y-%m-%d %H:%M:%S" - (apply 'encode-time (parse-time-string string)) - uni)) -(defun identica-local-strftime (fmt string) - (identica-setftime fmt string nil)) -(defun identica-global-strftime (fmt string) - (identica-setftime fmt string t)) - -(defvar identica-debug-mode nil) -(defvar identica-debug-buffer "*identica-debug*") -(defun identica-debug-buffer () - (identica-get-or-generate-buffer identica-debug-buffer)) -(defmacro debug-print (obj) - (let ((obsym (gensym))) - `(let ((,obsym ,obj)) - (if identica-debug-mode - (with-current-buffer (identica-debug-buffer) - (insert (prin1-to-string ,obsym)) - (newline) - ,obsym) - ,obsym)))) - -(defun identica-debug-mode () - (interactive) - (setq identica-debug-mode - (not identica-debug-mode)) - (message (if identica-debug-mode "debug mode:on" "debug mode:off"))) - -(defun identica-delete-notice () - (interactive) - (let ((id (get-text-property (point) 'id)) - (usern (get-text-property (point) 'username))) - (if (string= usern identica-username) - (when (y-or-n-p "Delete this notice? ") - (identica-http-post "statuses/destroy" (number-to-string id)) - (identica-get-timeline)) - (message "Can't delete a notice that isn't yours")))) - -(if identica-mode-map - (let ((km identica-mode-map)) - (define-key km "\C-c\C-f" 'identica-friends-timeline) -;; (define-key km "\C-c\C-i" 'identica-direct-messages-timeline) - (define-key km "\C-c\C-r" 'identica-replies-timeline) - (define-key km "\C-c\C-a" 'identica-public-timeline) - (define-key km "\C-c\C-g" 'identica-group-timeline) - (define-key km "\C-c\C-t" 'identica-tag-timeline) - (define-key km "\C-c\C-k" 'identica-stop) - (define-key km "\C-c\C-u" 'identica-user-timeline) - (define-key km "\C-c\C-s" 'identica-update-status-interactive) - (define-key km "\C-c\C-d" 'identica-direct-message-interactive) - (define-key km "\C-c\C-m" 'identica-redent) - (define-key km "r" 'identica-repeat) - (define-key km "F" 'identica-favorite) - (define-key km "\C-c\C-e" 'identica-erase-old-statuses) - (define-key km "\C-m" 'identica-enter) - (define-key km "R" 'identica-reply-to-user) - (define-key km "\t" 'identica-next-link) - (define-key km [backtab] 'identica-prev-link) - (define-key km [mouse-1] 'identica-click) - (define-key km "\C-c\C-v" 'identica-view-user-page) - (define-key km "q" 'bury-buffer) - (define-key km "j" 'identica-goto-next-status) - (define-key km "k" 'identica-goto-previous-status) - (define-key km "l" 'forward-char) - (define-key km "h" 'backward-char) - (define-key km "0" 'beginning-of-line) - (define-key km "^" 'beginning-of-line-text) - (define-key km "$" 'end-of-line) - (define-key km "n" 'identica-goto-next-status-of-user) - (define-key km "p" 'identica-goto-previous-status-of-user) - (define-key km [backspace] 'scroll-down) - (define-key km " " 'scroll-up) - (define-key km "G" 'end-of-buffer) - (define-key km "g" 'identica-current-timeline) - (define-key km "H" 'beginning-of-buffer) - (define-key km "i" 'identica-icon-mode) - (define-key km "s" 'identica-scroll-mode) - (define-key km "t" 'identica-toggle-proxy) - (define-key km "\C-k" 'identica-delete-notice) - (define-key km "\C-c\C-p" 'identica-toggle-proxy) - nil)) - -(defvar identica-mode-syntax-table nil "") - -(if identica-mode-syntax-table - () - (setq identica-mode-syntax-table (make-syntax-table)) - ;; (modify-syntax-entry ? "" identica-mode-syntax-table) - (modify-syntax-entry ?\" "w" identica-mode-syntax-table)) - -(defun identica-mode-init-variables () - ;; (make-variable-buffer-local 'variable) - ;; (setq variable nil) - (font-lock-mode -1) - (defface identica-username-face - `((t nil)) "" :group 'faces) - (copy-face 'font-lock-string-face 'identica-username-face) - (set-face-attribute 'identica-username-face nil :underline t) - (defface identica-reply-face - `((t nil)) "" :group 'faces) - (copy-face 'font-lock-string-face 'identica-reply-face) - (set-face-attribute 'identica-reply-face nil :foreground "white") - (set-face-attribute 'identica-reply-face nil :background "DarkSlateGray") - (defface identica-uri-face - `((t nil)) "" :group 'faces) - - (set-face-attribute 'identica-uri-face nil :underline t) - (add-to-list 'minor-mode-alist '(identica-icon-mode " id-icon")) - (add-to-list 'minor-mode-alist '(identica-scroll-mode " id-scroll"))) - -(defmacro case-string (str &rest clauses) - `(cond - ,@(mapcar - (lambda (clause) - (let ((keylist (car clause)) - (body (cdr clause))) - `(,(if (listp keylist) - `(or ,@(mapcar (lambda (key) `(string-equal ,str ,key)) keylist)) - 't) - ,@body))) - clauses))) - -;; If you use Emacs21, decode-char 'ucs will fail unless Mule-UCS is loaded. -;; TODO: Show error messages if Emacs 21 without Mule-UCS -(defmacro identica-ucs-to-char (num) - (if (functionp 'ucs-to-char) - `(ucs-to-char ,num) - `(decode-char 'ucs ,num))) - -(defvar identica-mode-string identica-method) - -(defun identica-set-mode-string (loading) - (setq mode-name - (if loading (concat "loading " identica-method "...") identica-method))) - -(defvar identica-mode-hook nil - "Identica-mode hook.") - -(defun identica-kill-buffer-function () - (when (eq major-mode 'identica-mode) - (identica-stop))) - -(defun identica-mode () - "Major mode for Identica -\\{identica-mode-map}" - (interactive) - (switch-to-buffer (identica-buffer)) - (buffer-disable-undo (identica-buffer)) - (kill-all-local-variables) - (identica-mode-init-variables) - (use-local-map identica-mode-map) - (setq major-mode 'identica-mode) - (setq mode-name identica-mode-string) - (setq mode-line-buffer-identification - `(,(default-value 'mode-line-buffer-identification) - (:eval (identica-mode-line-buffer-identification)))) - (identica-update-mode-line) - (set-syntax-table identica-mode-syntax-table) - (font-lock-mode -1) - (if identica-soft-wrap-status - (if (fboundp 'visual-line-mode) - (visual-line-mode t) - (if (fboundp 'longlines-mode) - (longlines-mode t)))) - (identica-start) - (add-hook 'kill-buffer-hook 'identica-kill-buffer-function) - (run-mode-hooks 'identica-mode-hook)) - -;;; -;;; Basic HTTP functions -;;; - -(defun identica-set-proxy (&optional url username passwd server port) - "Sets the proxy authentication variables as required by url -library.When called with no arguments, it reads `identica-mode' proxy -variables to get the authentication parameters.URL is either a string -or parsed URL. If URL is non-nil and valid, proxy authentication -values are read from it.the rest of the arguments can be used to -directly set proxy authentication.This function essentially adds -authentication parameters from one of the above methods to the double -alist `url-http-proxy-basic-auth-storage' and sets `url-using-proxy'." - (let* ((href (if (stringp url) - (url-generic-parse-url url) - url)) - (port (or (and href (url-port href)) - port identica-proxy-port)) - (port (if (integerp port) (int-to-string port) port)) - (server (or (and href (url-host href)) - server identica-proxy-server)) - (server (and server - (concat server (when port (concat ":" port))))) - (file (if href (let ((file-url (url-filename href))) - (cond - ((string= "" file-url) "/") - ((string-match "/$" file-url) file-url) - (t (url-basepath file-url)))) - "Proxy")) - (password (or (and href (url-password href)) - passwd identica-proxy-password)) - (auth (concat (or (and href (url-user href)) - username identica-proxy-user) - (and password (concat ":" password))))) - (when (and identica-proxy-use - (not (string= "" server)) - (not (string= "" auth))) - (setq url-using-proxy server) - (let* ((proxy-double-alist - (or (assoc server - url-http-proxy-basic-auth-storage) - (car (push (cons server nil) - url-http-proxy-basic-auth-storage)))) - (proxy-auth-alist (assoc file proxy-double-alist))) - (if proxy-auth-alist - (setcdr proxy-auth-alist (base64-encode-string auth)) - (setcdr proxy-double-alist - (cons (cons file - (base64-encode-string auth)) - (cdr-safe proxy-double-alist)))))))) - -(defun identica-change-user () - (interactive) - "Interactive function to instantly change user authentication by -directly reading parameters from user. This function only sets the -identica-mode variables `identica-username' and -`identica-password'. -It is the `identica-set-auth' function that eventually sets the -url library variables according to the above variables which does the -authentication. This will be done automatically in normal use cases -enabling dynamic change of user authentication." - (setq identica-username - (read-string (concat "Username [for " statusnet-server - ":" (int-to-string statusnet-port) "]: ") - nil nil identica-username) - identica-password - (read-passwd "Password: " nil identica-password)) - (identica-get-timeline)) - -(defun identica-set-auth (&optional url username passwd server port) - "Sets the authentication parameters as required by url library. -If URL is non-nil and valid, it reads user authentication -parameters from url. -If URL is nil, Rest of the arguments can be used to directly set user -authentication. -When called with no arguments, user authentication parameters are -read from identica-mode variables `identica-username' -`identica-password' `statusnet-server' `statusnet-port'." - (let* ((href (if (stringp url) - (url-generic-parse-url url) - url)) - (port (or (and href (url-port href)) - port statusnet-port)) - (port (if (integerp port) (int-to-string port) port)) - (server (or (and href (url-host href)) - server statusnet-server)) - (server (and server - (concat server (when port (concat ":" port))))) - (file (if href (let ((file-url (url-filename href))) - (cond - ((string= "" file-url) "/") - ((string-match "/$" file-url) file-url) - (t (url-basepath file-url)))) - "Identi.ca API")) - (password (or (and href (url-password href)) - passwd identica-password)) - (auth (concat (or (and href (url-user href)) - username identica-username) - (and password (concat ":" password))))) - (when (and (not (string= "" server)) - (not (string= "" auth))) - (let* ((server-double-alist - (or (assoc server - url-http-real-basic-auth-storage) - (car (push (cons server nil) - url-http-real-basic-auth-storage)))) - (api-auth-alist (assoc file server-double-alist))) - (if api-auth-alist - (setcdr api-auth-alist (base64-encode-string auth)) - (setcdr server-double-alist - (cons (cons file - (base64-encode-string auth)) - (cdr-safe server-double-alist)))))))) - -(defun identica-http-get (method-class method &optional parameters - sentinel sentinel-arguments) - "Basic function which communicates with server. -METHOD-CLASS and METHOD are parameters for getting dents messages and -other information from server as specified in api documentation. -Third optional arguments specify the additional parameters required by -the above METHOD. It is specified as an alist with parameter name and -its corresponding value -SENTINEL represents the callback function to be called after the http -response is completely retrieved. SENTINEL-ARGUMENTS is the list of -arguments (if any) of the SENTINEL procedure." - (or sentinel (setq sentinel 'identica-http-get-default-sentinel)) - (let ((url (concat "http://" statusnet-server "/api/" - (when (not (string-equal method-class "none")) - (concat method-class "/" )) - method ".xml" - (when parameters - (concat "?" - (mapconcat - (lambda (param-pair) - (format "%s=%s" - (identica-percent-encode (car param-pair)) - (identica-percent-encode (cdr param-pair)))) - parameters - "&"))))) - (url-package-name "emacs-identica-mode") - (url-package-version identica-mode-version) - (url-show-status nil)) - (identica-set-proxy) - (identica-set-auth url) - (when (get-buffer-process identica-http-buffer) - (delete-process identica-http-buffer) - (kill-buffer identica-http-buffer)) - (setq identica-http-buffer - (url-retrieve url sentinel - (append (list method-class method parameters) - sentinel-arguments))) - (save-excursion - (set-buffer identica-buffer) - (identica-set-mode-string t)))) - -(defun identica-http-get-default-sentinel - (&optional status method-class method parameters success-message) - (cond ((setq error-object - (or (assoc :error status) - (and (equal :error (car status)) - (cadr status)))) - (let ((error-data (format "%s" (caddr error-object)))) - (when (cond - ((string= error-data "deleted\n") t) - ((and (string= error-data "404") method - (= 13 (string-match "/" method))) - (message "No Such User: %s" (substring method 14)) - t) - ((y-or-n-p - (format "Identica-Mode: Network error:%s Retry? " - status)) - (identica-http-get method-class method parameters) - nil)) - ;; when the network process is deleted by another query - ;; or the user queried is not found , query is _finished_ - ;; unsuccessful and we want to restore identica-method - ;; to loose track of this unsuccessful attempt - (setq identica-method identica-last-timeline-retrieved)))) - ((< (- (point-max) (or (re-search-forward ">\r?\n\r*$" nil t) 0)) 2) - ;;Checking the whether the message is complete by - ;;searching for > that closes the last tag, followed by - ;;CRLF at (point-max) - (when (setq body (identica-get-response-body)) - (setq identica-new-dents-count - (count t (mapcar - #'identica-cache-status-datum - (reverse (identica-xmltree-to-status - body))))) - ; Shorten the timeline if necessary - (if (and identica-display-max-dents - (> (safe-length identica-timeline-data) - identica-display-max-dents)) - (cl-set-nthcdr identica-display-max-dents - identica-timeline-data nil)) - (identica-render-timeline) - (if (> identica-new-dents-count 0) - (run-hooks 'identica-new-dents-hook)) - (when identica-display-success-messages - (message (or success-message "Success: Get")))))) - (unless (get-buffer-process (current-buffer)) - (kill-buffer (current-buffer)))) - -(defun identica-render-timeline () - (with-current-buffer (identica-buffer) - (let ((point (point)) - (end (point-max)) - (wrapped (cond (longlines-mode 'longlines-mode) - (visual-line-mode 'visual-line-mode) - (t nil)))) - - (setq buffer-read-only nil) - (erase-buffer) - (when wrapped (funcall wrapped -1)) - (mapc (lambda (status) - (insert (identica-format-status - status identica-status-format)) - (if (not wrapped) - (progn - (fill-region-as-paragraph - (save-excursion (beginning-of-line) (point)) (point)))) - (insert "\n") - (if identica-oldest-first - (goto-char (point-min)))) - identica-timeline-data) - (if (and identica-image-stack window-system) - (clear-image-cache)) - (when wrapped (funcall wrapped 1)) - (setq buffer-read-only t) - (debug-print (current-buffer)) - (goto-char (+ point (if identica-scroll-mode (- (point-max) end) 0))) - (identica-set-mode-string nil) - (setq identica-last-timeline-retrieved identica-method) - (if transient-mark-mode (deactivate-mark))))) - -(defun identica-format-status (status format-str) - (flet ((attr (key) - (assocref key status)) - (profile-image - () - (let ((profile-image-url (attr 'user-profile-image-url)) - (icon-string "\n ")) - (if (string-match "/\\([^/?]+\\)\\(?:\\?\\|$\\)" profile-image-url) - (let ((filename (match-string-no-properties 1 profile-image-url))) - ;; download icons if does not exist - (if (file-exists-p (concat identica-tmp-dir - "/" filename)) - t - (add-to-list 'identica-image-stack profile-image-url)) - - (when (and icon-string identica-icon-mode) - (set-text-properties - 1 2 `(display ,(create-image (concat identica-tmp-dir "/" filename))) - icon-string) - icon-string)))))) - (let ((cursor 0) - (result ()) - c - found-at) - (setq cursor 0) - (setq result '()) - (while (setq found-at (string-match "%\\(C{\\([^}]+\\)}\\|[A-Za-z#@']\\)" format-str cursor)) - (setq c (string-to-char (match-string-no-properties 1 format-str))) - (if (> found-at cursor) - (list-push (substring format-str cursor found-at) result) - "|") - (setq cursor (match-end 1)) - - (case c - ((?s) ; %s - screen_name - (list-push (attr 'user-screen-name) result)) - ((?S) ; %S - name - (list-push (attr 'user-name) result)) - ((?i) ; %i - profile_image - (list-push (profile-image) result)) - ((?d) ; %d - description - (list-push (attr 'user-description) result)) - ((?l) ; %l - location - (list-push (attr 'user-location) result)) - ((?L) ; %L - " [location]" - (let ((location (attr 'user-location))) - (unless (or (null location) (string= "" location)) - (list-push (concat " [" location "]") result)) )) - ((?u) ; %u - url - (list-push (attr 'user-url) result)) - ((?j) ; %j - user.id - (list-push (format "%d" (attr 'user-id)) result)) - ((?r) ; %r - in_reply_to_status_id - (let ((reply-id (attr 'in-reply-to-status-id)) - (reply-name (attr 'in-reply-to-screen-name))) - (unless (or (null reply-id) (string= "" reply-id) - (null reply-name) (string= "" reply-name)) - (let ((in-reply-to-string (format "in reply to %s" reply-name)) - (url (identica-get-status-url reply-id))) - (add-text-properties - 0 (length in-reply-to-string) - `(mouse-face highlight - face identica-uri-face - uri ,url) - in-reply-to-string) - (list-push (concat " " in-reply-to-string) result))))) - ((?p) ; %p - protected? - (let ((protected (attr 'user-protected))) - (when (string= "true" protected) - (list-push "[x]" result)))) - ((?c) ; %c - created_at (raw UTC string) - (list-push (attr 'created-at) result)) - ((?C) ; %C{time-format-str} - created_at (formatted with time-format-str) - (list-push (identica-local-strftime - (or (match-string-no-properties 2 format-str) "%H:%M:%S") - (attr 'created-at)) - result)) - ((?@) ; %@ - X seconds ago - (let ((created-at - (apply - 'encode-time - (parse-time-string (attr 'created-at)))) - (now (current-time))) - (let ((secs (+ (* (- (car now) (car created-at)) 65536) - (- (cadr now) (cadr created-at)))) - time-string url) - (setq time-string - (cond ((< secs 5) "less than 5 seconds ago") - ((< secs 10) "less than 10 seconds ago") - ((< secs 20) "less than 20 seconds ago") - ((< secs 30) "half a minute ago") - ((< secs 60) "less than a minute ago") - ((< secs 150) "1 minute ago") - ((< secs 2400) (format "%d minutes ago" - (/ (+ secs 30) 60))) - ((< secs 5400) "about 1 hour ago") - ((< secs 84600) (format "about %d hours ago" - (/ (+ secs 1800) 3600))) - (t (format-time-string "%I:%M %p %B %d, %Y" created-at)))) - (setq url (identica-get-status-url (attr 'id))) - ;; make status url clickable - (add-text-properties - 0 (length time-string) - `(mouse-face highlight - face identica-uri-face - uri ,url) - time-string) - (list-push time-string result)))) - ((?t) ; %t - text - (list-push ;(clickable-text) - (attr 'text) - result)) - ((?') ; %' - truncated - (let ((truncated (attr 'truncated))) - (when (string= "true" truncated) - (list-push "..." result)))) - ((?f) ; %f - source - (list-push (attr 'source) result)) - ((?#) ; %# - id - (list-push (format "%d" (attr 'id)) result)) - (t - (list-push (char-to-string c) result)))) - (list-push (substring format-str cursor) result) - (let ((formatted-status (apply 'concat (nreverse result)))) - (add-text-properties 0 (length formatted-status) - `(username ,(attr 'user-screen-name) - id, (attr 'id) - text ,(attr 'text)) - formatted-status) - formatted-status)))) - -(defun identica-http-post - (method-class method &optional parameters sentinel sentinel-arguments) - "Send HTTP POST request to statusnet server -METHOD-CLASS must be one of Identica API method classes(statuses, users or direct_messages). -METHOD must be one of Identica API method which belongs to METHOD-CLASS. -PARAMETERS is alist of URI parameters. ex) ((\"mode\" . \"view\") (\"page\" . \"6\")) => <URI>?mode=view&page=6" - (or sentinel (setq sentinel 'identica-http-post-default-sentinel)) - (let ((url-request-method "POST") - (url (concat "http://"statusnet-server "/api/" method-class "/" method ".xml" - (when parameters - (concat "?" - (mapconcat - (lambda (param-pair) - (format "%s=%s" - (identica-percent-encode (car param-pair)) - (identica-percent-encode (cdr param-pair)))) - parameters - "&"))))) - (url-package-name "emacs-identicamode") - (url-package-version identica-mode-version) - (url-request-extra-headers '(("Content-Length" . "0"))) - (url-show-status nil)) - (identica-set-proxy) - (identica-set-auth url) - (when (get-buffer-process identica-http-buffer) - (delete-process identica-http-buffer) - (kill-buffer identica-http-buffer)) - (url-retrieve url sentinel - (append (list method-class method parameters) - sentinel-arguments)))) - -(defun identica-http-post-default-sentinel - (&optional status method-class method parameters success-message) - (cond ((and - (setq error-object (or (assoc :error status) - (and (equal :error (car status)) - (cadr status)))) - (y-or-n-p (format "Network error:%s %s Retry?" - (cadr error-object) - (caddr error-object)))) - (identica-http-post method-class method parameters nil success-message)) - (identica-display-success-messages - (message (or success-message "Success: Post")))) - (unless (get-buffer-process (current-buffer)) - (kill-buffer (current-buffer)))) - -(defun identica-get-response-header (&optional buffer) - "Exract HTTP response header from HTTP response. -`buffer' may be a buffer or the name of an existing buffer. - If `buffer' is omitted, current-buffer is parsed." - (or buffer - (setq buffer (current-buffer))) - (save-excursion - (set-buffer buffer) - (let ((end (or (and (search-forward-regexp "\r?\n\r?\n" (point-max) t) - (match-beginning 0)) - 0))) - (and (> end 1) - (buffer-substring (point-min) end))))) - -(defun identica-get-response-body (&optional buffer) - "Exract HTTP response body from HTTP response, parse it as XML, and return a XML tree as list. -`buffer' may be a buffer or the name of an existing buffer. - If `buffer' is omitted, current-buffer is parsed." - (or buffer - (setq buffer (current-buffer))) - (save-excursion - (set-buffer buffer) - (set-buffer-multibyte t) - (let ((start (save-excursion - (goto-char (point-min)) - (and (re-search-forward "<\?xml" (point-max) t) - (match-beginning 0))))) - (identica-clean-response-body) - (and start - (xml-parse-region start (point-max)))))) - -(defun identica-clean-weird-chars (&optional buffer) -;;(if (null buffer) (setq buffer (identica-http-buffer))) -(with-current-buffer (identica-http-buffer) - (goto-char (point-min)) - (while (re-search-forward "\ - -? -[0-9a-z]*\ - -? -?" nil t) -(replace-match "")) -(buffer-string))) - -(defun identica-clean-response-body () - "Removes weird strings (e.g., 1afc, a or 0) from within the -response body. Known Statusnet issue. Mostly harmless except if -in tags." - (goto-char (point-min)) - (while (re-search-forward "\r?\n[0-9a-z]+\r?\n" nil t) - (replace-match ""))) - -(defun identica-cache-status-datum (status-datum &optional data-var) - "Cache status datum into data-var(default identica-timeline-data) -If STATUS-DATUM is already in DATA-VAR, return nil. If not, return t." - (if (null data-var) - (setf data-var 'identica-timeline-data)) - (let ((id (cdr (assq 'id status-datum)))) - (if (or (null (symbol-value data-var)) - (not (find-if - (lambda (item) - (eql id (cdr (assq 'id item)))) - (symbol-value data-var)))) - (progn - (set data-var (cons status-datum (symbol-value data-var))) - t) - nil))) - -(defun identica-status-to-status-datum (status) - (flet ((assq-get (item seq) - (car (cddr (assq item seq))))) - (let* ((status-data (cddr status)) - id text source created-at truncated - in-reply-to-status-id - in-reply-to-screen-name - (user-data (cddr (assq 'user status-data))) - user-id user-name - user-screen-name - user-location - user-description - user-profile-image-url - user-url - user-protected - regex-index) - - (setq id (string-to-number (assq-get 'id status-data))) - (setq text (identica-decode-html-entities - (assq-get 'text status-data))) - (setq source (identica-decode-html-entities - (assq-get 'source status-data))) - (setq created-at (assq-get 'created_at status-data)) - (setq truncated (assq-get 'truncated status-data)) - (setq in-reply-to-status-id - (identica-decode-html-entities - (assq-get 'in_reply_to_status_id status-data))) - (setq in-reply-to-screen-name - (identica-decode-html-entities - (assq-get 'in_reply_to_screen_name status-data))) - (setq user-id (string-to-number (assq-get 'id user-data))) - (setq user-name (identica-decode-html-entities - (assq-get 'name user-data))) - (setq user-screen-name (identica-decode-html-entities - (assq-get 'screen_name user-data))) - (setq user-location (identica-decode-html-entities - (assq-get 'location user-data))) - (setq user-description (identica-decode-html-entities - (assq-get 'description user-data))) - (setq user-profile-image-url (assq-get 'profile_image_url user-data)) - (setq user-url (assq-get 'url user-data)) - (setq user-protected (assq-get 'protected user-data)) - - ;; make username clickable - (add-text-properties - 0 (length user-name) - `(mouse-face highlight - uri ,(concat "https://" statusnet-server "/" user-screen-name) - face identica-username-face) - user-name) - - ;; make screen-name clickable - (add-text-properties - 0 (length user-screen-name) - `(mouse-face highlight - face identica-username-face - uri ,(concat "https://" statusnet-server "/" user-screen-name) - face identica-username-face) - user-screen-name) - - ;; make URI clickable - (setq regex-index 0) - (while regex-index - (setq regex-index - (string-match "@\\([_[:word:]0-9]+\\)\\|!\\([_[:word:]0-9\-]+\\)\\|#\\([_[:word:]0-9\-]+\\)\\|\\(ur1\.ca/[a-z0-9]+/?\\|https?://[-_.!~*'()[:word:]0-9\;/?:@&=+$,%#]+\\)" - text - regex-index)) - (when regex-index - (let* ((matched-string (match-string-no-properties 0 text)) - (screen-name (match-string-no-properties 1 text)) - (group-name (match-string-no-properties 2 text)) - (tag-name (match-string-no-properties 3 text)) - (uri (match-string-no-properties 4 text))) - (add-text-properties - (if (or screen-name group-name tag-name) - (+ 1 (match-beginning 0)) - (match-beginning 0)) - (match-end 0) - (if (or screen-name group-name tag-name) - `(mouse-face - highlight - face identica-uri-face - uri ,(if screen-name - (concat "https://" statusnet-server "/" screen-name) - (if group-name - (concat "https://" statusnet-server "/group/" group-name) - (concat "https://" statusnet-server "/tag/" tag-name))) - uri-in-text ,(if screen-name - (concat "https://" statusnet-server "/" screen-name) - (if group-name - (concat "https://" statusnet-server "/group/" group-name) - (concat "https://" statusnet-server "/tag/" tag-name))) - tag ,tag-name - group ,group-name) - `(mouse-face highlight - face identica-uri-face - uri ,uri - uri-in-text ,uri)) - text)) - (setq regex-index (match-end 0)) )) - - - ;; make source pretty and clickable - (if (string-match "<a href=\"\\(.*\\)\">\\(.*\\)</a>" source) - (let ((uri (match-string-no-properties 1 source)) - (caption (match-string-no-properties 2 source))) - (setq source caption) - (add-text-properties - 0 (length source) - `(mouse-face highlight - face identica-uri-face - source ,source) - source))) - - ;; save last update time - (setq identica-timeline-last-update created-at) - - ;; highlight replies - (if (string-match (concat "@" identica-username) text) - (add-text-properties 0 (length text) - `(face identica-reply-face) text)) - (mapcar - (lambda (sym) - `(,sym . ,(symbol-value sym))) - '(id text source created-at truncated - in-reply-to-status-id - in-reply-to-screen-name - user-id user-name user-screen-name user-location - user-description - user-profile-image-url - user-url - user-protected))))) - -(defun identica-xmltree-to-status (xmltree) - (mapcar #'identica-status-to-status-datum - ;; quirk to treat difference between xml.el in Emacs21 and Emacs22 - ;; On Emacs22, there may be blank strings - (let ((ret nil) (statuses (reverse (cddr (car xmltree))))) - (while statuses - (if (consp (car statuses)) - (setq ret (cons (car statuses) ret))) - (setq statuses (cdr statuses))) - ret))) - -(defun identica-percent-encode (str &optional coding-system) - (if (or (null coding-system) - (not (coding-system-p coding-system))) - (setq coding-system 'utf-8)) - (mapconcat - (lambda (c) - (cond - ((identica-url-reserved-p c) - (char-to-string c)) - ((eq c ? ) "+") - (t (format "%%%x" c)))) - (encode-coding-string str coding-system) - "")) - -(defun identica-url-reserved-p (ch) - (or (and (<= ?A ch) (<= ch ?z)) - (and (<= ?0 ch) (<= ch ?9)) - (eq ?. ch) - (eq ?- ch) - (eq ?_ ch) - (eq ?~ ch))) - -(defun identica-decode-html-entities (encoded-str) - (if encoded-str - (let ((cursor 0) - (found-at nil) - (result '())) - (while (setq found-at - (string-match "&\\(#\\([0-9]+\\)\\|\\([A-Za-z]+\\)\\);" - encoded-str cursor)) - (when (> found-at cursor) - (list-push (substring encoded-str cursor found-at) result)) - (let ((number-entity (match-string-no-properties 2 encoded-str)) - (letter-entity (match-string-no-properties 3 encoded-str))) - (cond (number-entity - (list-push - (char-to-string - (identica-ucs-to-char - (string-to-number number-entity))) result)) - (letter-entity - (cond ((string= "gt" letter-entity) (list-push ">" result)) - ((string= "lt" letter-entity) (list-push "<" result)) - (t (list-push "?" result)))) - (t (list-push "?" result))) - (setq cursor (match-end 0)))) - (list-push (substring encoded-str cursor) result) - (apply 'concat (nreverse result))) - "")) - -(defun identica-timer-action (func) - (let ((buf (get-buffer identica-buffer))) - (if (null buf) - (identica-stop) - (funcall func)))) - -(defun identica-update-status-if-not-blank (method-class method status &optional parameters reply-to-id) - (if (string-match "^\\s-*\\(?:@[-_a-z0-9]+\\)?\\s-*$" status) - nil - (if (equal method-class "statuses") - (identica-http-post method-class method - `(("status" . ,status) - ("source" . ,identica-source) - ,@(if reply-to-id - `(("in_reply_to_status_id" - . ,(number-to-string reply-to-id)))))) - (identica-http-post method-class method - `(("text" . ,status) - ("user" . ,parameters) ;must change this to parse parameters as list - ("source" . ,identica-source)))) - - t)) - -(defvar identica-update-status-edit-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-c") 'identica-update-status-from-edit-buffer-send) - (define-key map (kbd "C-c C-k") 'identica-update-status-from-edit-buffer-cancel) - map)) - -(define-derived-mode identica-update-status-edit-mode text-mode "Identica Status Edit" - (use-local-map identica-update-status-edit-map)) - -(defvar identica-update-status-edit-method-class) -(defvar identica-update-status-edit-method) -(defvar identica-update-status-edit-parameters) -(defvar identica-update-status-edit-reply-to-id) - -(defun identica-update-status-edit-in-edit-buffer (init-str msgtype method-class method parameters &optional reply-to-id) - (let ((buf (get-buffer-create "*identica-status-update-edit*"))) - (pop-to-buffer buf) - (with-current-buffer buf - (if (not (equal major-mode 'identica-update-status-edit-mode)) - (progn - (identica-update-status-edit-mode) - (longlines-mode) - (make-local-variable 'identica-update-status-edit-method-class) - (make-local-variable 'identica-update-status-edit-method) - (make-local-variable 'identica-update-status-edit-parameters) - (make-local-variable 'identica-update-status-edit-reply-to-id) - (if (> (length parameters) 0) - (setq mode-line-format - (cons (format "%s(%s) (%%i/140) " msgtype parameters) - mode-line-format)) - t (setq mode-line-format - (cons (format "%s (%%i/140) " msgtype) mode-line-format))))) - (setq identica-update-status-edit-method-class method-class) - (setq identica-update-status-edit-method method) - (setq identica-update-status-edit-parameters parameters) - (setq identica-update-status-edit-reply-to-id reply-to-id) - (message identica-update-status-edit-method-class) - (insert init-str) - (message "Type C-c C-c to post status update (C-c C-k to cancel).")))) - -(defun identica-show-minibuffer-length (&optional beg end len) - "Show the number of characters in minibuffer." - (when (minibuffer-window-active-p (selected-window)) - (let* ((status-len (- (buffer-size) (minibuffer-prompt-width))) - (mes (format "%d" status-len))) - (if (<= 23 emacs-major-version) - (minibuffer-message mes) ; Emacs23 or later - (minibuffer-message (concat " (" mes ")"))) - ))) - -(defun identica-setup-minibuffer () - (identica-show-minibuffer-length) - (add-hook 'post-command-hook 'identica-show-minibuffer-length t t)) - -(defun identica-finish-minibuffer () - (remove-hook 'post-command-hook 'identica-show-minibuffer-length t)) - -(defun identica-update-status (update-input-method &optional init-str reply-to-id method-class method parameters) - (if (null init-str) (setq init-str "")) - (let ((msgtype "") - (status init-str) - (not-posted-p t) - (user nil) - (map minibuffer-local-map) - (minibuffer-message-timeout nil)) - (define-key map (kbd "<f4>") 'identica-shortenurl-replace-at-point) - (if (null method-class) - (progn (setq msgtype "Status") - (setq method-class "statuses") - (setq method "update")) - (progn (setq msgtype "Direct message") - (setq method-class "direct_messages") - (setq parameters (read-from-minibuffer "To user: " user nil nil nil nil t)) - (setq method "new"))) - (cond ((eq update-input-method 'minibuffer) - (add-hook 'minibuffer-setup-hook 'identica-setup-minibuffer t) - (add-hook 'minibuffer-exit-hook 'identica-finish-minibuffer t) - (unwind-protect - (while not-posted-p - (setq status (read-from-minibuffer (concat msgtype ": ") status nil nil nil nil t)) - (while (< 141 (length status)) - (setq status (read-from-minibuffer (format (concat msgtype "(%d): ") - (- 140 (length status))) - status nil nil nil nil t))) - (setq not-posted-p - (not (identica-update-status-if-not-blank method-class method status parameters reply-to-id)))) - (remove-hook 'minibuffer-setup-hook 'identica-setup-minibuffer) - (remove-hook 'minibuffer-exit-hook 'identica-finish-minibuffer))) - ((eq update-input-method 'edit-buffer) - (identica-update-status-edit-in-edit-buffer init-str msgtype method-class method parameters reply-to-id)) - (t (error "Unknown update-input-method in identica-update-status: %S" update-input-method))))) - -(defun identica-update-status-from-edit-buffer-send () - (interactive) - (with-current-buffer "*identica-status-update-edit*" - (longlines-encode-region (point-min) (point-max)) - (let* ((status (buffer-substring-no-properties (point-min) (point-max))) - (status-len (length status))) - (if (< 140 status-len) - (message (format "Beyond 140 chars. Remove %d chars." (- status-len 140))) - (if (identica-update-status-if-not-blank identica-update-status-edit-method-class - identica-update-status-edit-method status identica-update-status-edit-parameters identica-update-status-edit-reply-to-id) - (progn - (erase-buffer) - (bury-buffer)) - (message "Update failed!")))))) - -(defun identica-update-status-from-minibuffer (&optional init-str method-class method parameters reply-to-id) - (interactive) - (identica-update-status 'minibuffer init-str method-class method parameters reply-to-id)) - -(defun identica-update-status-from-edit-buffer (&optional init-str method-class method parameters) - (interactive) - (identica-update-status 'edit-buffer init-str method-class method parameters)) - -(defun identica-update-status-from-edit-buffer-cancel () - (interactive) - (when (or (not identica-update-status-edit-confirm-cancellation) - (yes-or-no-p - "Really cancel editing this status message (any changes will be lost)?")) - (erase-buffer) - (bury-buffer))) - -(defun identica-update-status-from-region (beg end) - (interactive "r") - (if (> (- end beg) 140) (setq end (+ beg 140))) - (if (< (- end beg) -140) (setq beg (+ end 140))) - (identica-update-status-if-not-blank "statuses" "update" (buffer-substring beg end))) - -(defun identica-tinyurl-unjson-google (result) - "Gets only the URL from JSON URL tinyfying service results. - -Google's shortening service, goo.gl, returns shortened URLs as a -JSON dictionary. This function retrieves only the URL value from -this dictionary, only if identica-urlshortening-service is 'google. -" - (if (eq identica-urlshortening-service 'google) - (cdr (assoc 'short_url (json-read-from-string result))) - result)) - -(defun identica-ur1ca-get (api longurl) - "Shortens url through ur1.ca free service 'as in freedom'" - (let* ((url-request-method "POST") - (url-request-extra-headers - '(("Content-Type" . "application/x-www-form-urlencoded"))) - (url-request-data (concat "longurl=" (url-hexify-string longurl))) - (buffer (url-retrieve-synchronously api))) - (with-current-buffer buffer - (goto-char (point-min)) - (prog1 - (setq ur1short - (if (search-forward-regexp "Your .* is: .*>\\(http://ur1.ca/[0-9A-Za-z].*\\)</a>" nil t) - (match-string-no-properties 1) - (error "URL shortening service failed: %s" longurl))) - (kill-buffer buffer))))) - -(defun identica-shortenurl-get (longurl) - "Shortens url through a url shortening service" - (let ((api (cdr (assoc identica-urlshortening-service - identica-urlshortening-services-map)))) - (unless api - (error "`identica-urlshortening-service' was invalid. try one of %s" - (mapconcat (lambda (x) - (symbol-name (car x))) - identica-urlshortening-services-map ", ") - ".")) - (if longurl - (if (or (eq identica-urlshortening-service 'ur1ca) (eq identica-urlshortening-service 'tighturl)) - (identica-ur1ca-get api longurl) - (let ((buffer (url-retrieve-synchronously (concat api longurl)))) - (with-current-buffer buffer - (goto-char (point-min)) - (prog1 - (identica-tinyurl-unjson-google - (if (search-forward-regexp "\n\r?\n\\([^\n\r]*\\)" nil t) - (match-string-no-properties 1) - (error "URL shortening service failed: %s" longurl))) - (kill-buffer buffer)))) - nil)))) - -(defun identica-shortenurl-replace-at-point () - "Replace the url at point with a tiny version." - (interactive) - (let ((url-bounds (bounds-of-thing-at-point 'url))) - (when url-bounds - (let ((url (identica-shortenurl-get (thing-at-point 'url)))) - (when url - (save-restriction - (narrow-to-region (car url-bounds) (cdr url-bounds)) - (delete-region (point-min) (point-max)) - (insert url))))))) -;;; -;;; Commands -;;; - -(defun identica-start (&optional action) - (interactive) - (if (null action) - (setq action #'identica-current-timeline)) - (if identica-timer - nil - (setq identica-timer - (run-at-time "0 sec" - identica-timer-interval - #'identica-timer-action action))) - (setq identica-active-mode t) - (identica-update-mode-line)) - -(defun identica-stop () -"Stop Current network activitiy (if any) and the reload-timer." - (interactive) - (when (get-buffer-process identica-http-buffer) - (delete-process identica-http-buffer) - (kill-buffer identica-http-buffer)) - (setq identica-method identica-last-timeline-retrieved) - (identica-set-mode-string nil) - (and identica-timer - (cancel-timer identica-timer)) - (setq identica-timer nil) - (setq identica-active-mode nil) - (identica-update-mode-line)) - -(defun identica-get-timeline () - (if (not (eq identica-last-timeline-retrieved identica-method)) - (setq identica-timeline-last-update nil - identica-timeline-data nil)) - (let ((buf (get-buffer identica-buffer))) - (if (not buf) - (identica-stop) - (identica-http-get identica-method-class identica-method))) - (if identica-icon-mode - (if (and identica-image-stack window-system) - (let ((proc - (apply - #'start-process - "wget-images" - nil - "wget" - (format "--directory-prefix=%s" identica-tmp-dir) - "--no-clobber" - "--quiet" - identica-image-stack))) - (set-process-sentinel - proc - (lambda (proc stat) - (clear-image-cache) - )))))) - -(defun identica-friends-timeline () - (interactive) - (setq identica-method "friends_timeline") - (setq identica-method-class "statuses") - (identica-get-timeline)) - -(defun identica-replies-timeline () - (interactive) - (setq identica-method "replies") - (setq identica-method-class "statuses") - (identica-get-timeline)) - -;; (defun identica-direct-messages-timeline () -;; (interactive) -;; (setq identica-method "direct_messages") -;; (setq identica-method-class "none") -;; (identica-get-timeline)) - -(defun identica-public-timeline () - (interactive) - (setq identica-method "public_timeline") - (setq identica-method-class "statuses") - (identica-get-timeline)) - -(defun identica-group-timeline (&optional group) - (interactive) - (unless group - (setq group (read-from-minibuffer "Group: " nil nil nil nil nil t))) - (setq identica-method-class "statusnet/groups") - (if (string-equal group "") - (setq identica-method "timeline") - (setq identica-method (concat "timeline/" group))) - (identica-get-timeline)) - -(defun identica-tag-timeline (&optional tag) - (interactive) - (unless tag - (setq tag (read-from-minibuffer "Tag: " nil nil nil nil nil t))) - (setq identica-method-class "statusnet/tags") - (if (string-equal tag "") - (setq identica-method "timeline") - (setq identica-method (concat "timeline/" tag))) - (identica-get-timeline)) - -(defun identica-user-timeline () - (interactive) - (let ((from-user (read-from-minibuffer "User [Empty for mine]: " - nil nil nil nil nil t))) - (if (string-equal from-user "") - (setq identica-method "user_timeline") - (setq identica-method (concat "user_timeline/" from-user)))) - (identica-get-timeline)) - -(defun identica-current-timeline () - (interactive) - (identica-get-timeline)) - -(defun identica-update-status-interactive () - (interactive) - (identica-update-status identica-update-status-method)) - -(defun identica-direct-message-interactive () - (interactive) - (identica-update-status identica-update-status-method nil nil "direct_messages" "new")) - -(defun identica-erase-old-statuses () - (interactive) - (setq identica-timeline-data nil) - (if (not identica-last-timeline-retrieved) - (setq identica-last-timeline-retrieved identica-method)) - (identica-http-get "statuses" identica-last-timeline-retrieved) - ) - -(defun identica-click () - (interactive) - (let ((uri (get-text-property (point) 'uri))) - (if uri - (browse-url uri)))) - -(defun identica-enter () - (interactive) - (let ((username (get-text-property (point) 'username)) - (id (get-text-property (point) 'id)) - (uri (get-text-property (point) 'uri)) - (group (get-text-property (point) 'group)) - (tag (get-text-property (point) 'tag))) - (if group (identica-group-timeline group) - (if tag (identica-tag-timeline tag) - (if uri (browse-url uri) - (if username - (identica-update-status identica-update-status-method - (concat "@" username " ") id))))))) - -(defun identica-next-link nil - (interactive) - (goto-char (next-single-property-change (point) 'uri)) - (if (not (get-text-property (point) 'uri)) - (goto-char (next-single-property-change (point) 'uri)))) - -(defun identica-prev-link nil - (interactive) - (goto-char (previous-single-property-change (point) 'uri)) - (if (not (get-text-property (point) 'uri)) - (goto-char (previous-single-property-change (point) 'uri)))) - -(defun identica-follow (&optional remove) - (interactive) - (let ((username (get-text-property (point) 'username)) - (method (if remove "destroy" "create")) - (message (if remove "unfollowing" "following"))) - (unless username - (setq username (read-from-minibuffer "user: "))) - (if (> (length username) 0) - (when (y-or-n-p (format "%s %s? " message username)) - (identica-http-post (format "friendships/%s" method) username) - (message (format "Now %s %s" message username))) - (message "No user selected")))) - -(defun identica-unfollow () - (interactive) - (identica-follow t)) - -(defun identica-favorite () - (interactive) - (if (y-or-n-p "Do you want to favor this notice? ") - (let ((id (get-text-property (point) 'id))) - (identica-http-post "favorites/create" (number-to-string id)) - (message "Notice saved as favorite")))) - -(defun identica-repeat () - (interactive) - (if (y-or-n-p "Do you want to repeat this notice? ") - (let ((id (get-text-property (point) 'id))) - (identica-http-post "statuses/retweet" (number-to-string id)) - (message "Notice repeated")))) - -(defun identica-view-user-page () - (interactive) - (let ((uri (get-text-property (point) 'uri))) - (if uri - (browse-url uri)))) - -(defun identica-redent () - (interactive) - (let ((username (get-text-property (point) 'username)) - (id (get-text-property (point) 'id)) - (text (replace-regexp-in-string "!\\(.\\)" "#\\1" (get-text-property (point) 'text)))) - (when username - (identica-update-status identica-update-status-method - (concat identica-redent-format " @" username ": " text) id)))) - -(defun identica-reply-to-user () - (interactive) - (let ((username (get-text-property (point) 'username)) - (id (get-text-property (point) 'id))) - (if username - (identica-update-status identica-update-status-method (concat "@" username " ") id)))) - -(defun identica-get-password () - (or identica-password - (setq identica-password (read-passwd "password: ")))) - -(defun identica-goto-next-status () - "Go to next status." - (interactive) - (let ((pos)) - (setq pos (identica-get-next-username-face-pos (point))) - (if pos - (goto-char pos) - (message "End of status.")))) - -(defun identica-get-next-username-face-pos (pos) - (interactive) - (let ((prop)) - (catch 'not-found - (while (and pos (not (eq prop identica-username-face))) - (setq pos (next-single-property-change pos 'face)) - (when (eq pos nil) (throw 'not-found nil)) - (setq prop (get-text-property pos 'face))) - pos))) - -(defun identica-goto-previous-status () - "Go to previous status." - (interactive) - (let ((pos)) - (setq pos (identica-get-previous-username-face-pos (point))) - (if pos - (goto-char pos) - (message "Start of status.")))) - -(defun identica-get-previous-username-face-pos (pos) - (interactive) - (let ((prop)) - (catch 'not-found - (while (and pos (not (eq prop identica-username-face))) - (setq pos (previous-single-property-change pos 'face)) - (when (eq pos nil) (throw 'not-found nil)) - (setq prop (get-text-property pos 'face))) - pos))) - -(defun identica-goto-next-status-of-user () - "Go to next status of user." - (interactive) - (let ((user-name (identica-get-username-at-pos (point))) - (pos (identica-get-next-username-face-pos (point)))) - (while (and (not (eq pos nil)) - (not (equal (identica-get-username-at-pos pos) user-name))) - (setq pos (identica-get-next-username-face-pos pos))) - (if pos - (goto-char pos) - (if user-name - (message "End of %s's status." user-name) - (message "Invalid user-name."))))) - -(defun identica-goto-previous-status-of-user () - "Go to previous status of user." - (interactive) - (let ((user-name (identica-get-username-at-pos (point))) - (pos (identica-get-previous-username-face-pos (point)))) - (while (and (not (eq pos nil)) - (not (equal (identica-get-username-at-pos pos) user-name))) - (setq pos (identica-get-previous-username-face-pos pos))) - (if pos - (goto-char pos) - (if user-name - (message "Start of %s's status." user-name) - (message "Invalid user-name."))))) - -(defun identica-get-username-at-pos (pos) - (let ((start-pos pos) - (end-pos)) - (catch 'not-found - (while (eq (get-text-property start-pos 'face) identica-username-face) - (setq start-pos (1- start-pos)) - (when (or (eq start-pos nil) (eq start-pos 0)) (throw 'not-found nil))) - (setq start-pos (1+ start-pos)) - (setq end-pos (next-single-property-change pos 'face)) - (buffer-substring start-pos end-pos)))) - -(defun identica-get-status-url (id) - "Generate status URL." - (format "https://%s/notice/%s" statusnet-server id)) - -(defun identica-get-context-url (id) - "Generate status URL." - (format "https://%s/conversation/%s" statusnet-server id)) - -;; Icons -;;; ACTIVE/INACTIVE -(defconst identica-active-indicator-image - (when (image-type-available-p 'xpm) - '(image :type xpm - :ascent center - :data - "/* XPM */ -static char * statusnet_xpm[] = { -\"16 16 14 1\", -\" c None\", -\". c #8F0000\", -\"+ c #AB4040\", -\"@ c #D59F9F\", -\"# c #E3BFBF\", -\"$ c #CE8F8F\", -\"% c #C78080\", -\"& c #FFFFFF\", -\"* c #B96060\", -\"= c #DCAFAF\", -\"- c #C07070\", -\"; c #F1DFDF\", -\"> c #961010\", -\", c #9D2020\", -\" ....... \", -\" ......... \", -\" ........... \", -\" ....+@#$+.... \", -\"....%&&&&&*.... \", -\"...+&&&&&&&+... \", -\"...=&&&&&&&$... \", -\"...#&&&&&&&#... \", -\"...=&&&&&&&@... \", -\"...*&&&&&&&-... \", -\"....@&&&&&&=... \", -\" ....-#&#$;&>.. \", -\" ..........,>.. \", -\" ............. \", -\" ............\", -\" . ..\"};"))) - -(defconst identica-inactive-indicator-image - (when (image-type-available-p 'xpm) - '(image :type xpm - :ascent center - :data - "/* XPM */ -static char * statusnet_off_xpm[] = { -\"16 16 13 1\", -\" g None\", -\". g #5B5B5B\", -\"+ g #8D8D8D\", -\"@ g #D6D6D6\", -\"# g #EFEFEF\", -\"$ g #C9C9C9\", -\"% g #BEBEBE\", -\"& g #FFFFFF\", -\"* g #A5A5A5\", -\"= g #E3E3E3\", -\"- g #B2B2B2\", -\"; g #676767\", -\"> g #747474\", -\" ....... \", -\" ......... \", -\" ........... \", -\" ....+@#$+.... \", -\"....%&&&&&*.... \", -\"...+&&&&&&&+... \", -\"...=&&&&&&&$... \", -\"...#&&&&&&&#... \", -\"...=&&&&&&&@... \", -\"...*&&&&&&&-... \", -\"....@&&&&&&=... \", -\" ....-#&#$&&;.. \", -\" ..........>;.. \", -\" ............. \", -\" ............\", -\" . ..\"};"))) - -(let ((props - (when (display-mouse-p) - `(local-map - ,(purecopy (make-mode-line-mouse-map - 'mouse-2 #'identica-toggle-activate-buffer)) - help-echo "mouse-2 toggles automatic updates")))) - (defconst identica-modeline-active - (if identica-active-indicator-image - (apply 'propertize " " - `(display ,identica-active-indicator-image ,@props)) - " ")) - (defconst identica-modeline-inactive - (if identica-inactive-indicator-image - (apply 'propertize "INACTIVE" - `(display ,identica-inactive-indicator-image ,@props)) - "INACTIVE"))) - - (make-local-variable 'identica-active-mode) - (setq identica-active-mode t) - -(defun identica-toggle-activate-buffer () - (interactive) - (setq identica-active-mode (not identica-active-mode)) - (if (not identica-active-mode) - (identica-stop) - (identica-start))) - -(defun identica-mode-line-buffer-identification () - (if identica-active-mode - identica-modeline-active - identica-modeline-inactive)) - -(defun identica-update-mode-line () - "Update mode line." - (force-mode-line-update)) - -;;;###autoload -(defun identica () - "Start identica-mode." - (interactive) - (identica-mode)) - -(provide 'identica-mode) -;;; identica.el ends here |