diff --git a/elpa/hydra-20160913.216/hydra-autoloads.el b/elpa/hydra-20160913.216/hydra-autoloads.el new file mode 100644 index 0000000..66e958e --- /dev/null +++ b/elpa/hydra-20160913.216/hydra-autoloads.el @@ -0,0 +1,75 @@ +;;; hydra-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "hydra" "hydra.el" (22501 5659 447421 78000)) +;;; Generated autoloads from hydra.el + +(autoload 'defhydra "hydra" "\ +Create a Hydra - a family of functions with prefix NAME. + +NAME should be a symbol, it will be the prefix of all functions +defined here. + +BODY has the format: + + (BODY-MAP BODY-KEY &rest BODY-PLIST) + +DOCSTRING will be displayed in the echo area to identify the +Hydra. When DOCSTRING starts with a newline, special Ruby-style +substitution will be performed by `hydra--format'. + +Functions are created on basis of HEADS, each of which has the +format: + + (KEY CMD &optional HINT &rest PLIST) + +BODY-MAP is a keymap; `global-map' is used quite often. Each +function generated from HEADS will be bound in BODY-MAP to +BODY-KEY + KEY (both are strings passed to `kbd'), and will set +the transient map so that all following heads can be called +though KEY only. BODY-KEY can be an empty string. + +CMD is a callable expression: either an interactive function +name, or an interactive lambda, or a single sexp (it will be +wrapped in an interactive lambda). + +HINT is a short string that identifies its head. It will be +printed beside KEY in the echo erea if `hydra-is-helpful' is not +nil. If you don't even want the KEY to be printed, set HINT +explicitly to nil. + +The heads inherit their PLIST from BODY-PLIST and are allowed to +override some keys. The keys recognized are :exit and :bind. +:exit can be: + +- nil (default): this head will continue the Hydra state. +- t: this head will stop the Hydra state. + +:bind can be: +- nil: this head will not be bound in BODY-MAP. +- a lambda taking KEY and CMD used to bind a head. + +It is possible to omit both BODY-MAP and BODY-KEY if you don't +want to bind anything. In that case, typically you will bind the +generated NAME/body command. This command is also the return +result of `defhydra'. + +\(fn NAME BODY &optional DOCSTRING &rest HEADS)" nil t) + +(put 'defhydra 'lisp-indent-function 'defun) + +;;;*** + +;;;### (autoloads nil nil ("hydra-examples.el" "hydra-ox.el" "hydra-pkg.el" +;;;;;; "lv.el") (22501 5659 473131 612000)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; hydra-autoloads.el ends here diff --git a/elpa/hydra-20160913.216/hydra-examples.el b/elpa/hydra-20160913.216/hydra-examples.el new file mode 100644 index 0000000..70f75b0 --- /dev/null +++ b/elpa/hydra-20160913.216/hydra-examples.el @@ -0,0 +1,386 @@ +;;; hydra-examples.el --- Some applications for Hydra + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Oleh Krehel + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs 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. If not, see . + +;;; Commentary: +;; +;; These are the sample Hydras. +;; +;; If you want to use them plainly, set `hydra-examples-verbatim' to t +;; before requiring this file. But it's probably better to only look +;; at them and use them as templates for building your own. + +;;; Code: + +(require 'hydra) + +;;* Examples +;;** Example 1: text scale +(when (bound-and-true-p hydra-examples-verbatim) + (defhydra hydra-zoom (global-map "") + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out"))) + +;; This example generates three commands: +;; +;; `hydra-zoom/text-scale-increase' +;; `hydra-zoom/text-scale-decrease' +;; `hydra-zoom/body' +;; +;; In addition, two of them are bound like this: +;; +;; (global-set-key (kbd " g") 'hydra-zoom/text-scale-increase) +;; (global-set-key (kbd " l") 'hydra-zoom/text-scale-decrease) +;; +;; Note that you can substitute `global-map' with e.g. `emacs-lisp-mode-map' if you need. +;; The functions generated will be the same, except the binding code will change to: +;; +;; (define-key emacs-lisp-mode-map [f2 103] +;; (function hydra-zoom/text-scale-increase)) +;; (define-key emacs-lisp-mode-map [f2 108] +;; (function hydra-zoom/text-scale-decrease)) + +;;** Example 2: move window splitter +(when (bound-and-true-p hydra-examples-verbatim) + (defhydra hydra-splitter (global-map "C-M-s") + "splitter" + ("h" hydra-move-splitter-left) + ("j" hydra-move-splitter-down) + ("k" hydra-move-splitter-up) + ("l" hydra-move-splitter-right))) + +;;** Example 3: jump to error +(when (bound-and-true-p hydra-examples-verbatim) + (defhydra hydra-error (global-map "M-g") + "goto-error" + ("h" first-error "first") + ("j" next-error "next") + ("k" previous-error "prev") + ("v" recenter-top-bottom "recenter") + ("q" nil "quit"))) + +;; This example introduces only one new thing: since the command +;; passed to the "q" head is nil, it will quit the Hydra without doing +;; anything. Heads that quit the Hydra instead of continuing are +;; referred to as having blue :color. All the other heads have red +;; :color, unless other is specified. + +;;** Example 4: toggle rarely used modes +(when (bound-and-true-p hydra-examples-verbatim) + (defvar whitespace-mode nil) + (global-set-key + (kbd "C-c C-v") + (defhydra hydra-toggle-simple (:color blue) + "toggle" + ("a" abbrev-mode "abbrev") + ("d" toggle-debug-on-error "debug") + ("f" auto-fill-mode "fill") + ("t" toggle-truncate-lines "truncate") + ("w" whitespace-mode "whitespace") + ("q" nil "cancel")))) + +;; Note that in this case, `defhydra' returns the `hydra-toggle-simple/body' +;; symbol, which is then passed to `global-set-key'. +;; +;; Another new thing is that both the keymap and the body prefix are +;; skipped. This means that `defhydra' will bind nothing - that's why +;; `global-set-key' is necessary. +;; +;; One more new thing is that you can assign a :color to the body. All +;; heads will inherit this color. The code above is very much equivalent to: +;; +;; (global-set-key (kbd "C-c C-v a") 'abbrev-mode) +;; (global-set-key (kbd "C-c C-v d") 'toggle-debug-on-error) +;; +;; The differences are: +;; +;; * You get a hint immediately after "C-c C-v" +;; * You can cancel and call a command immediately, e.g. "C-c C-v C-n" +;; is equivalent to "C-n" with Hydra approach, while it will error +;; that "C-c C-v C-n" isn't bound with the usual approach. + +;;** Example 5: mini-vi +(defun hydra-vi/pre () + (set-cursor-color "#e52b50")) + +(defun hydra-vi/post () + (set-cursor-color "#ffffff")) + +(when (bound-and-true-p hydra-examples-verbatim) + (global-set-key + (kbd "C-z") + (defhydra hydra-vi (:pre hydra-vi/pre :post hydra-vi/post :color amaranth) + "vi" + ("l" forward-char) + ("h" backward-char) + ("j" next-line) + ("k" previous-line) + ("m" set-mark-command "mark") + ("a" move-beginning-of-line "beg") + ("e" move-end-of-line "end") + ("d" delete-region "del" :color blue) + ("y" kill-ring-save "yank" :color blue) + ("q" nil "quit"))) + (hydra-set-property 'hydra-vi :verbosity 1)) + +;; This example introduces :color amaranth. It's similar to red, +;; except while you can quit red with any binding which isn't a Hydra +;; head, you can quit amaranth only with a blue head. So you can quit +;; this mode only with "d", "y", "q" or "C-g". +;; +;; Another novelty are the :pre and :post handlers. :pre will be +;; called before each command, while :post will be called when the +;; Hydra quits. In this case, they're used to override the cursor +;; color while Hydra is active. + +;;** Example 6: selective global bind +(when (bound-and-true-p hydra-examples-verbatim) + (defhydra hydra-next-error (global-map "C-x") + "next-error" + ("`" next-error "next") + ("j" next-error "next" :bind nil) + ("k" previous-error "previous" :bind nil))) + +;; This example will bind "C-x `" in `global-map', but it will not +;; bind "C-x j" and "C-x k". +;; You can still "C-x `jjk" though. + +;;** Example 7: toggle with Ruby-style docstring +(defvar whitespace-mode nil) +(defhydra hydra-toggle (:color pink) + " +_a_ abbrev-mode: %`abbrev-mode +_d_ debug-on-error: %`debug-on-error +_f_ auto-fill-mode: %`auto-fill-function +_t_ truncate-lines: %`truncate-lines +_w_ whitespace-mode: %`whitespace-mode + +" + ("a" abbrev-mode nil) + ("d" toggle-debug-on-error nil) + ("f" auto-fill-mode nil) + ("t" toggle-truncate-lines nil) + ("w" whitespace-mode nil) + ("q" nil "quit")) +;; Recommended binding: +;; (global-set-key (kbd "C-c C-v") 'hydra-toggle/body) + +;; Here, using e.g. "_a_" translates to "a" with proper face. +;; More interestingly: +;; +;; "foobar %`abbrev-mode" means roughly (format "foobar %S" abbrev-mode) +;; +;; This means that you actually see the state of the mode that you're changing. + +;;** Example 8: the whole menu for `Buffer-menu-mode' +(defhydra hydra-buffer-menu (:color pink + :hint nil) + " +^Mark^ ^Unmark^ ^Actions^ ^Search +^^^^^^^^----------------------------------------------------------------- (__) +_m_: mark _u_: unmark _x_: execute _R_: re-isearch (oo) +_s_: save _U_: unmark up _b_: bury _I_: isearch /------\\/ +_d_: delete ^ ^ _g_: refresh _O_: multi-occur / | || +_D_: delete up ^ ^ _T_: files only: % -28`Buffer-menu-files-only^^ * /\\---/\\ +_~_: modified ^ ^ ^ ^ ^^ ~~ ~~ +" + ("m" Buffer-menu-mark) + ("u" Buffer-menu-unmark) + ("U" Buffer-menu-backup-unmark) + ("d" Buffer-menu-delete) + ("D" Buffer-menu-delete-backwards) + ("s" Buffer-menu-save) + ("~" Buffer-menu-not-modified) + ("x" Buffer-menu-execute) + ("b" Buffer-menu-bury) + ("g" revert-buffer) + ("T" Buffer-menu-toggle-files-only) + ("O" Buffer-menu-multi-occur :color blue) + ("I" Buffer-menu-isearch-buffers :color blue) + ("R" Buffer-menu-isearch-buffers-regexp :color blue) + ("c" nil "cancel") + ("v" Buffer-menu-select "select" :color blue) + ("o" Buffer-menu-other-window "other-window" :color blue) + ("q" quit-window "quit" :color blue)) +;; Recommended binding: +;; (define-key Buffer-menu-mode-map "." 'hydra-buffer-menu/body) + +;;** Example 9: s-expressions in the docstring +;; You can inline s-expresssions into the docstring like this: +(defvar dired-mode-map) +(declare-function dired-mark "dired") +(when (bound-and-true-p hydra-examples-verbatim) + (require 'dired) + (defhydra hydra-marked-items (dired-mode-map "") + " +Number of marked items: %(length (dired-get-marked-files)) +" + ("m" dired-mark "mark"))) + +;; This results in the following dynamic docstring: +;; +;; (format "Number of marked items: %S\n" +;; (length (dired-get-marked-files))) +;; +;; You can use `format'-style width specs, e.g. % 10(length nil). + +;;** Example 10: apropos family +(defhydra hydra-apropos (:color blue + :hint nil) + " +_a_propos _c_ommand +_d_ocumentation _l_ibrary +_v_ariable _u_ser-option +^ ^ valu_e_" + ("a" apropos) + ("d" apropos-documentation) + ("v" apropos-variable) + ("c" apropos-command) + ("l" apropos-library) + ("u" apropos-user-option) + ("e" apropos-value)) +;; Recommended binding: +;; (global-set-key (kbd "C-c h") 'hydra-apropos/body) + +;;** Example 11: rectangle-mark-mode +(require 'rect) +(defhydra hydra-rectangle (:body-pre (rectangle-mark-mode 1) + :color pink + :post (deactivate-mark)) + " + ^_k_^ _d_elete _s_tring +_h_ _l_ _o_k _y_ank + ^_j_^ _n_ew-copy _r_eset +^^^^ _e_xchange _u_ndo +^^^^ ^ ^ _p_aste +" + ("h" rectangle-backward-char nil) + ("l" rectangle-forward-char nil) + ("k" rectangle-previous-line nil) + ("j" rectangle-next-line nil) + ("e" hydra-ex-point-mark nil) + ("n" copy-rectangle-as-kill nil) + ("d" delete-rectangle nil) + ("r" (if (region-active-p) + (deactivate-mark) + (rectangle-mark-mode 1)) nil) + ("y" yank-rectangle nil) + ("u" undo nil) + ("s" string-rectangle nil) + ("p" kill-rectangle nil) + ("o" nil nil)) + +;; Recommended binding: +;; (global-set-key (kbd "C-x SPC") 'hydra-rectangle/body) + +;;** Example 12: org-agenda-view +(defun org-agenda-cts () + (and (eq major-mode 'org-agenda-mode) + (let ((args (get-text-property + (min (1- (point-max)) (point)) + 'org-last-args))) + (nth 2 args)))) + +(defhydra hydra-org-agenda-view (:hint none) + " +_d_: ?d? day _g_: time grid=?g? _a_: arch-trees +_w_: ?w? week _[_: inactive _A_: arch-files +_t_: ?t? fortnight _f_: follow=?f? _r_: clock report=?r? +_m_: ?m? month _e_: entry text=?e? _D_: include diary=?D? +_y_: ?y? year _q_: quit _L__l__c_: log = ?l?" + ("SPC" org-agenda-reset-view) + ("d" org-agenda-day-view (if (eq 'day (org-agenda-cts)) "[x]" "[ ]")) + ("w" org-agenda-week-view (if (eq 'week (org-agenda-cts)) "[x]" "[ ]")) + ("t" org-agenda-fortnight-view (if (eq 'fortnight (org-agenda-cts)) "[x]" "[ ]")) + ("m" org-agenda-month-view (if (eq 'month (org-agenda-cts)) "[x]" "[ ]")) + ("y" org-agenda-year-view (if (eq 'year (org-agenda-cts)) "[x]" "[ ]")) + ("l" org-agenda-log-mode (format "% -3S" org-agenda-show-log)) + ("L" (org-agenda-log-mode '(4))) + ("c" (org-agenda-log-mode 'clockcheck)) + ("f" org-agenda-follow-mode (format "% -3S" org-agenda-follow-mode)) + ("a" org-agenda-archives-mode) + ("A" (org-agenda-archives-mode 'files)) + ("r" org-agenda-clockreport-mode (format "% -3S" org-agenda-clockreport-mode)) + ("e" org-agenda-entry-text-mode (format "% -3S" org-agenda-entry-text-mode)) + ("g" org-agenda-toggle-time-grid (format "% -3S" org-agenda-use-time-grid)) + ("D" org-agenda-toggle-diary (format "% -3S" org-agenda-include-diary)) + ("!" org-agenda-toggle-deadlines) + ("[" (let ((org-agenda-include-inactive-timestamps t)) + (org-agenda-check-type t 'timeline 'agenda) + (org-agenda-redo) + (message "Display now includes inactive timestamps as well"))) + ("q" (message "Abort") :exit t) + ("v" nil)) + +;; Recommended binding: +;; (define-key org-agenda-mode-map "v" 'hydra-org-agenda-view/body) + +;;* Helpers +(require 'windmove) + +(defun hydra-move-splitter-left (arg) + "Move window splitter left." + (interactive "p") + (if (let ((windmove-wrap-around)) + (windmove-find-other-window 'right)) + (shrink-window-horizontally arg) + (enlarge-window-horizontally arg))) + +(defun hydra-move-splitter-right (arg) + "Move window splitter right." + (interactive "p") + (if (let ((windmove-wrap-around)) + (windmove-find-other-window 'right)) + (enlarge-window-horizontally arg) + (shrink-window-horizontally arg))) + +(defun hydra-move-splitter-up (arg) + "Move window splitter up." + (interactive "p") + (if (let ((windmove-wrap-around)) + (windmove-find-other-window 'up)) + (enlarge-window arg) + (shrink-window arg))) + +(defun hydra-move-splitter-down (arg) + "Move window splitter down." + (interactive "p") + (if (let ((windmove-wrap-around)) + (windmove-find-other-window 'up)) + (shrink-window arg) + (enlarge-window arg))) + +(defvar rectangle-mark-mode) +(defun hydra-ex-point-mark () + "Exchange point and mark." + (interactive) + (if rectangle-mark-mode + (rectangle-exchange-point-and-mark) + (let ((mk (mark))) + (rectangle-mark-mode 1) + (goto-char mk)))) + +(provide 'hydra-examples) + +;; Local Variables: +;; no-byte-compile: t +;; End: +;;; hydra-examples.el ends here diff --git a/elpa/hydra-20160913.216/hydra-ox.el b/elpa/hydra-20160913.216/hydra-ox.el new file mode 100644 index 0000000..a992efc --- /dev/null +++ b/elpa/hydra-20160913.216/hydra-ox.el @@ -0,0 +1,127 @@ +;;; hydra-ox.el --- Org mode export widget implemented in Hydra + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Oleh Krehel + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs 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. If not, see . + +;;; Commentary: +;; +;; This shows how a complex dispatch menu can be built with Hydra. + +;;; Code: + +(require 'hydra) +(require 'org) +(declare-function org-html-export-as-html 'ox-html) +(declare-function org-html-export-to-html 'ox-html) +(declare-function org-latex-export-as-latex 'ox-latex) +(declare-function org-latex-export-to-latex 'ox-latex) +(declare-function org-latex-export-to-pdf 'ox-latex) +(declare-function org-ascii-export-as-ascii 'ox-ascii) +(declare-function org-ascii-export-to-ascii 'ox-ascii) + +(defhydradio hydra-ox () + (body-only "Export only the body.") + (export-scope "Export scope." [buffer subtree]) + (async-export "When non-nil, export async.") + (visible-only "When non-nil, export visible only") + (force-publishing "Toggle force publishing")) + +(defhydra hydra-ox-html (:color blue) + "ox-html" + ("H" (org-html-export-as-html + hydra-ox/async-export + (eq hydra-ox/export-scope 'subtree) + hydra-ox/visible-only + hydra-ox/body-only) + "As HTML buffer") + ("h" (org-html-export-to-html + hydra-ox/async-export + (eq hydra-ox/export-scope 'subtree) + hydra-ox/visible-only + hydra-ox/body-only) "As HTML file") + ("o" (org-open-file + (org-html-export-to-html + hydra-ox/async-export + (eq hydra-ox/export-scope 'subtree) + hydra-ox/visible-only + hydra-ox/body-only)) "As HTML file and open") + ("b" hydra-ox/body "back") + ("q" nil "quit")) + +(defhydra hydra-ox-latex (:color blue) + "ox-latex" + ("L" org-latex-export-as-latex "As LaTeX buffer") + ("l" org-latex-export-to-latex "As LaTeX file") + ("p" org-latex-export-to-pdf "As PDF file") + ("o" (org-open-file (org-latex-export-to-pdf)) "As PDF file and open") + ("b" hydra-ox/body "back") + ("q" nil "quit")) + +(defhydra hydra-ox-text (:color blue) + "ox-text" + ("A" (org-ascii-export-as-ascii + nil nil nil nil + '(:ascii-charset ascii)) + "As ASCII buffer") + + ("a" (org-ascii-export-to-ascii + nil nil nil nil + '(:ascii-charset ascii)) + "As ASCII file") + ("L" (org-ascii-export-as-ascii + nil nil nil nil + '(:ascii-charset latin1)) + "As Latin1 buffer") + ("l" (org-ascii-export-to-ascii + nil nil nil nil + '(:ascii-charset latin1)) + "As Latin1 file") + ("U" (org-ascii-export-as-ascii + nil nil nil nil + '(:ascii-charset utf-8)) + "As UTF-8 buffer") + ("u" (org-ascii-export-to-ascii + nil nil nil nil + '(:ascii-charset utf-8)) + "As UTF-8 file") + ("b" hydra-ox/body "back") + ("q" nil "quit")) + +(defhydra hydra-ox () + " +_C-b_ Body only: % -15`hydra-ox/body-only^^^ _C-v_ Visible only: %`hydra-ox/visible-only +_C-s_ Export scope: % -15`hydra-ox/export-scope _C-f_ Force publishing: %`hydra-ox/force-publishing +_C-a_ Async export: %`hydra-ox/async-export + +" + ("C-b" (hydra-ox/body-only) nil) + ("C-v" (hydra-ox/visible-only) nil) + ("C-s" (hydra-ox/export-scope) nil) + ("C-f" (hydra-ox/force-publishing) nil) + ("C-a" (hydra-ox/async-export) nil) + ("h" hydra-ox-html/body "Export to HTML" :exit t) + ("l" hydra-ox-latex/body "Export to LaTeX" :exit t) + ("t" hydra-ox-text/body "Export to Plain Text" :exit t) + ("q" nil "quit")) + +(define-key org-mode-map (kbd "C-c C-,") 'hydra-ox/body) + +(provide 'hydra-ox) + +;;; hydra-ox.el ends here diff --git a/elpa/hydra-20160913.216/hydra-pkg.el b/elpa/hydra-20160913.216/hydra-pkg.el new file mode 100644 index 0000000..02e88ee --- /dev/null +++ b/elpa/hydra-20160913.216/hydra-pkg.el @@ -0,0 +1,7 @@ +(define-package "hydra" "20160913.216" "Make bindings that stick around." + '((cl-lib "0.5")) + :url "https://github.com/abo-abo/hydra" :keywords + '("bindings")) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/hydra-20160913.216/hydra.el b/elpa/hydra-20160913.216/hydra.el new file mode 100644 index 0000000..61fb01c --- /dev/null +++ b/elpa/hydra-20160913.216/hydra.el @@ -0,0 +1,1273 @@ +;;; hydra.el --- Make bindings that stick around. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Oleh Krehel +;; Maintainer: Oleh Krehel +;; URL: https://github.com/abo-abo/hydra +;; Version: 0.13.6 +;; Keywords: bindings +;; Package-Requires: ((cl-lib "0.5")) + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs 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. If not, see . + +;;; Commentary: +;; +;; This package can be used to tie related commands into a family of +;; short bindings with a common prefix - a Hydra. +;; +;; Once you summon the Hydra (through the prefixed binding), all the +;; heads can be called in succession with only a short extension. +;; The Hydra is vanquished once Hercules, any binding that isn't the +;; Hydra's head, arrives. Note that Hercules, besides vanquishing the +;; Hydra, will still serve his orignal purpose, calling his proper +;; command. This makes the Hydra very seamless, it's like a minor +;; mode that disables itself automagically. +;; +;; Here's an example Hydra, bound in the global map (you can use any +;; keymap in place of `global-map'): +;; +;; (defhydra hydra-zoom (global-map "") +;; "zoom" +;; ("g" text-scale-increase "in") +;; ("l" text-scale-decrease "out")) +;; +;; It allows to start a command chain either like this: +;; " gg4ll5g", or " lgllg". +;; +;; Here's another approach, when you just want a "callable keymap": +;; +;; (defhydra hydra-toggle (:color blue) +;; "toggle" +;; ("a" abbrev-mode "abbrev") +;; ("d" toggle-debug-on-error "debug") +;; ("f" auto-fill-mode "fill") +;; ("t" toggle-truncate-lines "truncate") +;; ("w" whitespace-mode "whitespace") +;; ("q" nil "cancel")) +;; +;; This binds nothing so far, but if you follow up with: +;; +;; (global-set-key (kbd "C-c C-v") 'hydra-toggle/body) +;; +;; you will have bound "C-c C-v a", "C-c C-v d" etc. +;; +;; Knowing that `defhydra' defines e.g. `hydra-toggle/body' command, +;; you can nest Hydras if you wish, with `hydra-toggle/body' possibly +;; becoming a blue head of another Hydra. +;; +;; If you want to learn all intricacies of using `defhydra' without +;; having to figure it all out from this source code, check out the +;; wiki: https://github.com/abo-abo/hydra/wiki. There's a wealth of +;; information there. Everyone is welcome to bring the existing pages +;; up to date and add new ones. +;; +;; Additionally, the file hydra-examples.el serves to demo most of the +;; functionality. + +;;; Code: +;;* Requires +(require 'cl-lib) +(require 'lv) +(require 'ring) + +(defvar hydra-curr-map nil + "The keymap of the current Hydra called.") + +(defvar hydra-curr-on-exit nil + "The on-exit predicate for the current Hydra.") + +(defvar hydra-curr-foreign-keys nil + "The current :foreign-keys behavior.") + +(defvar hydra-curr-body-fn nil + "The current hydra-.../body function.") + +(defvar hydra-deactivate nil + "If a Hydra head sets this to t, exit the Hydra. +This will be done even if the head wasn't designated for exiting.") + +(defvar hydra-amaranth-warn-message "An amaranth Hydra can only exit through a blue head" + "Amaranth Warning message. Shown when the user tries to press an unbound/non-exit key while in an amaranth head.") + +(defun hydra-set-transient-map (keymap on-exit &optional foreign-keys) + "Set KEYMAP to the highest priority. + +Call ON-EXIT when the KEYMAP is deactivated. + +FOREIGN-KEYS determines the deactivation behavior, when a command +that isn't in KEYMAP is called: + +nil: deactivate KEYMAP and run the command. +run: keep KEYMAP and run the command. +warn: keep KEYMAP and issue a warning instead of running the command." + (if hydra-deactivate + (hydra-keyboard-quit) + (setq hydra-curr-map keymap) + (setq hydra-curr-on-exit on-exit) + (setq hydra-curr-foreign-keys foreign-keys) + (add-hook 'pre-command-hook 'hydra--clearfun) + (internal-push-keymap keymap 'overriding-terminal-local-map))) + +(defun hydra--clearfun () + "Disable the current Hydra unless `this-command' is a head." + (unless (eq this-command 'hydra-pause-resume) + (when (or + (memq this-command '(handle-switch-frame + keyboard-quit)) + (null overriding-terminal-local-map) + (not (or (eq this-command + (lookup-key hydra-curr-map (this-single-command-keys))) + (cl-case hydra-curr-foreign-keys + (warn + (setq this-command 'hydra-amaranth-warn)) + (run + t) + (t nil))))) + (hydra-disable)))) + +(defvar hydra--ignore nil + "When non-nil, don't call `hydra-curr-on-exit'.") + +(defvar hydra--input-method-function nil + "Store overridden `input-method-function' here.") + +(defun hydra-disable () + "Disable the current Hydra." + (setq hydra-deactivate nil) + (remove-hook 'pre-command-hook 'hydra--clearfun) + (unless hydra--ignore + (if (fboundp 'remove-function) + (remove-function input-method-function #'hydra--imf) + (when hydra--input-method-function + (setq input-method-function hydra--input-method-function) + (setq hydra--input-method-function nil)))) + (dolist (frame (frame-list)) + (with-selected-frame frame + (when overriding-terminal-local-map + (internal-pop-keymap hydra-curr-map 'overriding-terminal-local-map)))) + (unless hydra--ignore + (when hydra-curr-on-exit + (let ((on-exit hydra-curr-on-exit)) + (setq hydra-curr-on-exit nil) + (funcall on-exit))))) + +(unless (fboundp 'internal-push-keymap) + (defun internal-push-keymap (keymap symbol) + (let ((map (symbol-value symbol))) + (unless (memq keymap map) + (unless (memq 'add-keymap-witness (symbol-value symbol)) + (setq map (make-composed-keymap nil (symbol-value symbol))) + (push 'add-keymap-witness (cdr map)) + (set symbol map)) + (push keymap (cdr map)))))) + +(unless (fboundp 'internal-pop-keymap) + (defun internal-pop-keymap (keymap symbol) + (let ((map (symbol-value symbol))) + (when (memq keymap map) + (setf (cdr map) (delq keymap (cdr map)))) + (let ((tail (cddr map))) + (and (or (null tail) (keymapp tail)) + (eq 'add-keymap-witness (nth 1 map)) + (set symbol tail)))))) + +(defun hydra-amaranth-warn () + "Issue a warning that the current input was ignored." + (interactive) + (message hydra-amaranth-warn-message)) + +;;* Customize +(defgroup hydra nil + "Make bindings that stick around." + :group 'bindings + :prefix "hydra-") + +(defcustom hydra-is-helpful t + "When t, display a hint with possible bindings in the echo area." + :type 'boolean + :group 'hydra) + +(defcustom hydra-default-hint "" + "Default :hint property to use for heads when not specified in +the body or the head." + :type 'sexp + :group 'hydra) + +(defcustom hydra-lv t + "When non-nil, `lv-message' (not `message') will be used to display hints." + :type 'boolean) + +(defcustom hydra-verbose nil + "When non-nil, hydra will issue some non essential style warnings." + :type 'boolean) + +(defcustom hydra-key-format-spec "%s" + "Default `format'-style specifier for _a_ syntax in docstrings. +When nil, you can specify your own at each location like this: _ 5a_." + :type 'string) + +(defcustom hydra-doc-format-spec "%s" + "Default `format'-style specifier for ?a? syntax in docstrings." + :type 'string) + +(make-obsolete-variable + 'hydra-key-format-spec + "Since the docstrings are aligned by hand anyway, this isn't very useful." + "0.13.1") + +(defface hydra-face-red + '((t (:foreground "#FF0000" :bold t))) + "Red Hydra heads don't exit the Hydra. +Every other command exits the Hydra." + :group 'hydra) + +(defface hydra-face-blue + '((((class color) (background light)) + :foreground "#0000FF" :bold t) + (((class color) (background dark)) + :foreground "#8ac6f2" :bold t)) + "Blue Hydra heads exit the Hydra. +Every other command exits as well.") + +(defface hydra-face-amaranth + '((t (:foreground "#E52B50" :bold t))) + "Amaranth body has red heads and warns on intercepting non-heads. +Exitable only through a blue head.") + +(defface hydra-face-pink + '((t (:foreground "#FF6EB4" :bold t))) + "Pink body has red heads and runs intercepted non-heads. +Exitable only through a blue head.") + +(defface hydra-face-teal + '((t (:foreground "#367588" :bold t))) + "Teal body has blue heads and warns on intercepting non-heads. +Exitable only through a blue head.") + +;;* Fontification +(defun hydra-add-font-lock () + "Fontify `defhydra' statements." + (font-lock-add-keywords + 'emacs-lisp-mode + '(("(\\(defhydra\\)\\_> +\\(.*?\\)\\_>" + (1 font-lock-keyword-face) + (2 font-lock-type-face)) + ("(\\(defhydradio\\)\\_> +\\(.*?\\)\\_>" + (1 font-lock-keyword-face) + (2 font-lock-type-face))))) + +;;* Find Function +(eval-after-load 'find-func + '(defadvice find-function-search-for-symbol + (around hydra-around-find-function-search-for-symbol-advice + (symbol type library) activate) + "Navigate to hydras with `find-function-search-for-symbol'." + ad-do-it + ;; The orignial function returns (cons (current-buffer) (point)) + ;; if it found the point. + (unless (cdr ad-return-value) + (with-current-buffer (find-file-noselect library) + (let ((sn (symbol-name symbol))) + (when (and (null type) + (string-match "\\`\\(hydra-[a-z-A-Z0-9]+\\)/\\(.*\\)\\'" sn) + (re-search-forward (concat "(defhydra " (match-string 1 sn)) + nil t)) + (goto-char (match-beginning 0))) + (cons (current-buffer) (point))))))) + +;;* Universal Argument +(defvar hydra-base-map + (let ((map (make-sparse-keymap))) + (define-key map [?\C-u] 'hydra--universal-argument) + (define-key map [?-] 'hydra--negative-argument) + (define-key map [?0] 'hydra--digit-argument) + (define-key map [?1] 'hydra--digit-argument) + (define-key map [?2] 'hydra--digit-argument) + (define-key map [?3] 'hydra--digit-argument) + (define-key map [?4] 'hydra--digit-argument) + (define-key map [?5] 'hydra--digit-argument) + (define-key map [?6] 'hydra--digit-argument) + (define-key map [?7] 'hydra--digit-argument) + (define-key map [?8] 'hydra--digit-argument) + (define-key map [?9] 'hydra--digit-argument) + (define-key map [kp-0] 'hydra--digit-argument) + (define-key map [kp-1] 'hydra--digit-argument) + (define-key map [kp-2] 'hydra--digit-argument) + (define-key map [kp-3] 'hydra--digit-argument) + (define-key map [kp-4] 'hydra--digit-argument) + (define-key map [kp-5] 'hydra--digit-argument) + (define-key map [kp-6] 'hydra--digit-argument) + (define-key map [kp-7] 'hydra--digit-argument) + (define-key map [kp-8] 'hydra--digit-argument) + (define-key map [kp-9] 'hydra--digit-argument) + (define-key map [kp-subtract] 'hydra--negative-argument) + map) + "Keymap that all Hydras inherit. See `universal-argument-map'.") + +(defun hydra--universal-argument (arg) + "Forward to (`universal-argument' ARG)." + (interactive "P") + (setq prefix-arg (if (consp arg) + (list (* 4 (car arg))) + (if (eq arg '-) + (list -4) + '(4))))) + +(defun hydra--digit-argument (arg) + "Forward to (`digit-argument' ARG)." + (interactive "P") + (let* ((char (if (integerp last-command-event) + last-command-event + (get last-command-event 'ascii-character))) + (digit (- (logand char ?\177) ?0))) + (setq prefix-arg (cond ((integerp arg) + (+ (* arg 10) + (if (< arg 0) + (- digit) + digit))) + ((eq arg '-) + (if (zerop digit) + '- + (- digit))) + (t + digit))))) + +(defun hydra--negative-argument (arg) + "Forward to (`negative-argument' ARG)." + (interactive "P") + (setq prefix-arg (cond ((integerp arg) (- arg)) + ((eq arg '-) nil) + (t '-)))) + +;;* Repeat +(defvar hydra-repeat--prefix-arg nil + "Prefix arg to use with `hydra-repeat'.") + +(defvar hydra-repeat--command nil + "Command to use with `hydra-repeat'.") + +(defun hydra-repeat (&optional arg) + "Repeat last command with last prefix arg. +When ARG is non-nil, use that instead." + (interactive "p") + (if (eq arg 1) + (unless (string-match "hydra-repeat$" (symbol-name last-command)) + (setq hydra-repeat--command last-command) + (setq hydra-repeat--prefix-arg last-prefix-arg)) + (setq hydra-repeat--prefix-arg arg)) + (setq current-prefix-arg hydra-repeat--prefix-arg) + (funcall hydra-repeat--command)) + +;;* Misc internals +(defun hydra--callablep (x) + "Test if X is callable." + (or (functionp x) + (and (consp x) + (memq (car x) '(function quote))))) + +(defun hydra--make-callable (x) + "Generate a callable symbol from X. +If X is a function symbol or a lambda, return it. Otherwise, it +should be a single statement. Wrap it in an interactive lambda." + (cond ((or (symbolp x) (functionp x)) + x) + ((and (consp x) (eq (car x) 'function)) + (cadr x)) + (t + `(lambda () + (interactive) + ,x)))) + +(defun hydra-plist-get-default (plist prop default) + "Extract a value from a property list. +PLIST is a property list, which is a list of the form +\(PROP1 VALUE1 PROP2 VALUE2...). + +Return the value corresponding to PROP, or DEFAULT if PROP is not +one of the properties on the list." + (if (memq prop plist) + (plist-get plist prop) + default)) + +(defun hydra--head-property (h prop &optional default) + "Return for Hydra head H the value of property PROP. +Return DEFAULT if PROP is not in H." + (hydra-plist-get-default (cl-cdddr h) prop default)) + +(defun hydra--body-foreign-keys (body) + "Return what BODY does with a non-head binding." + (or + (plist-get (cddr body) :foreign-keys) + (let ((color (plist-get (cddr body) :color))) + (cl-case color + ((amaranth teal) 'warn) + (pink 'run))))) + +(defun hydra--body-exit (body) + "Return the exit behavior of BODY." + (or + (plist-get (cddr body) :exit) + (let ((color (plist-get (cddr body) :color))) + (cl-case color + ((blue teal) t) + (t nil))))) + +(defalias 'hydra--imf #'list) + +(defun hydra-default-pre () + "Default setup that happens in each head before :pre." + (when (eq input-method-function 'key-chord-input-method) + (if (fboundp 'add-function) + (add-function :override input-method-function #'hydra--imf) + (unless hydra--input-method-function + (setq hydra--input-method-function input-method-function) + (setq input-method-function nil))))) + +(defvar hydra-timeout-timer (timer-create) + "Timer for `hydra-timeout'.") + +(defvar hydra-message-timer (timer-create) + "Timer for the hint.") + +(defvar hydra--work-around-dedicated t + "When non-nil, assume there's no bug in `pop-to-buffer'. +`pop-to-buffer' should not select a dedicated window.") + +(defun hydra-keyboard-quit () + "Quitting function similar to `keyboard-quit'." + (interactive) + (hydra-disable) + (cancel-timer hydra-timeout-timer) + (cancel-timer hydra-message-timer) + (setq hydra-curr-map nil) + (unless (and hydra--ignore + (null hydra--work-around-dedicated)) + (if hydra-lv + (lv-delete-window) + (message ""))) + nil) + +(defvar hydra-head-format "[%s]: " + "The formatter for each head of a plain docstring.") + +(defvar hydra-key-doc-function 'hydra-key-doc-function-default + "The function for formatting key-doc pairs.") + +(defun hydra-key-doc-function-default (key key-width doc doc-width) + "Doc" + (format (format "%%%ds: %%%ds" key-width (- -1 doc-width)) + key doc)) + +(defun hydra--to-string (x) + (if (stringp x) + x + (eval x))) + +(defun hydra--hint (body heads) + "Generate a hint for the echo area. +BODY, and HEADS are parameters to `defhydra'." + (let (alist) + (dolist (h heads) + (let ((val (assoc (cadr h) alist)) + (pstr (hydra-fontify-head h body))) + (unless (null (cl-caddr h)) + (if val + (setf (cadr val) + (concat (cadr val) " " pstr)) + (push + (cons (cadr h) + (cons pstr (cl-caddr h))) + alist))))) + (let ((keys (nreverse (mapcar #'cdr alist))) + (n-cols (plist-get (cddr body) :columns)) + res) + (setq res + (if n-cols + (let ((n-rows (1+ (/ (length keys) n-cols))) + (max-key-len (apply #'max (mapcar (lambda (x) (length (car x))) keys))) + (max-doc-len (apply #'max (mapcar (lambda (x) + (length (hydra--to-string (cdr x)))) keys)))) + `(concat + "\n" + (mapconcat #'identity + (mapcar + (lambda (x) + (mapconcat + (lambda (y) + (and y + (funcall hydra-key-doc-function + (car y) + ,max-key-len + (hydra--to-string (cdr y)) + ,max-doc-len))) x "")) + ',(hydra--matrix keys n-cols n-rows)) + "\n"))) + + + `(concat + (mapconcat + (lambda (x) + (let ((str (hydra--to-string (cdr x)))) + (format + (if (> (length str) 0) + (concat hydra-head-format str) + "%s") + (car x)))) + ',keys + ", ") + ,(if keys "." "")))) + (if (cl-every #'stringp + (mapcar 'cddr alist)) + (eval res) + res)))) + +(defvar hydra-fontify-head-function nil + "Possible replacement for `hydra-fontify-head-default'.") + +(defun hydra-fontify-head-default (head body) + "Produce a pretty string from HEAD and BODY. +HEAD's binding is returned as a string with a colored face." + (let* ((foreign-keys (hydra--body-foreign-keys body)) + (head-exit (hydra--head-property head :exit)) + (head-color + (if head-exit + (if (eq foreign-keys 'warn) + 'teal + 'blue) + (cl-case foreign-keys + (warn 'amaranth) + (run 'pink) + (t 'red))))) + (when (and (null (cadr head)) + (not head-exit)) + (hydra--complain "nil cmd can only be blue")) + (propertize (if (string= (car head) "%") + "%%" + (car head)) + 'face + (or (hydra--head-property head :face) + (cl-case head-color + (blue 'hydra-face-blue) + (red 'hydra-face-red) + (amaranth 'hydra-face-amaranth) + (pink 'hydra-face-pink) + (teal 'hydra-face-teal) + (t (error "Unknown color for %S" head))))))) + +(defun hydra-fontify-head-greyscale (head _body) + "Produce a pretty string from HEAD and BODY. +HEAD's binding is returned as a string wrapped with [] or {}." + (format + (if (hydra--head-property head :exit) + "[%s]" + "{%s}") (car head))) + +(defun hydra-fontify-head (head body) + "Produce a pretty string from HEAD and BODY." + (funcall (or hydra-fontify-head-function 'hydra-fontify-head-default) + head body)) + +(defun hydra--strip-align-markers (str) + "Remove ^ from STR, unless they're escaped: \\^." + (let ((start 0)) + (while (setq start (string-match "\\\\?\\^" str start)) + (if (eq (- (match-end 0) (match-beginning 0)) 2) + (progn + (setq str (replace-match "^" nil nil str)) + (cl-incf start)) + (setq str (replace-match "" nil nil str)))) + str)) + +(defvar hydra-docstring-keys-translate-alist + '(("↑" . "") + ("↓" . "") + ("→" . "") + ("←" . "") + ("⌫" . "DEL") + ("⌦" . "") + ("⏎" . "RET"))) + +(defconst hydra-width-spec-regex " ?-?[0-9]*?" + "Regex for the width spec in keys and %` quoted sexps.") + +(defvar hydra-key-regex "\\[\\|]\\|[-[:alnum:] ~.,;:/|?<>={}*+#%@!&^↑↓←→⌫⌦⏎'`()\"$]+?" + "Regex for the key quoted in the docstring.") + +(defun hydra--format (_name body docstring heads) + "Generate a `format' statement from STR. +\"%`...\" expressions are extracted into \"%S\". +_NAME, BODY, DOCSTRING and HEADS are parameters of `defhydra'. +The expressions can be auto-expanded according to NAME." + (setq docstring (hydra--strip-align-markers docstring)) + (setq docstring (replace-regexp-in-string "___" "_β_" docstring)) + (let ((rest (if (eq (plist-get (cddr body) :hint) 'none) + "" + (hydra--hint body heads))) + (start 0) + varlist + offset) + (while (setq start + (string-match + (format + "\\(?:%%\\( ?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:[_?]\\(%s\\)\\(%s\\)[_?]\\)" + hydra-width-spec-regex + hydra-key-regex) + docstring start)) + (cond ((eq ?? (aref (match-string 0 docstring) 0)) + (let* ((key (match-string 4 docstring)) + (head (assoc key heads))) + (if head + (progn + (push (nth 2 head) varlist) + (setq docstring + (replace-match + (or + hydra-doc-format-spec + (concat "%" (match-string 3 docstring) "s")) + t nil docstring))) + (setq start (match-end 0)) + (warn "Unrecognized key: ?%s?" key)))) + ((eq ?_ (aref (match-string 0 docstring) 0)) + (let* ((key (match-string 4 docstring)) + (key (if (equal key "β") "_" key)) + normal-key + (head (or (assoc key heads) + (when (setq normal-key + (cdr (assoc + key hydra-docstring-keys-translate-alist))) + (assoc normal-key heads))))) + (if head + (progn + (push (hydra-fontify-head (if normal-key + (cons key (cdr head)) + head) + body) + varlist) + (let ((replacement + (or + hydra-key-format-spec + (concat "%" (match-string 3 docstring) "s")))) + (setq docstring + (replace-match replacement t nil docstring)) + (setq start (+ start (length replacement))))) + (setq start (match-end 0)) + (warn "Unrecognized key: _%s_" key)))) + + (t + (let* ((varp (if (eq ?` (aref (match-string 2 docstring) 0)) 1 0)) + (spec (match-string 1 docstring)) + (lspec (length spec))) + (setq offset + (with-temp-buffer + (insert (substring docstring (+ 1 start varp + (length spec)))) + (goto-char (point-min)) + (push (read (current-buffer)) varlist) + (- (point) (point-min)))) + (when (or (zerop lspec) + (/= (aref spec (1- (length spec))) ?s)) + (setq spec (concat spec "S"))) + (setq docstring + (concat + (substring docstring 0 start) + "%" spec + (substring docstring (+ start offset 1 lspec varp)))))))) + (if (eq ?\n (aref docstring 0)) + `(concat (format ,(substring docstring 1) ,@(nreverse varlist)) + ,rest) + (let ((r `(replace-regexp-in-string + " +$" "" + (concat ,docstring ": " + (replace-regexp-in-string + "\\(%\\)" "\\1\\1" ,rest))))) + (if (stringp rest) + `(format ,(eval r)) + `(format ,r)))))) + +(defun hydra--complain (format-string &rest args) + "Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil." + (if hydra-verbose + (apply #'error format-string args) + (apply #'message format-string args))) + +(defun hydra--doc (body-key body-name heads) + "Generate a part of Hydra docstring. +BODY-KEY is the body key binding. +BODY-NAME is the symbol that identifies the Hydra. +HEADS is a list of heads." + (format + "Create a hydra with %s body and the heads:\n\n%s\n\n%s" + (if body-key + (format "a \"%s\"" body-key) + "no") + (mapconcat + (lambda (x) + (format "\"%s\": `%S'" (car x) (cadr x))) + heads ",\n") + (format "The body can be accessed via `%S'." body-name))) + +(defun hydra--call-interactively (cmd name) + "Generate a `call-interactively' statement for CMD. +Set `this-command' to NAME." + (if (and (symbolp name) + (not (memq name '(nil body)))) + `(progn + (setq this-command ',name) + (call-interactively #',cmd)) + `(call-interactively #',cmd))) + +(defun hydra--make-defun (name body doc head + keymap body-pre body-before-exit + &optional body-after-exit) + "Make a defun wrapper, using NAME, BODY, DOC, HEAD, and KEYMAP. +NAME and BODY are the arguments to `defhydra'. +DOC was generated with `hydra--doc'. +HEAD is one of the HEADS passed to `defhydra'. +BODY-PRE is added to the start of the wrapper. +BODY-BEFORE-EXIT will be called before the hydra quits. +BODY-AFTER-EXIT is added to the end of the wrapper." + (let ((cmd-name (hydra--head-name head name)) + (cmd (when (car head) + (hydra--make-callable + (cadr head)))) + (doc (if (car head) + (format "%s\n\nCall the head: `%S'." doc (cadr head)) + doc)) + (hint (intern (format "%S/hint" name))) + (body-foreign-keys (hydra--body-foreign-keys body)) + (body-timeout (plist-get body :timeout)) + (body-idle (plist-get body :idle))) + `(defun ,cmd-name () + ,doc + (interactive) + (hydra-default-pre) + ,@(when body-pre (list body-pre)) + ,@(if (hydra--head-property head :exit) + `((hydra-keyboard-quit) + (setq hydra-curr-body-fn ',(intern (format "%S/body" name))) + ,@(if body-after-exit + `((unwind-protect + ,(when cmd + (hydra--call-interactively cmd (cadr head))) + ,body-after-exit)) + (when cmd + `(,(hydra--call-interactively cmd (cadr head)))))) + (delq + nil + `((let ((hydra--ignore ,(not (eq (cadr head) 'body)))) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn ',(intern (format "%S/body" name)))) + ,(when cmd + `(condition-case err + ,(hydra--call-interactively cmd (cadr head)) + ((quit error) + (message (error-message-string err)) + (unless hydra-lv + (sit-for 0.8))))) + ,(if (and body-idle (eq (cadr head) 'body)) + `(hydra-idle-message ,body-idle ,hint ',name) + `(hydra-show-hint ,hint ',name)) + (hydra-set-transient-map + ,keymap + (lambda () (hydra-keyboard-quit) ,body-before-exit) + ,(when body-foreign-keys + (list 'quote body-foreign-keys))) + ,body-after-exit + ,(when body-timeout + `(hydra-timeout ,body-timeout)))))))) + +(defvar hydra-props-alist nil) + +(defun hydra-set-property (name key val) + "Set hydra property. +NAME is the symbolic name of the hydra. +KEY and VAL are forwarded to `plist-put'." + (let ((entry (assoc name hydra-props-alist)) + plist) + (when (null entry) + (add-to-list 'hydra-props-alist (list name)) + (setq entry (assoc name hydra-props-alist))) + (setq plist (cdr entry)) + (setcdr entry (plist-put plist key val)))) + +(defun hydra-get-property (name key) + "Get hydra property. +NAME is the symbolic name of the hydra. +KEY is forwarded to `plist-get'." + (let ((entry (assoc name hydra-props-alist))) + (when entry + (plist-get (cdr entry) key)))) + +(defun hydra-show-hint (hint caller) + (let ((verbosity (plist-get (cdr (assoc caller hydra-props-alist)) + :verbosity))) + (cond ((eq verbosity 0)) + ((eq verbosity 1) + (message (eval hint))) + (t + (when hydra-is-helpful + (if hydra-lv + (lv-message (eval hint)) + (message (eval hint)))))))) + +(defmacro hydra--make-funcall (sym) + "Transform SYM into a `funcall' to call it." + `(when (and ,sym (symbolp ,sym)) + (setq ,sym `(funcall #',,sym)))) + +(defun hydra--head-name (h name) + "Return the symbol for head H of hydra with NAME." + (let ((str (format "%S/%s" name + (cond ((symbolp (cadr h)) + (cadr h)) + ((and (consp (cadr h)) + (eq (cl-caadr h) 'function)) + (cadr (cadr h))) + (t + (concat "lambda-" (car h))))))) + (when (and (hydra--head-property h :exit) + (not (memq (cadr h) '(body nil)))) + (setq str (concat str "-and-exit"))) + (intern str))) + +(defun hydra--delete-duplicates (heads) + "Return HEADS without entries that have the same CMD part. +In duplicate HEADS, :cmd-name is modified to whatever they duplicate." + (let ((ali '(((hydra-repeat . nil) . hydra-repeat))) + res entry) + (dolist (h heads) + (if (setq entry (assoc (cons (cadr h) + (hydra--head-property h :exit)) + ali)) + (setf (cl-cdddr h) (plist-put (cl-cdddr h) :cmd-name (cdr entry))) + (push (cons (cons (cadr h) + (hydra--head-property h :exit)) + (plist-get (cl-cdddr h) :cmd-name)) + ali) + (push h res))) + (nreverse res))) + +(defun hydra--pad (lst n) + "Pad LST with nil until length N." + (let ((len (length lst))) + (if (= len n) + lst + (append lst (make-list (- n len) nil))))) + +(defmacro hydra-multipop (lst n) + "Return LST's first N elements while removing them." + `(if (<= (length ,lst) ,n) + (prog1 ,lst + (setq ,lst nil)) + (prog1 ,lst + (setcdr + (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst)))) + nil)))) + +(defun hydra--matrix (lst rows cols) + "Create a matrix from elements of LST. +The matrix size is ROWS times COLS." + (let ((ls (copy-sequence lst)) + res) + (dotimes (_c cols) + (push (hydra--pad (hydra-multipop ls rows) rows) res)) + (nreverse res))) + +(defun hydra--cell (fstr names) + "Format a rectangular cell based on FSTR and NAMES. +FSTR is a format-style string with two string inputs: one for the +doc and one for the symbol name. +NAMES is a list of variables." + (let ((len (cl-reduce + (lambda (acc it) (max (length (symbol-name it)) acc)) + names + :initial-value 0))) + (mapconcat + (lambda (sym) + (if sym + (format fstr + (documentation-property sym 'variable-documentation) + (let ((name (symbol-name sym))) + (concat name (make-string (- len (length name)) ?^))) + sym) + "")) + names + "\n"))) + +(defun hydra--vconcat (strs &optional joiner) + "Glue STRS vertically. They must be the same height. +JOINER is a function similar to `concat'." + (setq joiner (or joiner #'concat)) + (mapconcat + (lambda (s) + (if (string-match " +$" s) + (replace-match "" nil nil s) + s)) + (apply #'cl-mapcar joiner + (mapcar + (lambda (s) (split-string s "\n")) + strs)) + "\n")) + +(defvar hydra-cell-format "% -20s %% -8`%s" + "The default format for docstring cells.") + +(defun hydra--table (names rows cols &optional cell-formats) + "Format a `format'-style table from variables in NAMES. +The size of the table is ROWS times COLS. +CELL-FORMATS are `format' strings for each column. +If CELL-FORMATS is a string, it's used for all columns. +If CELL-FORMATS is nil, `hydra-cell-format' is used for all columns." + (setq cell-formats + (cond ((null cell-formats) + (make-list cols hydra-cell-format)) + ((stringp cell-formats) + (make-list cols cell-formats)) + (t + cell-formats))) + (hydra--vconcat + (cl-mapcar + #'hydra--cell + cell-formats + (hydra--matrix names rows cols)) + (lambda (&rest x) + (mapconcat #'identity x " ")))) + +(defun hydra-reset-radios (names) + "Set varibles NAMES to their defaults. +NAMES should be defined by `defhydradio' or similar." + (dolist (n names) + (set n (aref (get n 'range) 0)))) + +(defun hydra-idle-message (secs hint name) + "In SECS seconds display HINT." + (cancel-timer hydra-message-timer) + (setq hydra-message-timer (timer-create)) + (timer-set-time hydra-message-timer + (timer-relative-time (current-time) secs)) + (timer-set-function + hydra-message-timer + (lambda () + (hydra-show-hint hint name) + (cancel-timer hydra-message-timer))) + (timer-activate hydra-message-timer)) + +(defun hydra-timeout (secs &optional function) + "In SECS seconds call FUNCTION, then function `hydra-keyboard-quit'. +Cancel the previous `hydra-timeout'." + (cancel-timer hydra-timeout-timer) + (setq hydra-timeout-timer (timer-create)) + (timer-set-time hydra-timeout-timer + (timer-relative-time (current-time) secs)) + (timer-set-function + hydra-timeout-timer + `(lambda () + ,(when function + `(funcall ,function)) + (hydra-keyboard-quit))) + (timer-activate hydra-timeout-timer)) + +;;* Macros +;;;###autoload +(defmacro defhydra (name body &optional docstring &rest heads) + "Create a Hydra - a family of functions with prefix NAME. + +NAME should be a symbol, it will be the prefix of all functions +defined here. + +BODY has the format: + + (BODY-MAP BODY-KEY &rest BODY-PLIST) + +DOCSTRING will be displayed in the echo area to identify the +Hydra. When DOCSTRING starts with a newline, special Ruby-style +substitution will be performed by `hydra--format'. + +Functions are created on basis of HEADS, each of which has the +format: + + (KEY CMD &optional HINT &rest PLIST) + +BODY-MAP is a keymap; `global-map' is used quite often. Each +function generated from HEADS will be bound in BODY-MAP to +BODY-KEY + KEY (both are strings passed to `kbd'), and will set +the transient map so that all following heads can be called +though KEY only. BODY-KEY can be an empty string. + +CMD is a callable expression: either an interactive function +name, or an interactive lambda, or a single sexp (it will be +wrapped in an interactive lambda). + +HINT is a short string that identifies its head. It will be +printed beside KEY in the echo erea if `hydra-is-helpful' is not +nil. If you don't even want the KEY to be printed, set HINT +explicitly to nil. + +The heads inherit their PLIST from BODY-PLIST and are allowed to +override some keys. The keys recognized are :exit and :bind. +:exit can be: + +- nil (default): this head will continue the Hydra state. +- t: this head will stop the Hydra state. + +:bind can be: +- nil: this head will not be bound in BODY-MAP. +- a lambda taking KEY and CMD used to bind a head. + +It is possible to omit both BODY-MAP and BODY-KEY if you don't +want to bind anything. In that case, typically you will bind the +generated NAME/body command. This command is also the return +result of `defhydra'." + (declare (indent defun)) + (cond ((stringp docstring)) + ((and (consp docstring) + (memq (car docstring) '(hydra--table concat format))) + (setq docstring (concat "\n" (eval docstring)))) + (t + (setq heads (cons docstring heads)) + (setq docstring "hydra"))) + (when (keywordp (car body)) + (setq body (cons nil (cons nil body)))) + (condition-case-unless-debug err + (let* ((keymap (copy-keymap hydra-base-map)) + (keymap-name (intern (format "%S/keymap" name))) + (body-name (intern (format "%S/body" name))) + (body-key (cadr body)) + (body-plist (cddr body)) + (body-map (or (car body) + (plist-get body-plist :bind))) + (body-pre (plist-get body-plist :pre)) + (body-body-pre (plist-get body-plist :body-pre)) + (body-before-exit (or (plist-get body-plist :post) + (plist-get body-plist :before-exit))) + (body-after-exit (plist-get body-plist :after-exit)) + (body-inherit (plist-get body-plist :inherit)) + (body-foreign-keys (hydra--body-foreign-keys body)) + (body-exit (hydra--body-exit body))) + (dolist (base body-inherit) + (setq heads (append heads (copy-sequence (eval base))))) + (dolist (h heads) + (let ((len (length h))) + (cond ((< len 2) + (error "Each head should have at least two items: %S" h)) + ((= len 2) + (setcdr (cdr h) + (list + (hydra-plist-get-default + body-plist :hint hydra-default-hint))) + (setcdr (nthcdr 2 h) (list :exit body-exit))) + (t + (let ((hint (cl-caddr h))) + (unless (or (null hint) + (stringp hint) + (consp hint)) + (let ((inherited-hint + (hydra-plist-get-default + body-plist :hint hydra-default-hint))) + (setcdr (cdr h) (cons + (if (eq 'none inherited-hint) + nil + inherited-hint) + (cddr h)))))) + (let ((hint-and-plist (cddr h))) + (if (null (cdr hint-and-plist)) + (setcdr hint-and-plist (list :exit body-exit)) + (let* ((plist (cl-cdddr h)) + (h-color (plist-get plist :color))) + (if h-color + (progn + (plist-put plist :exit + (cl-case h-color + ((blue teal) t) + (t nil))) + (cl-remf (cl-cdddr h) :color)) + (let ((h-exit (hydra-plist-get-default plist :exit 'default))) + (plist-put plist :exit + (if (eq h-exit 'default) + body-exit + h-exit)))))))))) + (plist-put (cl-cdddr h) :cmd-name (hydra--head-name h name)) + (when (null (cadr h)) (plist-put (cl-cdddr h) :exit t))) + (let ((doc (hydra--doc body-key body-name heads)) + (heads-nodup (hydra--delete-duplicates heads))) + (mapc + (lambda (x) + (define-key keymap (kbd (car x)) + (plist-get (cl-cdddr x) :cmd-name))) + heads) + (hydra--make-funcall body-pre) + (hydra--make-funcall body-body-pre) + (hydra--make-funcall body-before-exit) + (hydra--make-funcall body-after-exit) + (when (memq body-foreign-keys '(run warn)) + (unless (cl-some + (lambda (h) + (hydra--head-property h :exit)) + heads) + (error + "An %S Hydra must have at least one blue head in order to exit" + body-foreign-keys))) + `(progn + ;; create keymap + (set (defvar ,keymap-name + nil + ,(format "Keymap for %S." name)) + ',keymap) + ;; declare heads + (set (defvar ,(intern (format "%S/heads" name)) + nil + ,(format "Heads for %S." name)) + ',(mapcar (lambda (h) + (let ((j (copy-sequence h))) + (cl-remf (cl-cdddr j) :cmd-name) + j)) + heads)) + (set + (defvar ,(intern (format "%S/hint" name)) nil + ,(format "Dynamic hint for %S." name)) + ',(hydra--format name body docstring heads)) + ;; create defuns + ,@(mapcar + (lambda (head) + (hydra--make-defun name body doc head keymap-name + body-pre + body-before-exit + body-after-exit)) + heads-nodup) + ;; free up keymap prefix + ,@(unless (or (null body-key) + (null body-map) + (hydra--callablep body-map)) + `((unless (keymapp (lookup-key ,body-map (kbd ,body-key))) + (define-key ,body-map (kbd ,body-key) nil)))) + ;; bind keys + ,@(delq nil + (mapcar + (lambda (head) + (let ((name (hydra--head-property head :cmd-name))) + (when (and (cadr head) + (or body-key body-map)) + (let ((bind (hydra--head-property head :bind body-map)) + (final-key + (if body-key + (vconcat (kbd body-key) (kbd (car head))) + (kbd (car head))))) + (cond ((null bind) nil) + ((hydra--callablep bind) + `(funcall ,bind ,final-key (function ,name))) + ((and (symbolp bind) + (if (boundp bind) + (keymapp (symbol-value bind)) + t)) + `(define-key ,bind ,final-key (quote ,name))) + (t + (error "Invalid :bind property `%S' for head %S" bind head))))))) + heads)) + ,(hydra--make-defun + name body doc '(nil body) + keymap-name + (or body-body-pre body-pre) body-before-exit + '(setq prefix-arg current-prefix-arg))))) + (error + (hydra--complain "Error in defhydra %S: %s" name (cdr err)) + nil))) + +(defmacro defhydradio (name _body &rest heads) + "Create radios with prefix NAME. +_BODY specifies the options; there are none currently. +HEADS have the format: + + (TOGGLE-NAME &optional VALUE DOC) + +TOGGLE-NAME will be used along with NAME to generate a variable +name and a function that cycles it with the same name. VALUE +should be an array. The first element of VALUE will be used to +inialize the variable. +VALUE defaults to [nil t]. +DOC defaults to TOGGLE-NAME split and capitalized." + (declare (indent defun)) + `(progn + ,@(apply #'append + (mapcar (lambda (h) + (hydra--radio name h)) + heads)) + (defvar ,(intern (format "%S/names" name)) + ',(mapcar (lambda (h) (intern (format "%S/%S" name (car h)))) + heads)))) + +(defun hydra--radio (parent head) + "Generate a hydradio with PARENT from HEAD." + (let* ((name (car head)) + (full-name (intern (format "%S/%S" parent name))) + (doc (cadr head)) + (val (or (cl-caddr head) [nil t]))) + `((defvar ,full-name ,(hydra--quote-maybe (aref val 0)) ,doc) + (put ',full-name 'range ,val) + (defun ,full-name () + (hydra--cycle-radio ',full-name))))) + +(defun hydra--quote-maybe (x) + "Quote X if it's a symbol." + (cond ((null x) + nil) + ((symbolp x) + (list 'quote x)) + (t + x))) + +(defun hydra--cycle-radio (sym) + "Set SYM to the next value in its range." + (let* ((val (symbol-value sym)) + (range (get sym 'range)) + (i 0) + (l (length range))) + (setq i (catch 'done + (while (< i l) + (if (equal (aref range i) val) + (throw 'done (1+ i)) + (cl-incf i))) + (error "Val not in range for %S" sym))) + (set sym + (aref range + (if (>= i l) + 0 + i))))) + +(defvar hydra-pause-ring (make-ring 10) + "Ring for paused hydras.") + +(defun hydra-pause-resume () + "Quit the current hydra and save it to the stack. +If there's no active hydra, pop one from the stack and call its body. +If the stack is empty, call the last hydra's body." + (interactive) + (cond (hydra-curr-map + (ring-insert hydra-pause-ring hydra-curr-body-fn) + (hydra-keyboard-quit)) + ((zerop (ring-length hydra-pause-ring)) + (funcall hydra-curr-body-fn)) + (t + (funcall (ring-remove hydra-pause-ring 0))))) + +;; Local Variables: +;; outline-regexp: ";;\\([;*]+ [^\s\t\n]\\|###autoload\\)\\|(" +;; indent-tabs-mode: nil +;; End: + +(provide 'hydra) + +;;; hydra.el ends here diff --git a/elpa/hydra-20160913.216/lv.el b/elpa/hydra-20160913.216/lv.el new file mode 100644 index 0000000..87f7e5e --- /dev/null +++ b/elpa/hydra-20160913.216/lv.el @@ -0,0 +1,117 @@ +;;; lv.el --- Other echo area + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Oleh Krehel + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs 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. If not, see . + +;;; Commentary: +;; +;; This package provides `lv-message' intended to be used in place of +;; `message' when semi-permanent hints are needed, in order to not +;; interfere with Echo Area. +;; +;; "Я тихо-тихо пiдглядаю, +;; І тiшуся собi, як бачу то, +;; Шо страшить i не пiдпускає, +;; А iншi п’ють тебе, як воду пiсок." +;; -- Андрій Кузьменко, L.V. + +;;; Code: + +(defgroup lv nil + "The other echo area." + :group 'minibuffer + :group 'hydra) + +(defcustom lv-use-separator nil + "Whether to draw a line between the LV window and the Echo Area." + :group 'lv + :type 'boolean) + +(defface lv-separator + '((((class color) (background light)) :background "grey80") + (((class color) (background dark)) :background "grey30")) + "Face used to draw line between the lv window and the echo area. +This is only used if option `lv-use-separator' is non-nil. +Only the background color is significant." + :group 'lv) + +(defvar lv-wnd nil + "Holds the current LV window.") + +(defun lv-window () + "Ensure that LV window is live and return it." + (if (window-live-p lv-wnd) + lv-wnd + (let ((ori (selected-window)) + buf) + (prog1 (setq lv-wnd + (select-window + (let ((ignore-window-parameters t)) + (split-window + (frame-root-window) -1 'below)))) + (if (setq buf (get-buffer " *LV*")) + (switch-to-buffer buf) + (switch-to-buffer " *LV*") + (set-window-hscroll lv-wnd 0) + (setq window-size-fixed t) + (setq mode-line-format nil) + (setq cursor-type nil) + (set-window-dedicated-p lv-wnd t) + (set-window-parameter lv-wnd 'no-other-window t)) + (select-window ori))))) + +(defvar golden-ratio-mode) + +(defvar lv-force-update nil + "When non-nil, `lv-message' will refresh even for the same string.") + +(defun lv-message (format-string &rest args) + "Set LV window contents to (`format' FORMAT-STRING ARGS)." + (let* ((str (apply #'format format-string args)) + (n-lines (cl-count ?\n str)) + deactivate-mark + golden-ratio-mode) + (with-selected-window (lv-window) + (unless (and (string= (buffer-string) str) + (null lv-force-update)) + (delete-region (point-min) (point-max)) + (insert str) + (when (and (window-system) lv-use-separator) + (unless (looking-back "\n" nil) + (insert "\n")) + (insert + (propertize "__" 'face 'lv-separator 'display '(space :height (1))) + (propertize "\n" 'face 'lv-separator 'line-height t))) + (set (make-local-variable 'window-min-height) n-lines) + (setq truncate-lines (> n-lines 1)) + (let ((window-resize-pixelwise t) + (window-size-fixed nil)) + (fit-window-to-buffer nil nil 1))) + (goto-char (point-min))))) + +(defun lv-delete-window () + "Delete LV window and kill its buffer." + (when (window-live-p lv-wnd) + (let ((buf (window-buffer lv-wnd))) + (delete-window lv-wnd) + (kill-buffer buf)))) + +(provide 'lv) + +;;; lv.el ends here diff --git a/elpa/id-manager-20160425.216/id-manager-autoloads.el b/elpa/id-manager-20160425.216/id-manager-autoloads.el new file mode 100644 index 0000000..1096db2 --- /dev/null +++ b/elpa/id-manager-20160425.216/id-manager-autoloads.el @@ -0,0 +1,27 @@ +;;; id-manager-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "id-manager" "id-manager.el" (22501 4892 376900 +;;;;;; 628000)) +;;; Generated autoloads from id-manager.el + +(autoload 'idm-open-list-command "id-manager" "\ +Load the id-password DB and open a list buffer. + +\(fn &optional DB)" t nil) + +(autoload 'idm-helm-command "id-manager" "\ +Helm interface for id-manager. + +\(fn)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; id-manager-autoloads.el ends here diff --git a/elpa/id-manager-20160425.216/id-manager-pkg.el b/elpa/id-manager-20160425.216/id-manager-pkg.el new file mode 100644 index 0000000..a0da938 --- /dev/null +++ b/elpa/id-manager-20160425.216/id-manager-pkg.el @@ -0,0 +1 @@ +(define-package "id-manager" "20160425.216" "id-password management" 'nil :keywords '("password" "convenience")) diff --git a/elpa/id-manager-20160425.216/id-manager.el b/elpa/id-manager-20160425.216/id-manager.el new file mode 100644 index 0000000..253486a --- /dev/null +++ b/elpa/id-manager-20160425.216/id-manager.el @@ -0,0 +1,831 @@ +;;; id-manager.el --- id-password management + +;; Copyright (C) 2009, 2010, 2011, 2013 SAKURAI Masashi +;; Time-stamp: <2015-06-06 12:38:31 sakurai> + +;; Author: SAKURAI Masashi +;; Keywords: password, convenience +;; Package-Version: 20160425.216 + +;; This program 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 3 of the License, or +;; (at your option) any later version. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; ID-password management utility. +;; This utility manages ID-password list and generates passwords. + +;; The ID-password DB is saved in the tab-separated file. The default +;; file name of the DB `idm-database-file' is "~/.idm-db.gpg". +;; The file format is following: +;; (name)^t(ID)^t(password)^t(Update date "YYYY/MM/DD")[^t(memo)] +;; . One can prepare an initial data or modify the data by hand or +;; the Excel. +;; +;; Implicitly, this elisp program expects that the DB file is +;; encrypted by the some GPG encryption elisp, such as EasyPG or +;; alpaca. +;; +;; Excuting the command `idm-open-list-command', you can open the +;; ID-password list buffer. Check the function `describe-bindings'. + +;;; Installation: + +;; To use this program, locate this file to load-path directory, +;; and add the following code to your .emacs. +;; ------------------------------ +;; (require 'id-manager) +;; ------------------------------ +;; If you have helm.el, bind `id-manager' to key, +;; like (global-set-key (kbd "M-7") 'id-manager). + +;;; Setting example: + +;; For EasyPG users: +;; +;; (autoload 'id-manager "id-manager" nil t) +;; (global-set-key (kbd "M-7") 'id-manager) ; helm UI +;; (setq epa-file-cache-passphrase-for-symmetric-encryption t) ; saving password +;; (setenv "GPG_AGENT_INFO" nil) ; non-GUI password dialog. + +;; For alpaca users: +;; +;; (autoload 'id-manager "id-manager" nil t) +;; (global-set-key (kbd "M-7") 'id-manager) ; helm UI +;; (setq idm-db-buffer-save-function ; adjustment for alpaca.el +;; (lambda (file) +;; (set-visited-file-name file) +;; (alpaca-save-buffer)) +;; idm-db-buffer-password-var ; if you are using `alpaca-cache-passphrase'. +;; 'alpaca-passphrase) + +;;; Current implementation: + +;; This program generates passwords by using external command: +;; `idm-gen-password-cmd'. If you have some better idea, please let me +;; know. +;; +;; I think that this program makes lazy password management more +;; securely. But I'm not sure that this program is secure enough. +;; I'd like many people to check and advice me. + +;;; Code: + +(eval-when-compile (require 'cl)) + +(require 'widget) +(eval-when-compile (require 'wid-edit)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Setting + +(defvar idm-database-file "~/.idm-db.gpg" + "Encripted id-password database file. The file name may + end with '.gpg' for encryption by the GnuPG.") + +(defvar idm-gen-password-cmd + "head -c 10 < /dev/random | uuencode -m - | tail -n 2 |head -n 1 | head -c10" + "[String] Password generation command. If a function symbol or + lambda whose receive no parameter is set to this variable, + id-manager calls the function to generate the password.") +;; "openssl rand 32 | uuencode -m - | tail -n 2 |head -n 1 | head -c10" +;; ...any other password generation ? + +(defvar idm-copy-action + (lambda (text) (x-select-text text)) + "Action for copying a password text into clipboard.") + +(defvar idm-db-buffer-load-function + 'find-file-noselect + "File loading function. This function has one argument FILENAME and returns a buffer, + like `find-file-noselect'. Some decryption should work at this + function.") + +(defvar idm-db-buffer-save-function + 'write-file + "File saving function. This function has one arguments FILENAME, + like `write-file'. Some encryption should work at this + function.") + +(defvar idm-db-buffer-password-var nil + "Password variable. See the text of settings for alpaca.el. ") + +(defvar idm-clipboard-expire-time-sec 5 + "Expire time for the clipboard content.") + +(defvar idm-clipboard-expire-timer nil + "The timer object that will expire the clipboard content.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Macros + +(defmacro idm--aif (test-form then-form &rest else-forms) + `(let ((it ,test-form)) + (if it ,then-form ,@else-forms))) +(put 'idm--aif 'lisp-indent-function 2) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Management API + +(defun idm-gen-password () + "Generate a password." + (cond + ((functionp idm-gen-password-cmd) + (funcall idm-gen-password-cmd)) + ((stringp idm-gen-password-cmd) + (let ((buf (get-buffer-create " *idm-work*")) ret) + (call-process-shell-command + idm-gen-password-cmd + nil buf nil) + (with-current-buffer buf + (setq ret (buffer-string))) + (kill-buffer buf) + ret)) + (t (error "idm-gen-password-cmd is set to wrong value. [%S]" + idm-gen-password-cmd)))) + +;; record struct +(defstruct (idm-record + (:constructor make-idm-record-bylist + (name account-id password update-time + &optional memo))) + name account-id password update-time memo) + +(defun idm-load-db () + "Load the DB file `idm-database-file' and make a DB object." + (let* ((coding-system-for-read 'utf-8) + (tmpbuf + (funcall idm-db-buffer-load-function + (expand-file-name idm-database-file))) + db-object) + (unwind-protect + (let ((db (idm--make-db tmpbuf))) + (when idm-db-buffer-password-var + (with-current-buffer tmpbuf + (funcall db 'file-password + (symbol-value idm-db-buffer-password-var)))) + db) + (kill-buffer tmpbuf)))) + +(defun idm--save-db (records file-vars &optional password) + "Save RECORDS into the DB file `idm-database-file'. This +function is called by a DB object." + (let ((coding-system-for-write 'utf-8) + (tmpbuf (get-buffer-create " *idm-tmp*"))) + (with-current-buffer tmpbuf + (erase-buffer) + (goto-char (point-min)) + (loop for (sym . v) in file-vars do + (set (make-local-variable sym) v)) + (insert (format + ";; -*- %s -*-" + (loop for (n . v) in file-vars concat + (format "%s: %S; " n v))) "\n") + (dolist (i records) + (insert (concat (idm-record-name i) "\t" + (idm-record-account-id i) "\t" + (idm-record-password i) "\t" + (idm-record-update-time i) + (idm--aif (idm-record-memo i) + (concat "\t" it)) + "\n"))) + (when password + (set idm-db-buffer-password-var password)) + (funcall idm-db-buffer-save-function idm-database-file) + (kill-buffer tmpbuf)))) + +(defun idm--make-db (tmpbuf) + "Build a database management object from the given buffer text. +The object is a dispatch function. One can access the methods +`funcall' with the method name symbol and some method arguments." + (lexical-let (records + (db-modified nil) + file-vars ; file variables + file-password) ; password for alpaca + (setq file-vars (buffer-local-value 'file-local-variables-alist tmpbuf)) + (idm--each-line + tmpbuf + (lambda (line) + (cond + ((string-match "^;; " line) ; file variables + ) ; ignore + (t ; entry lines + (let ((cols (split-string line "\t"))) + (if (or (= 4 (length cols)) + (= 5 (length cols))) + (push (apply 'make-idm-record-bylist cols) + records))))))) + (lambda (method &rest args) + (cond + ((eq method 'get) ; get record object by name + (lexical-let ((name (car args)) ret) + (mapc (lambda (i) + (if (equal name (idm-record-name i)) + (setq ret i))) + records) + ret)) + ((eq method 'get-all-records) records) ; get-all-records + ((eq method 'add-record) ; add-record + (progn + (lexical-let* ((record (car args)) + (name (idm-record-name record))) + (setf records (loop for i in records + unless (equal (idm-record-name i) name) + collect i)) + (push record records) + (setq db-modified t)))) + ((eq method 'delete-record-by-name) ; delete-record-by-name + (lexical-let ((name (car args))) + (setf records (loop for i in records + unless (equal (idm-record-name i) name) + collect i)) + (setq db-modified t))) + ((eq method 'set-modified) ; set-modified + (setq db-modified t)) + ((eq method 'save) ; save + (when db-modified + (idm--save-db records file-vars file-password) + (setq db-modified nil))) + ((eq method 'file-password) ; file-password + (setq file-password (car args)) nil) + (t (error "Unknown method [%s]" method)))))) + +(defun idm--each-line (buf task) + "Execute the function TASK with each lines in the buffer +`buf'. This function is called by `idm--make-db'." + (with-current-buffer buf + (goto-char (point-min)) + (unless (eobp) + (while + (let ((line + (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)))) + (funcall task line) + (forward-line 1) + (not (eobp))))))) + +(defun idm--strtime (time) + "Translate emacs time to formatted string." + (format-time-string "%Y/%m/%d" time)) + +(defun idm--parsetime (str) + "Translate formatted string to emacs time." + (when (string-match "\\([0-9]+\\)\\/\\([0-9]+\\)\\/\\([0-9]+\\)" str) + (apply 'encode-time + (let (ret) + (dotimes (i 6) + (push (string-to-number (match-string (+ i 1) str)) ret)) + ret)))) + +(defun idm--message (&rest args) + "Show private text in the echo area without message buffer +recording." + (let (message-log-max) + (apply 'message args))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; GUI + +(defvar idm-show-password nil + "Display passwords switch. If this variable is non-nil, some + functions show the password as plain text.") + +(defun idm-toggle-show-password () + "Toggle the switch for display passwords. This function does not update views." + (interactive) + (setq idm-show-password (not idm-show-password))) + +(defun idm-add-record-dialog (db on-ok-func) + "Make an account record interactively and register it with DB." + (lexical-let ((db db) (on-ok-func on-ok-func)) + (idm-edit-record-dialog + (make-idm-record) + (lambda (r) + (cond + ((funcall db 'get (idm-record-name r)) + (idm-edit-record-dialog r on-ok-func nil "Record [%s] exists!")) + (t (funcall on-ok-func r))))))) + +(defun idm-edit-record-dialog (record on-ok-func &optional password-show error-msg) + "Pop up the edit buffer for the given record. +If the user pushes the `ok' button, the function +`idm-edit-record-dialog-commit' is called." + (let ((before-win-num (length (window-list))) + (main-buf (current-buffer)) + (edit-buf (idm--edit-record-dialog-buffer record on-ok-func password-show error-msg))) + (with-current-buffer edit-buf + (set (make-local-variable 'idm-before-win-num) before-win-num) + (set (make-local-variable 'idm-main-buf) main-buf)) + (pop-to-buffer edit-buf))) + +(defun idm--edit-record-dialog-buffer (record on-ok-func &optional password-show error-msg) + "Return the editing buffer for the given record." + (let ((buf (get-buffer-create "*idm-record-dialog*"))) + (with-current-buffer buf + (let ((inhibit-read-only t)) (erase-buffer)) + (kill-all-local-variables) + (remove-overlays) + (widget-insert + (format "Record: %s\n\n" + (idm--aif (idm-record-name record) it "(new record)"))) + (when error-msg + (widget-insert + (let ((text (substring-no-properties error-msg))) + (put-text-property 0 (length text) 'face 'font-lock-warning-face text) + text)) + (widget-insert "\n\n")) + (lexical-let + ((record record) (on-ok-func on-ok-func) (error-msg error-msg) + fname fid fpassword fmemo cbshow bgenerate fields) + ;; create dialog fields + (setq fname (widget-create + 'editable-field + :size 20 :format " Account Name: %v \n" + :value (or (idm-record-name record) "")) + fid (widget-create + 'editable-field + :size 20 :format " Account ID : %v \n" + :value (or (idm-record-account-id record) "")) + fpassword (widget-create + 'editable-field + :size 20 :format " Password: %v \n" + :secret (and (not password-show) ?*) + :value (or (idm-record-password record) ""))) + (widget-insert " (show password ") + (setq cbshow + (widget-create 'checkbox :value password-show)) + (widget-insert " ) ") + (setq bgenerate + (widget-create 'push-button "Generate")) + (widget-insert "\n") + (setq fmemo (widget-create + 'editable-field + :size 20 + :format " Memo : %v \n" + :value (or (idm-record-memo record) ""))) + (setq fields + (list 'name fname 'id fid 'password fpassword 'memo fmemo 'password-show cbshow)) + + ;; OK / Cancel + (widget-insert "\n") + (widget-create + 'push-button + :notify (lambda (&rest ignore) + (idm-edit-record-dialog-commit record fields on-ok-func)) + "Ok") + (widget-insert " ") + (widget-create + 'push-button + :notify (lambda (&rest ignore) + (idm-edit-record-kill-buffer)) + "Cancel") + (widget-insert "\n") + + ;; add event actions + (widget-put cbshow + :notify + (lambda (&rest ignore) + (let ((current-record + (make-idm-record + :name (widget-value fname) + :account-id (widget-value fid) + :password (widget-value fpassword) + :memo (widget-value fmemo))) + (password-show (widget-value cbshow))) + (message "CLICK : %s" password-show) + (idm-edit-record-kill-buffer) + (idm-edit-record-dialog + current-record on-ok-func password-show error-msg) + (widget-forward 3)))) + (widget-put bgenerate + :notify + (lambda (&rest ignore) + (widget-value-set fpassword (idm-gen-password)) + (widget-setup))) + + ;; setup widgets + (use-local-map widget-keymap) + (widget-setup) + (goto-char (point-min)) + (widget-forward 1))) + buf)) + +(defun idm-edit-record-dialog-commit (record fields on-ok-func) + "edit-record-dialog-commit" + (let ((name-value (widget-value (plist-get fields 'name)))) + (cond + ((or (null name-value) + (string-equal "" name-value)) + (idm-edit-record-kill-buffer) + (idm-edit-record-dialog + record on-ok-func + (widget-value (plist-get fields 'password-show)) + "Should not be empty!")) + (t + (setf (idm-record-name record) name-value + (idm-record-account-id record) + (widget-value (plist-get fields 'id)) + (idm-record-password record) + (widget-value (plist-get fields 'password)) + (idm-record-memo record) + (widget-value (plist-get fields 'memo)) + (idm-record-update-time record) (idm--strtime (current-time))) + (idm-edit-record-kill-buffer) + (funcall on-ok-func record))))) + +(defun idm-edit-record-kill-buffer () + "edit-record-kill-buffer" + (interactive) + (let ((cbuf (current-buffer)) + (win-num (length (window-list))) + (next-win (get-buffer-window idm-main-buf))) + (when (and (not (one-window-p)) + (> win-num idm-before-win-num)) + (delete-window)) + (kill-buffer cbuf) + (when next-win (select-window next-win)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; id-password list buffer + +(defun idm-open-list (db) + "Open id-password list buffer." + (lexical-let ((buf (get-buffer-create "ID-Password List")) + (db db)) + (with-current-buffer buf + (idm--layout-list db) + (idm--set-list-mode db) + ) + (set-buffer buf))) + +(defun idm--put-text-property (text attr val) + "Put a text property on the whole text." + (put-text-property 0 (length text) attr val text) text) + +(defun idm--put-record-id (text id) + "Put the record id with the text property `idm-record-id'." + (idm--put-text-property text 'idm-record-id id)) + +(defun idm--get-record-id () + "Get the record id on the current point." + (get-text-property (point) 'idm-record-id)) + +(defun idm--layout-list (db &optional order) + "Erase the content in the current buffer and insert record +lines. ORDER is sort key, which can be `time', `name' and `id'." + (unless order + (setq order 'name)) + (let* ((name-max (length "Account Name")) + (id-max (length "ID")) + (pw-max (length "Password")) + (pw-mask "********") + (pw-getter (lambda (record) + (if idm-show-password + (idm-record-password record) + pw-mask))) + (cut (lambda (str) (substring str 0 (min (length str) 20)))) + numcolm (count 1) + (line-format "%%-%ds|%%-10s | %%-%ds | %%-%ds : %%-%ds : %%s\n") + (records (funcall db 'get-all-records))) + (when records + (setq numcolm (fceiling (log10 (length records)))) + (dolist (i records) + (setq name-max (min 20 (max name-max (length (idm-record-name i)))) + id-max (min 20 (max id-max (length (idm-record-account-id i)))) + pw-max (max pw-max (length (funcall pw-getter i))))) + (setq line-format (format line-format numcolm name-max id-max pw-max)) + (let ((buffer-read-only nil) (prev-line (line-number-at-pos))) + (erase-buffer) + (goto-char (point-min)) + (insert (format line-format + " " "Time" "Name" "ID" "Password" "Memo")) + (insert (make-string (- (window-width) 1) ?-) "\n") + (dolist (i (idm--sort-records records order)) + (insert + (idm--put-record-id + (format line-format + count + (idm-record-update-time i) + (funcall cut (idm-record-name i)) + (funcall cut (idm-record-account-id i)) + (funcall pw-getter i) + (idm-record-memo i)) + (idm-record-name i))) + (incf count)) + (goto-char (point-min)) + (when (< 1 prev-line) + (ignore-errors + (forward-line (1- prev-line)))))))) + +(defun idm--sort-records (records order) + "Sort records by the key ORDER, which can be `time', `name', +`memo' and `id'." + (let* + ((comparator + (lambda (ref) + (lexical-let ((ref ref)) + (lambda (i j) + (let ((ii (funcall ref i)) + (jj (funcall ref j))) + (cond + ((string= ii jj) 0) + ((string< ii jj) -1) + (t 1))))))) + (to-bool + (lambda (f) + (lexical-let ((f f)) + (lambda (i j) + (< (funcall f i j) 0))))) + (cmp-id (funcall comparator 'idm-record-account-id)) + (cmp-name (funcall comparator 'idm-record-name)) + (cmp-time (funcall comparator 'idm-record-update-time)) + (cmp-memo (funcall comparator 'idm-record-memo)) + (chain + (lambda (a b) + (lexical-let ((a a) (b b)) + (lambda (i j) + (let ((v (funcall a i j))) + (if (= 0 v) + (funcall b i j) + v))))))) + (sort + (loop for i in records collect i) ; copy-list + (cond + ((eq order 'id) ; id -> id, name + (funcall to-bool (funcall chain cmp-id cmp-name))) + ((eq order 'name) ; name -> name + (funcall to-bool cmp-name)) + ((eq order 'time) ; time -> time, name + (funcall to-bool (funcall chain cmp-time cmp-name))) + ((eq order 'memo) ; memo -> time, name + (funcall to-bool (funcall chain cmp-memo cmp-name))) + (t ; default + (funcall to-bool cmp-name)))))) + +(defvar idm-list-mode-map nil + "Keymap for `idm-list-mode'.") +(setq idm-list-mode-map nil) ; for debug +(unless idm-list-mode-map + (setq idm-list-mode-map (make-sparse-keymap)) + (mapc (lambda (i) + (define-key idm-list-mode-map (car i) (cdr i))) + `(("q" . idm-list-mode-quit) + ("Q" . idm-list-mode-quit-without-save) + + ("n" . next-line) + ("p" . previous-line) + ("j" . next-line) + ("k" . previous-line) + + ("d" . idm-list-mode-delete) + ("-" . idm-list-mode-delete) + ("e" . idm-list-mode-edit-dialog) + ("m" . idm-list-mode-edit-dialog) + ("a" . idm-list-mode-add) + ("+" . idm-list-mode-add) + + ("u" . idm-list-mode-reload) + ("r" . idm-list-mode-reload) + + ("T" . idm-list-mode-sortby-time) + ("N" . idm-list-mode-sortby-name) + ("I" . idm-list-mode-sortby-id) + ("M" . idm-list-mode-sortby-memo) + + ("S" . idm-list-mode-toggle-show-password) + ("s" . idm-list-mode-show-password) + ([return] . idm-list-mode-copy) + ))) + +(defun idm-list-mode-copy () + (interactive) + (idm--aif (idm--get-record-id) + (let ((record (funcall idm-db 'get it))) + (when record + (idm--copy-password-action record))))) + +(defun idm--copy-password-action (record) + (interactive) + (message (concat "Copied the password for the account ID: " + (idm-record-account-id record))) + (funcall idm-copy-action (idm-record-password record)) + (idm-set-clipboard-expiry)) + +(defun idm--copy-id-action (record) + (interactive) + (message (concat "Copied account ID: " + (idm-record-account-id record))) + (funcall idm-copy-action (idm-record-account-id record)) + (idm-set-clipboard-expiry)) + +(defun idm-set-clipboard-expiry () + (when idm-clipboard-expire-timer + (cancel-timer idm-clipboard-expire-timer)) + (when idm-clipboard-expire-time-sec + (setq idm-clipboard-expire-timer + (run-at-time idm-clipboard-expire-time-sec nil 'idm-expire-clipboard)))) + +(defun idm-expire-clipboard () + "Clear clipboard" + (funcall idm-copy-action "") + (idm--message "ID Manager: expired.")) + +(defun idm-list-mode-sortby-id () + (interactive) + (idm--layout-list idm-db 'id)) + +(defun idm-list-mode-sortby-name () + (interactive) + (idm--layout-list idm-db 'name)) + +(defun idm-list-mode-sortby-time () + (interactive) + (idm--layout-list idm-db 'time)) + +(defun idm-list-mode-sortby-memo () + (interactive) + (idm--layout-list idm-db 'memo)) + +(defun idm-list-mode-reload () + "Reload the id-password database file." + (interactive) + (setq idm-db (idm-load-db)) + (idm--layout-list idm-db)) + +(defun idm-list-mode-toggle-show-password () + "Toggle whether to show passwords." + (interactive) + (idm-toggle-show-password) + (idm--layout-list idm-db)) + +(defun idm-list-mode-show-password () + "Show password of the selected record." + (interactive) + (idm--aif (idm--get-record-id) + (let ((record (funcall idm-db 'get it))) + (if record + (idm--message + (concat + "ID: " (idm-record-account-id record) + " / PW: "(idm-record-password record))))))) + +(defun idm--set-list-mode (db) + "Set up major mode for id-password list mode." + (kill-all-local-variables) + (make-local-variable 'idm-db) + (setq idm-db db) + + (setq truncate-lines t) + (use-local-map idm-list-mode-map) + (setq major-mode 'idm-list-mode + mode-name "ID-Password List") + (hl-line-mode 1)) + +(defun idm-list-mode-quit () + "Save the DB and kill buffer." + (interactive) + (funcall idm-db 'save) + (kill-buffer (current-buffer))) + +(defun idm-list-mode-quit-without-save () + "Kill buffer without saving the DB." + (interactive) + (kill-buffer (current-buffer))) + +(defun idm-list-mode-delete () + "Delete a selected record from the DB. After deleting, update +the list buffer." + (interactive) + (idm--aif (idm--get-record-id) + (progn + (when (y-or-n-p (format "Delete this record[%s] ?" it)) + (funcall idm-db 'delete-record-by-name it) + (idm--layout-list idm-db))))) + +(defun idm-list-mode-add () + "Add a new record. After adding, update the list buffer." + (interactive) + (lexical-let ((db idm-db) + (curbuf (current-buffer))) + (idm-add-record-dialog db + (lambda (r) + (with-current-buffer curbuf + (funcall db 'add-record r) + (idm--layout-list db)))))) + +(defun idm-list-mode-edit-dialog () + "Edit the selected record. After editting, update the list +buffer." + (interactive) + (idm--aif (idm--get-record-id) + (let ((record (funcall idm-db 'get it))) + (if record + (lexical-let ((db idm-db) (prev record) + (curbuf (current-buffer))) + (idm-edit-record-dialog + record + (lambda (r) + (with-current-buffer curbuf + (funcall db 'delete-record-by-name (idm-record-name prev)) + (funcall db 'add-record r) + (idm--layout-list db))))))))) + +;;;###autoload +(defun idm-open-list-command (&optional db) + "Load the id-password DB and open a list buffer." + (interactive) + (unless db + (setq db (idm-load-db))) + (switch-to-buffer (idm-open-list db))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helm UI + +(defun idm--helm-add-dialog (db) + "Add a new record by the helm interface." + (interactive) + (lexical-let ((db db)) + (idm-add-record-dialog db + (lambda (r) + (funcall db 'add-record r) + (funcall db 'save) + (when (eq major-mode 'idm-list-mode) + (idm--layout-list db)))))) + +(defun idm--helm-edit-dialog (db record) + "Edit a record selected by the helm interface." + (interactive) + (lexical-let ((db db) (prev record)) + (idm-edit-record-dialog + record + (lambda (r) + (funcall db 'delete-record-by-name (idm-record-name prev)) + (funcall db 'add-record r) + (funcall db 'save) + (when (eq major-mode 'idm-list-mode) + (idm--layout-list db)))))) + +;;;###autoload +(defun idm-helm-command () + "Helm interface for id-manager." + (interactive) + (let* ((db (idm-load-db)) + (source-commands + (helm-build-sync-source "id-manager-global-command" + :name "Global Command : " + :candidates '(("Add a record" . (lambda () + (idm--helm-add-dialog db))) + ("Show all records" . (lambda () + (idm-open-list-command db)))) + :action (helm-make-actions "Execute" (lambda (i) (funcall i))))) + (souce-records + (helm-build-sync-source "id-manager-source-commands" + :name "Accounts : " + :candidates (lambda () + (mapcar + (lambda (record) + (cons (concat + (idm-record-name record) + " (" (idm-record-account-id record) ") " + " " (idm-record-memo record)) + record)) + (funcall db 'get-all-records))) + :action (helm-make-actions "Copy password" (lambda (record) + (idm--copy-password-action record)) + "Copy id" (lambda (record) + (idm--copy-id-action record)) + "Show ID / Password" (lambda (record) + (idm--message + (concat + "ID: " (idm-record-account-id record) + " / PW: "(idm-record-password record)))) + "Edit fields" (lambda (record) + (idm--helm-edit-dialog db record))) + :migemo t))) + (helm + :sources '(source-commands souce-records) + :buffer "ID-Password Management : "))) + +(defalias 'id-manager 'idm-open-list-command) + +(eval-after-load "helm" + '(defalias 'id-manager 'idm-helm-command)) + +(provide 'id-manager) +;;; id-manager.el ends here diff --git a/elpa/identica-mode-20130204.1453/bbdb-identica.el b/elpa/identica-mode-20130204.1453/bbdb-identica.el new file mode 100644 index 0000000..77d3016 --- /dev/null +++ b/elpa/identica-mode-20130204.1453/bbdb-identica.el @@ -0,0 +1,381 @@ +;;; bbdb-identica.el --- +;; +;; Filename: bbdb-identica.el +;; Description: +;; Author: Christian +;; Maintainer: +;; Created: dom oct 2 22:15:13 2011 (-0300) +;; Version: +;; Last-Updated: +;; By: +;; Update #: 0 +;; URL: +;; Keywords: +;; Compatibility: +;; +;; Features that might be required by this library: +;; +;; BBDB +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; This should work in BBDB V.3.x for now... +;; It is in heavy, really heavy, development. +;; +;; As far I tried, I couldn't make it work in the way proposed by BBDB. +;; I couldn't find any documentation of how to use the MUA API. +;; For now, I will use every possible command despite it is not desirable +;; for BBDB developers(I think :-S ). +;; +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Change Log: +;; +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program 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 3, or +;; (at your option) any later version. +;; +;; This program 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 this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth +;; Floor, Boston, MA 02110-1301, USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Code: + +(require 'bbdb) +(require 'bbdb-com) +(require 'bbdb-mua) +(require 'identica-mode) +(require 'identica-friends) + + ; Identica-friends-buffer +;; Identica friends buffer must have a way to introduce people into BBDB. +;; There's need of creating a new field into a record. This field will be called "identica". + +;; We'll define a ':' key for introducing a new record into BBDB or updating a record. + +(defcustom bbdb/identica-update-records-p + (lambda () + (let ((bbdb-update-records-p 'query )) + (bbdb-select-message))) + "How `bbdb-mua-update-records' processes mail addresses in Identica and Identica-friends. +Allowed values are: + nil Do nothing. + search Search for existing records. + query Update existing records or query for creating new ones. + create or t Update existing records or create new ones. +A function which returns one of the above values." + :group 'bbdb-mua-identica + :type '(choice (const :tag "do nothing" nil) + (const :tag "search for existing records" + (lambda () (let ((bbdb-update-records-p 'search)) + (bbdb-select-message)))) + (const :tag "query annotation of all messages" + (lambda () (let ((bbdb-update-records-p 'query)) + (bbdb-select-message)))) + ;; (const :tag "annotate (query) only new messages" + ;; (lambda () + ;; (let ((bbdb-update-records-p + ;; (if (bbdb/rmail-new-flag) 'query 'search))) + ;; (bbdb-select-message)))) + (const :tag "annotate all messages" + (lambda () (let ((bbdb-update-records-p 'create)) + (bbdb-select-message)))) + (const :tag "accept messages" bbdb-accept-message) + (const :tag "ignore messages" bbdb-ignore-message) + (const :tag "select messages" bbdb-select-message) + (sexp :tag "user defined function"))) + +;; (defun bbdb/identica-header (header) +;; "" +;; ) + ; -------------------- + ; Insinuation + ; -------------------- + +;; It doesn't work :-( Is still under development. +;; +;; ;;;###autoload +;; (defun bbdb-insinuate-identica () +;; "Add every keymap and hooks necesary for using BBDB into `identica-friends-mode'. +;; You shouldn't call this in your init file, instead use `bbdb-initialize'" +;; (define-key identica-friends-mode-map ":" 'bbdb-mua-display-sender) +;; (define-key identica-friends-mode-map ";" 'bbdb-mua-edit-notes-sender) +;; ) + + + +;; ;; We have to make bbdb-mua recognice identica-friends-mode, if not it will fall-back with error. +;; (defadvice bbdb-mua (before identica-bbdb-mua ()) +;; "This advice add into `bbdb-mua' the necessary for BBDB to recognice identica-friends-mode, and identica-mode." +;; (if (member major-mode '(identica-mode identica-friends-mode)) +;; 'identica) +;; ) + +;; Activate identica-bbdb-mua advice +;; (ad-activate 'bbdb-mua) +;; (ad-deactivate 'bbdb-mua) + + + ; ____________________ + +(defun bbdb-identica-friends-next-usr () + "This function is supposed to be used as a hook to the function `identica-friends-next-user'. +Check if the actual user is in BBDB. If not, add it *without query the user*. + +Remember: +Adding into the BBDB means: +1) to create a new BBDB record with the same name of the identica user name(NOT NICK!) +2) Add the nick into a new field called \"identica\"." + (setq usr (identica-friends-get-current-user)) + ;; Our idea is to show the user if founded... + ;; Search for the *first mach* in the BBDB: + (setq record + (let ((usr-name (nth 1 usr))) + (car (bbdb-search (bbdb-records) usr-name)) + ) + ) + + ;; check if exist, if not add it(or query to add it). + (if record + (progn + (bbdb-display-records (cons record '())) + (unless (bbdb-identica-check-record record usr) + ;; It has to be updated! + (bbdb-identica-query-update-record record usr) + (bbdb-display-records (cons record '())) + ) + ) + (progn + ;; No record available... query to add it.. + (bbdb-identica-query-add-record record usr) + ;; Show new record... + (setq record + (let ((usr-name (nth 1 usr))) + (car (bbdb-search (bbdb-records) usr-name)) + ) + ) + (when record + (bbdb-display-records (cons record '())) + ) + ) + ) + ) + +(defun bbdb-identica-query-update-record (record usr) + "Query the user if she/he wants to update the BBDB record. +If she/he answer \"yes\", update it. +If she/he answer \"no\", do nothing." + (when (bbdb-identica-prompt-yepnop "Do you want to update this record?(y/n)") + (bbdb-identica-update-record record usr) + ) +) + +(defun bbdb-identica-update-record (record usr) + "Update the record usr with new values: +1) Update the \"identica\" field. +2) No need to update anything else..." + (bbdb-record-set-note record 'identica (nth 0 usr)) + ) + +(defun bbdb-identica-prompt-yepnop (prompt) + "Ask a question to the user for a yes-no answer. +Return t when user answer yes. +Return nil when user answer no." + (let ( + (yepnop (read-char prompt))) + (cond + ((eq ?y yepnop) + t) + ((eq ?n yepnop) + nil) + (t + (message "Please, answer 'y' or 'n'.") + (bbdb-identica-prompt-yepnop prompt)) + ) + ) + ) + + +(defun bbdb-identica-query-add-record (record usr) + "Query the user if she/he wants to add this identica user into BBDB. +If she/he answer \"yes\", add it. +If she/he answer \"no\", don't add it of course." + (when (bbdb-identica-prompt-yepnop "Do you want to add this user and identica nick?(y/n)") + (bbdb-identica-add-record usr) + ) + ) + +(defun bbdb-identica-add-record (usr) + "Add friend/follower into BBDB." + (bbdb-create-internal + (nth 1 usr) ;;name + nil ;; affix + nil ;; aka + nil ;; organizations + nil ;; mail + nil ;; phones + nil ;; addresses + (cons + (cons 'identica (nth 0 usr)) + '() + ) ;; notes + ) + ) + +(defun bbdb-identica-check-record (record usr) + "Check if the record has the same value in the \"identica\" field and the name field. +If it is the same return t. +If it is different return nil. +If the \"identica\" field does not exists return nil(it means it has different value). +" + ;; Get if exists the field + (if (and + record + usr) + (string= + (bbdb-record-note record 'identica) + (car usr) + ) + nil + ) + ) + +(defun bbdb-identica-ask-for-save () + "This is intended when the user wants to quit identica. +As soon he/she wants to quit, is necessary to ask if she/he wants to update BBDB database." + (bbdb-save t t) + ) + +(eval-and-compile + (add-hook 'identica-friends-good-bye-hooks 'bbdb-identica-ask-for-save) + (add-hook 'identica-friends-next-user-hooks 'bbdb-identica-friends-next-usr) + (add-hook 'identica-friends-prev-user-hooks 'bbdb-identica-friends-next-usr) + ) + +(defun bbdb-identica-next-usr () + "Go to next identica user in the identica buffer, find its BBDB record and show it if exists." + (interactive) + (save-excursion + (goto-char (bbdb-identica-find-next-usr-pos)) + ;; Get user nick + (save-excursion + (search-forward-regexp "[^[:blank:]]+" nil t) + (setq usrnick (match-string-no-properties 0)) + ) + ;; Remove the '@' + (when (string= "@" (substring usrnick 0 1)) + ;;Has a '@', take it out. + (setq usrnick (substring usrnick 0 1)) + ) + ;; Remove the ',' + (when (string= "," (substring usrnick -1)) + (setq usrnick (substring usrnick 0 -1)) + ) + + ;; Find usrnick in the BBDB + (bbdb-search-notes "identica" usrnick) + ) + ) + + +(defun bbdb-identica-find-next-usr-1-pos () + "Find the next identica nick starting with '@'." + (with-current-buffer identica-buffer + (save-excursion + (search-forward-regexp "@[^[:blank:]]*" nil t) + (match-beginning 0) + ) + ) + ) + +(defun bbdb-identica-find-next-usr-2-pos () + "Find the next identica nick as the first element that appear of a status. For example: + +_ + rms, 10:26 septiembre 26, 2011: + hola, esto es un estado // from web [algúnlado] in reply to someone + +in this case the return value is 'rms'." + (with-current-buffer identica-buffer + (identica-get-next-username-face-pos (point)) + ) + ) + +(defun bbdb-identica-find-next-usr-pos () + "Return the position of the first identica nick after the current point, no matters if it is a '@user' form or just +the name of the status's remitent." + (let ((usr1 (bbdb-identica-find-next-usr-1-pos)) + (usr2 (bbdb-identica-find-next-usr-2-pos)) + ) + ;; Look wich one is first, and return that one + (if (< usr1 usr2) + usr1 + usr2 + ) + ) + ) + +(defun bbdb-identica-down-key () + "Go to down, and then show the next possible nick BBDB record." + (interactive) + (next-line) + (bbdb-identica-next-usr) + ) + +(defun bbdb-identica-up-key () + "Go to up and then show the next possible nick BBDB record." + (interactive) + (previous-line) + (bbdb-identica-next-usr) + ) + +;; I see that this could be a bit destructive. +;; If down or up key are setted to other functions, this will make identica to ignore them! + +(eval-and-compile + ;; If you want, at every position, to search for BBDB uncomment this: + ;;(define-key identica-mode-map [down] 'bbdb-identica-down-key) + ;;(define-key identica-mode-map [up] 'bbdb-identica-up-key) + ) + +;; This is better: at each j and k key(identica-goto-next-status) search for its BBDB record. +(defadvice identica-goto-next-status (after bbdb-identica-next-status) + "Search for BBDB record of the next nearest nick." + (save-excursion + (backward-char) + (bbdb-identica-next-usr) + ) + ) + +(defadvice identica-goto-previous-status (after bbdb-identica-next-status) + "Search for BBDB record of the next nearest nick." + (save-excursion + (backward-char) + (bbdb-identica-next-usr) + ) + ) + +(eval-and-compile + (ad-activate 'identica-goto-next-status) + (ad-activate 'identica-goto-previous-status) + ) + +(provide 'bbdb-identica) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; bbdb-identica.el ends here diff --git a/elpa/identica-mode-20130204.1453/dir b/elpa/identica-mode-20130204.1453/dir new file mode 100644 index 0000000..59e5e6b --- /dev/null +++ b/elpa/identica-mode-20130204.1453/dir @@ -0,0 +1,19 @@ +This is the file .../info/dir, which contains the +topmost node of the Info hierarchy, called (dir)Top. +The first time you invoke Info you start off looking at this node. + +File: dir, Node: Top This is the top of the INFO tree + + This (the Directory node) gives a menu of major topics. + Typing "q" exits, "?" lists all Info commands, "d" returns here, + "h" gives a primer for first-timers, + "mEmacs" visits the Emacs manual, etc. + + In Emacs, you can click mouse button 2 on a menu item or cross reference + to select it. + +* Menu: + +Emacs +* Identica mode: (identica-mode). + Emacs mode for microblogging services. diff --git a/elpa/identica-mode-20130204.1453/fdl.info b/elpa/identica-mode-20130204.1453/fdl.info new file mode 100644 index 0000000..68a21fc --- /dev/null +++ b/elpa/identica-mode-20130204.1453/fdl.info @@ -0,0 +1,430 @@ +This is fdl.info, produced by makeinfo version 5.2 from fdl.texi. + + Version 1.2, November 2002 + + Copyright (C) 2000,2001,2002 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + 0. PREAMBLE + + The purpose of this License is to make a manual, textbook, or other + functional and useful document "free" in the sense of freedom: to + assure everyone the effective freedom to copy and redistribute it, + with or without modifying it, either commercially or + noncommercially. Secondarily, this License preserves for the + author and publisher a way to get credit for their work, while not + being considered responsible for modifications made by others. + + This License is a kind of "copyleft", which means that derivative + works of the document must themselves be free in the same sense. + It complements the GNU General Public License, which is a copyleft + license designed for free software. + + We have designed this License in order to use it for manuals for + free software, because free software needs free documentation: a + free program should come with manuals providing the same freedoms + that the software does. But this License is not limited to + software manuals; it can be used for any textual work, regardless + of subject matter or whether it is published as a printed book. We + recommend this License principally for works whose purpose is + instruction or reference. + + 1. APPLICABILITY AND DEFINITIONS + + This License applies to any manual or other work, in any medium, + that contains a notice placed by the copyright holder saying it can + be distributed under the terms of this License. Such a notice + grants a world-wide, royalty-free license, unlimited in duration, + to use that work under the conditions stated herein. The + "Document", below, refers to any such manual or work. Any member + of the public is a licensee, and is addressed as "you". You accept + the license if you copy, modify or distribute the work in a way + requiring permission under copyright law. + + A "Modified Version" of the Document means any work containing the + Document or a portion of it, either copied verbatim, or with + modifications and/or translated into another language. + + A "Secondary Section" is a named appendix or a front-matter section + of the Document that deals exclusively with the relationship of the + publishers or authors of the Document to the Document's overall + subject (or to related matters) and contains nothing that could + fall directly within that overall subject. (Thus, if the Document + is in part a textbook of mathematics, a Secondary Section may not + explain any mathematics.) The relationship could be a matter of + historical connection with the subject or with related matters, or + of legal, commercial, philosophical, ethical or political position + regarding them. + + The "Invariant Sections" are certain Secondary Sections whose + titles are designated, as being those of Invariant Sections, in the + notice that says that the Document is released under this License. + If a section does not fit the above definition of Secondary then it + is not allowed to be designated as Invariant. The Document may + contain zero Invariant Sections. If the Document does not identify + any Invariant Sections then there are none. + + The "Cover Texts" are certain short passages of text that are + listed, as Front-Cover Texts or Back-Cover Texts, in the notice + that says that the Document is released under this License. A + Front-Cover Text may be at most 5 words, and a Back-Cover Text may + be at most 25 words. + + A "Transparent" copy of the Document means a machine-readable copy, + represented in a format whose specification is available to the + general public, that is suitable for revising the document + straightforwardly with generic text editors or (for images composed + of pixels) generic paint programs or (for drawings) some widely + available drawing editor, and that is suitable for input to text + formatters or for automatic translation to a variety of formats + suitable for input to text formatters. A copy made in an otherwise + Transparent file format whose markup, or absence of markup, has + been arranged to thwart or discourage subsequent modification by + readers is not Transparent. An image format is not Transparent if + used for any substantial amount of text. A copy that is not + "Transparent" is called "Opaque". + + Examples of suitable formats for Transparent copies include plain + ASCII without markup, Texinfo input format, LaTeX input format, + SGML or XML using a publicly available DTD, and standard-conforming + simple HTML, PostScript or PDF designed for human modification. + Examples of transparent image formats include PNG, XCF and JPG. + Opaque formats include proprietary formats that can be read and + edited only by proprietary word processors, SGML or XML for which + the DTD and/or processing tools are not generally available, and + the machine-generated HTML, PostScript or PDF produced by some word + processors for output purposes only. + + The "Title Page" means, for a printed book, the title page itself, + plus such following pages as are needed to hold, legibly, the + material this License requires to appear in the title page. For + works in formats which do not have any title page as such, "Title + Page" means the text near the most prominent appearance of the + work's title, preceding the beginning of the body of the text. + + A section "Entitled XYZ" means a named subunit of the Document + whose title either is precisely XYZ or contains XYZ in parentheses + following text that translates XYZ in another language. (Here XYZ + stands for a specific section name mentioned below, such as + "Acknowledgements", "Dedications", "Endorsements", or "History".) + To "Preserve the Title" of such a section when you modify the + Document means that it remains a section "Entitled XYZ" according + to this definition. + + The Document may include Warranty Disclaimers next to the notice + which states that this License applies to the Document. These + Warranty Disclaimers are considered to be included by reference in + this License, but only as regards disclaiming warranties: any other + implication that these Warranty Disclaimers may have is void and + has no effect on the meaning of this License. + + 2. VERBATIM COPYING + + You may copy and distribute the Document in any medium, either + commercially or noncommercially, provided that this License, the + copyright notices, and the license notice saying this License + applies to the Document are reproduced in all copies, and that you + add no other conditions whatsoever to those of this License. You + may not use technical measures to obstruct or control the reading + or further copying of the copies you make or distribute. However, + you may accept compensation in exchange for copies. If you + distribute a large enough number of copies you must also follow the + conditions in section 3. + + You may also lend copies, under the same conditions stated above, + and you may publicly display copies. + + 3. COPYING IN QUANTITY + + If you publish printed copies (or copies in media that commonly + have printed covers) of the Document, numbering more than 100, and + the Document's license notice requires Cover Texts, you must + enclose the copies in covers that carry, clearly and legibly, all + these Cover Texts: Front-Cover Texts on the front cover, and + Back-Cover Texts on the back cover. Both covers must also clearly + and legibly identify you as the publisher of these copies. The + front cover must present the full title with all words of the title + equally prominent and visible. You may add other material on the + covers in addition. Copying with changes limited to the covers, as + long as they preserve the title of the Document and satisfy these + conditions, can be treated as verbatim copying in other respects. + + If the required texts for either cover are too voluminous to fit + legibly, you should put the first ones listed (as many as fit + reasonably) on the actual cover, and continue the rest onto + adjacent pages. + + If you publish or distribute Opaque copies of the Document + numbering more than 100, you must either include a machine-readable + Transparent copy along with each Opaque copy, or state in or with + each Opaque copy a computer-network location from which the general + network-using public has access to download using public-standard + network protocols a complete Transparent copy of the Document, free + of added material. If you use the latter option, you must take + reasonably prudent steps, when you begin distribution of Opaque + copies in quantity, to ensure that this Transparent copy will + remain thus accessible at the stated location until at least one + year after the last time you distribute an Opaque copy (directly or + through your agents or retailers) of that edition to the public. + + It is requested, but not required, that you contact the authors of + the Document well before redistributing any large number of copies, + to give them a chance to provide you with an updated version of the + Document. + + 4. MODIFICATIONS + + You may copy and distribute a Modified Version of the Document + under the conditions of sections 2 and 3 above, provided that you + release the Modified Version under precisely this License, with the + Modified Version filling the role of the Document, thus licensing + distribution and modification of the Modified Version to whoever + possesses a copy of it. In addition, you must do these things in + the Modified Version: + + A. Use in the Title Page (and on the covers, if any) a title + distinct from that of the Document, and from those of previous + versions (which should, if there were any, be listed in the + History section of the Document). You may use the same title + as a previous version if the original publisher of that + version gives permission. + + B. List on the Title Page, as authors, one or more persons or + entities responsible for authorship of the modifications in + the Modified Version, together with at least five of the + principal authors of the Document (all of its principal + authors, if it has fewer than five), unless they release you + from this requirement. + + C. State on the Title page the name of the publisher of the + Modified Version, as the publisher. + + D. Preserve all the copyright notices of the Document. + + E. Add an appropriate copyright notice for your modifications + adjacent to the other copyright notices. + + F. Include, immediately after the copyright notices, a license + notice giving the public permission to use the Modified + Version under the terms of this License, in the form shown in + the Addendum below. + + G. Preserve in that license notice the full lists of Invariant + Sections and required Cover Texts given in the Document's + license notice. + + H. Include an unaltered copy of this License. + + I. Preserve the section Entitled "History", Preserve its Title, + and add to it an item stating at least the title, year, new + authors, and publisher of the Modified Version as given on the + Title Page. If there is no section Entitled "History" in the + Document, create one stating the title, year, authors, and + publisher of the Document as given on its Title Page, then add + an item describing the Modified Version as stated in the + previous sentence. + + J. Preserve the network location, if any, given in the Document + for public access to a Transparent copy of the Document, and + likewise the network locations given in the Document for + previous versions it was based on. These may be placed in the + "History" section. You may omit a network location for a work + that was published at least four years before the Document + itself, or if the original publisher of the version it refers + to gives permission. + + K. For any section Entitled "Acknowledgements" or "Dedications", + Preserve the Title of the section, and preserve in the section + all the substance and tone of each of the contributor + acknowledgements and/or dedications given therein. + + L. Preserve all the Invariant Sections of the Document, unaltered + in their text and in their titles. Section numbers or the + equivalent are not considered part of the section titles. + + M. Delete any section Entitled "Endorsements". Such a section + may not be included in the Modified Version. + + N. Do not retitle any existing section to be Entitled + "Endorsements" or to conflict in title with any Invariant + Section. + + O. Preserve any Warranty Disclaimers. + + If the Modified Version includes new front-matter sections or + appendices that qualify as Secondary Sections and contain no + material copied from the Document, you may at your option designate + some or all of these sections as invariant. To do this, add their + titles to the list of Invariant Sections in the Modified Version's + license notice. These titles must be distinct from any other + section titles. + + You may add a section Entitled "Endorsements", provided it contains + nothing but endorsements of your Modified Version by various + parties--for example, statements of peer review or that the text + has been approved by an organization as the authoritative + definition of a standard. + + You may add a passage of up to five words as a Front-Cover Text, + and a passage of up to 25 words as a Back-Cover Text, to the end of + the list of Cover Texts in the Modified Version. Only one passage + of Front-Cover Text and one of Back-Cover Text may be added by (or + through arrangements made by) any one entity. If the Document + already includes a cover text for the same cover, previously added + by you or by arrangement made by the same entity you are acting on + behalf of, you may not add another; but you may replace the old + one, on explicit permission from the previous publisher that added + the old one. + + The author(s) and publisher(s) of the Document do not by this + License give permission to use their names for publicity for or to + assert or imply endorsement of any Modified Version. + + 5. COMBINING DOCUMENTS + + You may combine the Document with other documents released under + this License, under the terms defined in section 4 above for + modified versions, provided that you include in the combination all + of the Invariant Sections of all of the original documents, + unmodified, and list them all as Invariant Sections of your + combined work in its license notice, and that you preserve all + their Warranty Disclaimers. + + The combined work need only contain one copy of this License, and + multiple identical Invariant Sections may be replaced with a single + copy. If there are multiple Invariant Sections with the same name + but different contents, make the title of each such section unique + by adding at the end of it, in parentheses, the name of the + original author or publisher of that section if known, or else a + unique number. Make the same adjustment to the section titles in + the list of Invariant Sections in the license notice of the + combined work. + + In the combination, you must combine any sections Entitled + "History" in the various original documents, forming one section + Entitled "History"; likewise combine any sections Entitled + "Acknowledgements", and any sections Entitled "Dedications". You + must delete all sections Entitled "Endorsements." + + 6. COLLECTIONS OF DOCUMENTS + + You may make a collection consisting of the Document and other + documents released under this License, and replace the individual + copies of this License in the various documents with a single copy + that is included in the collection, provided that you follow the + rules of this License for verbatim copying of each of the documents + in all other respects. + + You may extract a single document from such a collection, and + distribute it individually under this License, provided you insert + a copy of this License into the extracted document, and follow this + License in all other respects regarding verbatim copying of that + document. + + 7. AGGREGATION WITH INDEPENDENT WORKS + + A compilation of the Document or its derivatives with other + separate and independent documents or works, in or on a volume of a + storage or distribution medium, is called an "aggregate" if the + copyright resulting from the compilation is not used to limit the + legal rights of the compilation's users beyond what the individual + works permit. When the Document is included in an aggregate, this + License does not apply to the other works in the aggregate which + are not themselves derivative works of the Document. + + If the Cover Text requirement of section 3 is applicable to these + copies of the Document, then if the Document is less than one half + of the entire aggregate, the Document's Cover Texts may be placed + on covers that bracket the Document within the aggregate, or the + electronic equivalent of covers if the Document is in electronic + form. Otherwise they must appear on printed covers that bracket + the whole aggregate. + + 8. TRANSLATION + + Translation is considered a kind of modification, so you may + distribute translations of the Document under the terms of section + 4. Replacing Invariant Sections with translations requires special + permission from their copyright holders, but you may include + translations of some or all Invariant Sections in addition to the + original versions of these Invariant Sections. You may include a + translation of this License, and all the license notices in the + Document, and any Warranty Disclaimers, provided that you also + include the original English version of this License and the + original versions of those notices and disclaimers. In case of a + disagreement between the translation and the original version of + this License or a notice or disclaimer, the original version will + prevail. + + If a section in the Document is Entitled "Acknowledgements", + "Dedications", or "History", the requirement (section 4) to + Preserve its Title (section 1) will typically require changing the + actual title. + + 9. TERMINATION + + You may not copy, modify, sublicense, or distribute the Document + except as expressly provided for under this License. Any other + attempt to copy, modify, sublicense or distribute the Document is + void, and will automatically terminate your rights under this + License. However, parties who have received copies, or rights, + from you under this License will not have their licenses terminated + so long as such parties remain in full compliance. + + 10. FUTURE REVISIONS OF THIS LICENSE + + The Free Software Foundation may publish new, revised versions of + the GNU Free Documentation License from time to time. Such new + versions will be similar in spirit to the present version, but may + differ in detail to address new problems or concerns. See + . + + Each version of the License is given a distinguishing version + number. If the Document specifies that a particular numbered + version of this License "or any later version" applies to it, you + have the option of following the terms and conditions either of + that specified version or of any later version that has been + published (not as a draft) by the Free Software Foundation. If the + Document does not specify a version number of this License, you may + choose any version ever published (not as a draft) by the Free + Software Foundation. + +ADDENDUM: How to use this License for your documents +==================================================== + +To use this License in a document you have written, include a copy of +the License in the document and put the following copyright and license +notices just after the title page: + + Copyright (C) YEAR YOUR NAME. + Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.2 + or any later version published by the Free Software Foundation; + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover + Texts. A copy of the license is included in the section entitled ``GNU + Free Documentation License''. + + If you have Invariant Sections, Front-Cover Texts and Back-Cover +Texts, replace the "with...Texts." line with this: + + with the Invariant Sections being LIST THEIR TITLES, with + the Front-Cover Texts being LIST, and with the Back-Cover Texts + being LIST. + + If you have Invariant Sections without Cover Texts, or some other +combination of the three, merge those two alternatives to suit the +situation. + + If your document contains nontrivial examples of program code, we +recommend releasing these examples in parallel under your choice of free +software license, such as the GNU General Public License, to permit +their use in free software. + + + +Tag Table: + +End Tag Table diff --git a/elpa/identica-mode-20130204.1453/identica-friends.el b/elpa/identica-mode-20130204.1453/identica-friends.el new file mode 100644 index 0000000..1efaef0 --- /dev/null +++ b/elpa/identica-mode-20130204.1453/identica-friends.el @@ -0,0 +1,793 @@ +;;; identica-friends.el --- +;; +;; Filename: identica-friends.el +;; Description: A library that provides some functions to look who are your friends in your identi.ca account. +;; Author: Christian Giménez +;; Maintainer: +;; Created: dom sep 25 17:58:40 2011 (-0300) +;; Version: +;; Last-Updated: +;; By: +;; Update #: 0 +;; URL: +;; Keywords: +;; Compatibility: +;; +;; Features that might be required by this library: +;; +;; None +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; Use M-x identica first, if you are not connected, this library +;; will not work. +;; You can check who are your friends on Identi.ca using the function +;; M-x identica-show-friends +;; If you want to check who are following you, type: +;; M-x identica-show-followers +;; +;; I divided the code into sections. This sections are tabbed asside +;; and commented by an only one ";". Also are overlined and underlined +;; so, they are very visible. +;; +;; Convention: +;; All functions and variables in this modules has the prefix +;; "identica-friends" so you can identify easyly. +;; The main functions may not have this prefix so users don't get +;; confused. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Change Log: +;; +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program 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 3, or +;; (at your option) any later version. +;; +;; This program 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 this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth +;; Floor, Boston, MA 02110-1301, USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Code: + +(require 'xml) +(require 'identica-mode) + + ; ____________________ + ; + ; Variables + ; ____________________ + + +(defvar identica-friends-buffer nil + "Friend's Buffer. Internal use of identica-friends.el." + ) + +(defvar identica-friends-buffer-name "*identica-friends*" + "Friends buffer's name. Changing this variable will effect after you +recall identica-friends functions. +Be aware of no function or actual buffers exists. Reboot all identica-friends functions." + ) + +(defvar identica-friends-buffer-type nil + "If the buffer contains a list of users, the this is setted into 'users. +If the buffer contains a list of groups, this is setted into 'groups. +Nil means, no buffer or just the programmer forgot to set it! :-S ." + ) + + ; ---- + ; Hooks Variables + ; ---- + +(defcustom identica-friends-good-bye-hooks + 'nil + "These functions are called as soon as the `identica-friends-good-bye' functions finnish." + :type '(hook) + ) + + +(defcustom identica-friends-mode-hooks + 'nil + "These functions are called as soon as the `identica-friends-mode' functions finnish." + :type '(hook) + ) + + +(defcustom identica-friends-show-friends-hooks + 'nil + "These functions are called as soon as the `identica-show-friends' functions finnish." + :type '(hook) + ) + +(defcustom identica-friends-show-followers-hooks + 'nil + "These functions are called as soon as the `identica-show-followers' functions finnish." + :type '(hook) + ) + +(defcustom identica-friends-next-user-hooks + 'nil + "These functions are called as soon as the `identica-friends-next-user' functions finnish." + :type '(hook) + ) + +(defcustom identica-friends-prev-user-hooks + 'nil + "These functions are called as soon as the `identica-friends-prev-user' functions finnish." + :type '(hook) + ) + + + + + ; ____________________ + ; + ; Faces and font-lock + ; ____________________ + +(defface identica-friends-mode-id + '( + ; If there's dark background... + (((class color) (background dark)) + :foreground "yellow" + ) + ; If there's light background... + (((class color) (background light)) + :foreground "red" + ) + + (t :background "white" + :foreground "blue") + ) + "" + ) + +(defface identica-friends-mode-bar + '( + ; If there's dark background... + (((class color) (background dark)) + :bold t + ) + ; If there's light background... + (((class color) (background light)) + :bold t + ) + + (t :background "white" + :foreground "blue" + :bold t) + ) + "" + ) + +(defvar identica-friends-mode-font-lock + '( + ;; font-lock-keywords + ( + ("^Id: .*$" . 'identica-friends-mode-id) + ("^Nick: .*$" . 'identica-username-face) + ("^--------------------$" . 'identica-friends-mode-bar) + ) + + ;; Otros... + ) + ;; + "Font lock for `identica-friends--mode'" + ) + + ; ____________________ + ; + ; Keymaps + ; ____________________ + +;; Keymaps calls functions from the "Interactive API Commands" sections(see below). + +(defvar identica-friends-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "q" 'identica-friends-good-bye) + (define-key map "n" 'identica-friends-next-user) + (define-key map "p" 'identica-friends-prev-user) + (define-key map [down] 'identica-friends-next-user) + (define-key map [up] 'identica-friends-prev-user) + (define-key map [left] 'identica-friends-prev-user) + (define-key map [right] 'identica-friends-next-user) + (define-key map [return] 'identica-friends-goto-timeline-at-point) + map) + "Keymap for `identica-friends-mode'." + ) + + + ; ____________________ + ; + ; Major Mode + ; ____________________ + + +(define-derived-mode identica-friends-mode nil "Identica-friends-mode" + "Major mode for identica-friends buffer. +Use `identica-show-friends' to call this buffer." + ;; font lock para ej-mode + (set (make-local-variable 'font-lock-defaults) + identica-friends-mode-font-lock) + (set (make-local-variable 'buffer-read-only) t) + (make-local-variable 'inhibit-read-only) + (run-hooks 'identica-friends-mode-hooks) + ) + + + ; ________________________________________ + ; + ; Interactive API Commands + ; ________________________________________ + + +(defun identica-friends-good-bye () + "Bury the *identica-friends* buffer" + (interactive) + (with-current-buffer identica-friends-buffer + (bury-buffer) + (run-hooks 'identica-friends-good-bye-hooks) + ) + ) + +(defun identica-friends-next-user () + "Put the pointer in the next friend or follower in the identica-friend buffer." + (interactive) + (with-current-buffer identica-friends-buffer + (goto-char (identica-friends-find-next-user-position)) + ) + (run-hooks 'identica-friends-next-user-hooks) + ) + +(defun identica-friends-prev-user () + "Put the pointer in the previous friend or follower in the identica-friend buffer." + (interactive) + (with-current-buffer identica-friends-buffer + (goto-char (identica-friends-find-prev-user-position)) + ) + (run-hooks 'identica-friends-prev-user-hooks) + ) + +(defun identica-friends-goto-timeline-at-point () + "Check whenever we are in user-list or group-list. If we are listing user, call `identica-friends-goto-user-timeline-at-point', +if not call `identica-friends-goto-group-timeline-at-point'." + (interactive) + (cond + ((eq identica-friends-buffer-type 'users) + (identica-friends-goto-user-timeline-at-point) + ) + ((eq identica-friends-buffer-type 'groups) + (identica-friends-goto-group-timeline-at-point) + ) + ) + ) + +(defun identica-friends-goto-user-timeline-at-point () + "Search for the username and go to his timeline." + (interactive) + (let ((username (identica-friends-find-username)) + ) + (identica-user-timeline username) + (switch-to-buffer identica-buffer) + ) + ) + +(defun identica-friends-goto-group-timeline-at-point () + "Search for the group name and go to his timeline." + (interactive) + ;; Look that `identica-friends-find-username' can be used for getting anything that starts with the "Nick: " string, + ;; so is usefull here as well! + (let ((groupname (identica-friends-find-username)) + ) + (identica-group-timeline groupname) + (switch-to-buffer identica-buffer) + ) + ) + ; + ; Main function: + ; Followers Commands + ; + + +(defun identica-show-followers() + (interactive) + (setq identica-friends-buffer-type 'users) + (identica-http-get (sn-account-server sn-current-account) + (sn-account-auth-mode sn-current-account) + "statuses" "followers" nil 'identica-friends-show-user-sentinel '("follower")) + (run-hooks 'identica-friends-show-followers-hooks) + ) + + + ; + ; Main function: + ; Friends Commands + ; + + +(defun identica-show-friends () + (interactive) +; (setq identica-method-class "statuses") +; (setq identica-method "friends") +; (identica-http-get identica-method-class identica-method identica-show-friend-sentinel) + (setq identica-friends-buffer-type 'users) + (identica-http-get (sn-account-server sn-current-account) ;; server + (sn-account-auth-mode sn-current-account);; auth-mode + "statuses" "friends" nil 'identica-friends-show-user-sentinel '("friend")) + (run-hooks 'identica-friends-show-friends-hooks) + ) + +(defun identica-show-groups () + (interactive) +;; (setq identica-method-class "statuses") +;; (setq identica-method "friends") +;; (identica-http-get identica-method-class identica-method identica-show-friend-sentinel) + (setq identica-friends-buffer-type 'groups) + (identica-http-get (sn-account-server sn-current-account) ;; server + (sn-account-auth-mode sn-current-account);; auth-mode + "statusnet" "groups/list" nil 'identica-friends-show-user-sentinel '("group")) + ;;(run-hooks 'identica-friends-show-groups-hooks) + ) + + + ; ____________________ + ; + ; Auxiliary Functions + ; ____________________ + + +(defun identica-friends-find-username () + "Find the username in the nearby at current position. + +I suppose that the cursor is on the nickname and not anywhere." + (save-excursion + (if (search-forward-regexp "Nick: \\(.*\\)" nil t) + (match-string-no-properties 1) + nil + ) + ) + ) + +(defun identica-friends-buffer () + "Show a new buffer with all the friends. " + (setq identica-friends-buffer (get-buffer-create identica-friends-buffer-name)) + (switch-to-buffer identica-friends-buffer) + (identica-friends-mode) + ) + + +(defun identica-friends-get-current-user () + "Return the current user(friend or follower) that we are pointing now in the *identica-buffer*. +This will be returned as a list wich components are in these order: + (NICK NAME DESCRIPTION LOCATION)" + + (setq usr '()) + (save-excursion + ;; Position at the beginning of the user. + (search-backward-regexp "^--------------------$" nil t) + (goto-char (match-beginning 0)) + + (setq usr (cons (identica-friends-get-location) usr)) + (setq usr (cons (identica-friends-get-desc) usr)) + + (setq usr (cons (identica-friends-get-name) usr)) + (setq usr (cons (identica-friends-get-nick) usr)) + ) + usr + ) + +(defun identica-friends-get-nick () + "Get the *next* user(friend or follower) nick. +If there are no user, return nil." + (with-current-buffer identica-friends-buffer + (save-excursion + (search-forward-regexp "Nick: \\(.*\\)$" nil t) + (match-string-no-properties 1) + ) + ) + ) + +(defun identica-friends-get-name () + "Get the *next* user(friend or follower) nick. +If there are no user, return nil." + (with-current-buffer identica-friends-buffer + (save-excursion + (search-forward-regexp "Name: \\(.*\\)$" nil t) + (match-string-no-properties 1) + ) + ) + ) + +(defun identica-friends-get-desc () + "Get the current user(friend or follower) nick. +If there are no user, return nil." + (with-current-buffer identica-friends-buffer + (save-excursion + (search-forward-regexp "Description: \\(.*\\)$" nil t) + (match-string-no-properties 1) + ) + ) + ) + +(defun identica-friends-get-location () + "Get the current user(friend or follower) nick. +If there are no user, return nil." + (with-current-buffer identica-friends-buffer + (save-excursion + (search-forward-regexp "Location: \\(.*\\)$" nil t) + (match-string-no-properties 1) + ) + ) + ) + +(defun identica-friends-show-user-sentinel + (&optional status method-class method parameters type-of-user) + "Sentinel executed after recieving all the information from identi.ca. +This sentinel needs to know if the TYPE-OF-USER(or type of list) is one of these: +- \"friend\" +- \"follower\" +- \"group\" + +First, its parse the XML file recieved by identi.ca. While parsing, it show the user data into a buffer. + +" + ;; cnngimenez: This I used for debug HTTP + (identica-friends-copiar-http-buffer) + ;; Search for the begining of the xml... + (goto-char (point-min)) + (search-forward " +;; Last update: 2011-10-20 +;; Version: 1.3.1 +;; Keywords: identica web +;; URL: http://blog.gabrielsaldana.org/identica-mode-for-emacs/ +;; Contributors: +;; Jason McBrayer (minor updates for working under Emacs 23) +;; Alex Schröder (mode map patches) +;; Christian Cheng (fixed long standing xml parsing bug) +;; Carlos A. Perilla from denting-mode +;; Alberto Garcia (integrated patch from twittering-mode for retrieving multiplemethods) +;; Bradley M. Kuhn (editing status from edit-buffer rather than minibuffer) +;; Jason McBrayer (replace group tags with hashtags on redents, longlines use) +;; Sean Neakums (patches of bugs flagged by byte-compiler) +;; Shyam Karanatt (several patches and code cleanup, new http backend based on url.el) +;; Tezcatl Franco (ur1.ca support) +;; Anthony Garcia (fix for icon-mode) +;; Alexande Oliva (fix for icon placement on reverse order dents, bug fixes) +;; Aidan Gauland (variable scope code cleanup) +;; Joel J. Adamson Added countdown minibuffer-prompt style +;; Kevin Granade (OAuth support) + +;;; Commentary: + +;; 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 +;; + +;; 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 FORCouldn't findSE. 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 +;; To use the OAuth support, you need oauth.el +;; Downloadable from http://github.com/psanford/emacs-oauth/ + +;; If using Oauth with Emacs earlier than 23.3 you'll also need w3m. + +;;; Install: + +;; 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") + +;; If you want to use simple authentication add your password +;; (setq identica-password "yourpassword") + +;; It is recommended to create a file ~/.authinfo with your login credentials +;; instead of storing your password in plain text, the file should have the +;; following contents: + +;; machine servername login yourusername password yourpassword + +;; Replace servername with your server (if Identica server use identi.ca) +;; yourusername and yourpassword with your information. If you setup your +;; authinfo file, you don't need to set identica-password variable anywhere + +;; If you want to use OAuth authentication add the following +;; (setq identica-auth-mode "oauth") + +;; 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 + +;;; Code: + +(require 'cl) +(require 'xml) +(require 'parse-time) +(require 'url) +(require 'url-http) +(require 'json) +(require 'image) + +(defconst identica-mode-version "1.3.1") + +;;url-basepath fix for emacs22 +(unless (fboundp 'url-basepath) + (defalias 'url-basepath 'url-file-directory)) + +;;workaround for url-unhex-string bug that was fixed in emacs 23.3 +(defvar identica-unhex-broken nil + "Predicate indicating broken-ness of `url-unhex-string'. + +If non-nil, indicates that `url-unhex-string' is broken and +must be worked around when using oauth.") + +(defgroup identica-mode nil + "Identica Mode for microblogging" + :tag "Microblogging" + :link '(url-link http://blog.gabrielsaldana.org/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-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/?longurl=") + (tighturl . "http://2tu.us/?save=y&url=") + (isgd . "http://is.gd/create.php?format=simple&url=")) + "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] + ["Tag timeline" identica-tag-timeline t] + ["--" nil nil] + ;; ["Group timeline" identica-group-timeline t] + ;; ["Join to this group" identica-group-join t] + ["Leave this group" identica-group-leave 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 identica-auth-mode "password" + "Authorization mode used, options are password and oauth." + :type 'string + :group 'identica-mode) + +(defun identica-enable-oauth () + "Enables oauth for identica-mode." + (interactive) + (require 'oauth) + ;Test if we're running on an emacs version with broken unhex and apply workaround. + (unless (eq (url-unhex-string (url-hexify-string "²")) "²") + (setq identica-unhex-broken t) + (require 'w3m)) + (setq identica-auth-mode "oauth")) + +(defvar identica-mode-oauth-consumer-key + "53e8e7bf7d1be8e58ef1024b31478d2b") + +(defvar identica-mode-oauth-consumer-secret + "1ab0876f14bd82c4eb450f720a0e84ae") + +(defcustom statusnet-server "identi.ca" + "Statusnet instance url." + :type 'string + :group 'identica-mode) + +(defcustom statusnet-request-url + "https://identi.ca/api/oauth/request_token" + "Statusnet oauth request_token url." + :type 'string + :group 'identica-mode) + +(defcustom statusnet-access-url + "https://identi.ca/api/oauth/access_token" + "Statusnet oauth access_token url." + :type 'string + :group 'identica-mode) + +(defcustom statusnet-authorize-url + "https://identi.ca/api/oauth/authorize" + "Statusnet authorization url." + :type 'string + :group 'identica-mode) + +(defcustom statusnet-server-textlimit 140 + "Number of characters allowed in a status." + :type 'integer + :group 'identica-mode) + +(defvar oauth-access-token nil) + +(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-statuses-count 20 + "Default number of statuses to retrieve." + :type 'integer + :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 t + "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-remote-server nil) + +(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-blacklist '() + "List of regexes used to filter statuses, evaluated after status formatting is applied." + :type 'string + :group 'identica-mode) + +(defcustom identica-status-format "%i %s, %@:\n %h%t // from %f%L%r\n\n" + "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 +;; %h - favorited +;; %f - source +;; %# - id + +(defcustom identica-urlshortening-service 'ur1ca + "The service to use for URL shortening. +Values understood are ur1ca, tighturl, tinyurl, toly, google and isgd." + :type 'symbol + :group 'identica-mode) + +(defvar identica-buffer "*identica*") +(defun identica-buffer (&optional method) + "Create a buffer for use by identica-mode. +Initialize the global method with the default, or with METHOD, if present." + (unless method + (setq method "friends_timeline")) + (get-buffer-create identica-buffer)) + +(defstruct (statusnet-oauth-data + (:conc-name sn-oauth-)) + "The oauth configuration associated with a statusnet account." + consumer-key ; string + consumer-secret ; string + request-url ; string + access-url ; string + authorize-url ; string + access-token ; string + ) + +(defstruct (statusnet-account + (:conc-name sn-account-)) + "Container for account information." + server ; string + port ; integer + username ; string + auth-mode ; string, either "password" or "oauth" + password ; string + textlimit ; integer + oauth-data ; statusnet-account-oauth-data + last-timeline-retrieved ; string + ) + +(defvar statusnet-accounts nil + "A list of login credentials for statusnet instances.") + +(defvar sn-current-account nil + "A pointer to the statusnet account being processed.") + +(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-highlighted-entries nil + "List of entry ids selected for highlighting.") + +(defcustom identica-enable-highlighting nil + "If non-nil, set the background of every selected entry to the background +of identica-highlight-face." + :type 'boolean + :group 'identica-mode) + +(defcustom identica-enable-striping nil + "If non-nil, set the background of every second entry to the background +of identica-stripe-face." + :type 'boolean + :group 'identica-mode) + +(defvar identica-username-face 'identica-username-face) +(defvar identica-uri-face 'identica-uri-face) +(defvar identica-reply-face 'identica-reply-face) +(defvar identica-stripe-face 'identica-stripe-face) +(defvar identica-highlight-face 'identica-highlight-face) + +(defcustom identica-reply-bg-color "DarkSlateGray" + "The background color on which replies are displayed." + :type 'string + :group 'identica-mode) + +(defcustom identica-stripe-bg-color "SlateGray" + "The background color on which striped entries are displayed." + :type 'string + :group 'identica-mode) + +(defcustom identica-highlight-bg-color "DarkSlateGray" + "The background color on which highlighted entries are displayed." + :type 'string + :group 'identica-mode) + +;;; 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 () + "Toggle whether identica-mode uses a 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-current-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 () + (get-buffer-create 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 (sn-account-username sn-current-account)) + (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-ley km "\C-c\C-j" 'identica-group-join) + ;; (define-ley km "\C-c\C-l" 'identica-group-leave) + (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-c" 'identica-conversation-timeline) + (define-key km "\C-c\C-o" 'identica-remote-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 "\C-c\C-h" 'identica-toggle-highlight) + (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 "A" 'identica-reply-to-all) + (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 "e" 'identica-expand-replace-at-point) + (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) + (make-variable-buffer-local 'identica-active-mode) + (set-default 'identica-active-mode t) + (font-lock-mode -1) + (defface identica-username-face + `((t nil)) "" :group 'faces) + (defface identica-reply-face + `((t nil)) "" :group 'faces) + (defface identica-stripe-face + `((t nil)) "" :group 'faces) + (defface identica-highlight-face + `((t nil)) "" :group 'faces) + (defface identica-uri-face + `((t nil)) "" :group 'faces) + (defface identica-heart-face + `((t nil)) "" :group 'faces) + + (add-to-list 'minor-mode-alist '(identica-icon-mode " id-icon")) + (add-to-list 'minor-mode-alist '(identica-scroll-mode " id-scroll")) + + ;; make face properties nonsticky + (unless (boundp 'identica-text-property-nonsticky-adjustment) + (setq identica-text-property-nonsticky-adjustment t) + (nconc text-property-default-nonsticky + '((face . t)(mouse-face . t)(uri . t)(source . t)(uri-in-text . t)))) + + (identica-create-account)) + +(defun identica-create-account () + "Create an account object based on the various custom variables. + Insert it into the statusnet accounts list. +This needs to be called from any globally-accessable entry point." + (unless (boundp 'statusnet-account-created) + (setq statusnet-account-created t) + (setq statusnet-accounts + (cons (make-statusnet-account + :server statusnet-server + :port statusnet-port + :username identica-username + :auth-mode identica-auth-mode + :password identica-password + :textlimit statusnet-server-textlimit + :oauth-data (if (string= identica-auth-mode "oauth") + (make-statusnet-oauth-data + :consumer-key identica-mode-oauth-consumer-key + :consumer-secret identica-mode-oauth-consumer-secret + :request-url statusnet-request-url + :access-url statusnet-access-url + :authorize-url statusnet-authorize-url + :access-token nil) + nil) + :last-timeline-retrieved nil) + statusnet-accounts)) + (setq sn-current-account (car statusnet-accounts)))) + +(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) + (with-current-buffer (identica-buffer) + (let ((timeline-url + (concat (or identica-remote-server + (sn-account-server sn-current-account)) + "/" identica-method))) + (setq mode-name + (if loading (concat + (if (stringp loading) loading "loading") + " " timeline-url "...") + timeline-url)) + (debug-print mode-name)))) + +(defvar identica-mode-hook nil + "Identica-mode hook.") + +(defcustom identica-load-hook nil + "Hook that is run after identica-mode.el has been loaded." + :group 'identica-mode + :type 'hook) + +(defun identica-kill-buffer-function () + (when (eq major-mode 'identica-mode) + (identica-stop))) + +(defun identica-autoload-oauth () + "Autoloads oauth.el when needed." + (autoload 'oauth-authorize-app "oauth") + (autoload 'oauth-hexify-string "oauth") + (autoload 'make-oauth-access-token "oauth")) + +(defun identica-mode () + "Major mode for Identica. + \\{identica-mode-map}" + (interactive) + (identica-autoload-oauth) + (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-retrieve-configuration) + (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. +Directly reads parameters from user. This function only sets the +identica-mode variables `(sn-account-username sn-current-account)' and +`(sn-account-password sn-current-account)'. +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." + (interactive) + (identica-ask-credentials) + (identica-get-timeline)) + +(defun identica-ask-credentials () + "Asks for your username and password." + (setf (sn-account-username sn-current-account) + (read-string (concat "Username [for " (sn-account-server sn-current-account) + ":" (int-to-string (sn-account-port sn-current-account)) "]: ") + nil nil (sn-account-username sn-current-account)) + (sn-account-password sn-current-account) + (read-passwd "Password: " nil (sn-account-password sn-current-account)))) + +(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 `(sn-account-username sn-current-account)' +`(sn-account-password sn-current-account)' `(sn-account-server sn-current-account)' + `(sn-account-port sn-current-account)'. +The username and password can also be set on ~/.authinfo, +~/.netrc or ~/.authinfo.gpg files for better security. +In this case `(sn-account-password sn-current-account)' should +not be predefined in any .emacs or init.el files, only +`(sn-account-username sn-current-account)' should be set." + (unless (sn-account-username sn-current-account) + (identica-ask-credentials)) + (let* ((href (if (stringp url) + (url-generic-parse-url url) + url)) + (port (or (and href (url-port href)) + port (sn-account-port sn-current-account))) + (port (if (integerp port) (int-to-string port) port)) + (server (or (and href (url-host href)) + server (sn-account-server sn-current-account))) + (servername 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")) + + (auth-user (if (functionp 'auth-source-search) + (plist-get (car (auth-source-search :host servername :max 1)) :user) + (auth-source-user-or-password "login" server "http"))) + (auth-pass (if (functionp 'auth-source-search) + (if (functionp (plist-get (car (auth-source-search :host servername :max 1)) :secret)) + (funcall (plist-get (car (auth-source-search :host servername :max 1)) :secret)) + (plist-get (car (auth-source-search :host servername :max 1)) :secret)) + (auth-source-user-or-password "password" server "http"))) + (password (or auth-pass (and href (url-password href)) + passwd (sn-account-password sn-current-account))) + (auth (concat (or auth-user (and href (url-user href)) + username (sn-account-username sn-current-account)) + (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-initialize-oauth () + "Get authentication token unless we have one stashed already. +Shamelessly stolen from yammer.el" + (let ((filename (concat "~/." (sn-account-server sn-current-account) "-" + (sn-account-username sn-current-account) "-oauth-token"))) + (when (file-exists-p filename) + (save-excursion + (find-file filename) + (let ((str (buffer-substring (point-min) (point-max)))) + (if (string-match "\\([^:]*\\):\\(.*\\)" + (buffer-substring (point-min) (point-max))) + (setf (sn-oauth-access-token (sn-account-oauth-data sn-current-account)) + (make-oauth-access-token + :consumer-key (sn-oauth-consumer-key (sn-account-oauth-data sn-current-account)) + :consumer-secret (sn-oauth-consumer-secret (sn-account-oauth-data sn-current-account)) + :auth-t (make-oauth-t + :token (match-string 1 str) + :token-secret (match-string 2 str)))))) + (save-buffer) + (kill-this-buffer))) + (unless (sn-oauth-access-token (sn-account-oauth-data sn-current-account)) + (setf (sn-oauth-access-token (sn-account-oauth-data sn-current-account)) + (oauth-authorize-app (sn-oauth-consumer-key (sn-account-oauth-data sn-current-account)) + (sn-oauth-consumer-secret (sn-account-oauth-data sn-current-account)) + (sn-oauth-request-url (sn-account-oauth-data sn-current-account)) + (sn-oauth-access-url (sn-account-oauth-data sn-current-account)) + (sn-oauth-authorize-url (sn-account-oauth-data sn-current-account)))) + (save-excursion + (find-file filename) + (end-of-buffer) + (let ((token (oauth-access-token-auth-t (sn-oauth-access-token (sn-account-oauth-data sn-current-account))))) + (insert (format "%s:%s\n" + (oauth-t-token token) + (oauth-t-token-secret token)))) + (save-buffer) + (kill-this-buffer)))) + (sn-oauth-access-token (sn-account-oauth-data sn-current-account))) + +(defun identica-http-get + (server auth-mode 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://" 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) + (unless (equal auth-mode "none") + (if (equal auth-mode "oauth") + (or (sn-oauth-access-token (sn-account-oauth-data sn-current-account)) + (identica-initialize-oauth)) + (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 + (identica-url-retrieve url sentinel method-class + method parameters sentinel-arguments auth-mode)) + (set-buffer identica-buffer) + (identica-set-mode-string t))) + +(defun identica-render-pending-dents () + (interactive) + "If at the time an HTTP request for new dents finishes, +identica-buffer is not active, we defer its update, to make sure +we adjust point within the right frame." + (identica-render-timeline) + (when (> identica-new-dents-count 0) + (run-hooks 'identica-new-dents-hook) + (setq identica-new-dents-count 0)) + (when identica-display-success-messages + (message "Success: Get"))) + +(defun identica-http-get-default-sentinel + (&optional status method-class method parameters success-message) + (debug-print (window-buffer)) + (let ((error-object (assoc-workaround :error status)) + (active-p (eq (window-buffer) (identica-buffer)))) + (cond (error-object + (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 (sn-account-server sn-current-account) + (sn-account-auth-mode sn-current-account) + 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 (sn-account-last-timeline-retrieved sn-current-account))))) + ((< (- (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) + (let ((body (identica-get-response-body))) + (if (not body) + (identica-set-mode-string nil) + (setq identica-new-dents-count + (+ 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)) + (if active-p + (identica-render-pending-dents) + (identica-set-mode-string "pending")))))))) + +(defun merge-text-attribute (start end new-face attribute) + "Merge the ATTRIBUTE of NEW-FACE into the text between START and END. +If we just add the new face its attributes somehow get overridden by +the attributes of the underlying face, so instead we just add the attribute +we are interested in." + (while (not (eq start end)) + (let ((bg (face-attribute new-face attribute)) + (prop (get-text-property start 'face)) + (next-change + (next-single-property-change start 'face (current-buffer) end))) + (if prop + (add-text-properties start next-change + (list 'face + (list prop + (list attribute bg)))) + (add-text-properties start next-change + (list 'face (list attribute bg)))) + (setq start next-change)))) + +(defun identica-render-timeline () + (with-current-buffer (identica-buffer) + (set-face-attribute 'identica-username-face nil + :underline t) + (set-face-attribute 'identica-reply-face nil + :background identica-reply-bg-color) + (set-face-attribute 'identica-stripe-face nil + :background identica-stripe-bg-color) + (set-face-attribute 'identica-highlight-face nil + :background identica-highlight-bg-color) + (set-face-attribute 'identica-uri-face nil + :underline t) + (set-face-attribute 'identica-heart-face nil + :foreground "firebrick1" :height 2.0) + (let ((point (point)) + (end (point-max)) + (wrapped (cond (visual-line-mode 'visual-line-mode) + (longlines-mode 'longlines-mode) + (t nil))) + (stripe-entry nil)) + + (setq buffer-read-only nil) + (erase-buffer) + (when wrapped (funcall wrapped -1)) + (mapc (lambda (status) + (let ((before-status (point-marker)) + (blacklisted 'nil) + (formatted-status (identica-format-status + status identica-status-format))) + (mapc (lambda (regex) + (when (string-match-p regex formatted-status) + (setq blacklisted 't))) + identica-blacklist) + (unless blacklisted + (when identica-enable-striping + (setq stripe-entry (not stripe-entry))) + (insert formatted-status) + (when (not wrapped) + (fill-region-as-paragraph + (save-excursion (beginning-of-line -1) (point)) (point))) + (insert-and-inherit "\n") + ;; Apply highlight overlays to status + (when (or (string-equal (sn-account-username sn-current-account) + (assoc-default 'in-reply-to-screen-name status)) + (string-match + (concat "@" (sn-account-username sn-current-account) + "\\([^[:word:]_-]\\|$\\)") (assoc-default 'text status))) + (merge-text-attribute before-status (point) 'identica-reply-face :background)) + (when (and identica-enable-highlighting + (memq (assoc-default 'id status) identica-highlighted-entries)) + (merge-text-attribute before-status (point) 'identica-highlight-face :background)) + (when stripe-entry + (merge-text-attribute before-status (point) 'identica-stripe-face :background)) + (when identica-oldest-first (goto-char (point-min)))))) + identica-timeline-data) + (when (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) + (setf (sn-account-last-timeline-retrieved sn-current-account) identica-method) + (if transient-mark-mode (deactivate-mark))))) + +(defun identica-format-status (status format-str) + (flet ((attr (key) + (assoc-default key status)) + (profile-image + () + (let ((profile-image-url (attr 'user-profile-image-url))) + (when (string-match "/\\([^/?]+\\)\\(?:\\?\\|$\\)" profile-image-url) + (let ((filename (match-string-no-properties 1 profile-image-url)) + (xfilename (match-string-no-properties 0 profile-image-url))) + ;; download icons if does not exist + (unless (file-exists-p (concat identica-tmp-dir filename)) + (if (file-exists-p (concat identica-tmp-dir xfilename)) + (setq filename xfilename) + (setq filename nil) + (add-to-list 'identica-image-stack profile-image-url))) + (when (and identica-icon-mode filename) + (let ((avatar (create-image (concat identica-tmp-dir filename)))) + ;; Make sure the avatar is 48 pixels (which it should already be!, but hey...) + ;; For offenders, the top left slice of 48 by 48 pixels is displayed + ;; TODO: perhaps make this configurable? + (insert-image avatar nil nil `(0 0 48 48))) + nil)))))) + (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) + (push (substring format-str cursor found-at) result) + "|") + (setq cursor (match-end 1)) + + (case c + ((?s) ; %s - screen_name + (push (attr 'user-screen-name) result)) + ((?S) ; %S - name + (push (attr 'user-name) result)) + ((?i) ; %i - profile_image + (push (profile-image) result)) + ((?d) ; %d - description + (push (attr 'user-description) result)) + ((?l) ; %l - location + (push (attr 'user-location) result)) + ((?L) ; %L - " [location]" + (let ((location (attr 'user-location))) + (unless (or (null location) (string= "" location)) + (push (concat " [" location "]") result)) )) + ((?u) ; %u - url + (push (attr 'user-url) result)) + ((?U) ; %U - profile url + (push (cadr (split-string (attr 'user-profile-url) "https*://")) result)) + ((?j) ; %j - user.id + (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) + (push (concat " " in-reply-to-string) result))))) + ((?p) ; %p - protected? + (let ((protected (attr 'user-protected))) + (when (string= "true" protected) + (push "[x]" result)))) + ((?c) ; %c - created_at (raw UTC string) + (push (attr 'created-at) result)) + ((?C) ; %C{time-format-str} - created_at (formatted with time-format-str) + (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) + (push time-string result)))) + ((?t) ; %t - text + (push ;(clickable-text) + (attr 'text) + result)) + ((?') ; %' - truncated + (let ((truncated (attr 'truncated))) + (when (string= "true" truncated) + (push "..." result)))) + ((?f) ; %f - source + (push (attr 'source) result)) + ((?F) ; %F - ostatus-aware source + (push (if (string= (attr 'source) "ostatus") + (cadr (split-string (attr 'user-profile-url) "https*://")) + (attr 'source)) result)) + ((?#) ; %# - id + (push (format "%d" (attr 'id)) result)) + ((?x) ; %x - conversation id (conteXt) - default 0 + (push (attr 'conversation-id) result)) + ((?h) + (let ((likes (attr 'favorited))) + (when (string= "true" likes) + (push (propertize "❤" 'face 'identica-heart-face) result)))) + (t + (push (char-to-string c) result)))) + (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) + profile-url, (attr 'user-profile-url) + conversation-id, (attr 'conversation-id)) + formatted-status) + formatted-status)))) + +(defun identica-url-retrieve + (url sentinel method-class method parameters sentinel-arguments &optional auth-mode unhex-workaround) + "Call url-retrieve or oauth-url-retrieve dsepending on the mode. +Apply url-unhex-string workaround if necessary." + (if (and (equal auth-mode "oauth") + (sn-oauth-access-token (sn-account-oauth-data sn-current-account))) + (if unhex-workaround + (flet ((oauth-extract-url-params + (req) + "Modified oauth-extract-url-params using w3m-url-decode-string to work around +bug in url-unhex-string present in emacsen previous to 23.3." + (let ((url (oauth-request-url req))) + (when (string-match (regexp-quote "?") url) + (mapcar (lambda (pair) + `(,(car pair) . ,(w3m-url-decode-string (cadr pair)))) + (url-parse-query-string (substring url (match-end 0)))))))) + (identica-url-retrieve url sentinel method-class method parameters sentinel-arguments auth-mode)) + (oauth-url-retrieve (sn-oauth-access-token (sn-account-oauth-data sn-current-account)) url sentinel + (append (list method-class method parameters) + sentinel-arguments))) + (url-retrieve url sentinel + (append (list method-class method parameters) + sentinel-arguments)))) + +(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\")) => ?mode=view&page=6" + (or sentinel (setq sentinel 'identica-http-post-default-sentinel)) + (let ((url-request-method "POST") + (url (concat "http://"(sn-account-server sn-current-account) "/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) + ;; (if (assoc `media parameters) + ;; (url-request-extra-headers '(("Content-Type" . "multipart/form-data"))) + (url-request-extra-headers '(("Content-Length" . "0"))) + (url-show-status nil)) + (identica-set-proxy) + (if (equal (sn-account-auth-mode sn-current-account) "oauth") + (or (sn-oauth-access-token (sn-account-oauth-data sn-current-account)) + (identica-initialize-oauth)) + (identica-set-auth url)) + (when (get-buffer-process identica-http-buffer) + (delete-process identica-http-buffer) + (kill-buffer identica-http-buffer)) + (identica-url-retrieve url sentinel method-class method parameters + sentinel-arguments (sn-account-auth-mode sn-current-account) identica-unhex-broken))) + +(defun identica-http-post-default-sentinel + (&optional status method-class method parameters success-message) + (let ((error-object (assoc-workaround :error status))) + (cond ((and + error-object + (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))) + (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))) + (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 + (prog1 + (xml-parse-region start (point-max)) + (if identica-debug-mode + t + (kill-buffer buffer)))))) + +(defun identica-clean-weird-chars (&optional 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 () + "Remove weird strings (e.g., 1afc, a or 0) from 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-compare-statuses (a b) + "Compare a pair of statuses. +For use as a predicate for sort." + (< (assoc-default 'id b) (assoc-default 'id a))) + +(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." + (when (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 (sort (cons status-datum (symbol-value data-var)) + 'identica-compare-statuses)) + 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 favorited + in-reply-to-status-id + in-reply-to-screen-name + (user-data (cddr (assq 'user status-data))) + user-id user-name + conversation-id + user-screen-name + user-location + user-description + user-profile-image-url + user-profile-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 favorited (assq-get 'favorited 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 conversation-id (or (assq-get 'statusnet:conversation_id status-data) "0")) + (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)) + (setq user-profile-url (assq-get 'statusnet:profile_url user-data)) + + ;; make username clickable + (add-text-properties + 0 (length user-name) + `(mouse-face highlight + uri ,user-profile-url + 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 ,user-profile-url + 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://" (sn-account-server sn-current-account) "/" screen-name) + (if group-name + (concat "https://" (sn-account-server sn-current-account) "/group/" group-name) + (concat "https://" (sn-account-server sn-current-account) "/tag/" tag-name))) + uri-in-text ,(if screen-name + (concat "https://" (sn-account-server sn-current-account) "/" screen-name) + (if group-name + (concat "https://" (sn-account-server sn-current-account) "/group/" group-name) + (concat "https://" (sn-account-server sn-current-account) "/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 + (when (string-match "\\(.*\\)" 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) + + (mapcar + (lambda (sym) + `(,sym . ,(symbol-value sym))) + '(id text source created-at truncated favorited + in-reply-to-status-id + in-reply-to-screen-name + conversation-id + user-id user-name user-screen-name user-location + user-description + user-profile-image-url + user-profile-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 + (when (consp (car statuses)) + (setq ret (cons (car statuses) ret))) + (setq statuses (cdr statuses))) + ret))) + +(defun identica-percent-encode (str &optional coding-system) + (if (equal (sn-account-auth-mode sn-current-account) "oauth") + (oauth-hexify-string str) + (when (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) + (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 + (push + (char-to-string + (identica-ucs-to-char + (string-to-number number-entity))) result)) + (letter-entity + (cond ((string= "gt" letter-entity) (push ">" result)) + ((string= "lt" letter-entity) (push "<" result)) + (t (push "?" result)))) + (t (push "?" result))) + (setq cursor (match-end 0)))) + (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 (assoc `media parameters) + `(("media" . ,(cdr (assoc `media parameters)))) + nil) + ,@(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 + (when (not (equal major-mode 'identica-update-status-edit-mode)) + (progn + (identica-update-status-edit-mode) + (when identica-soft-wrap-status + (when (fboundp 'visual-line-mode) + (visual-line-mode t))) + (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/%s) " msgtype parameters + (sn-account-textlimit sn-current-account)) + mode-line-format)) + t (setq mode-line-format + (cons (format "%s (%%i/%s) " msgtype (sn-account-textlimit sn-current-account)) + 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).")))) + +(defcustom identica-minibuffer-length-prompt-style nil + "The preferred style of counting characters in the minibuffer. +prompt; \"Down\" counts down from (sn-account-textlimit sn-current-account); \"Up\" counts + up from 0" + :type '(choice (const :tag "Down" nil) + (const :tag "Up" t)) + :group 'identica-mode) + +(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" (if identica-minibuffer-length-prompt-style + status-len + (- (sn-account-textlimit sn-current-account) 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) + (identica-create-account) + (when (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 "") '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 (< (+ (sn-account-textlimit sn-current-account) 1) (length status)) + (setq status (read-from-minibuffer (format (concat msgtype "(%d): ") + (- (sn-account-textlimit sn-current-account) (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*" + (if longlines-mode + (longlines-encode-region (point-min) (point-max))) + (let* ((status (buffer-substring-no-properties (point-min) (point-max))) + (status-len (length status))) + (if (< (sn-account-textlimit sn-current-account) status-len) + (message (format "Beyond %s chars. Remove %d chars." + (sn-account-textlimit sn-current-account) + (- status-len (sn-account-textlimit sn-current-account)))) + (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") + (when (> (- end beg) (sn-account-textlimit sn-current-account)) + (setq end (+ beg (sn-account-textlimit sn-current-account)))) + (when (< (- end beg) (sn-account-textlimit sn-current-account)) + (setq beg (+ end (sn-account-textlimit sn-current-account)))) + (identica-update-status-if-not-blank "statuses" "update" (buffer-substring beg end))) + +(defun identica-update-status-with-media (attachment &optional init-str method-class method parameters reply-to-id) + (interactive "f") + (identica-update-status 'minibuffer nil reply-to-id nil nil `((media . ,(insert-file-contents-literally attachment))))) + +(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* ((apiurl (if (string-match "\\(http://.*\\)\\?\\(.*=\\)" api) + (match-string 1 api))) + (url-request-method "POST") + (url-request-extra-headers + '(("Content-Type" . "application/x-www-form-urlencoded"))) + (datavar (match-string 2 api)) + (url-request-data (concat datavar (url-hexify-string longurl))) + (buffer (url-retrieve-synchronously apiurl))) + (with-current-buffer buffer + (goto-char (point-min)) + (prog1 + (if (string-equal identica-urlshortening-service "ur1ca") + (if (search-forward-regexp "Your .* is: .*>\\(http://ur1.ca/[0-9A-Za-z].*\\)" nil t) + (match-string-no-properties 1) + (error "URL shortening service failed: %s" longurl)) + (if (search-forward-regexp "\\(http://[0-9A-Za-z/].*\\)" 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 (not (eq identica-urlshortening-service 'google)) + (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))))))) + +(defun identica-expand-replace-at-point () + "Replace the url at point with a tiny version." + (interactive) + (let ((url-bounds (bounds-of-thing-at-point 'url)) + (original-url (thing-at-point 'url))) + (when url-bounds + (message (concat "Expanding url: " original-url)) + (let ((uri (identica-expand-shorturl original-url))) + (when uri + (set-buffer (get-buffer identica-buffer)) + (save-restriction + (setq buffer-read-only nil) + (narrow-to-region (car url-bounds) (cdr url-bounds)) + (delete-region (point-min) (point-max)) + (add-text-properties 0 (length uri) + `(mouse-face highlight + face identica-uri-face + uri ,uri + uri-in-text ,uri) uri) + (insert uri) + (message (concat "Expanded Short URL " original-url "to Long URL: " uri)) + (setq buffer-read-only t))))))) + +(defun identica-expand-shorturl (url) + "Return the redirected URL, or the original url if not found." + (let ((temp-buf (get-buffer-create "*HTTP headers*"))) + (set-buffer temp-buf) + (erase-buffer) + (goto-char 0) + (let* + ((url (replace-regexp-in-string "http://" "" url)) + (host (substring url 0 (string-match "/" url))) + (file (if (string-match "/" url) + (substring url (string-match "/" url)) + "/")) + (tcp-connection (open-network-stream "Identica URLExpand" + temp-buf host 80)) + (request (concat "GET http://" url " HTTP/1.1\r\n" + "Host:" host "\r\n" + "User-Agent: " (identica-user-agent) "\r\n" + "Authorization: None\r\n" + "Accept-Charset: utf-8;q=0.7,*;q=0.7\r\n\r\n"))) + (set-marker (process-mark tcp-connection) (point-min)) + (set-process-sentinel tcp-connection 'identica-http-headers-sentinel) + (process-send-string tcp-connection request) + (sit-for 2) + (let ((location (identica-get-location-from-header (concat "http://" host file) tcp-connection))) + (delete-process tcp-connection) + (kill-buffer temp-buf) + location)))) + +(defun identica-http-headers-sentinel (process string) + "Process the results from the efine network connection." + + ) + +(defun identica-get-location-from-header (url process) + "Parse HTTP header." + (let ((buffer) + (headers) + (location)) + (setq buffer (get-buffer-create "*HTTP headers*")) + (set-buffer buffer) + (goto-char 0) + (setq location + (if (search-forward-regexp "^Location: \\(http://.*?\\)\r?$" nil t) + (match-string-no-properties 1) + url)) + (replace-regexp-in-string "\r" "" location))) + +;;; +;;; Commands +;;; + +(defun identica-start (&optional action) + (interactive) + (when (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))) + (set '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 (sn-account-last-timeline-retrieved sn-current-account)) + (identica-set-mode-string nil) + (and identica-timer + (cancel-timer identica-timer)) + (setq identica-timer nil) + (set 'identica-active-mode nil) + (identica-update-mode-line)) + +(defun identica-switch-account () + "Update the current account and reload the default timeline." + (interactive) + (let ((current-account (member* sn-current-account statusnet-accounts))) + (setq sn-current-account + (if (cdr current-account) + (cadr current-account) + (car statusnet-accounts)) + identica-timeline-data nil) + (identica-current-timeline))) + +(defun identica-get-timeline (&optional server parameters) + (setq identica-remote-server server) + (unless parameters (setq parameters `(("count" . ,(int-to-string identica-statuses-count))))) + (when (not (eq (sn-account-last-timeline-retrieved sn-current-account) identica-method)) + (setq identica-timeline-last-update nil + identica-timeline-data nil)) + (let ((buf (get-buffer identica-buffer))) + (if (not buf) + (identica-stop) + (progn + (when (not identica-method) + (setq identica-method "friends_timeline")) + (identica-http-get (or server (sn-account-server sn-current-account)) + (if server "none" + (sn-account-auth-mode sn-current-account)) + identica-method-class identica-method parameters)))) + (identica-get-icons)) + +(defun identica-get-icons () + "Retrieve icons if icon-mode is active." + (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 (&optional from-user) + "Retrieve user timeline given its username. + +FROM-USER can be an empty string (\"\") meaning that you want to retrieve your own timeline. +If nil, will ask for username in minibuffer." + (interactive) + (unless from-user + (setq from-user (read-from-minibuffer "User [Empty for mine]: " + nil nil nil nil nil t))) + (setq identica-method-class "statuses") + (if (string-equal from-user "") + (setq identica-method "user_timeline") + (setq identica-method (concat "user_timeline/" from-user))) + (identica-get-timeline) + ) + +(defun identica-conversation-timeline () + (interactive) + (let ((context-id (get-text-property (point) 'conversation-id))) + (setq identica-method-class "statusnet") + (setq identica-method (concat "conversation/" context-id))) + (identica-get-timeline identica-remote-server)) + +(defun identica-remote-user-timeline () + (interactive) + (let* ((profile (get-text-property (point) 'profile-url)) + (username (get-text-property (point) 'username)) + ;Strip potential trailing slashes and username references from profile url to get the server url + (server-url (if (string-match (concat "/?\\(" username "\\)?/?$") profile) + (replace-match "" nil t profile) + profile)) + (server (if (string-match "^https?://" server-url) + (replace-match "" nil t server-url) + server-url))) + (setq identica-method-class "statuses") + (setq identica-method (concat "user_timeline/" username)) + (identica-get-timeline server))) + +(defun identica-current-timeline (&optional count) + "Load newer notices, with an argument load older notices, and with a numeric argument load that number of notices." + (interactive "P") + (if (> identica-new-dents-count 0) + (identica-render-pending-dents) + (identica-get-timeline + identica-remote-server + (if count + (cons `("count" . + ,(int-to-string + (if (listp count) identica-statuses-count count))) + (if (listp count) + `(("max_id" . + ,(int-to-string + (- (assoc-default 'id (car (last identica-timeline-data))) 1)))) + ())) + nil)))) + +(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) + (when (not (sn-account-last-timeline-retrieved sn-current-account)) + (setf (sn-account-last-timeline-retrieved sn-current-account) identica-method)) + (identica-http-get (sn-account-server sn-current-account) (sn-account-auth-mode sn-current-account) + "statuses" (sn-account-last-timeline-retrieved sn-current-account))) + +(defun identica-click () + (interactive) + (let ((uri (get-text-property (point) 'uri))) + (when 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)) + (when (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)) + (when (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-group-join (&optional leaving) + "Simple functions to join/leave a group we are visiting." + (setq identica-method-class "statusnet/groups") + (string-match "\\([^\\]*\\)\\(/.*\\)" identica-method) + (let ((group-method (replace-match + (if leaving "leave" + "join") nil nil identica-method 1))) + (identica-http-post identica-method-class group-method nil))) + +(defun identica-group-leave () + (identica-group-join t)) + +(defun identica-favorite () + (interactive) + (when (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) + (when (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))) + (when 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 "!\\(\\b\\)" "#\\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 (all) + "Open a minibuffer initialized to type a reply to the notice at point. +With no argument, populate with the username of the author of the notice. +With an argument, populate with the usernames of the author and any usernames mentioned in the notice." + (interactive "P") + (let ((username (get-text-property (point) 'username)) + (notice-text (get-text-property (point) 'text)) + (id (get-text-property (point) 'id)) + (usernames nil) + (usernames-string "")) + (when all + (setq usernames + (mapcar (lambda (string) + (when (and (char-equal (aref string 0) ?@) + (memq-face identica-uri-face + (get-text-property 2 'face string))) + (concat string " "))) + (split-string notice-text)))) + (when username (setq usernames (cons (concat "@" username " ") usernames))) + (setq usernames (delete-dups usernames)) + (setq usernames (delete (concat "@" (sn-account-username sn-current-account) " ") usernames)) + (setq usernames-string (apply 'concat usernames)) + (identica-update-status identica-update-status-method usernames-string id))) + +(defun identica-reply-to-all () + (interactive) + (identica-reply-to-user t)) + +(defun identica-get-password () + (or (sn-account-password sn-current-account) + (setf (sn-account-password sn-current-account) (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) + (progn (goto-char (buffer-end 1)) (message "End of status."))))) + +(defun identica-toggle-highlight (&optional arg) + "Toggle the highlighting of entry at 'point'. +With no arg or prefix, toggle the highlighting of the entry at 'point'. +With arg (or prefix, if interactive), highlight the current entry and +un-highlight all other entries." + (interactive "P") + (let ((id (get-text-property (point) 'id))) + (setq identica-highlighted-entries + (if arg (list id) + (if (memq id identica-highlighted-entries) + (delq id identica-highlighted-entries) + (cons id identica-highlighted-entries))))) + (identica-render-timeline)) + +(defun memq-face (face property) + "Check whether FACE is present in PROPERTY." + (if (listp property) + (memq face property) + (eq property face))) + +(defun identica-get-next-username-face-pos (pos &optional object) + "Returns the position of the next username after POS, or nil when end of string or buffer is reached." + (interactive "P") + (let ((prop)) + (catch 'not-found + (while (and pos (not (memq-face identica-username-face prop))) + (setq pos (next-single-property-change pos 'face object)) + (when (eq pos nil) (throw 'not-found nil)) + (setq prop (get-text-property pos 'face object))) + 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 &optional object) + "Returns the position of the previous username before POS, or nil when start of string or buffer is reached." + (interactive) + (let ((prop)) + (catch 'not-found + (while (and pos (not (memq-face identica-username-face prop))) + (setq pos (previous-single-property-change pos 'face object)) + (when (eq pos nil) (throw 'not-found nil)) + (setq prop (get-text-property pos 'face object))) + 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 (memq-face identica-username-face (get-text-property start-pos '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 assoc-workaround (tag array) + "Workaround odd semi-associative array returned by url-http." + (or (assoc tag array) + (and (equal tag (car array)) + (cadr array)))) + +(defun identica-get-status-url (id) + "Generate status URL." + (format "https://%s/notice/%s" (sn-account-server sn-current-account) id)) + +(defun identica-get-context-url (id) + "Generate status URL." + (format "https://%s/conversation/%s" (sn-account-server sn-current-account) id)) + +(defun identica-retrieve-configuration () + "Retrieve the configuration for the current statusnet server." + (identica-http-get (sn-account-server sn-current-account) (sn-account-auth-mode sn-current-account) + "statusnet" "config" nil 'identica-http-get-config-sentinel)) + +(defun identica-http-get-config-sentinel + (&optional status method-class method parameters success-message) + "Process configuration page retrieved from statusnet server." + (let ((error-object (assoc-workaround :error status))) + (unless error-object + (let* ((body (identica-get-response-body)) + (site (xml-get-children (car body) 'site)) + (textlimit (xml-get-children (car site) 'textlimit)) + (textlimit-value (caddar textlimit))) + (when (> (string-to-number textlimit-value) 0) + (setf (sn-account-textlimit sn-current-account) (string-to-number textlimit-value)))))) + (identica-start)) + +(defun identica-get-config-url () + "Generate configuration URL." + (format "http://%s/api/statusnet/config.xml" (sn-account-server sn-current-account))) + +;; 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"))) + +(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) +(add-hook 'identica-load-hook 'identica-autoload-oauth) +(run-hooks 'identica-load-hook) + +;;; identica-mode.el ends here diff --git a/elpa/identica-mode-20130204.1453/identica-mode.info b/elpa/identica-mode-20130204.1453/identica-mode.info new file mode 100644 index 0000000..0082c2c --- /dev/null +++ b/elpa/identica-mode-20130204.1453/identica-mode.info @@ -0,0 +1,859 @@ +This is identica-mode.info, produced by makeinfo version 5.2 from +identica-mode.texi. + +Copyright (C) 2009 Chris Bryant (). Permission is +granted to copy, distribute and/or modify this document under the terms +of the GNU Free Documentation License, Version 1.2 or any later version +published by the Free Software Foundation; with no Invariant Sections, +no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is +included in the section entitled "GNU Free Documentation License". +INFO-DIR-SECTION Emacs +START-INFO-DIR-ENTRY +* Identica mode: (identica-mode). Emacs mode for microblogging services. +END-INFO-DIR-ENTRY + + +File: identica-mode.info, Node: Top, Next: About Identica mode and obtaining it, Prev: (dir), Up: (dir) + +identica-mode +************* + +This manual is for identica-mode.el, version 0.9. + +* Menu: + +* About Identica mode and obtaining it:: +* Installation and configuration:: +* Using identica-mode.el:: +* Credits and contributing:: +* GNU Free Documentation License:: + + +File: identica-mode.info, Node: About Identica mode and obtaining it, Next: Installation and configuration, Prev: Top, Up: Top + +1 About Identica mode and obtaining it +************************************** + +* Menu: + +* About identica-mode.el and this manual:: +* Getting a copy:: + + +File: identica-mode.info, Node: About identica-mode.el and this manual, Next: Getting a copy, Prev: About Identica mode and obtaining it, Up: About Identica mode and obtaining it + +1.1 About identica-mode.el and this manual +========================================== + +This manual instructs in the use of identica-mode.el, a major mode for +GNU Emacs used to perform useful actions with StatusNet +(http://status.net) microblogging services, like identi.ca +(http://identi.ca). + + identica-mode.el was developed by Gabriel Saldana +(mailto:gsaldana@gmail.com) and other contributors (*note Credits::). +It is originally based on Twittering mode version 0.6 by Y. Hayamizu and +Tsuyoshi CHO. + + +File: identica-mode.info, Node: Getting a copy, Prev: About identica-mode.el and this manual, Up: About Identica mode and obtaining it + +1.2 Getting a copy +================== + +Identica mode can be obtained from the Savannah +(https://savannah.gnu.org) software forge. The URLs for the Identica +mode project are: + + * http://www.nongnu.org/identica-mode + (http://www.nongnu.org/identica-mode/) - Main website + * https://savannah.nongnu.org/projects/identica-mode + (https://savannah.nongnu.org/projects/identica-mode/) - Software + forge + + You can obtain identica-mode.el directly from the git repository at +Savannah by executing a git clone command: + git clone git://git.savannah.nongnu.org/identica-mode.git + + This action will fetch the latest identica-mode.el file as well as +the latest manual, located under the 'doc/' directory. + + +File: identica-mode.info, Node: Installation and configuration, Next: Using identica-mode.el, Prev: About Identica mode and obtaining it, Up: Top + +2 Installation and configuration +******************************** + +* Menu: + +* Installing identica-mode.el:: +* Configuring GNU Emacs:: + + +File: identica-mode.info, Node: Installing identica-mode.el, Next: Configuring GNU Emacs, Prev: Installation and configuration, Up: Installation and configuration + +2.1 Installing identica-mode.el +=============================== + +Installation of indentica-mode.el is fairly straightforward. Like most +GNU Emacs customizations, it is recommended you place your +identica-mode.el file under your 'emacs.d' directory. The location of +this directory will vary between OSs, but it is generally under +'~/.emacs.d/' for UNIX style systems. Consult your GNU Emacs +(http://www.gnu.org/software/emacs/) documentation. + + Alternatively, you can create your own directory for this GNU Emacs +mode file, and others, if you choose. Read on for information on how to +configure your '.emacs' file to find indentica-mode.el. + + +File: identica-mode.info, Node: Configuring GNU Emacs, Prev: Installing identica-mode.el, Up: Installation and configuration + +2.2 Configuring GNU Emacs +========================= + +* Menu: + +* identica-mode requirements:: +* Configuring .emacs:: + + +File: identica-mode.info, Node: identica-mode requirements, Next: Configuring .emacs, Prev: Configuring GNU Emacs, Up: Configuring GNU Emacs + +2.2.1 identica-mode requirements +-------------------------------- + +The following GNU Emacs libraries are required by identica-mode.el. A +standard GNU Emacs installation should provide these, but if yours does +not, fetch a copy of the GNU Emacs (http://www.gnu.org/software/emacs/) +source. The libraries are generally found under the +'emacs-/lisp/' directory. + + * cl + * xml + * parse-time + * longlines + + In addition to the library requirements, the following software is +currently required: + + * GNU Emacs 22 or later + * Curl + * Wget + * UNIX-like OS (GNU/Linux, BSD, etcetera) + + +File: identica-mode.info, Node: Configuring .emacs, Prev: identica-mode requirements, Up: Configuring GNU Emacs + +2.2.2 Configuring .emacs +------------------------ + +Some or all or the following settings can be configured from within GNU +Emacs or written to your '.emacs' file. To configure within GNU Emacs, +execute 'M-x' and type 'customize-group'. When prompted for the group +to customize, enter 'identica-mode'. The settings are: + + * Identica Idle Time + * Identica Timer Interval + * Identica Username + * Identica Password + * Laconica Server + * Identica Default Timeline + * Identica Display Success Messages + * Identica Update Status Edit Confirm Cancellation + * Identica Update Status Method + * Identica Http Get Timeout + * Identica Status Format + + For general usage, the defaults for each of these settings (excluding +Username and Password) should be fine to get started for use with +identi.ca. If you wish to customize these settings, please see the +StatusNet wiki (http://status.net/wiki/) for documentation of usage. +Management of the customizations can also be performed from within your +'.emacs' file. Below is a sample, explicitly calling the +identica-mode.el file and with an added global keybinding to allow +posting from the minibuffer without having the identica buffer active: + ;; Identica Mode + (load "/home/identicauser/.emacs.d/identica-mode.el") + (require 'identica-mode) + (setq identica-username "identicauser") + (setq identica-password "password") + (global-set-key "\C-cip" 'identica-update-status-interactive) + + + +File: identica-mode.info, Node: Using identica-mode.el, Next: Credits and contributing, Prev: Installation and configuration, Up: Top + +3 Using identica-mode.el +************************ + +* Menu: + +* Basic usage:: +* Tips and tricks:: + + +File: identica-mode.info, Node: Basic usage, Next: Tips and tricks, Prev: Using identica-mode.el, Up: Using identica-mode.el + +3.1 Basic usage +=============== + +* Menu: + +* Introduction:: +* Startup:: +* Icons:: +* Replies timeline:: +* Public timeline:: +* Personal timeline:: +* Update status:: +* Send notice:: +* Shorten url:: + + +File: identica-mode.info, Node: Introduction, Next: Startup, Prev: Basic usage, Up: Basic usage + +3.1.1 Introduction +------------------ + +Identica mode currently works under GNU Emacs in both terminal and +graphical mode. Where there are special considerations for one or the +other mode, they will be clearly highlighted. The purpose of Identica +mode is to provide an easy method to send and view updates while working +within a GNU Emacs environment. Thus, the command set detailed below is +simple. If you are interested in more complex functionality, feel free +to send suggestions through the Savannah project website. Additionally, +keep up-to-date with the latest releases. Also, see *note Extending +identica-mode:: for tips on writing your own functions. + + +File: identica-mode.info, Node: Startup, Next: Icons, Prev: Introduction, Up: Basic usage + +3.1.2 Startup +------------- + +To get started using Identica mode, execute 'M-x' and type +'identica-mode'. This will initiate the identica-mode buffer, +*identica*, and display the default timeline. At any time you wish to +refresh the timeline, press the 'G' key. + + +File: identica-mode.info, Node: Icons, Next: Replies timeline, Prev: Startup, Up: Basic usage + +3.1.3 Icons +----------- + +If you are using GNU Emacs with a graphical interface, you can toggle +the view of user icons by pressing the 'I' key. + + +File: identica-mode.info, Node: Replies timeline, Next: Public timeline, Prev: Icons, Up: Basic usage + +3.1.4 Replies timeline +---------------------- + +To view your Replies timeline execute: + C-c C-r + + +File: identica-mode.info, Node: Public timeline, Next: Personal timeline, Prev: Replies timeline, Up: Basic usage + +3.1.5 Public timeline +--------------------- + +To view the Public timeline execute: + C-c C-g + + +File: identica-mode.info, Node: Personal timeline, Next: Update status, Prev: Public timeline, Up: Basic usage + +3.1.6 Personal timeline +----------------------- + +To view your Personal timeline execute: + C-c C-f + + +File: identica-mode.info, Node: Update status, Next: Send notice, Prev: Personal timeline, Up: Basic usage + +3.1.7 Update status +------------------- + +To update your Identica status execute: + C-c C-s + + At the 'Status:' prompt, type the content of your status, up to 140 +characters. When done, hit the 'Enter' key. The message 'Success: +Post' will apper in the minibuffer. + + +File: identica-mode.info, Node: Send notice, Next: Shorten url, Prev: Update status, Up: Basic usage + +3.1.8 Send notice +----------------- + +To send a notice directly to a user execute: + C-c C-d + + At the 'To user:' prompt type the exact user name and press the +'Enter' key. At the 'Direct message:' prompt, type your message and +press the 'Enter' key. + + +File: identica-mode.info, Node: Shorten url, Prev: Send notice, Up: Basic usage + +3.1.9 Shorten url +----------------- + +You can shorten a url while typing your update notice on the minibuffer +by pressing the '' key while the cursor is in between or at the end +of the long url you just typed. + + +File: identica-mode.info, Node: Tips and tricks, Prev: Basic usage, Up: Using identica-mode.el + +3.2 Tips and tricks +=================== + +* Menu: + +* Run commands after recieving notices:: +* Extending identica-mode:: + + +File: identica-mode.info, Node: Run commands after recieving notices, Prev: Tips and tricks, Up: Tips and tricks + +3.2.1 Run commands after recieving notices +------------------------------------------ + +You can now create "hooks" that will run after recieving new notices. +Just add a hook function to 'identica-new-dents-hook'. + + To display a notification message on KDE 4 you can add the following +code on your .emacs file: + ;; KDE 4 Notification of new dents with kdialog + (add-hook 'identica-new-dents-hook (lambda () + (let ((n identica-new-dents-count)) + (start-process "identica-notify" nil "kdialog" + "--title" + "Emacs Identica-mode New dents" + "--passivepopup" + (format "You have %d new dent%s" + n (if (> n 1) "s" "")) + "3" + )))) + + +File: identica-mode.info, Node: Extending identica-mode, Prev: Tips and tricks, Up: Tips and tricks + +3.2.2 Extending identica-mode +----------------------------- + +Because identica-mode.el is written in Emacs Lisp, there are many +options to extend the mode to your liking. As this is the first release +of the Identica mode manual, this section will serve to simply encourage +you to experiment with the code, and to see *note Contributing:: for +ways to let us know how you've extended identica-mode.el - maybe we'll +add your extensions to the code, and this section, in further releases! + + +File: identica-mode.info, Node: Credits and contributing, Next: GNU Free Documentation License, Prev: Using identica-mode.el, Up: Top + +4 Credits and contributing +************************** + +* Menu: + +* Credits:: +* Contributing:: + + +File: identica-mode.info, Node: Credits, Next: Contributing, Prev: Credits and contributing, Up: Credits and contributing + +4.1 Credits +=========== + +The following individuals have contributed to the Identica mode project. +See the identica-mode.el file for more information. + + * Christian Cheng + * Alberto Garcia + * Bradley M. Kuhn + * Jason McBrayer + * Carlos A. Perilla + * Alex Schröder + * Shyam Karanatt + + +File: identica-mode.info, Node: Contributing, Prev: Credits, Up: Credits and contributing + +4.2 Contributing +================ + +If you have any ideas for features, patches or bug fixes, please add +them to the identica-mode bug tracking list +(https://savannah.nongnu.org/bugs/?group=identica-mode). If you are +submitting something specifically for *note Extending identica-mode::, +be sure to note this in your ticket. + + +File: identica-mode.info, Node: GNU Free Documentation License, Prev: Credits and contributing, Up: Top + +GNU Free Documentation License +****************************** + + Version 1.2, November 2002 + + Copyright (C) 2000,2001,2002 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + 0. PREAMBLE + + The purpose of this License is to make a manual, textbook, or other + functional and useful document "free" in the sense of freedom: to + assure everyone the effective freedom to copy and redistribute it, + with or without modifying it, either commercially or + noncommercially. Secondarily, this License preserves for the + author and publisher a way to get credit for their work, while not + being considered responsible for modifications made by others. + + This License is a kind of "copyleft", which means that derivative + works of the document must themselves be free in the same sense. + It complements the GNU General Public License, which is a copyleft + license designed for free software. + + We have designed this License in order to use it for manuals for + free software, because free software needs free documentation: a + free program should come with manuals providing the same freedoms + that the software does. But this License is not limited to + software manuals; it can be used for any textual work, regardless + of subject matter or whether it is published as a printed book. We + recommend this License principally for works whose purpose is + instruction or reference. + + 1. APPLICABILITY AND DEFINITIONS + + This License applies to any manual or other work, in any medium, + that contains a notice placed by the copyright holder saying it can + be distributed under the terms of this License. Such a notice + grants a world-wide, royalty-free license, unlimited in duration, + to use that work under the conditions stated herein. The + "Document", below, refers to any such manual or work. Any member + of the public is a licensee, and is addressed as "you". You accept + the license if you copy, modify or distribute the work in a way + requiring permission under copyright law. + + A "Modified Version" of the Document means any work containing the + Document or a portion of it, either copied verbatim, or with + modifications and/or translated into another language. + + A "Secondary Section" is a named appendix or a front-matter section + of the Document that deals exclusively with the relationship of the + publishers or authors of the Document to the Document's overall + subject (or to related matters) and contains nothing that could + fall directly within that overall subject. (Thus, if the Document + is in part a textbook of mathematics, a Secondary Section may not + explain any mathematics.) The relationship could be a matter of + historical connection with the subject or with related matters, or + of legal, commercial, philosophical, ethical or political position + regarding them. + + The "Invariant Sections" are certain Secondary Sections whose + titles are designated, as being those of Invariant Sections, in the + notice that says that the Document is released under this License. + If a section does not fit the above definition of Secondary then it + is not allowed to be designated as Invariant. The Document may + contain zero Invariant Sections. If the Document does not identify + any Invariant Sections then there are none. + + The "Cover Texts" are certain short passages of text that are + listed, as Front-Cover Texts or Back-Cover Texts, in the notice + that says that the Document is released under this License. A + Front-Cover Text may be at most 5 words, and a Back-Cover Text may + be at most 25 words. + + A "Transparent" copy of the Document means a machine-readable copy, + represented in a format whose specification is available to the + general public, that is suitable for revising the document + straightforwardly with generic text editors or (for images composed + of pixels) generic paint programs or (for drawings) some widely + available drawing editor, and that is suitable for input to text + formatters or for automatic translation to a variety of formats + suitable for input to text formatters. A copy made in an otherwise + Transparent file format whose markup, or absence of markup, has + been arranged to thwart or discourage subsequent modification by + readers is not Transparent. An image format is not Transparent if + used for any substantial amount of text. A copy that is not + "Transparent" is called "Opaque". + + Examples of suitable formats for Transparent copies include plain + ASCII without markup, Texinfo input format, LaTeX input format, + SGML or XML using a publicly available DTD, and standard-conforming + simple HTML, PostScript or PDF designed for human modification. + Examples of transparent image formats include PNG, XCF and JPG. + Opaque formats include proprietary formats that can be read and + edited only by proprietary word processors, SGML or XML for which + the DTD and/or processing tools are not generally available, and + the machine-generated HTML, PostScript or PDF produced by some word + processors for output purposes only. + + The "Title Page" means, for a printed book, the title page itself, + plus such following pages as are needed to hold, legibly, the + material this License requires to appear in the title page. For + works in formats which do not have any title page as such, "Title + Page" means the text near the most prominent appearance of the + work's title, preceding the beginning of the body of the text. + + A section "Entitled XYZ" means a named subunit of the Document + whose title either is precisely XYZ or contains XYZ in parentheses + following text that translates XYZ in another language. (Here XYZ + stands for a specific section name mentioned below, such as + "Acknowledgements", "Dedications", "Endorsements", or "History".) + To "Preserve the Title" of such a section when you modify the + Document means that it remains a section "Entitled XYZ" according + to this definition. + + The Document may include Warranty Disclaimers next to the notice + which states that this License applies to the Document. These + Warranty Disclaimers are considered to be included by reference in + this License, but only as regards disclaiming warranties: any other + implication that these Warranty Disclaimers may have is void and + has no effect on the meaning of this License. + + 2. VERBATIM COPYING + + You may copy and distribute the Document in any medium, either + commercially or noncommercially, provided that this License, the + copyright notices, and the license notice saying this License + applies to the Document are reproduced in all copies, and that you + add no other conditions whatsoever to those of this License. You + may not use technical measures to obstruct or control the reading + or further copying of the copies you make or distribute. However, + you may accept compensation in exchange for copies. If you + distribute a large enough number of copies you must also follow the + conditions in section 3. + + You may also lend copies, under the same conditions stated above, + and you may publicly display copies. + + 3. COPYING IN QUANTITY + + If you publish printed copies (or copies in media that commonly + have printed covers) of the Document, numbering more than 100, and + the Document's license notice requires Cover Texts, you must + enclose the copies in covers that carry, clearly and legibly, all + these Cover Texts: Front-Cover Texts on the front cover, and + Back-Cover Texts on the back cover. Both covers must also clearly + and legibly identify you as the publisher of these copies. The + front cover must present the full title with all words of the title + equally prominent and visible. You may add other material on the + covers in addition. Copying with changes limited to the covers, as + long as they preserve the title of the Document and satisfy these + conditions, can be treated as verbatim copying in other respects. + + If the required texts for either cover are too voluminous to fit + legibly, you should put the first ones listed (as many as fit + reasonably) on the actual cover, and continue the rest onto + adjacent pages. + + If you publish or distribute Opaque copies of the Document + numbering more than 100, you must either include a machine-readable + Transparent copy along with each Opaque copy, or state in or with + each Opaque copy a computer-network location from which the general + network-using public has access to download using public-standard + network protocols a complete Transparent copy of the Document, free + of added material. If you use the latter option, you must take + reasonably prudent steps, when you begin distribution of Opaque + copies in quantity, to ensure that this Transparent copy will + remain thus accessible at the stated location until at least one + year after the last time you distribute an Opaque copy (directly or + through your agents or retailers) of that edition to the public. + + It is requested, but not required, that you contact the authors of + the Document well before redistributing any large number of copies, + to give them a chance to provide you with an updated version of the + Document. + + 4. MODIFICATIONS + + You may copy and distribute a Modified Version of the Document + under the conditions of sections 2 and 3 above, provided that you + release the Modified Version under precisely this License, with the + Modified Version filling the role of the Document, thus licensing + distribution and modification of the Modified Version to whoever + possesses a copy of it. In addition, you must do these things in + the Modified Version: + + A. Use in the Title Page (and on the covers, if any) a title + distinct from that of the Document, and from those of previous + versions (which should, if there were any, be listed in the + History section of the Document). You may use the same title + as a previous version if the original publisher of that + version gives permission. + + B. List on the Title Page, as authors, one or more persons or + entities responsible for authorship of the modifications in + the Modified Version, together with at least five of the + principal authors of the Document (all of its principal + authors, if it has fewer than five), unless they release you + from this requirement. + + C. State on the Title page the name of the publisher of the + Modified Version, as the publisher. + + D. Preserve all the copyright notices of the Document. + + E. Add an appropriate copyright notice for your modifications + adjacent to the other copyright notices. + + F. Include, immediately after the copyright notices, a license + notice giving the public permission to use the Modified + Version under the terms of this License, in the form shown in + the Addendum below. + + G. Preserve in that license notice the full lists of Invariant + Sections and required Cover Texts given in the Document's + license notice. + + H. Include an unaltered copy of this License. + + I. Preserve the section Entitled "History", Preserve its Title, + and add to it an item stating at least the title, year, new + authors, and publisher of the Modified Version as given on the + Title Page. If there is no section Entitled "History" in the + Document, create one stating the title, year, authors, and + publisher of the Document as given on its Title Page, then add + an item describing the Modified Version as stated in the + previous sentence. + + J. Preserve the network location, if any, given in the Document + for public access to a Transparent copy of the Document, and + likewise the network locations given in the Document for + previous versions it was based on. These may be placed in the + "History" section. You may omit a network location for a work + that was published at least four years before the Document + itself, or if the original publisher of the version it refers + to gives permission. + + K. For any section Entitled "Acknowledgements" or "Dedications", + Preserve the Title of the section, and preserve in the section + all the substance and tone of each of the contributor + acknowledgements and/or dedications given therein. + + L. Preserve all the Invariant Sections of the Document, unaltered + in their text and in their titles. Section numbers or the + equivalent are not considered part of the section titles. + + M. Delete any section Entitled "Endorsements". Such a section + may not be included in the Modified Version. + + N. Do not retitle any existing section to be Entitled + "Endorsements" or to conflict in title with any Invariant + Section. + + O. Preserve any Warranty Disclaimers. + + If the Modified Version includes new front-matter sections or + appendices that qualify as Secondary Sections and contain no + material copied from the Document, you may at your option designate + some or all of these sections as invariant. To do this, add their + titles to the list of Invariant Sections in the Modified Version's + license notice. These titles must be distinct from any other + section titles. + + You may add a section Entitled "Endorsements", provided it contains + nothing but endorsements of your Modified Version by various + parties--for example, statements of peer review or that the text + has been approved by an organization as the authoritative + definition of a standard. + + You may add a passage of up to five words as a Front-Cover Text, + and a passage of up to 25 words as a Back-Cover Text, to the end of + the list of Cover Texts in the Modified Version. Only one passage + of Front-Cover Text and one of Back-Cover Text may be added by (or + through arrangements made by) any one entity. If the Document + already includes a cover text for the same cover, previously added + by you or by arrangement made by the same entity you are acting on + behalf of, you may not add another; but you may replace the old + one, on explicit permission from the previous publisher that added + the old one. + + The author(s) and publisher(s) of the Document do not by this + License give permission to use their names for publicity for or to + assert or imply endorsement of any Modified Version. + + 5. COMBINING DOCUMENTS + + You may combine the Document with other documents released under + this License, under the terms defined in section 4 above for + modified versions, provided that you include in the combination all + of the Invariant Sections of all of the original documents, + unmodified, and list them all as Invariant Sections of your + combined work in its license notice, and that you preserve all + their Warranty Disclaimers. + + The combined work need only contain one copy of this License, and + multiple identical Invariant Sections may be replaced with a single + copy. If there are multiple Invariant Sections with the same name + but different contents, make the title of each such section unique + by adding at the end of it, in parentheses, the name of the + original author or publisher of that section if known, or else a + unique number. Make the same adjustment to the section titles in + the list of Invariant Sections in the license notice of the + combined work. + + In the combination, you must combine any sections Entitled + "History" in the various original documents, forming one section + Entitled "History"; likewise combine any sections Entitled + "Acknowledgements", and any sections Entitled "Dedications". You + must delete all sections Entitled "Endorsements." + + 6. COLLECTIONS OF DOCUMENTS + + You may make a collection consisting of the Document and other + documents released under this License, and replace the individual + copies of this License in the various documents with a single copy + that is included in the collection, provided that you follow the + rules of this License for verbatim copying of each of the documents + in all other respects. + + You may extract a single document from such a collection, and + distribute it individually under this License, provided you insert + a copy of this License into the extracted document, and follow this + License in all other respects regarding verbatim copying of that + document. + + 7. AGGREGATION WITH INDEPENDENT WORKS + + A compilation of the Document or its derivatives with other + separate and independent documents or works, in or on a volume of a + storage or distribution medium, is called an "aggregate" if the + copyright resulting from the compilation is not used to limit the + legal rights of the compilation's users beyond what the individual + works permit. When the Document is included in an aggregate, this + License does not apply to the other works in the aggregate which + are not themselves derivative works of the Document. + + If the Cover Text requirement of section 3 is applicable to these + copies of the Document, then if the Document is less than one half + of the entire aggregate, the Document's Cover Texts may be placed + on covers that bracket the Document within the aggregate, or the + electronic equivalent of covers if the Document is in electronic + form. Otherwise they must appear on printed covers that bracket + the whole aggregate. + + 8. TRANSLATION + + Translation is considered a kind of modification, so you may + distribute translations of the Document under the terms of section + 4. Replacing Invariant Sections with translations requires special + permission from their copyright holders, but you may include + translations of some or all Invariant Sections in addition to the + original versions of these Invariant Sections. You may include a + translation of this License, and all the license notices in the + Document, and any Warranty Disclaimers, provided that you also + include the original English version of this License and the + original versions of those notices and disclaimers. In case of a + disagreement between the translation and the original version of + this License or a notice or disclaimer, the original version will + prevail. + + If a section in the Document is Entitled "Acknowledgements", + "Dedications", or "History", the requirement (section 4) to + Preserve its Title (section 1) will typically require changing the + actual title. + + 9. TERMINATION + + You may not copy, modify, sublicense, or distribute the Document + except as expressly provided for under this License. Any other + attempt to copy, modify, sublicense or distribute the Document is + void, and will automatically terminate your rights under this + License. However, parties who have received copies, or rights, + from you under this License will not have their licenses terminated + so long as such parties remain in full compliance. + + 10. FUTURE REVISIONS OF THIS LICENSE + + The Free Software Foundation may publish new, revised versions of + the GNU Free Documentation License from time to time. Such new + versions will be similar in spirit to the present version, but may + differ in detail to address new problems or concerns. See + . + + Each version of the License is given a distinguishing version + number. If the Document specifies that a particular numbered + version of this License "or any later version" applies to it, you + have the option of following the terms and conditions either of + that specified version or of any later version that has been + published (not as a draft) by the Free Software Foundation. If the + Document does not specify a version number of this License, you may + choose any version ever published (not as a draft) by the Free + Software Foundation. + +ADDENDUM: How to use this License for your documents +==================================================== + +To use this License in a document you have written, include a copy of +the License in the document and put the following copyright and license +notices just after the title page: + + Copyright (C) YEAR YOUR NAME. + Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.2 + or any later version published by the Free Software Foundation; + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover + Texts. A copy of the license is included in the section entitled ``GNU + Free Documentation License''. + + If you have Invariant Sections, Front-Cover Texts and Back-Cover +Texts, replace the "with...Texts." line with this: + + with the Invariant Sections being LIST THEIR TITLES, with + the Front-Cover Texts being LIST, and with the Back-Cover Texts + being LIST. + + If you have Invariant Sections without Cover Texts, or some other +combination of the three, merge those two alternatives to suit the +situation. + + If your document contains nontrivial examples of program code, we +recommend releasing these examples in parallel under your choice of free +software license, such as the GNU General Public License, to permit +their use in free software. + + + +Tag Table: +Node: Top652 +Node: About Identica mode and obtaining it1020 +Node: About identica-mode.el and this manual1305 +Node: Getting a copy1996 +Node: Installation and configuration2855 +Node: Installing identica-mode.el3143 +Node: Configuring GNU Emacs3960 +Node: identica-mode requirements4208 +Node: Configuring .emacs4960 +Node: Using identica-mode.el6550 +Node: Basic usage6788 +Node: Introduction7115 +Node: Startup7883 +Node: Icons8244 +Node: Replies timeline8489 +Node: Public timeline8698 +Node: Personal timeline8915 +Node: Update status9136 +Node: Send notice9521 +Node: Shorten url9885 +Node: Tips and tricks10185 +Node: Run commands after recieving notices10406 +Node: Extending identica-mode11273 +Node: Credits and contributing11865 +Node: Credits12100 +Node: Contributing12526 +Node: GNU Free Documentation License12948 + +End Tag Table diff --git a/elpa/ng2-mode-20160910.820/ng2-html.el b/elpa/ng2-mode-20160910.820/ng2-html.el new file mode 100644 index 0000000..e66bab3 --- /dev/null +++ b/elpa/ng2-mode-20160910.820/ng2-html.el @@ -0,0 +1,93 @@ +;;; ng2-html.el --- Major mode for editing Angular 2 templates + +;; Copyright 2016 Adam Niederer + +;; Author: Adam Niederer +;; URL: http://github.com/AdamNiederer/ng2-mode +;; Version: 0.1 +;; Keywords: typescript angular angular2 +;; Package-Requires: () + +;; This program 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 3 of the License, or +;; (at your option) any later version. +;; +;; This program 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 this program. If not, see . + +;;; Commentary + +;; The main features of this mode are syntax highlighting (enabled with +;; `font-lock-mode' or `global-font-lock-mode'), and html-mode +;; integration +;; +;; Exported names start with "ng2-html-"; private names start with +;; "ng2-html--". + +;;; Code: + +(defconst ng2-html-var-regex + "#\\(\\w+\\)") + +(defconst ng2-html-interp-regex + "{{.*?}}") + +(defconst ng2-html-directive-regex + "\*\\(.*?\\)[\"= ]") + +(defconst ng2-html-binding-regex + "\\(\\[.*?\\]\\)=\\(\".*?\"\\)") + +(defconst ng2-html-event-regex + "\\((.*?)\\)=\".*?\"") + +(defconst ng2-html-pipe-regex + "{{.*?\\(|\\) *\\(.*?\\) *}}") + +(defcustom ng2-html-tab-width 2 + "Tab width for ng2-html-mode" + :group 'ng2 + :type 'integer) + +(defun ng2-html-goto-binding () + "Opens the corresponding component TypeScript file, then places the cursor at the function corresponding to the binding" + (interactive) + (let ((fn-name (word-at-point))) + (ng2-open-counterpart) + (ng2-ts-goto-fn fn-name))) + +(defvar ng2-html-font-lock-keywords + `((,ng2-html-var-regex (1 font-lock-variable-name-face)) + (,ng2-html-interp-regex . (0 font-lock-variable-name-face t)) + (,ng2-html-directive-regex . (1 font-lock-keyword-face t)) + (,ng2-html-binding-regex . (1 font-lock-type-face t)) + (,ng2-html-event-regex . (1 font-lock-type-face t)) + (,ng2-html-pipe-regex . (1 font-lock-keyword-face t)) + (,ng2-html-pipe-regex . (2 font-lock-function-name-face t)))) + +(defvar ng2-html-map + (let ((map (make-keymap))) + (define-key map (kbd "C-c b") 'ng2-html-goto-binding) + (define-key map (kbd "C-c c") 'ng2-open-counterpart) + map) + "Keymap for ng2-html-mode") + +;;;###autoload +(define-derived-mode ng2-html-mode + html-mode "ng2-html" + "Major mode for Angular 2 templates" + (use-local-map ng2-html-map) + (setq tab-width ng2-html-tab-width) + (font-lock-add-keywords nil ng2-html-font-lock-keywords)) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.component.html\\'" . ng2-html-mode)) + +(provide 'ng2-html) +;;; ng2-html.el ends here diff --git a/elpa/ng2-mode-20160910.820/ng2-mode-autoloads.el b/elpa/ng2-mode-20160910.820/ng2-mode-autoloads.el new file mode 100644 index 0000000..9b2f7b1 --- /dev/null +++ b/elpa/ng2-mode-20160910.820/ng2-mode-autoloads.el @@ -0,0 +1,54 @@ +;;; ng2-mode-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "ng2-html" "ng2-html.el" (22500 63829 326570 +;;;;;; 417000)) +;;; Generated autoloads from ng2-html.el + +(autoload 'ng2-html-mode "ng2-html" "\ +Major mode for Angular 2 templates + +\(fn)" t nil) + +(add-to-list 'auto-mode-alist '("\\.component.html\\'" . ng2-html-mode)) + +;;;*** + +;;;### (autoloads nil "ng2-mode" "ng2-mode.el" (22500 63829 338570 +;;;;;; 480000)) +;;; Generated autoloads from ng2-mode.el + +(autoload 'ng2-mode "ng2-mode" "\ +Activates the appropriate Angular 2-related mode for the buffer. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "ng2-ts" "ng2-ts.el" (22500 63829 318570 374000)) +;;; Generated autoloads from ng2-ts.el + +(autoload 'ng2-ts-mode "ng2-ts" "\ +Major mode for Angular 2 TypeScript + +\(fn)" t nil) + +(add-to-list 'auto-mode-alist '("\\.component.ts\\'" . ng2-ts-mode)) + +(add-to-list 'auto-mode-alist '("\\.service.ts\\'" . ng2-ts-mode)) + +;;;*** + +;;;### (autoloads nil nil ("ng2-mode-pkg.el") (22500 63829 371106 +;;;;;; 271000)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; ng2-mode-autoloads.el ends here diff --git a/elpa/ng2-mode-20160910.820/ng2-mode-pkg.el b/elpa/ng2-mode-20160910.820/ng2-mode-pkg.el new file mode 100644 index 0000000..4dccc41 --- /dev/null +++ b/elpa/ng2-mode-20160910.820/ng2-mode-pkg.el @@ -0,0 +1,7 @@ +(define-package "ng2-mode" "20160910.820" "Major modes for editing Angular 2" + '((typescript-mode "0.1")) + :url "http://github.com/AdamNiederer/ng2-mode" :keywords + '("typescript" "angular" "angular2" "template")) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/ng2-mode-20160910.820/ng2-mode.el b/elpa/ng2-mode-20160910.820/ng2-mode.el new file mode 100644 index 0000000..9aa48c1 --- /dev/null +++ b/elpa/ng2-mode-20160910.820/ng2-mode.el @@ -0,0 +1,80 @@ +;;; ng2-mode.el --- Major modes for editing Angular 2 + +;; Copyright 2016 Adam Niederer + +;; Author: Adam Niederer +;; URL: http://github.com/AdamNiederer/ng2-mode +;; Version: 0.1 +;; Keywords: typescript angular angular2 template +;; Package-Requires: ((typescript-mode "0.1")) + +;; This program 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 3 of the License, or +;; (at your option) any later version. +;; +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; The main features of the modes are syntax highlighting (enabled with +;; `font-lock-mode' or `global-font-lock-mode'), and easy switching +;; between templates and components. +;; +;; Exported names start with "ng2-"; private names start with +;; "ng2--". + +;;; Code: + +(require 'typescript-mode) +(require 'ng2-ts) +(require 'ng2-html) + +(defgroup ng2 nil + "Major mode for AngularJS 2 files" + :prefix "ng2-" + :group 'languages + :link '(url-link :tag "Github" "https://github.com/AdamNiederer/ng2-mode") + :link '(emacs-commentary-link :tag "Commentary" "ng2-mode")) + +(defun ng2--counterpart-name (name) + "Return the file name of this file's counterpart. If a file has no counterpart, returns the name of the file. Ex. kek.component.html <-> kek.component.ts" + (when (not (ng2--is-component name)) name) + (let ((ext (file-name-extension name)) + (base (file-name-sans-extension name))) + (if (equal ext "ts") + (concat base ".html") + (concat base ".ts")))) + +(defun ng2--sans-type (name) + "Return the file name, minus its extension an type. Ex. kek.component.ts -> kek" + (file-name-sans-extension (file-name-sans-extension name))) + +(defun ng2--is-component (name) + (equal (file-name-extension (file-name-sans-extension name)) "component")) + +(defun ng2-open-counterpart () + "Opens the counterpart file to this one. If it's a component, open the corresponding template, and vice versa" + (interactive) + (find-file (ng2--counterpart-name (buffer-file-name)))) + +;;;###autoload +(defun ng2-mode () + "Activates the appropriate Angular 2-related mode for the buffer." + (interactive) + (if (equal buffer-file-name nil) + (message "This doesn't appear to be an Angular2 component or service.") + (let ((file-ext (file-name-extension (buffer-file-name)))) + (cond + ((equal file-ext "html") (ng2-html-mode)) + ((equal file-ext "ts") (ng2-ts-mode)) + (t (message "This doesn't appear to be an Angular2 component or service.")))))) + +(provide 'ng2-mode) +;;; ng2-mode.el ends here diff --git a/elpa/ng2-mode-20160910.820/ng2-ts.el b/elpa/ng2-mode-20160910.820/ng2-ts.el new file mode 100644 index 0000000..74597b0 --- /dev/null +++ b/elpa/ng2-mode-20160910.820/ng2-ts.el @@ -0,0 +1,99 @@ +;;; ng2-ts.el --- Major mode for editing Angular 2 TypeScript + +;; Copyright 2016 Adam Niederer + +;; Author: Adam Niederer +;; URL: http://github.com/AdamNiederer/ng2-mode +;; Version: 0.1 +;; Keywords: typescript angular angular2 +;; Package-Requires: ((typescript-mode "0.1")) + +;; This program 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 3 of the License, or +;; (at your option) any later version. +;; +;; This program 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 this program. If not, see . + +;;; Commentary + +;; The main features of this mode are syntax highlighting (enabled with +;; `font-lock-mode' or `global-font-lock-mode'), and typescript-mode +;; integration +;; +;; Exported names start with "ng2-ts-"; private names start with +;; "ng2-ts--". + +;;; Code: + +(defconst ng2-ts-decorator-keywords + '("@Component" + "@Directive" + "@Pipe" + "@NgModule")) + +(defconst ng2-ts-interp-regex + "${.*?}") + +(defconst ng2-ts-var-regex + "[^?/.] \\(\\w+\\) *[=:]") + +(defconst ng2-ts-fn-regex + "\\(\\w+\\)\(.*\).*{") + +(defconst ng2-ts-class-regex + "class \\(\\w+\\)") + +(defconst ng2-ts-lambda-regex + "\\(\\w+\\) *\\(=>\\)") + +(defconst ng2-ts-generic-regex + "<\\(\\w+\\)\\(\\[\\]\\)?>") + +(defcustom ng2-ts-tab-width 2 + "Tab width for ng2-ts-mode" + :group 'ng2 + :type 'integer) + +(defun ng2-ts-goto-fn (fn-name) + "Places the point on the function called fn-name" + (beginning-of-buffer) + (search-forward-regexp (format "\\(\\%s\\)\(.*\).*{" fn-name))) + +(defvar ng2-ts-map + (let ((map (make-keymap))) + (define-key map (kbd "C-c c") 'ng2-open-counterpart) + map) + "Keymap for ng2-ts-mode") + +(defvar ng2-ts-font-lock-keywords + `((,ng2-ts-interp-regex . (0 font-lock-constant-face t)) + (,ng2-ts-var-regex (1 font-lock-variable-name-face)) + (,ng2-ts-class-regex (1 font-lock-type-face)) + (,ng2-ts-fn-regex (1 font-lock-function-name-face)) + (,ng2-ts-generic-regex (1 font-lock-type-face)) + (,ng2-ts-lambda-regex (1 font-lock-variable-name-face)) + (,ng2-ts-lambda-regex (2 font-lock-function-name-face)) + (,(regexp-opt ng2-ts-decorator-keywords) . font-lock-builtin-face))) + +;;;###autoload +(define-derived-mode ng2-ts-mode + typescript-mode "ng2-ts" + "Major mode for Angular 2 TypeScript" + (use-local-map ng2-ts-map) + (setq tab-width ng2-ts-tab-width) + (font-lock-add-keywords nil ng2-ts-font-lock-keywords)) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.component.ts\\'" . ng2-ts-mode)) +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.service.ts\\'" . ng2-ts-mode)) + +(provide 'ng2-ts) +;;; ng2-ts.el ends here