gergely/my-emacs-d
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Install some packages

Browse Source
This commit is contained in:
Gergely Polonkai 2016-10-17 23:42:31 +02:00
parent d07a7938ad
commit d3a2edb4d4
88 changed files with 54969 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
elpa/alert-20160824.821/alert-autoloads.el Normal file
View File

@ -0,0 +1,92 @@
;;; alert-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "alert" "alert.el" (22533 17539 221493 451000))
;;; Generated autoloads from alert.el
(autoload 'alert-add-rule "alert" "\
Programmatically add an alert configuration rule.
Normally, users should custoimze `alert-user-configuration'.
This facility is for module writers and users that need to do
things the Lisp way.
Here is a rule the author currently uses with ERC, so that the
fringe gets colored whenever people chat on BitlBee:
\(alert-add-rule :status \\='(buried visible idle)
:severity \\='(moderate high urgent)
:mode \\='erc-mode
:predicate
#\\='(lambda (info)
(string-match (concat \"\\\\`[^&].*@BitlBee\\\\\\='\")
(erc-format-target-and/or-network)))
:persistent
#\\='(lambda (info)
;; If the buffer is buried, or the user has been
;; idle for `alert-reveal-idle-time' seconds,
;; make this alert persistent. Normally, alerts
;; become persistent after
;; `alert-persist-idle-time' seconds.
(memq (plist-get info :status) \\='(buried idle)))
:style \\='fringe
:continue t)
\(fn &key SEVERITY STATUS MODE CATEGORY TITLE MESSAGE PREDICATE ICON (style alert-default-style) PERSISTENT CONTINUE NEVER-PERSIST APPEND)" nil nil)
(autoload 'alert "alert" "\
Alert the user that something has happened.
MESSAGE is what the user will see. You may also use keyword
arguments to specify additional details. Here is a full example:
\(alert \"This is a message\"
:severity \\='high ;; The default severity is `normal'
:title \"Title\" ;; An optional title
:category \\='example ;; A symbol to identify the message
:mode \\='text-mode ;; Normally determined automatically
:buffer (current-buffer) ;; This is the default
:data nil ;; Unused by alert.el itself
:persistent nil ;; Force the alert to be persistent;
;; it is best not to use this
:never-persist nil ;; Force this alert to never persist
:style \\='fringe) ;; Force a given style to be used;
;; this is only for debugging!
If no :title is given, the buffer-name of :buffer is used. If
:buffer is nil, it is the current buffer at the point of call.
:data is an opaque value which modules can pass through to their
own styles if they wish.
Here are some more typical examples of usage:
;; This is the most basic form usage
(alert \"This is an alert\")
;; You can adjust the severity for more important messages
(alert \"This is an alert\" :severity \\='high)
;; Or decrease it for purely informative ones
(alert \"This is an alert\" :severity \\='trivial)
;; Alerts can have optional titles. Otherwise, the title is the
;; buffer-name of the (current-buffer) where the alert originated.
(alert \"This is an alert\" :title \"My Alert\")
;; Further, alerts can have categories. This allows users to
;; selectively filter on them.
(alert \"This is an alert\" :title \"My Alert\"
:category \\='some-category-or-other)
\(fn MESSAGE &key (severity (quote normal)) TITLE ICON CATEGORY BUFFER MODE DATA STYLE PERSISTENT NEVER-PERSIST)" nil nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; alert-autoloads.el ends here

2
elpa/alert-20160824.821/alert-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "alert" "20160824.821" "Growl-style notification system for Emacs" '((gntp "0.1") (log4e "0.3.0")) :url "https://github.com/jwiegley/alert" :keywords '("notification" "emacs" "message"))

1045
elpa/alert-20160824.821/alert.el Normal file
View File

File diff suppressed because it is too large Load Diff

225
elpa/circe-20160608.1315/circe-autoloads.el Normal file
View File

@ -0,0 +1,225 @@
;;; circe-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "circe" "circe.el" (22533 17540 927532 375000))
;;; Generated autoloads from circe.el
(autoload 'circe-version "circe" "\
Display Circe's version.
\(fn)" t nil)
(autoload 'circe "circe" "\
Connect to IRC.
Connect to the given network specified by NETWORK-OR-SERVER.
When this function is called, it collects options from the
SERVER-OPTIONS argument, the user variable
`circe-network-options', and the defaults found in
`circe-network-defaults', in this order.
If NETWORK-OR-SERVER is not found in any of these variables, the
argument is assumed to be the host name for the server, and all
relevant settings must be passed via SERVER-OPTIONS.
All SERVER-OPTIONS are treated as variables by getting the string
\"circe-\" prepended to their name. This variable is then set
locally in the server buffer.
See `circe-network-options' for a list of common options.
\(fn NETWORK-OR-SERVER &rest SERVER-OPTIONS)" t nil)
;;;***
;;;### (autoloads nil "circe-color-nicks" "circe-color-nicks.el"
;;;;;; (22533 17540 792529 295000))
;;; Generated autoloads from circe-color-nicks.el
(autoload 'enable-circe-color-nicks "circe-color-nicks" "\
Enable the Color Nicks module for Circe.
This module colors all encountered nicks in a cross-server fashion.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "circe-highlight-all-nicks" "circe-highlight-all-nicks.el"
;;;;;; (22533 17541 95536 208000))
;;; Generated autoloads from circe-highlight-all-nicks.el
(autoload 'enable-circe-highlight-all-nicks "circe-highlight-all-nicks" "\
Enable the Highlight Nicks module for Circe.
This module highlights all occurances of nicks in the current
channel in messages of other people.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "circe-lagmon" "circe-lagmon.el" (22533 17540
;;;;;; 882531 348000))
;;; Generated autoloads from circe-lagmon.el
(defvar circe-lagmon-mode nil "\
Non-nil if Circe-Lagmon mode is enabled.
See the `circe-lagmon-mode' command
for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `circe-lagmon-mode'.")
(custom-autoload 'circe-lagmon-mode "circe-lagmon" nil)
(autoload 'circe-lagmon-mode "circe-lagmon" "\
Circe-lagmon-mode monitors the amount of lag on your
connection to each server, and displays the lag time in seconds
in the mode-line.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil "circe-new-day-notifier" "circe-new-day-notifier.el"
;;;;;; (22533 17541 242539 562000))
;;; Generated autoloads from circe-new-day-notifier.el
(autoload 'enable-circe-new-day-notifier "circe-new-day-notifier" "\
\(fn)" t nil)
(autoload 'disable-circe-new-day-notifier "circe-new-day-notifier" "\
\(fn)" t nil)
;;;***
;;;### (autoloads nil "lui-autopaste" "lui-autopaste.el" (22533 17541
;;;;;; 5534 154000))
;;; Generated autoloads from lui-autopaste.el
(autoload 'enable-lui-autopaste "lui-autopaste" "\
Enable the lui autopaste feature.
If you enter more than `lui-autopaste-lines' at once, Lui will
ask if you would prefer to use a paste service instead. If you
agree, Lui will paste your input to `lui-autopaste-function' and
replace it with the resulting URL.
\(fn)" t nil)
(autoload 'disable-lui-autopaste "lui-autopaste" "\
Disable the lui autopaste feature.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "lui-irc-colors" "lui-irc-colors.el" (22533
;;;;;; 17541 310541 113000))
;;; Generated autoloads from lui-irc-colors.el
(autoload 'enable-lui-irc-colors "lui-irc-colors" "\
Enable IRC color interpretation for Lui.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "lui-track-bar" "lui-track-bar.el" (22533 17540
;;;;;; 837530 321000))
;;; Generated autoloads from lui-track-bar.el
(autoload 'enable-lui-track-bar "lui-track-bar" "\
Enable a bar in Lui buffers that shows where you stopped reading.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "shorten" "shorten.el" (22533 17541 129536
;;;;;; 984000))
;;; Generated autoloads from shorten.el
(autoload 'shorten-strings "shorten" "\
Takes a list of strings and returns an alist ((STRING
. SHORTENED-STRING) ...). Uses `shorten-split-function' to split
the strings, and `shorten-join-function' to join shortened
components back together into SHORTENED-STRING. See also
`shorten-validate-component-function'.
\(fn STRINGS)" nil nil)
;;;***
;;;### (autoloads nil "tracking" "tracking.el" (22533 17540 713527
;;;;;; 492000))
;;; Generated autoloads from tracking.el
(defvar tracking-mode nil "\
Non-nil if Tracking mode is enabled.
See the `tracking-mode' command
for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `tracking-mode'.")
(custom-autoload 'tracking-mode "tracking" nil)
(autoload 'tracking-mode "tracking" "\
Allow cycling through modified buffers.
This mode in itself does not track buffer modification, but
provides an API for programs to add buffers as modified (using
`tracking-add-buffer').
Once this mode is active, modified buffers are shown in the mode
line. The user can cycle through them using
\\[tracking-next-buffer].
\(fn &optional ARG)" t nil)
(autoload 'tracking-add-buffer "tracking" "\
Add BUFFER as being modified with FACES.
This does check whether BUFFER is currently visible.
If FACES is given, it lists the faces that might be appropriate
for BUFFER in the mode line. The highest-priority face of these
and the current face of the buffer, if any, is used. Priority is
decided according to `tracking-faces-priorities'.
\(fn BUFFER &optional FACES)" nil nil)
(autoload 'tracking-remove-buffer "tracking" "\
Remove BUFFER from being tracked.
\(fn BUFFER)" nil nil)
(autoload 'tracking-next-buffer "tracking" "\
Switch to the next active buffer.
\(fn)" t nil)
(autoload 'tracking-previous-buffer "tracking" "\
Switch to the last active buffer.
\(fn)" t nil)
;;;***
;;;### (autoloads nil nil ("circe-chanop.el" "circe-compat.el" "circe-pkg.el"
;;;;;; "irc.el" "lcs.el" "lui-format.el" "lui-logging.el" "lui.el"
;;;;;; "make-tls-process.el") (22533 17541 344541 889000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; circe-autoloads.el ends here

97
elpa/circe-20160608.1315/circe-chanop.el Normal file
View File

@ -0,0 +1,97 @@
;;; circe-chanop.el --- Provide common channel operator commands
;; Copyright (C) 2006, 2015 Jorgen Schaefer
;; Author: Jorgen Schaefer <forcer@forcix.cx>
;; This file is part of Circe.
;; 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, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Commentary:
;; This Circe module provides some often-used chanop commands. I was
;; very reluctant to add this. None of these commands will make it in
;; the core, or even be provided by default. You should have to go to
;; great lengths to use them.
;; Always remember the Tao of IRC:
;;
;; IGNORE is the weapon of an IRC knight. Not as clumsy or as
;; random as a kickban.
;;; Code:
(require 'circe)
(defun circe-command-MODE (mode)
"Set MODE in the current channel."
(interactive "sMode change: ")
(cond
((not (string-match "^[+-]" mode))
(irc-send-raw (circe-server-process)
(format "MODE %s" mode)))
((eq major-mode 'circe-channel-mode)
(irc-send-raw (circe-server-process)
(format "MODE %s %s" circe-chat-target mode)))
(t
(circe-display-server-message "Not in a channel buffer."))))
(defun circe-command-BANS (&optional ignored)
"Show channel bans"
(if (not circe-chat-target)
(circe-display-server-message "No target for current buffer")
(irc-send-raw (circe-server-process)
(format "MODE %s +b" circe-chat-target))))
(defun circe-command-KICK (nick &optional reason)
"Kick WHO from the current channel with optional REASON."
(interactive "sKick who: \nsWhy: ")
(if (not (eq major-mode 'circe-channel-mode))
(circe-display-server-message "Not in a channel buffer.")
(when (not reason)
(if (string-match "^\\([^ ]*\\) +\\(.+\\)" nick)
(setq reason (match-string 2 nick)
nick (match-string 1 nick))
(setq reason "-")))
(irc-send-raw (circe-server-process)
(format "KICK %s %s :%s"
circe-chat-target nick reason))))
(defun circe-command-GETOP (&optional ignored)
"Ask chanserv for op on the current channel."
(interactive)
(if (not (eq major-mode 'circe-channel-mode))
(circe-display-server-message "Not in a channel buffer.")
(irc-send-PRIVMSG (circe-server-process)
"chanserv"
(format "op %s" circe-chat-target))))
(defun circe-command-DROPOP (&optional ignored)
"Lose op mode on the current channel."
(interactive)
(if (not (eq major-mode 'circe-channel-mode))
(circe-display-server-message "Not in a channel buffer.")
(irc-send-raw (circe-server-process)
(format "MODE %s -o %s"
circe-chat-target
(circe-nick)))))
;; For KICKBAN (requested by Riastradh), we'd need a callback on a
;; USERHOST command.
(provide 'circe-chanop)
;;; circe-chanop.el ends here

345
elpa/circe-20160608.1315/circe-color-nicks.el Normal file
View File

@ -0,0 +1,345 @@
;;; circe-color-nicks.el --- Color nicks in the channel
;; Copyright (C) 2012 Taylan Ulrich Bayırlı/Kammer
;; Author: Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;; This file is part of Circe.
;; 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, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Commentary:
;; This Circe module adds the ability to assign a color to each
;; nick in a channel.
;; Some ideas/code copied from rcirc-colors.el.
;; To use it, put the following into your .emacs:
;; (require 'circe-color-nicks)
;; (enable-circe-color-nicks)
;;; Code:
(require 'circe)
(require 'color)
(require 'cl-lib)
;;;###autoload
(defun enable-circe-color-nicks ()
"Enable the Color Nicks module for Circe.
This module colors all encountered nicks in a cross-server fashion."
(interactive)
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (eq major-mode 'circe-channel-mode)
(add-circe-color-nicks))))
(add-hook 'circe-channel-mode-hook
'add-circe-color-nicks))
(defun disable-circe-color-nicks ()
"Disable the Color Nicks module for Circe.
See `enable-circe-color-nicks'."
(interactive)
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (eq major-mode 'circe-channel-mode)
(remove-circe-color-nicks))))
(remove-hook 'circe-channel-mode-hook
'add-circe-color-nicks))
(defun add-circe-color-nicks ()
"Add `circe-color-nicks' to `lui-pre-output-hook'."
(add-hook 'lui-pre-output-hook 'circe-color-nicks))
(defun remove-circe-color-nicks ()
"Remove `circe-color-nicks' from `lui-pre-output-hook'."
(remove-hook 'lui-pre-output-hook 'circe-color-nicks))
(defgroup circe-color-nicks nil
"Nicks colorization for Circe"
:prefix "circe-color-nicks-"
:group 'circe)
(defcustom circe-color-nicks-min-contrast-ratio 7
"Minimum contrast ratio from background for generated colors;
recommended is 7:1, or at least 4.5:1 (7 stands for 7:1 here).
Lower value allows higher color spread, but could lead to less
readability."
:group 'circe-color-nicks)
(defcustom circe-color-nicks-min-difference 17
"Minimum difference from each other for generated colors."
:group 'circe-color-nicks)
(defcustom circe-color-nicks-min-fg-difference 17
"Minimum difference from foreground for generated colors."
:group 'circe-color-nicks)
(defcustom circe-color-nicks-min-my-message-difference 0
"Minimum difference from own nick color for generated colors."
:group 'circe-color-nicks)
(defcustom circe-color-nicks-everywhere nil
"Whether nicks should be colored in message bodies too."
:type 'boolean
:group 'circe-color-nicks)
(defcustom circe-color-nicks-message-blacklist nil
"Blacklist for nicks that shall never be highlighted inside
images."
:type '(repeat string)
:group 'circe-color-nicks)
(defcustom circe-color-nicks-pool-type 'adaptive
"Type of the color nick pool.
Must be one of the following:
'adaptive: Generate colors based on the current theme.
List of strings: Pick colors from the specified list of hex codes
or color names (see `color-name-rgb-alist')."
:type '(choice (const :tag "Adaptive" adaptive)
(repeat string))
:group 'circe-color-nicks)
;;; See http://www.w3.org/TR/2013/NOTE-WCAG20-TECHS-20130905/G18
(defsubst circe-w3-contrast-c-to-l (c)
(if (<= c 0.03928)
(/ c 12.92)
(expt (/ (+ c 0.055) 1.055) 2.4)))
(defsubst circe-w3-contrast-relative-luminance (rgb)
(apply #'+
(cl-mapcar (lambda (color coefficient)
(* coefficient
(circe-w3-contrast-c-to-l color)))
rgb
'(0.2126 0.7152 0.0722))))
(defsubst circe-w3-contrast-contrast-ratio (color1 color2)
(let ((l1 (+ 0.05 (circe-w3-contrast-relative-luminance color1)))
(l2 (+ 0.05 (circe-w3-contrast-relative-luminance color2))))
(if (> l1 l2)
(/ l1 l2)
(/ l2 l1))))
(defun circe-color-alist ()
"Return list of colors (name rgb lab) where rgb is 0 to 1."
(let ((alist (if (display-graphic-p)
color-name-rgb-alist
(mapcar (lambda (c)
(cons (car c) (cddr c)))
(tty-color-alist))))
(valmax (float (car (color-values "#ffffff")))))
(mapcar (lambda (c)
(let* ((name (car c))
(rgb (mapcar (lambda (v)
(/ v valmax))
(cdr c)))
(lab (apply #'color-srgb-to-lab rgb)))
(list name rgb lab)))
alist)))
(defun circe-color-canonicalize-format (color)
"Turns COLOR into (name rgb lab) format. Avoid calling this in
a loop, it's very slow on a tty!"
(let* ((name color)
(rgb (circe-color-name-to-rgb color))
(lab (apply #'color-srgb-to-lab rgb)))
(list name rgb lab)))
(defun circe-color-contrast-ratio (color1 color2)
"Gives the contrast ratio between two colors."
(circe-w3-contrast-contrast-ratio (nth 1 color1) (nth 1 color2)))
(defun circe-color-diff (color1 color2)
"Gives the difference between two colors per CIEDE2000."
(color-cie-de2000 (nth 2 color1) (nth 2 color2)))
(defun circe-color-name-to-rgb (color)
"Like `color-name-to-rgb' but also handles \"unspecified-bg\"
and \"unspecified-fg\"."
(cond ((equal color "unspecified-bg") '(0 0 0))
((equal color "unspecified-fg") '(1 1 1))
(t (color-name-to-rgb color))))
(defun circe-nick-color-appropriate-p (color bg fg my-msg)
"Tells whether COLOR is appropriate for being a nick color.
BG, FG, and MY-MSG are the background, foreground, and my-message
colors; these are expected as parameters instead of computed here
because computing them repeatedly is a heavy operation."
(and (>= (circe-color-contrast-ratio color bg)
circe-color-nicks-min-contrast-ratio)
(>= (circe-color-diff color fg)
circe-color-nicks-min-fg-difference)
(>= (circe-color-diff color my-msg)
circe-color-nicks-min-my-message-difference)))
(defun circe-nick-colors-delete-similar (colors)
"Return list COLORS with pairs of colors filtered out that are
too similar per `circe-color-nicks-min-difference'. COLORS may
be mutated."
(cl-mapl (lambda (rest)
(let ((color (car rest)))
(setcdr rest (cl-delete-if
(lambda (c)
(< (circe-color-diff color c)
circe-color-nicks-min-difference))
(cdr rest)))))
colors)
colors)
(defun circe-nick-color-generate-pool ()
"Return a list of appropriate nick colors."
(if (consp circe-color-nicks-pool-type)
circe-color-nicks-pool-type
(let ((bg (circe-color-canonicalize-format (face-background 'default)))
(fg (circe-color-canonicalize-format (face-foreground 'default)))
(my-msg (circe-color-canonicalize-format
(face-attribute
'circe-my-message-face :foreground nil 'default))))
(mapcar #'car (circe-nick-colors-delete-similar
(cl-remove-if-not
(lambda (c)
(circe-nick-color-appropriate-p c bg fg my-msg))
(circe-color-alist)))))))
(defun circe-nick-color-pool-test ()
"Display all appropriate nick colors in a temp buffer."
(interactive)
(switch-to-buffer (get-buffer-create "*Circe color test*"))
(erase-buffer)
(let ((pool (circe-nick-color-generate-pool)))
(while pool
(let ((pt (point)))
(insert "The quick brown fox jumped over the lazy dog.\n")
(put-text-property pt (point) 'face `(:foreground ,(pop pool)))))))
(defvar circe-nick-color-pool nil
"Pool of yet unused nick colors.")
(defvar circe-nick-color-mapping (make-hash-table :test 'equal)
"Hash-table from nicks to colors.")
(defun circe-nick-color-nick-list ()
"Return list of all nicks that have a color assigned to them.
Own and blacklisted nicks are excluded."
(let ((our-nick (circe-nick))
(channel-nicks (circe-channel-nicks))
nicks)
(maphash
(lambda (nick color)
(when (and (member nick channel-nicks)
(not (string= our-nick nick))
(not (member nick circe-color-nicks-message-blacklist)))
(push nick nicks)))
circe-nick-color-mapping)
nicks))
(defvar circe-nick-color-timestamps (make-hash-table :test 'equal)
"Hash-table from colors to the timestamp of their last use.")
(defun circe-nick-color-for-nick (nick)
"Return the color for NICK. Assigns a color to NICK if one
wasn't assigned already."
(let ((color (gethash nick circe-nick-color-mapping)))
(when (not color)
;; NOTE use this as entry point for taking NICK into account for
;; picking the new color
(setq color (circe-nick-color-pick))
(puthash nick color circe-nick-color-mapping))
(puthash color (float-time) circe-nick-color-timestamps)
color))
(defun circe-nick-color-pick ()
"Picks either a color from the pool of unused colors, or the
color that was used least recently (i.e. nicks that have it
assigned have been least recently active)."
(if (zerop (hash-table-count circe-nick-color-mapping))
(setq circe-nick-color-pool (circe-nick-color-generate-pool)))
(or (pop circe-nick-color-pool)
(circe-nick-color-pick-least-recent)))
(defun circe-nick-color-pick-least-recent ()
"Pick the color that was used least recently.
See `circe-nick-color-pick', which is where this is used."
(let ((least-recent-color nil)
(oldest-time (float-time)))
(maphash
(lambda (color time)
(if (< time oldest-time)
(progn
(setq least-recent-color color)
(setq oldest-time time))))
circe-nick-color-timestamps)
(if least-recent-color
least-recent-color
;; Someone must have messed with `circe-nick-color-mapping', recover by
;; re-filling the pool.
(setq circe-nick-color-pool (circe-nick-color-generate-pool))
(pop circe-nick-color-pool))))
(defun circe-color-nicks ()
"Color nicks on this lui output line."
(when (eq major-mode 'circe-channel-mode)
(let ((nickstart (text-property-any (point-min) (point-max)
'lui-format-argument 'nick)))
(when nickstart
(goto-char nickstart)
(let ((nickend (next-single-property-change nickstart
'lui-format-argument))
(nick (plist-get (plist-get (text-properties-at nickstart)
'lui-keywords)
:nick)))
(when (not (circe-server-my-nick-p nick))
(let ((color (circe-nick-color-for-nick nick)))
(add-face-text-property nickstart nickend
`(:foreground ,color)))))))
(when circe-color-nicks-everywhere
(let ((body (text-property-any (point-min) (point-max)
'lui-format-argument 'body)))
(when body
(with-syntax-table circe-nick-syntax-table
(goto-char body)
(let* ((nicks (circe-nick-color-nick-list))
(regex (regexp-opt nicks 'words)))
(let (case-fold-search)
(while (re-search-forward regex nil t)
(let* ((nick (match-string-no-properties 0))
(color (circe-nick-color-for-nick nick)))
(add-face-text-property (match-beginning 0) (match-end 0)
`(:foreground ,color))))))))))))
(defun circe-nick-color-reset ()
"Reset the nick color mapping (and some internal data).
This is useful if you switched between frames supporting
different color ranges and would like nicks to get new colors
appropriate to the new color range."
(interactive)
(setq circe-nick-color-pool (circe-nick-color-generate-pool))
(setq circe-nick-color-mapping (make-hash-table :test 'equal))
(setq circe-nick-color-timestamps (make-hash-table :test 'equal)))
(provide 'circe-color-nicks)
;;; circe-color-nicks.el ends here

53
elpa/circe-20160608.1315/circe-compat.el Normal file
View File

@ -0,0 +1,53 @@
;;; circe-compat.el --- Compatibility definitions
;; Copyright (C) 2015 Jorgen Schaefer <contact@jorgenschaefer.de>
;; Author: Jorgen Schaefer <contact@jorgenschaefer.de>
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Define functions and variables as needed by Circe to remain
;; compatible with older Emacsen.
;;; Code:
(when (not (fboundp 'string-trim))
(defun string-trim (string)
"Remove leading and trailing whitespace from STRING."
(if (string-match "\\` *\\(.*[^[:space:]]\\) *\\'" string)
(match-string 1 string)
string)))
(when (not (fboundp 'add-face-text-property))
(defun add-face-text-property (start end face &optional append object)
(while (/= start end)
(let* ((next (next-single-property-change start 'face object end))
(prev (get-text-property start 'face object))
(value (if (listp prev) prev (list prev))))
(put-text-property start next 'face
(if append
(append value (list face))
(append (list face) value))
object)
(setq start next)))))
(when (not (boundp 'mode-line-misc-info))
(defvar mode-line-misc-info nil
"Misc info in the mode line.")
(add-to-list 'mode-line-format 'mode-line-misc-info t))
(provide 'circe-compat)
;;; circe-compat.el ends here

100
elpa/circe-20160608.1315/circe-highlight-all-nicks.el Normal file
View File

@ -0,0 +1,100 @@
;;; circe-highlight-all-nicks.el --- Highlight all nicks in the current channel
;; Copyright (C) 2005 Jorgen Schaefer
;; Author: Jorgen Schaefer <forcer@forcix.cx>
;; This file is part of Circe.
;; 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, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Commentary:
;; This Circe module adds the ability to highlight every occurance of
;; a nick in the current channel in a message by other people.
;; To use it, put the following into your .emacs:
;; (require 'circe-highlight-all-nicks)
;; (enable-circe-highlight-all-nicks)
;;; Code:
(require 'circe)
(defface circe-highlight-all-nicks-face
'((t (:foreground "green")))
"The face used for nicks from the current channel.
See `enable-circe-highlight-all-nicks'."
:group 'circe)
;;;###autoload
(defun enable-circe-highlight-all-nicks ()
"Enable the Highlight Nicks module for Circe.
This module highlights all occurances of nicks in the current
channel in messages of other people."
(interactive)
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (eq major-mode 'circe-channel-mode)
(add-circe-highlight-all-nicks))))
(add-hook 'circe-channel-mode-hook
'add-circe-highlight-all-nicks))
(defun disable-circe-highlight-all-nicks ()
"Disable the Highlight Nicks module for Circe.
See `enable-circe-highlight-all-nicks'."
(interactive)
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (eq major-mode 'circe-channel-mode)
(remove-circe-highlight-all-nicks))))
(remove-hook 'circe-channel-mode-hook
'add-circe-highlight-all-nicks))
(defun add-circe-highlight-all-nicks ()
"Add `circe-highlight-all-nicks' to `lui-pre-output-hook'."
(add-hook 'lui-pre-output-hook 'circe-highlight-all-nicks
nil t))
(defun remove-circe-highlight-all-nicks ()
"Remove `circe-highlight-all-nicks' from `lui-pre-output-hook'."
(remove-hook 'lui-pre-output-hook 'circe-highlight-all-nicks
t))
(defun circe-highlight-all-nicks ()
"Highlight all occurances of nicks of the current channel in the message."
(when (eq major-mode 'circe-channel-mode)
(let ((body (text-property-any (point-min) (point-max)
'lui-format-argument 'body))
(nicks '())
(regex nil))
(when body
(let ((channel-nicks (circe-channel-nicks)))
(when channel-nicks
(mapc (lambda (nick)
(when (not (circe-server-my-nick-p nick))
(setq nicks (cons nick nicks))))
channel-nicks)))
(setq regex (regexp-opt nicks 'words))
(goto-char body)
(while (re-search-forward regex nil t)
(add-text-properties (match-beginning 0)
(match-end 0)
'(face circe-highlight-all-nicks-face)))))))
(provide 'circe-highlight-all-nicks)
;;; circe-highlight-all-nicks.el ends here

243
elpa/circe-20160608.1315/circe-lagmon.el Normal file
View File

@ -0,0 +1,243 @@
;;; circe-lagmon.el --- Lag Monitor for Circe
;; Copyright (C) 2011-2012 Jorgen Schaefer
;; Author: John J Foerch <jjfoerch@earthlink.net>,
;; Jorgen Schaefer
;; This file is part of Circe.
;; 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, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301, USA.
;;; Commentary:
;;;
;;; Circe-lagmon-mode monitors the amount of lag on your connection to
;;; each server, and displays the lag time in seconds in the mode-line.
;;; It works by managing two timers. Timer1 sends CTCP LAGMON to yourself
;;; on each server every 60 seconds. Each time around, timer1 starts
;;; timer2 to monitor for timeouts of these messages. Timer2 cancels
;;; itself when all of the pings in the round have been answered.
;;;
;;; Code:
(require 'circe)
;;; User variables
(defgroup circe-lagmon nil
"Lag Monitor for Circe"
:prefix "circe-lagmon-"
:group 'circe)
(defcustom circe-lagmon-timer-tick 5
"How often to check for lag.
Increase this to improve performance at the cost of accuracy."
:type 'number
:group 'circe-lagmon)
(defcustom circe-lagmon-check-interval 60
"Interval in seconds at which to send the CTCP message."
:type 'number
:group 'circe-lagmon)
(defcustom circe-lagmon-reconnect-interval 120
"Seconds after which to automatically reconnect upon a timeout
of a lag monitor message. A value of nil disables the feature."
:type '(choice (const :tag "Disable auto-reconnect" nil)
number)
:group 'circe-lagmon)
(defcustom circe-lagmon-mode-line-format-string "lag:%.1f "
"Format string for displaying the lag in the mode-line."
:type 'string
:group 'circe-lagmon)
(defcustom circe-lagmon-mode-line-unknown-lag-string "lag:? "
"Indicator string for displaying unknown lag in the mode-line."
:type 'string
:group 'circe-lagmon)
(defvar circe-lagmon-disabled nil
"A boolean value if lagmon should be disabled on this network.
Don't set this by hand, use `circe-network-options'.")
(make-variable-buffer-local 'circe-lagmon-disabled)
;;; Internal variables
;;;
(defvar circe-lagmon-timer nil)
(defvar circe-lagmon-server-lag nil)
(make-variable-buffer-local 'circe-lagmon-server-lag)
(defvar circe-lagmon-last-send-time nil)
(make-variable-buffer-local 'circe-lagmon-last-send-time)
(defvar circe-lagmon-last-receive-time nil)
(make-variable-buffer-local 'circe-lagmon-last-receive-time)
(defun circe-lagmon-timer-tick ()
"Function run periodically to check lag.
This will call `circe-lagmon-server-check' in every active server
buffer. You can call it yourself if you like to force an update,
there is no harm in running it too often, but it really should be
run sufficiently often with the timer."
(dolist (buffer (circe-server-buffers))
(with-current-buffer buffer
(when (and (eq major-mode 'circe-server-mode)
circe-server-process
(eq (irc-connection-state circe-server-process)
'registered)
(not circe-lagmon-disabled))
(circe-lagmon-server-check)))))
(defun circe-lagmon-server-check ()
"Check the current server for lag.
This will reconnect if we haven't heard back for too long, or
send a request if it's time for that. See
`circe-lagmon-reconnect-interval' and
`circe-lagmon-check-interval' to configure the behavior.."
(let ((now (float-time)))
(cond
;; No answer so far...
((and circe-lagmon-last-send-time
(not circe-lagmon-last-receive-time))
;; Count up until the answer comes.
(let ((lag (/ (- now circe-lagmon-last-send-time) 2)))
(when (or (not circe-lagmon-server-lag)
(> lag circe-lagmon-server-lag))
(setq circe-lagmon-server-lag lag)
(circe-lagmon-force-mode-line-update)))
;; Check for timeout.
(when (and circe-lagmon-reconnect-interval
(> now
(+ circe-lagmon-last-send-time
circe-lagmon-reconnect-interval)))
(setq circe-lagmon-last-send-time nil
circe-lagmon-last-receive-time nil)
(circe-reconnect)))
;; Nothing sent so far, or last send was too long ago.
((or (not circe-lagmon-last-send-time)
(> now
(+ circe-lagmon-last-send-time
circe-lagmon-check-interval)))
(irc-send-raw (circe-server-process)
(format "PRIVMSG %s :\C-aLAGMON %s\C-a"
(circe-nick) now)
:nowait)
(setq circe-lagmon-last-send-time now
circe-lagmon-last-receive-time nil))
)))
(defun circe-lagmon-force-mode-line-update ()
"Call force-mode-line-update on a circe server buffer and all
of its chat buffers."
(force-mode-line-update)
(dolist (b (circe-server-chat-buffers))
(with-current-buffer b
(force-mode-line-update))))
(defun circe-lagmon-format-mode-line-entry ()
"Format the mode-line entry for displaying the lag."
(let ((buf (cond
((eq major-mode 'circe-server-mode)
(current-buffer))
(circe-server-buffer
circe-server-buffer)
(t
nil))))
(when buf
(with-current-buffer buf
(cond
(circe-lagmon-disabled
nil)
(circe-lagmon-server-lag
(format circe-lagmon-mode-line-format-string
circe-lagmon-server-lag))
(t
circe-lagmon-mode-line-unknown-lag-string))))))
(defun circe-lagmon-init ()
"Initialize the values of the lag monitor for one server, and
start the lag monitor if it has not been started."
(setq circe-lagmon-server-lag nil
circe-lagmon-last-send-time nil
circe-lagmon-last-receive-time nil)
(circe-lagmon-force-mode-line-update)
(unless circe-lagmon-timer
(setq circe-lagmon-timer
(run-at-time nil circe-lagmon-timer-tick
'circe-lagmon-timer-tick))))
(defun circe-lagmon--rpl-welcome-handler (conn &rest ignored)
(with-current-buffer (irc-connection-get conn :server-buffer)
(circe-lagmon-init)))
(defun circe-lagmon--ctcp-lagmon-handler (conn event sender target argument)
(when (irc-current-nick-p conn (irc-userstring-nick sender))
(with-current-buffer (irc-connection-get conn :server-buffer)
(let* ((now (float-time))
(lag (/ (- now (string-to-number argument))
2)))
(setq circe-lagmon-server-lag lag
circe-lagmon-last-receive-time now)
(circe-lagmon-force-mode-line-update)))))
(defun circe-lagmon--nick-handler (conn event sender new-nick)
(when (irc-current-nick-p conn (irc-userstring-nick sender))
(with-current-buffer (irc-connection-get conn :server-buffer)
(setq circe-lagmon-last-send-time nil))))
;;;###autoload
(define-minor-mode circe-lagmon-mode
"Circe-lagmon-mode monitors the amount of lag on your
connection to each server, and displays the lag time in seconds
in the mode-line."
:global t
(let ((mode-line-entry '(:eval (circe-lagmon-format-mode-line-entry))))
(remove-hook 'mode-line-modes mode-line-entry)
(let ((table (circe-irc-handler-table)))
(irc-handler-remove table "001" 'circe-lagmon--rpl-welcome-handler)
(irc-handler-remove table "irc.ctcp.LAGMON"
'circe-lagmon--ctcp-lagmon-handler)
(irc-handler-remove table "NICK" 'circe-lagmon--nick-handler))
(circe-set-display-handler "irc.ctcp.LAGMON" nil)
(when circe-lagmon-timer
(cancel-timer circe-lagmon-timer)
(setq circe-lagmon-timer nil))
(when circe-lagmon-mode
(add-hook 'mode-line-modes mode-line-entry)
(let ((table (circe-irc-handler-table)))
(irc-handler-add table "001" 'circe-lagmon--rpl-welcome-handler)
(irc-handler-add table "irc.ctcp.LAGMON"
'circe-lagmon--ctcp-lagmon-handler)
(irc-handler-add table "NICK" 'circe-lagmon--nick-handler))
(circe-set-display-handler "irc.ctcp.LAGMON" 'circe-display-ignore)
(dolist (buffer (circe-server-buffers))
(with-current-buffer buffer
(setq circe-lagmon-server-lag nil)
(when (and circe-server-process
(eq (irc-connection-state circe-server-process)
'registered))
(circe-lagmon-init)))))))
(provide 'circe-lagmon)
;;; circe-lagmon.el ends here

86
elpa/circe-20160608.1315/circe-new-day-notifier.el Normal file
View File

@ -0,0 +1,86 @@
;;; circe-new-day-notifier.el --- Send a message every midnight to all
;;; channels
;; Copyright (C) 2015 Pásztor János
;; Author: Pásztor János <model87@freemail.hu>
;; This file is part of Circe.
;; 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 2
;; 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, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Commentary:
;; This Circe module adds the ability to send a notification to all
;; channels every midnight
;; Some ideas/code copied from circe-lagmon.el and
;; circe-color-nicks.el
;; To use it, put the following into your .emacs:
;; (require 'circe-new-day-notifier)
;; (enable-circe-new-day-notifier)
;;; Code:
(require 'circe)
(defgroup circe-new-day-notifier nil
"Midnight notification to Circe"
:prefix "circe-new-day-notifier-"
:group 'circe)
(defcustom circe-new-day-notifier-format-message "*** Day changed to {day}"
"The format string which will be printed to the channels. It
should contain {day} to print the date. See `circe-display' for
further documentation"
:type 'string
:group 'circe-new-day-notifier)
(defcustom circe-new-day-notifier-date-format "%Y-%m-%d, %A"
"The date format, which will be used at
circe-new-day-notifier-format-message. See `format-time-string' for
documentation"
:type 'string
:group 'circe-new-day-notifier)
(defvar circe-new-day-notifier-timer nil)
;;;###autoload
(defun enable-circe-new-day-notifier ()
(interactive)
(unless circe-new-day-notifier-timer
(setq circe-new-day-notifier-timer
(run-at-time "24:00:00" (* 24 60 60) 'circe-new-day-notification))))
;;;###autoload
(defun disable-circe-new-day-notifier ()
(interactive)
(when circe-new-day-notifier-timer
(cancel-timer circe-new-day-notifier-timer)
(setq circe-new-day-notifier-timer nil)))
(defun circe-new-day-notification ()
"This function prints the new day notification to each query and chat buffer"
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (derived-mode-p 'circe-chat-mode)
(circe-display 'circe-new-day-notifier-format-message
:day (format-time-string circe-new-day-notifier-date-format))))))
(provide 'circe-new-day-notifier)
;;; circe-new-day-notifier.el ends here

6
elpa/circe-20160608.1315/circe-pkg.el Normal file
View File

@ -0,0 +1,6 @@
(define-package "circe" "20160608.1315" "Client for IRC in Emacs"
'((cl-lib "0.5"))
:url "https://github.com/jorgenschaefer/circe")
;; Local Variables:
;; no-byte-compile: t
;; End:

3586
elpa/circe-20160608.1315/circe.el Normal file
View File

File diff suppressed because it is too large Load Diff

1406
elpa/circe-20160608.1315/irc.el Normal file
View File

File diff suppressed because it is too large Load Diff

202
elpa/circe-20160608.1315/lcs.el Normal file
View File

@ -0,0 +1,202 @@
;;; lcs.el --- find out the longest common sequence
;; Copyright (c) 2002-2003 by Alex Shinn, All rights reserved.
;; Copyright (c) 2002-2003 by Shiro Kawai, All rights reserved.
;; Copyright (c) 2006, 2012 by Jorgen Schaefer, All rights reserved.
;; Authors: Alex Shinn, Shiro Kawai
;; Maintainer: Jorgen Schaefer <forcer@forcix.cx>
;; URL: https://github.com/jorgenschaefer/circe/wiki/lcs
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;; 3. Neither the name of the authors nor the names of its contributors
;; may be used to endorse or promote products derived from this
;; software without specific prior written permission.
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;; Commentary:
;; lcs.el is a library for other Emacs Lisp programs not useful by
;; itself.
;; This library provides functions to find the Longest Common Sequence
;; (LCS) of two sequences. This is used to create a unified diff of to
;; two lists. See `lcs-unified-diff' for a useful function to be
;; called.
;; The code is more or less a literal translation of (part of)
;; Gauche's util/lcs.scm module to Emacs Lisp.
;;; Code:
(put 'lcs-for 'lisp-indent-function 4)
(defmacro lcs-for (var from to step &rest body)
"A simple FOR loop macro.
Count VAR from FROM to TO by stepsize STEP. Evaluate BODY in each
iteration."
(let ((sto (make-symbol "to"))
(sstep (make-symbol "step")))
`(let ((,var ,from)
(,sto ,to)
(,sstep ,step))
(while (<= ,var ,sto)
(progn
,@body)
(setq ,var (+ ,var ,sstep))))))
(defun lcs-split-at (lis pos)
"Return a cons cell of the first POS elements of LIS and the rest."
(let ((head nil))
(while (> pos 0)
(setq head (cons (car lis)
head)
pos (- pos 1)
lis (cdr lis)))
(cons (reverse head)
lis)))
(defun lcs-finish (M+N V_l vl V_r vr)
"Finalize the LCS algorithm.
Should be used only by `lcs-with-positions'."
(let ((maxl 0)
(r '()))
(lcs-for i (- M+N) M+N 1
(when (> (funcall vl i)
maxl)
(setq maxl (funcall vl i)
r (funcall vr i))))
(list maxl (reverse r))))
(defun lcs-with-positions (a-ls b-ls &optional equalp)
"Return the longest common subsequence (LCS) of A-LS and B-LS.
EQUALP can be any procedure which returns non-nil when two
elements should be considered equal."
(let* ((A (vconcat a-ls))
(B (vconcat b-ls))
(N (length A))
(M (length B))
(M+N (+ M N))
(V_d (make-vector (+ 1 (* 2 M+N))
0))
(V_r (make-vector (+ 1 (* 2 M+N))
nil))
(V_l (make-vector (+ 1 (* 2 M+N))
0))
(vd (lambda (i &optional x)
(if x
(aset V_d (+ i M+N) x)
(aref V_d (+ i M+N)))))
(vr (lambda (i &optional x)
(if x
(aset V_r (+ i M+N) x)
(aref V_r (+ i M+N)))))
(vl (lambda (i &optional x)
(if x
(aset V_l (+ i M+N) x)
(aref V_l (+ i M+N))))))
(when (not equalp)
(setq equalp 'equal))
(catch 'return
(if (= M+N 0)
(throw 'return '(0 ()))
(lcs-for d 0 M+N 1
(lcs-for k (- d) d 2
(let ((x nil)
(y nil)
(l nil)
(r nil))
(if (or (= k (- d))
(and (not (= k d))
(< (funcall vd (- k 1))
(funcall vd (+ k 1)))))
(setq x (funcall vd (+ k 1))
l (funcall vl (+ k 1))
r (funcall vr (+ k 1)))
(setq x (+ 1 (funcall vd (- k 1)))
l (funcall vl (- k 1))
r (funcall vr (- k 1))))
(setq y (- x k))
(while (and (< x N)
(< y M)
(funcall equalp (aref A x) (aref B y)))
(setq r (cons (list (aref A x) x y)
r)
x (+ x 1)
y (+ y 1)
l (+ l 1)))
(funcall vd k x)
(funcall vr k r)
(funcall vl k l)
(when (and (>= x N)
(>= y M))
(throw 'return(lcs-finish M+N V_l vl V_r vr)))))))
(error "Can't happen"))))
(defun lcs-unified-diff (a b &optional equalp)
"Return a unified diff of the lists A and B.
EQUALP should can be a procedure that returns non-nil when two
elements of A and B should be considered equal. It's `equal' by
default."
(let ((common (cadr (lcs-with-positions a b equalp)))
(a a)
(a-pos 0)
(b b)
(b-pos 0)
(diff '()))
(while common
(let* ((elt (car common))
(a-off (nth 1 elt))
(a-skip (- a-off a-pos))
(b-off (nth 2 elt))
(b-skip (- b-off b-pos))
(a-split (lcs-split-at a a-skip))
(a-head (car a-split))
(a-tail (cdr a-split))
(b-split (lcs-split-at b b-skip))
(b-head (car b-split))
(b-tail (cdr b-split)))
(setq diff (append diff
(mapcar (lambda (a)
`(- ,a))
a-head)
(mapcar (lambda (b)
`(+ ,b))
b-head)
`((! ,(car elt))))
common (cdr common)
a (cdr a-tail)
a-pos (+ a-off 1)
b (cdr b-tail)
b-pos (+ b-off 1))))
(append diff
(mapcar (lambda (a)
`(- ,a))
a)
(mapcar (lambda (b)
`(+ ,b))
b))))
(provide 'lcs)
;;; lcs.el ends here

115
elpa/circe-20160608.1315/lui-autopaste.el Normal file
View File

@ -0,0 +1,115 @@
;;; lui-autopaste.el --- Extension for lui for long text input
;; Copyright (C) 2012 Jorgen Schaefer <forcer@forcix.cx>
;; Author: Jorgen Schaefer <forcer@forcix.cx>
;; This file is part of Lui.
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This extension for lui will intercept long input and replace it by
;; an URL to a paste service.
;; What is considered "long" is defined by `lui-autopaste-lines'. You
;; can configure which paste service to use by changing
;; `lui-autopaste-function'.
;; Run `enable-lui-autopaste' to enable this.
;;; Code:
(defgroup lui-autopaste nil
"The Lui autopaste extension."
:prefix "lui-autopaste-"
:group 'lui)
(defcustom lui-autopaste-lines 3
"Starting at this number of lines, Lui will ask to paste the input."
:type 'integer
:group 'lui-autopaste)
(defcustom lui-autopaste-function 'lui-autopaste-service-ixio
"Which paste service to use.
This function will be called with some text as its only argument,
and is expected to return an URL to view the contents."
:type '(choice (const :tag "ix.io" lui-autopaste-service-ixio)
(const :tag "ptpb.pw" lui-autopaste-service-ptpb-pw))
:group 'lui-autopaste)
;;;###autoload
(defun enable-lui-autopaste ()
"Enable the lui autopaste feature.
If you enter more than `lui-autopaste-lines' at once, Lui will
ask if you would prefer to use a paste service instead. If you
agree, Lui will paste your input to `lui-autopaste-function' and
replace it with the resulting URL."
(interactive)
(add-hook 'lui-pre-input-hook 'lui-autopaste))
;;;###autoload
(defun disable-lui-autopaste ()
"Disable the lui autopaste feature."
(interactive)
(remove-hook 'lui-pre-input-hook 'lui-autopaste))
(defun lui-autopaste ()
"Check if the lui input is too large. If so, paste it instead."
(when (and (>= (count-lines (point-min) (point-max))
lui-autopaste-lines)
(y-or-n-p "That's pretty long, would you like to use a paste service instead? "))
(let ((url (funcall lui-autopaste-function
(buffer-substring (point-min)
(point-max)))))
(delete-region (point-min) (point-max))
(insert url))))
(defun lui-autopaste-service-ptpb-pw (text)
"Paste TEXT to ptpb.pw and return the paste url."
(let ((url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded")))
(url-request-data (format "c=%s" (url-hexify-string text)))
(url-http-attempt-keepalives nil))
(let ((buf (url-retrieve-synchronously "https://ptpb.pw/")))
(unwind-protect
(with-current-buffer buf
(goto-char (point-min))
(if (re-search-forward "^url: \\(.*\\)" nil t)
(match-string 1)
(error "Error during pasting to ptpb.pw")))
(kill-buffer buf)))))
(defun lui-autopaste-service-ixio (text)
"Paste TEXT to ix.io and return the paste url."
(let ((url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded")))
(url-request-data (format "f:1=%s" (url-hexify-string text)))
(url-http-attempt-keepalives nil))
(let ((buf (url-retrieve-synchronously "http://ix.io/")))
(unwind-protect
(with-current-buffer buf
(goto-char (point-min))
(if (re-search-forward "\n\n" nil t)
(buffer-substring (point) (point-at-eol))
(error "Error during pasting to ix.io")))
(kill-buffer buf)))))
(provide 'lui-autopaste)
;;; lui-autopaste.el ends here

198
elpa/circe-20160608.1315/lui-format.el Normal file
View File

@ -0,0 +1,198 @@
;;; lui-format.el --- A formatting function for use with Lui
;; Copyright (C) 2005, 2012 Jorgen Schaefer
;; Author: Jorgen Schaefer <forcer@forcix.cx>
;; This file is part of Lui.
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; An improved formatting function using named parameters.
;;
;; See the docstring of `lui-format' for more details.
;;
;; Most of the design is borrowed from Python's string.format.
;;; Code:
(require 'lui)
(defun lui-display (format not-tracked-p &rest keywords)
"Display a formatted string in the current Lui interface.
The string is formatted using FORMAT and `lui-format'.
If NOT-TRACKED-P is given, the inserted string won't trigger
tracking. See `lui-insert' for a description.
KEYWORDS are the keyword arguments passed to `lui-format'.
See `lui-format' for a full description of the arguments."
(lui-insert (lui-format format keywords)
not-tracked-p))
(defun lui-format (format &rest keywords)
"Display FORMAT formatted with KEYWORDS.
FORMAT should be a symbol whose value is taken. If the value is a
procedure, the keyword list is passed as a single argument to it,
and it should return the formatted string. If the value is a
string, it is formatted according to the rules below.
KEYWORDS is a plist of keywords and strings, or symbols and
strings. They are used as format arguments.
The string is taken verbatim, unless there is are opening or
closing braces.
Double opening or closing braces are replaced by single
occurrences of those characters. Otherwise, the contents between
opening and closing braces is a format description and replaced
by a formatted string.
The string between opening and closing braces is taken as a name
of a keyword argument, and replaced by that argument's value. If
there is a colon in the string, the keyword name is the part
before the colon. The part after the colon is used to format the
argument using standard `format'
Example:
(lui-format \"Hello {foo:.1f}\" :foo 3.1415)
is equivalent to
(format \"Hello %.1f\" 3.1415)
If the name is either a number, a number followed by a dash, or
two numbers with a dash in between them, this is taken as a
special name that is looked up in the list given using the list
argument to the :indexed-args keyword.
{1} refers to the second element (element 1)
{1-} refers to the second and all following elements
{1-3} refers to the second through fourth element
If more than one element is selected, the elements are separated
by a single space character.
All named arguments receive a property of `lui-format-argument'
with the respective name as value. The whole string receives a
`lui-format' property with FORMAT as a value, and a
`lui-keywords' argument with KEYWORDS as a value."
;; If it's only a single argument, that argument is a list.
(when (not (cdr keywords))
(setq keywords (car keywords)))
(cond
((functionp format)
(apply format keywords))
((and (symbolp format)
(functionp (symbol-value format)))
(apply (symbol-value format) keywords))
(t
(let* ((format-string (if (symbolp format)
(symbol-value format)
format))
(plist (mapcar (lambda (entry)
(if (keywordp entry)
;; Keyword -> symbol
(intern (substring (symbol-name entry)
1))
entry))
keywords)))
(propertize (lui-format-internal format-string plist)
'lui-format format
'lui-keywords keywords)))))
(defun lui-format-internal (fmt keywords)
"Internal function for `lui-format'.
FMT is the format string and KEYWORDS is the symbol-based plist.
See `lui-format'."
(with-temp-buffer
(insert fmt)
(goto-char (point-min))
(while (re-search-forward "{{\\|}}\\|{\\([^}]*\\)}" nil t)
(cond
((string-equal (match-string 0) "3.1")
(replace-match "{"))
((string-equal (match-string 0) "}}")
(replace-match "}"))
(t ;; (match-string 1)
(replace-match (save-match-data
(lui-format-single (match-string 1) keywords))
t t))))
(buffer-string)))
(defun lui-format-single (specifier keywords)
"Format a single braced SPECIFIER according to KEYWORDS.
See `lui-format' for details.
This adds `lui-format-argument' as necessary."
(let* ((split (split-string specifier ":"))
(identifier (car split))
(format (cadr split)))
(when (not format)
(setq format "s"))
(propertize (format (concat "%" format)
(lui-format-lookup identifier keywords))
'lui-format-argument (intern identifier))))
(defun lui-format-lookup (identifier keywords)
"Lookup the format IDENTIFIER in KEYWORDS.
See `lui-format' for details."
(cond
((string-match "^\\([0-9]+\\)\\(-\\([0-9]+\\)?\\)?$" identifier)
(let ((from (match-string 1 identifier))
(rangep (match-string 2 identifier))
(to (match-string 3 identifier))
(indexed-args (plist-get keywords 'indexed-args)))
(if rangep
(mapconcat (lambda (element)
(if (stringp element)
element
(format "%s" element)))
(lui-sublist indexed-args
(string-to-number from)
(when to (string-to-number to)))
" ")
(or (nth (string-to-number from)
indexed-args)
""))))
(t
(or (plist-get keywords (intern identifier))
(error "Unknown keyword argument %S" identifier)))))
(defun lui-sublist (list from &optional to)
"Return the sublist from LIST starting at FROM and ending at TO."
(if (not to)
(nthcdr from list)
(let ((from-list (nthcdr from list))
(i (- to from))
(to-list nil))
(while (>= i 0)
(when (null from-list)
(error "Argument out of range: %S" to))
(setq to-list (cons (car from-list)
to-list)
i (- i 1)
from-list (cdr from-list)))
(nreverse to-list))))
(provide 'lui-format)
;;; lui-format.el ends here

182
elpa/circe-20160608.1315/lui-irc-colors.el Normal file
View File

@ -0,0 +1,182 @@
;;; lui-irc-colors.el --- Add IRC color support to LUI
;; Copyright (C) 2005 Jorgen Schaefer
;; Author: Jorgen Schaefer <forcer@forcix.cx>
;; This file is part of Lui.
;; 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, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Commentary:
;; This tells LUI how to display IRC colors:
;; ^B - Bold
;; ^_ - Underline
;; ^V - Inverse
;; ^] - Italic
;; ^O - Return to normal
;; ^C1,2 - Colors
;; The colors are documented at http://www.mirc.co.uk/help/color.txt
;;; Code:
(require 'lui)
(defgroup lui-irc-colors nil
"LUI IRC colors faces."
:group 'circe)
(defface lui-irc-colors-inverse-face
'((t (:inverse-video t)))
"Face used for inverse video."
:group 'lui-irc-colors)
(defun lui-irc-defface (face property on-dark on-light rest doc)
(custom-declare-face
face
`((((type graphic) (class color) (background dark))
(,property ,on-dark))
(((type graphic) (class color) (background light))
(,property ,on-light))
(t (,property ,rest)))
doc
:group 'lui-irc-colors))
(defun lui-irc-defface-pair (number on-dark on-light rest name)
(lui-irc-defface
(intern (format "lui-irc-colors-fg-%d-face" number))
:foreground
on-dark on-light rest
(concat "Face used for foreground IRC color "
(number-to-string number) " (" name ")."))
(lui-irc-defface
(intern (format "lui-irc-colors-bg-%d-face" number))
:background
on-light on-dark rest
(concat "Face used for background IRC color "
(number-to-string number) " (" name ").")))
(defun lui-irc-defface-bulk (colors)
(dotimes (n (length colors))
(apply 'lui-irc-defface-pair n (nth n colors))))
(lui-irc-defface-bulk
'(("#ffffff" "#585858" "white" "white")
("#a5a5a5" "#000000" "black" "black")
("#9b9bff" "#0000ff" "blue4" "blue")
("#40eb51" "#006600" "green4" "green")
("#ff9696" "#b60000" "red" "red")
("#d19999" "#8f3d3d" "red4" "brown")
("#d68fff" "#9c009c" "magenta4" "purple")
("#ffb812" "#7a4f00" "yellow4" "orange")
("#ffff00" "#5c5c00" "yellow" "yellow")
("#80ff95" "#286338" "green" "light green")
("#00b8b8" "#006078" "cyan4" "teal")
("#00ffff" "#006363" "cyan" "light cyan")
("#a8aeff" "#3f568c" "blue" "light blue")
("#ff8bff" "#853885" "magenta" "pink")
("#cfcfcf" "#171717" "dimgray" "grey")
("#e6e6e6" "#303030" "gray" "light grey")))
(defvar lui-irc-colors-regex
"\\(\x02\\|\x1F\\|\x16\\|\x1D\\|\x0F\\|\x03\\)"
"A regular expression matching IRC control codes.")
;;;###autoload
(defun enable-lui-irc-colors ()
"Enable IRC color interpretation for Lui."
(interactive)
(add-hook 'lui-pre-output-hook 'lui-irc-colors))
(defun disable-lui-irc-colors ()
"Disable IRC color interpretation for Lui."
(interactive)
(remove-hook 'lui-pre-output-hook 'lui-irc-colors))
(defun lui-irc-colors ()
"Add color faces for IRC colors.
This is an appropriate function for `lui-pre-output-hook'."
(goto-char (point-min))
(let ((start (point))
(boldp nil)
(inversep nil)
(italicp nil)
(underlinep nil)
(fg nil)
(bg nil))
(while (re-search-forward lui-irc-colors-regex nil t)
(lui-irc-propertize start (point)
boldp inversep italicp underlinep
fg bg)
(let ((code (match-string 1)))
(replace-match "")
(setq start (point))
(cond
((string= code "")
(setq boldp (not boldp)))
((string= code "")
(setq inversep (not inversep)))
((string= code "")
(setq italicp (not italicp)))
((string= code "")
(setq underlinep (not underlinep)))
((string= code "")
(setq boldp nil
inversep nil
italicp nil
underlinep nil
fg nil
bg nil))
((string= code "")
(if (looking-at "\\([0-9][0-9]?\\)\\(,\\([0-9][0-9]?\\)\\)?")
(progn
(setq fg (string-to-number (match-string 1))
bg (if (match-string 2)
(string-to-number (match-string 3))
bg))
(setq fg (if (and fg (not (= fg 99))) (mod fg 16) nil)
bg (if (and bg (not (= bg 99))) (mod bg 16) nil))
(replace-match ""))
(setq fg nil
bg nil)))
(t
(error "lui-irc-colors: Can't happen!")))))
(lui-irc-propertize (point) (point-max)
boldp inversep italicp underlinep fg bg)))
(defun lui-irc-propertize (start end boldp inversep italicp underlinep fg bg)
"Propertize the region between START and END."
(let ((faces (append (and boldp '(bold))
(and inversep '(lui-irc-colors-inverse-face))
(and italicp '(italic))
(and underlinep '(underline))
(and fg (list (lui-irc-colors-face 'fg fg)))
(and bg (list (lui-irc-colors-face 'bg bg))))))
(when faces
(add-face-text-property start end faces))))
(defun lui-irc-colors-face (type n)
"Return a face appropriate for face number N.
TYPE is either 'fg or 'bg."
(if (and (<= 0 n)
(<= n 15))
(intern (format "lui-irc-colors-%s-%s-face" type n))
'default-face))
(provide 'lui-irc-colors)
;;; lui-irc-colors.el ends here

201
elpa/circe-20160608.1315/lui-logging.el Normal file
View File

@ -0,0 +1,201 @@
;;; lui-logging.el --- Logging support for lui
;; Copyright (C) 2006 Jorgen Schaefer,
;; 2012 Anthony Martinez
;; Author: Anthony Martinez <pi+circe@pihost.us>
;; This file is part of Lui.
;; 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, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Commentary:
;; This lui module enables logging. Lui applications can change the
;; values of `lui-logging-format-arguments' to provide further
;; possibilities of customizing `lui-logging-file-format' for users.
;;; Code:
(require 'lui-format)
(require 'url-util)
(defgroup lui-logging nil
"Logging support."
:prefix "lui-logging-"
:group 'lui)
(defcustom lui-logging-format "[%T] {text}"
"The format used for log file entries.
This is first passed through `format-time-string' and then through
`lui-format'. The following format strings exist:
{text} - the text to be logged"
:type 'string
:group 'lui-logging)
(defcustom lui-logging-directory "~/.logs"
"The directory where log files are stored."
:type 'directory
:group 'lui-logging)
(defcustom lui-logging-file-format "{buffer}_%Y-%m-%d.txt"
"The format to be used for the log file name.
This is first passed through `format-time-string', and then
through `lui-format'. Possible lui format strings are:
{buffer} - the buffer name where the logging happened.
Lui applications can provide further format strings. See
`lui-logging-format-arguments' in the appropriate buffer."
:type 'string
:group 'lui-logging)
(defcustom lui-logging-flush-delay 0
"The number of seconds to delay writing newly-received messages
to disk. This can increase performance/decrease IO-wait at the
cost of a little bit of safety."
:type 'integer
:group 'lui-logging)
(defvar lui-logging-format-arguments nil
"A list of arguments to be passed to `lui-format'.
This can be used to extend the formatting possibilities of the
file name for lui applications.")
(make-variable-buffer-local 'lui-logging-format-arguments)
(defvar lui-logging-file-name-unreserved-chars
;; All but '/' is fine actually, but also omit '%' because otherwise there's
;; ambiguity between one introduced by encoding and a literal one.
'(?! ?\" ?# ?$ ?& ?` ?\( ?\) ?* ?+ ?,?: ?\; ?< ?= ?> ?? ?@?\[ ?\\ ?\] ?^ ?`
?\{ ?| ?\})
"A list of characters that should not be percent-encoded by
`url-hexify-string' while generating a logging file name.")
(defvar lui-pending-logs
(make-hash-table :test 'equal)
"Storage for log messages awaiting write. It is structured as a
hash table mapping filenames to a list-of-strings, which serves as
a queue.")
(defvar lui-logging-timer nil
"The timer used to flush lui-logged buffers")
(defun lui-logging-delayed-p ()
(> lui-logging-flush-delay 0))
(defun enable-lui-logging ()
"Enable lui logging for this buffer. Also create the log
file's directory, should it not exist."
(interactive)
(add-hook 'lui-pre-output-hook 'lui-logging
nil t))
(defun disable-lui-logging ()
"Disable lui logging for this buffer, and flush any pending
logs to disk."
(interactive)
(remove-hook 'lui-pre-output-hook 'lui-logging t)
(lui-logging-flush))
(defun enable-lui-logging-globally ()
"Enable lui logging for all Lui buffers.
This affects current as well as future buffers."
(interactive)
(add-hook 'lui-mode-hook 'enable-lui-logging)
(dolist (buf (buffer-list))
(with-current-buffer buf
(when lui-input-marker
(enable-lui-logging)))))
(defun disable-lui-logging-globally ()
"Disable logging in all future Lui buffers.
This affects current as well as future buffers."
(interactive)
(remove-hook 'lui-mode-hook 'enable-lui-logging)
(dolist (buf (buffer-list))
(with-current-buffer buf
(when lui-input-marker
(disable-lui-logging)))))
(defun lui-logging-file-name ()
"Create the name of the log file based on `lui-logging-file-format'."
(let* ((time-formatted (format-time-string lui-logging-file-format))
(buffer (let ((url-unreserved-chars
(append url-unreserved-chars
lui-logging-file-name-unreserved-chars))
(downcased (downcase (buffer-name (current-buffer)))))
(url-hexify-string downcased)))
(filename (apply 'lui-format
time-formatted
:buffer buffer
lui-logging-format-arguments)))
(concat lui-logging-directory "/" filename)))
(defun lui-logging-flush ()
"Flush out the lui-logging queue, and clear the timer set by
`lui-logging'."
(maphash #'lui-logging-flush-file lui-pending-logs)
(clrhash lui-pending-logs)
(cancel-timer lui-logging-timer)
(setq lui-logging-timer nil))
(defun lui-logging-write-to-log (file-name content)
"Actually perform a write to the logfile."
(let ((coding-system-for-write 'raw-text)
(dir (file-name-directory file-name)))
(when (not (file-directory-p dir))
(make-directory dir t))
(write-region content nil file-name t 'nomessage)))
(defun lui-logging-flush-file (file-name queue)
"Consume the logging queue and write the content to the log
file."
(let ((content (apply #'concat (nreverse queue))))
(lui-logging-write-to-log file-name content)))
(defun lui-logging-format-string (text)
"Generate a string to be either directly written or enqueued."
(substring-no-properties
(lui-format
(format-time-string lui-logging-format)
:text text)))
(defun lui-logging-enqueue (file-name text)
"Given a filename, push text onto its queue, and tickle the
timer, if necessary."
(puthash file-name
(cons text (gethash file-name lui-pending-logs))
lui-pending-logs)
(when (null lui-logging-timer)
(setq lui-logging-timer
(run-with-timer lui-logging-flush-delay nil
#'lui-logging-flush))))
(defun lui-logging ()
"If output-queueing is enabled, append the to-be-logged string
to the output queue. Otherwise, write directly to the logfile.
This should be added to `lui-pre-output-hook' by way of
`enable-lui-logging'."
(let ((text (lui-logging-format-string (buffer-string))))
(if (lui-logging-delayed-p)
(lui-logging-enqueue (lui-logging-file-name) text)
(lui-logging-write-to-log (lui-logging-file-name) text))))
(provide 'lui-logging)
;;; lui-logging.el ends here

110
elpa/circe-20160608.1315/lui-track-bar.el Normal file
View File

@ -0,0 +1,110 @@
;;; lui-track-bar.el --- Provides a bar to track the last read position
;; Copyright (C) 2016 Vasilij Schneidermann <v.schneidermann@gmail.com>
;; Author: Vasilij Schneidermann <v.schneidermann@gmail.com>
;; This file is part of LUI.
;; 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, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Commentary:
;; This allows you to track where you've last left off a buffer.
;; Use (enable-lui-track-bar) to enable this mode globally. You can
;; customize `lui-track-bar-behavior' to change when the track bar
;; moves. You can also use M-x lui-track-bar-move to move the track
;; bar manually.
;;; Code:
(require 'lui)
(require 'tracking)
(defgroup lui-track-bar nil
"Last read position tracking for LUI"
:prefix "lui-track-bar-"
:group 'lui)
(defcustom lui-track-bar-behavior 'before-switch-to-buffer
"When to move the track bar.
The following values are possible.
before-switch-to-buffer (default)
Move the bar to the bottom of the buffer when switching away
from a buffer.
before-tracking-next-buffer
Move the bar when switching to the next buffer using
\\[tracking-next-buffer].
after-send
Move the bar after sending a message."
:type '(choice (const :tag "Before switching buffers"
before-switch-to-buffer)
(const :tag "Before tracking switch"
before-tracking-next-buffer)
(const :tag "After sending"
after-send))
:group 'lui-track-bar)
(defface lui-track-bar
'((((type graphic) (background light))
:inherit default :background "dim gray" :height 0.1)
(((type graphic) (background dark))
:inherit default :background "light gray" :height 0.1)
(((type tty))
:inherit (font-lock-comment-face default) :underline t))
"Track bar face"
:group 'lui-track-bar)
(defvar lui-track-bar-overlay nil)
(make-variable-buffer-local 'lui-track-bar-overlay)
;;;###autoload
(defun enable-lui-track-bar ()
"Enable a bar in Lui buffers that shows where you stopped reading."
(interactive)
(defadvice switch-to-buffer (before lui-track-bar activate)
(when (and (eq lui-track-bar-behavior 'before-switch-to-buffer)
;; Do not move the bar if the buffer is displayed still
(<= (length (get-buffer-window-list (current-buffer)))
1))
(lui-track-bar-move)))
(defadvice tracking-next-buffer (before lui-track-bar activate)
(when (eq lui-track-bar-behavior 'before-tracking-next-buffer)
(lui-track-bar-move)))
(add-hook 'lui-pre-input-hook 'lui-track-bar--move-pre-input))
(defun lui-track-bar--move-pre-input ()
(when (eq lui-track-bar-behavior 'after-send)
(lui-track-bar-move)))
(defun lui-track-bar-move ()
"Move the track bar down."
(interactive)
(when (derived-mode-p 'lui-mode)
(when (not lui-track-bar-overlay)
(setq lui-track-bar-overlay (make-overlay (point-min) (point-min)))
(overlay-put lui-track-bar-overlay 'after-string
(propertize "\n" 'face 'lui-track-bar)))
(move-overlay lui-track-bar-overlay
lui-output-marker lui-output-marker)))
(provide 'lui-track-bar)
;;; lui-track-bar.el ends here

1353
elpa/circe-20160608.1315/lui.el Normal file
View File

File diff suppressed because it is too large Load Diff

194
elpa/circe-20160608.1315/make-tls-process.el Normal file
View File

@ -0,0 +1,194 @@
;;; make-tls-process.el --- A non-blocking TLS connection function
;; Copyright (C) 2015 Jorgen Schaefer <contact@jorgenschaefer.de>
;; Author: Jorgen Schaefer <contact@jorgenschaefer.de>
;; URL: https://github.com/jorgenschaefer/circe
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; A `make-tls-process' function like `make-network-process', in
;; particular supporting non-blocking connects.
;;; Code:
(require 'tls)
(defcustom tls-connection-command
(if (executable-find "gnutls-cli")
"gnutls-cli --insecure -p %p %h"
"openssl s_client -connect %h:%p -no_ssl2 -ign_eof")
"The command to use to create a TLS connection.
%h is replaced with server hostname, %p with port to connect to.
The program should read input on stdin and write output to
stdout.
Also see `tls-success' for what the program should output after
successful negotiation."
:group 'tls
:type 'string)
(defvar tls-debug-output nil
"Non-nil if you want to see lots of debug messages.")
(defun tls--debug (format-string &rest args)
"Display a message if debug output is enabled.
If `tls-debug-output' is non-nil, this acts like `message'.
Otherwise, it's a no-op."
(when tls-debug-output
(apply #'message format-string args)))
(defun make-tls-process (&rest args)
"Create a TLS client process.
A TLS network process is a command process that runs a command
line program like gnutls or openssl, not a full network process.
Network communication should work as usual, but the sentinel
might receive process-specific events.
Different from a process sentinel, but like a network sentinel,
the sentinel is called with an event \"open\\n\" when the
connection is established.
This function uses `tls-connection-command' to connect to a
server.
Do NOT use `set-process-filter' or `set-process-sentinel' on the
return value of this function. The connection setup uses special
sentinels and filters to be deal with the program output used
here. Use the :sentinel and :filter keyword arguments to set them
once the connection is fully established.
Arguments are specified as keyword/argument pairs, similar to
`make-network-process'. The following arguments are defined:
:name NAME -- NAME is name for process. It is modified if necessary
to make it unique.
:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
with the process. Process output goes at end of that buffer, unless
you specify an output stream or filter function to handle the output.
BUFFER may be also nil, meaning that this process is not associated
with any buffer.
:host HOST -- HOST is name of the host to connect to, or its IP
address. The symbol `local' specifies the local host. If specified
for a server process, it must be a valid name or address for the local
host, and only clients connecting to that address will be accepted.
:service SERVICE -- SERVICE is name of the service desired, or an
integer specifying a port number to connect to. If SERVICE is t,
a random port number is selected for the server. (If Emacs was
compiled with getaddrinfo, a port number can also be specified as
a string, e.g. \"80\", as well as an integer. This is not
portable.)
:coding CODING -- If CODING is a symbol, it specifies the coding
system used for both reading and writing for this process. If CODING
is a cons (DECODING . ENCODING), DECODING is used for reading, and
ENCODING is used for writing.
:noquery BOOL -- Query the user unless BOOL is non-nil, and process is
running when Emacs is exited.
:filter FILTER -- Install FILTER as the process filter.
:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
:plist PLIST -- Install PLIST as the new process's initial plist."
(let* ((name (plist-get args :name))
(host (plist-get args :host))
(service (plist-get args :service))
(proc (tls--start-process name tls-connection-command host service)))
(process-put proc :tls-args args)
(set-process-sentinel proc #'tls--sentinel)
(set-process-filter proc #'tls--filter)
proc))
(defun tls--sentinel (proc event)
"The default sentinel for TLS connections.
Try the next command in the list, or fail if there are none
left."
(tls--debug "tls--sentinel %S %S"
(process-status proc)
event)
(tls--debug "Failed TLS output: %s"
(process-get proc :tls-data))
(if (eq (process-status proc)
'exit)
(let ((sentinel (plist-get (process-get proc :tls-args)
:sentinel)))
(when sentinel
(funcall sentinel proc (format "failed with %s\n" event))))
(error "Unexpected event in tls sentinel: %S" event)))
(defun tls--filter (proc data)
"The default filter for TLS connections.
We wait until both `tls-success' and `tls-end-of-info' have been
received. Once that happens, we are done and we can switch over
to the real connection."
(let ((data (concat (or (process-get proc :tls-data)
"")
data)))
(if (and (string-match tls-success data)
(string-match tls-end-of-info data))
(let* ((remaining-data (substring data (match-end 0)))
(args (process-get proc :tls-args))
(buffer (plist-get args :buffer))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(plist (plist-get args :plist)))
(set-process-plist proc plist)
(set-process-sentinel proc sentinel)
(set-process-filter proc filter)
(set-process-buffer proc buffer)
(if (consp coding)
(set-process-coding-system proc (car coding) (cdr coding))
(set-process-coding-system proc coding coding))
(set-process-query-on-exit-flag proc (not noquery))
(when sentinel
(funcall sentinel proc "open\n"))
(when (and (not (equal remaining-data ""))
filter)
(funcall filter proc remaining-data)))
(process-put proc :tls-data data))))
(defun tls--start-process (name cmd host port)
"Start a single process for network communication.
This code is mostly taken from tls.el."
(let ((process-connection-type tls-process-connection-type)
(formatted-cmd
(format-spec
cmd
(format-spec-make
?h host
?p (if (integerp port)
(int-to-string port)
port)))))
(tls--debug "TLS starting process: %s" formatted-cmd)
(start-process name nil
shell-file-name shell-command-switch
formatted-cmd)))
(provide 'make-tls-process)
;;; make-tls-process.el ends here

223
elpa/circe-20160608.1315/shorten.el Normal file
View File

@ -0,0 +1,223 @@
;;; shorten.el --- component-wise string shortener
;; Copyright (C) 2013 John J Foerch <jjfoerch@earthlink.net>
;; Keywords: extensions
;; Author: John J Foerch <jjfoerch@earthlink.net>
;; URL: https://github.com/jorgenschaefer/circe/blob/master/shorten.el
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This is a component-wise string shortener, meaning that, given a list
;; of strings, it breaks each string into parts, then computes shortest
;; prefix of each part with respect to others of the same 'depth', such
;; that when joined back together, the shortened form of the whole string
;; remains unique within the resulting list. Many styles of shortening
;; are made possible via three functions that the caller may provide: the
;; split function, the join function, and the validate-component function.
;;
;; Strings are broken with the value of `shorten-split-function' (a
;; procedure string->list), and shortened components are rejoined with the
;; value of `shorten-join-function' (a procedure list->string[*]). The
;; default split and join functions break the string on word boundaries,
;; and rejoin on the empty string. Potential shortened forms of
;; components are tested with `shorten-validate-component-function'; its
;; default value passes only if its argument contains at least one
;; word-constituent character (regexp \w), meaning that by default,
;; components consisting entirely of non-word characters will not be
;; shortened, and components that start with non-word characters will only
;; be shortened so much that they have at least one word-constituent
;; character in them.
;;
;; The main entry point is `shorten-strings', which takes a list of strings
;; as its argument and returns an alist ((STRING . SHORTENED-STRING) ...).
;;
;; [*] Also takes a second argument; see docstring of
;; `shorten-join-function'.
;;; History:
;; - Version 0.1 (March 7, 2013): initial release
;;; Code:
;; Tree utils
;;
(defsubst shorten-make-tree-root ()
(cons nil nil))
(defsubst shorten-tree-make-entry (token short full)
(list token short full nil))
(defsubst shorten-tree-token (entry)
(car entry))
(defsubst shorten-tree-fullname (entry)
(nth 2 entry))
(defsubst shorten-tree-descendants (entry)
(nthcdr 3 entry))
(defsubst shorten-tree-set-shortened (entry short)
(setcar (cdr entry) short))
(defsubst shorten-tree-set-fullname (entry full)
(setcar (nthcdr 2 entry) full))
(defsubst shorten-tree-insert (node item)
(when (car node)
(setcdr node (cons (car node) (cdr node))))
(setcar node item))
;; Caller configuration
;;
(defun shorten-split (s)
(split-string s "\\b" t))
(defun shorten-join (lst &optional tail-count)
(mapconcat #'identity lst ""))
(defun shorten-join-sans-tail (lst tail-count)
"A shorten-join that drops unnecessary tail components."
(shorten-join (butlast lst tail-count)))
(defun shorten-validate-component (str)
(string-match-p "\\w" str))
(defvar shorten-split-function #'shorten-split
"Value should be a function of string->list that breaks a
string into components. The default breaks on word-boundaries.
To get simple prefix shortening, bind this to `list'.
Users should not generally change the global value of this
variable; instead, bind it dynamically around calls to
`shorten-strings'.")
(defvar shorten-join-function #'shorten-join
"A function that takes a list of components and a tail-count,
and returns a joined string. Tail-count is the number of
components on the end of the list that are not needed to uniquify
the result, and so may be safely dropped if aggressive shortening
is desired. The default preserves tail components, and joins the
list on the empty string.
Users should not generally change the global value of this
variable; instead, bind it dynamically around calls to
`shorten-strings'.")
(defvar shorten-validate-component-function #'shorten-validate-component
"Predicate that returns t if a proposed shortened form of a
single component is acceptable, nil if a longer one should be
tried. The default validates only when the candidate contains at
least one word-constituent character, thus strings consisting of
punctuation will not be shortened. For aggressive shortening,
bind to a procedure that always returns t.
Users should not generally change the global value of this
variable; instead, bind it dynamically around calls to
`shorten-strings'.")
;; Main procedures
;;
(defun shorten-one (str others)
"Return shortest unique prefix of STR among OTHERS, or STR if
it cannot be shortened. If STR is a member of OTHERS (tested
with `eq') that entry is ignored. The value of
`shorten-validate-component-function' will be used to validate
any prefix."
(let ((max (length str))
(len 1))
(or (catch 'return
(while (< len max)
(let ((prefix (substring str 0 len)))
(when (funcall shorten-validate-component-function prefix)
(when (catch 'return
(dolist (other others t)
(when (and (>= (length other) len)
(string= (substring other 0 len) prefix)
(not (eq other str)))
(throw 'return nil))))
(throw 'return prefix)))
(setq len (1+ len)))))
str)))
(defun shorten-walk-internal (node path tail-count result-out)
(let ((others (mapcar #'car node)))
(setq tail-count (if (cdr node) 0 (1+ tail-count)))
(dolist (entry node)
(let* ((token (shorten-tree-token entry))
(shortened (shorten-one token others))
(path (cons shortened path))
(fullname (shorten-tree-fullname entry))
(descendants (shorten-tree-descendants entry))
(have-descendants (not (equal '(nil) descendants))))
(shorten-tree-set-shortened entry shortened)
;; if this entry has a fullname, add to result-out
(when fullname
(let ((joined (funcall shorten-join-function
(reverse path)
(if have-descendants 0 tail-count))))
(shorten-tree-insert result-out (cons fullname joined))))
;; if this entry has descendants, recurse
(when have-descendants
(shorten-walk-internal descendants path
(if fullname -1 tail-count)
result-out))))))
(defun shorten-walk (tree)
"Takes a tree of the type made by `shorten-make-tree' and
returns an alist ((STRING . SHORTENED-STRING) ...). Uses
`shorten-join-function' to join shortened components back
together into SHORTENED-STRING. See also
`shorten-validate-component-function'."
(let ((result-out (shorten-make-tree-root)))
(shorten-walk-internal tree '() -1 result-out)
(if (equal '(nil) result-out) nil result-out)))
(defun shorten-make-tree (strings)
"Takes a list of strings and returns a tree of the type used by
`shorten-walk' to generate shortened strings. Uses
`shorten-split-function' to split the strings."
(let ((tree (shorten-make-tree-root)))
(dolist (s strings)
(let ((node tree)
(tokens (funcall shorten-split-function s))
(entry nil))
;; create a path in tree for tokens
(dolist (token tokens)
(setq entry (assoc token node))
(when (not entry)
(setq entry (shorten-tree-make-entry token nil nil))
(shorten-tree-insert node entry))
(setq node (shorten-tree-descendants entry)))
;; for the last token, set 'fullname'
(shorten-tree-set-fullname entry s)))
(if (equal tree '(nil)) nil tree)))
;;;###autoload
(defun shorten-strings (strings)
"Takes a list of strings and returns an alist ((STRING
. SHORTENED-STRING) ...). Uses `shorten-split-function' to split
the strings, and `shorten-join-function' to join shortened
components back together into SHORTENED-STRING. See also
`shorten-validate-component-function'."
(shorten-walk (shorten-make-tree strings)))
(provide 'shorten)
;;; shorten.el ends here

391
elpa/circe-20160608.1315/tracking.el Normal file
View File

@ -0,0 +1,391 @@
;;; tracking.el --- Buffer modification tracking
;; Copyright (C) 2006, 2012 - 2015 Jorgen Schaefer
;; Author: Jorgen Schaefer <forcer@forcix.cx>
;; URL: https://github.com/jorgenschaefer/circe/wiki/Tracking
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; tracking.el is a library for other Emacs Lisp programs not useful
;; by itself.
;; The library provides a way to globally register buffers as being
;; modified and scheduled for user review. The user can cycle through
;; the buffers using C-c C-SPC. This is especially useful for buffers
;; that interact with external sources, such as chat clients and
;; similar programs.
;;; Code:
(require 'easy-mmode)
(require 'shorten)
(require 'cl-lib)
;;; User customization
(defgroup tracking nil
"Tracking of buffer activities."
:prefix "tracking-"
:group 'applications)
(defcustom tracking-shorten-buffer-names-p t
"Whether to shorten buffer names in the mode line.
A non-nil value will cause tracked buffer names to be shortened
as much as possible to stay unambiguous when displaying them in
the mode line."
:type 'boolean
:group 'tracking)
(defcustom tracking-frame-behavior 'visible
"How to deal with frams to determine visibility of buffers.
This is passed as the second argument to `get-buffer-window',
see there for further explanation."
:type '(choice (const :tag "All visible frames" visible)
(const :tag "Visible and iconified frames" 0)
(const :tag "All frames" t)
(const :tag "Selected frame only" nil))
:group 'tracking)
(defcustom tracking-position 'before-modes
"Where tracked buffers should appear in the mode line.
'before-modes
Before the mode indicators
'after-modes
After the mode indicators
'end
At the end of the mode line"
:type '(choice (const :tag "Before the Mode Indicators" before-modes)
(const :tag "Afterthe Mode Indicators" after-modes)
(const :tag "At the End of the Mode Line" end))
:group 'tracking)
(defcustom tracking-faces-priorities nil
"A list of faces which should be shown by tracking in the mode line.
The first face found in this list is used."
:type '(repeat face)
:group 'tracking)
(defcustom tracking-ignored-buffers nil
"A list of buffers that are never tracked.
Each element of this list has one of the following forms:
regexp - Any buffer matching won't be tracked.
function - Any buffer matching won't be tracked.
(regexp faces ...) - Any buffer matching won't be tracked,
unless it has a face in FACES ... associated with it.
If no faces are given, `tracking-faces-priorities' is
used.
(function faces ...) - As per above, but with a function
as predicate instead of a regexp."
:type '(repeat (choice regexp
function
(list (choice regexp function)
(repeat face))))
:group 'tracking)
(defcustom tracking-most-recent-first nil
"When non-nil, newly tracked buffers will go to the front of the
list, rather than to the end."
:type 'boolean
:group 'tracking)
(defcustom tracking-buffer-added-hook nil
"Hook run when a buffer has some activity.
The functions are run in the context of the buffer.
This can also happen when the buffer is already tracked. Check if the
buffer name is in `tracking-buffers' if you want to see if it was
added before."
:type 'hook
:group 'tracking)
(defcustom tracking-buffer-removed-hook nil
"Hook run when a buffer becomes active and is removed.
The functions are run in the context of the buffer."
:type 'hook
:group 'tracking)
;;; Internal variables
(defvar tracking-buffers nil
"The list of currently tracked buffers.")
(defvar tracking-mode-line-buffers ""
"The entry to the mode line.")
(put 'tracking-mode-line-buffers 'risky-local-variable t)
(defvar tracking-start-buffer nil
"The buffer we started from when cycling through the active buffers.")
(defvar tracking-last-buffer nil
"The buffer we last switched to with `tracking-next-buffer'.
When this is not the current buffer when we continue switching, a
new `tracking-start-buffer' is created.")
(defvar tracking-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-SPC") 'tracking-next-buffer)
(define-key map (kbd "C-c C-@") 'tracking-next-buffer)
map)
"The keymap used for tracking mode.")
;;;###autoload
(define-minor-mode tracking-mode
"Allow cycling through modified buffers.
This mode in itself does not track buffer modification, but
provides an API for programs to add buffers as modified (using
`tracking-add-buffer').
Once this mode is active, modified buffers are shown in the mode
line. The user can cycle through them using
\\[tracking-next-buffer]."
:group 'tracking
:global t
(cond
(tracking-mode
(cond
((eq tracking-position 'before-modes)
(let ((head nil)
(tail (default-value 'mode-line-format)))
(when (not (memq 'tracking-mode-line-buffers tail))
(catch 'return
(while tail
(if (not (eq (car tail)
'mode-line-modes))
(setq head (cons (car tail)
head)
tail (cdr tail))
(setq-default mode-line-format
(append (reverse head)
'(tracking-mode-line-buffers)
tail))
(throw 'return t)))))))
((eq tracking-position 'after-modes)
(add-to-list 'mode-line-misc-info
'tracking-mode-line-buffers))
((eq tracking-position 'end)
(add-to-list 'mode-line-misc-info
'tracking-mode-line-buffers
t))
(t
(error "Invalid value for `tracking-position' (%s)" tracking-position)))
(add-hook 'window-configuration-change-hook
'tracking-remove-visible-buffers))
(t
(setq mode-line-misc-info (delq 'tracking-mode-line-buffers
mode-line-misc-info))
(setq-default mode-line-format (delq 'tracking-mode-line-buffers
(default-value 'mode-line-format)))
(remove-hook 'window-configuration-change-hook
'tracking-remove-visible-buffers))))
;;;###autoload
(defun tracking-add-buffer (buffer &optional faces)
"Add BUFFER as being modified with FACES.
This does check whether BUFFER is currently visible.
If FACES is given, it lists the faces that might be appropriate
for BUFFER in the mode line. The highest-priority face of these
and the current face of the buffer, if any, is used. Priority is
decided according to `tracking-faces-priorities'."
(when (and (not (get-buffer-window buffer tracking-frame-behavior))
(not (tracking-ignored-p buffer faces)))
(with-current-buffer buffer
(run-hooks 'tracking-buffer-added-hook))
(let* ((entry (member (buffer-name buffer)
tracking-buffers)))
(if entry
(setcar entry (tracking-faces-merge (car entry)
faces))
(setq tracking-buffers
(if tracking-most-recent-first
(cons (tracking-faces-merge (buffer-name buffer)
faces)
tracking-buffers)
(nconc tracking-buffers
(list (tracking-faces-merge (buffer-name buffer)
faces)))))))
(setq tracking-mode-line-buffers (tracking-status))
(force-mode-line-update t)
))
;;;###autoload
(defun tracking-remove-buffer (buffer)
"Remove BUFFER from being tracked."
(when (member (buffer-name buffer)
tracking-buffers)
(with-current-buffer buffer
(run-hooks 'tracking-buffer-removed-hook)))
(setq tracking-buffers (delete (buffer-name buffer)
tracking-buffers))
(setq tracking-mode-line-buffers (tracking-status))
(sit-for 0) ;; Update mode line
)
;;;###autoload
(defun tracking-next-buffer ()
"Switch to the next active buffer."
(interactive)
(cond
((and (not tracking-buffers)
tracking-start-buffer)
(let ((buf tracking-start-buffer))
(setq tracking-start-buffer nil)
(if (buffer-live-p buf)
(switch-to-buffer buf)
(message "Original buffer does not exist anymore")
(ding))))
((not tracking-buffers)
nil)
(t
(when (not (eq tracking-last-buffer
(current-buffer)))
(setq tracking-start-buffer (current-buffer)))
(let ((new (car tracking-buffers)))
(when (buffer-live-p (get-buffer new))
(with-current-buffer new
(run-hooks 'tracking-buffer-removed-hook)))
(setq tracking-buffers (cdr tracking-buffers)
tracking-mode-line-buffers (tracking-status))
(if (buffer-live-p (get-buffer new))
(switch-to-buffer new)
(message "Buffer %s does not exist anymore" new)
(ding)
(setq tracking-mode-line-buffers (tracking-status))))
(setq tracking-last-buffer (current-buffer))
;; Update mode line. See `force-mode-line-update' for the idea for
;; this code. Using `sit-for' can be quite inefficient for larger
;; buffers.
(dolist (w (window-list))
(with-current-buffer (window-buffer w)))
)))
;;;###autoload
(defun tracking-previous-buffer ()
"Switch to the last active buffer."
(interactive)
(when tracking-buffers
(switch-to-buffer (car (last tracking-buffers)))))
(defun tracking-ignored-p (buffer faces)
"Return non-nil when BUFFER with FACES shouldn't be tracked.
This uses `tracking-ignored-buffers'. Actual returned value is
the entry from tracking-ignored-buffers that causes this buffer
to be ignored."
(catch 'return
(let ((buffer-name (buffer-name buffer)))
(dolist (entry tracking-ignored-buffers)
(cond
((stringp entry)
(and (string-match entry buffer-name)
(throw 'return entry)))
((functionp entry)
(and (funcall entry buffer-name)
(throw 'return entry)))
((or (and (stringp (car entry))
(string-match (car entry) buffer-name))
(and (functionp (car entry))
(funcall (car entry) buffer-name)))
(when (not (tracking-any-in (or (cdr entry)
tracking-faces-priorities)
faces))
(throw 'return entry))))))
nil))
(defun tracking-status ()
"Return the current track status.
This returns a list suitable for `mode-line-format'."
(if (not tracking-buffers)
""
(let* ((buffer-names (cl-remove-if-not #'get-buffer tracking-buffers))
(shortened-names (tracking-shorten tracking-buffers))
(result (list " [")))
(while buffer-names
(push `(:propertize
,(car shortened-names)
face ,(get-text-property 0 'face (car buffer-names))
keymap ,(let ((map (make-sparse-keymap)))
(define-key map [mode-line down-mouse-1]
`(lambda ()
(interactive)
(pop-to-buffer ,(car buffer-names))))
map)
mouse-face mode-line-highlight
help-echo ,(format (concat "New activity in %s\n"
"mouse-1: pop to the buffer")
(car buffer-names)))
result)
(setq buffer-names (cdr buffer-names)
shortened-names (cdr shortened-names))
(when buffer-names
(push "," result)))
(push "] " result)
(nreverse result))))
(defun tracking-remove-visible-buffers ()
"Remove visible buffers from the tracked buffers.
This is usually called via `window-configuration-changed-hook'."
(interactive)
(dolist (buffer-name tracking-buffers)
(let ((buffer (get-buffer buffer-name)))
(cond
((not buffer)
(setq tracking-buffers (delete buffer-name tracking-buffers))
(setq tracking-mode-line-buffers (tracking-status))
(sit-for 0))
((get-buffer-window buffer tracking-frame-behavior)
(tracking-remove-buffer buffer))))))
;;; Helper functions
(defun tracking-shorten (buffers)
"Shorten BUFFERS according to `tracking-shorten-buffer-names-p'."
(if tracking-shorten-buffer-names-p
(let ((all (shorten-strings (mapcar #'buffer-name (buffer-list)))))
(mapcar (lambda (buffer)
(let ((short (cdr (assoc buffer all))))
(set-text-properties
0 (length short)
(text-properties-at 0 buffer)
short)
short))
buffers))
buffers))
(defun tracking-any-in (lista listb)
"Return non-nil when any element in LISTA is in LISTB"
(catch 'return
(dolist (entry lista)
(when (memq entry listb)
(throw 'return t)))
nil))
(defun tracking-faces-merge (string faces)
"Merge faces into string, adhering to `tracking-faces-priorities'.
This returns STRING with the new face."
(let ((faces (cons (get-text-property 0 'face string)
faces)))
(catch 'return
(dolist (candidate tracking-faces-priorities)
(when (memq candidate faces)
(throw 'return
(propertize string 'face candidate))))
string)))
(provide 'tracking)
;;; tracking.el ends here

26
elpa/emojify-20160928.550/data/emoji-sets.json Normal file
View File

@ -0,0 +1,26 @@
{
"emojione-v2-22" : {
"description" : "Emojis provided by Emoji One (version 2), resized to 22px",
"website" : "http://emojione.com",
"url" : "https://github.com/iqbalansari/emacs-emojify/blob/a81cfd11cdd0eb5b6840d2a7fe95a9505195c1a3/emojione-v2-22.tar?raw=true",
"sha256" : "adbe3cf2c776fe7daf375d8e8dbd4c40567a1dbb753dce1d05e61a2f815572d3"
},
"emojione-v2" : {
"description" : "Emojis provided by Emoji One (version 2)",
"website" : "http://emojione.com",
"url" : "https://github.com/iqbalansari/emacs-emojify/blob/a81cfd11cdd0eb5b6840d2a7fe95a9505195c1a3/emojione-v2.tar?raw=true",
"sha256" : "46c5a600a148897da22d42d36f42ad764868568943e96917c33e0fe44113afef"
},
"emojione-v2.2.6-22" : {
"description" : "Emojis provided by Emoji One (version 2.2.6), resized to 22px",
"website" : "http://emojione.com",
"url" : "https://github.com/iqbalansari/emacs-emojify/blob/4e91ba8c2b3415cd78f53e7026fc76b9ac935fc3/emojione-v2.2.6-22.tar?raw=true",
"sha256" : "56dede1c77ad690eebc21e00913b9c7525d290f1a936f87aad282014b04bf2a7"
},
"emojione-v2.2.6" : {
"description" : "Emojis provided by Emoji One (version 2.2.6)",
"website" : "http://emojione.com",
"url" : "https://github.com/iqbalansari/emacs-emojify/blob/4e91ba8c2b3415cd78f53e7026fc76b9ac935fc3/emojione-v2.2.6.tar?raw=true",
"sha256" : "416b5807d9836a7030434710c9b859accce1e2e5c3c0dcae8ef2a0d9483ff2e9"
}
}

31306
elpa/emojify-20160928.550/data/emoji.json Normal file
View File

File diff suppressed because it is too large Load Diff

68
elpa/emojify-20160928.550/emojify-autoloads.el Normal file
View File

@ -0,0 +1,68 @@
;;; emojify-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "emojify" "emojify.el" (22533 17536 588433
;;;;;; 374000))
;;; Generated autoloads from emojify.el
(autoload 'emojify-set-emoji-styles "emojify" "\
Set the type of emojis that should be displayed.
STYLES is the styles emoji styles that should be used, see `emojify-emoji-styles'
\(fn STYLES)" nil nil)
(autoload 'emojify-mode "emojify" "\
Emojify mode
\(fn &optional ARG)" t nil)
(defvar global-emojify-mode nil "\
Non-nil if Global Emojify mode is enabled.
See the `global-emojify-mode' command
for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-emojify-mode'.")
(custom-autoload 'global-emojify-mode "emojify" nil)
(autoload 'global-emojify-mode "emojify" "\
Toggle Emojify mode in all buffers.
With prefix ARG, enable Global Emojify mode if ARG is positive;
otherwise, disable it. If called from Lisp, enable the mode if
ARG is omitted or nil.
Emojify mode is enabled in all buffers where
`emojify-mode' would do it.
See `emojify-mode' for more information on Emojify mode.
\(fn &optional ARG)" t nil)
(autoload 'emojify-apropos-emoji "emojify" "\
Show Emojis that match PATTERN.
\(fn PATTERN)" t nil)
(autoload 'emojify-insert-emoji "emojify" "\
Interactively prompt for Emojis and insert them in the current buffer.
This respects the `emojify-emoji-styles' variable.
\(fn)" t nil)
;;;***
;;;### (autoloads nil nil ("emojify-pkg.el") (22533 17536 554432
;;;;;; 598000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; emojify-autoloads.el ends here

9
elpa/emojify-20160928.550/emojify-pkg.el Normal file
View File

@ -0,0 +1,9 @@
(define-package "emojify" "20160928.550" "Display emojis in Emacs"
'((seq "1.11")
(ht "2.0")
(emacs "24.3"))
:url "https://github.com/iqbalansari/emacs-emojify" :keywords
'("multimedia" "convenience"))
;; Local Variables:
;; no-byte-compile: t
;; End:

1571
elpa/emojify-20160928.550/emojify.el Normal file
View File

File diff suppressed because it is too large Load Diff

22
elpa/gntp-20141024.1950/gntp-autoloads.el Normal file
View File

@ -0,0 +1,22 @@
;;; gntp-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "gntp" "gntp.el" (22533 17538 230470 839000))
;;; Generated autoloads from gntp.el
(autoload 'gntp-notify "gntp" "\
Send notification NAME with TITLE, TEXT, PRIORITY and ICON to SERVER:PORT.
PORT defaults to `gntp-server-port'
\(fn NAME TITLE TEXT SERVER &optional PORT PRIORITY ICON)" nil nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; gntp-autoloads.el ends here

2
elpa/gntp-20141024.1950/gntp-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "gntp" "20141024.1950" "Growl Notification Protocol for Emacs" 'nil)

243
elpa/gntp-20141024.1950/gntp.el Normal file
View File

@ -0,0 +1,243 @@
;;; gntp.el --- Growl Notification Protocol for Emacs -*- lexical-binding: t -*-
;; Author: Engelke Eschner <tekai@gmx.li>
;; Version: 0.1
;; Package-Version: 20141024.1950
;; Created: 2013-03-21
;; LICENSE
;; Copyright (c) 2013 Engelke Eschner
;; All rights reserved.
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; * Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; * Redistributions in binary form must reproduce the above
;; copyright notice, this list of conditions and the following
;; disclaimer in the documentation and/or other materials provided
;; with the distribution.
;; * Neither the name of the gntp.el nor the names of its
;; contributors may be used to endorse or promote products derived
;; from this software without specific prior written permission.
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT
;; HOLDER> BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY
;; OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;; Commentary:
;; This package implements the Growl Notification Protocol GNTP
;; described at http://www.growlforwindows.com/gfw/help/gntp.aspx
;; It is incomplete as it only lets you send but not receive
;; notifications.
;;; Code:
(defgroup gntp nil
"GNTP, send/register growl notifications via GNTP from within emacs."
:group 'external)
(defcustom gntp-application-name "Emacs/gntp.el"
"Name of the application gntp registers itself."
:type '(string))
(defcustom gntp-application-icon nil
"Icon to display as the application icon.
Either a URL or a path to a file."
:type '(string))
(defcustom gntp-server "localhost"
"Default port of the server.
Standard says can't be changed, but port-forwarding etc."
:type '(string))
(defcustom gntp-server-port 23053
"Default port of the server.
Standard says can't be changed, but port-forwarding etc."
:type '(integer))
(defcustom gntp-register-alist nil
"Registration item list."
:type '(choice string (const nil)))
(defun gntp-register (&optional notifications server port)
(interactive)
"Register NOTIFICATIONS at SERVER:PORT.
PORT defaults to `gntp-server-port'."
(let ((message (gntp-build-message-register (if notifications notifications gntp-register-alist))))
(gntp-send message (if server server gntp-server) port)))
;;;###autoload
(defun gntp-notify (name title text server &optional port priority icon)
"Send notification NAME with TITLE, TEXT, PRIORITY and ICON to SERVER:PORT.
PORT defaults to `gntp-server-port'"
(let ((message (gntp-build-message-notify name title text priority icon)))
(gntp-send message server port)))
(defun gntp-build-message-register (notifications)
"Build the message to register NOTIFICATIONS types."
(let ((lines (list "GNTP/1.0 REGISTER NONE"
(format "Application-Name: %s"
gntp-application-name)
(format "Notifications-Count: %d"
(length notifications))))
(icon-uri (gntp-app-icon-uri))
(icon-data (gntp-app-icon-data))
(icons (list)))
;; append icon uri
(when icon-uri
(nconc lines (list (format "Application-Icon: %s" icon-uri)))
;; and data when it exists
(when icon-data
(setq icons (cons icon-data icons))))
(dolist (notice notifications)
;; "For each notification being registered:
;; Each notification being registered should be seperated by a
;; blank line, including the first notification
(nconc lines (cons "" (gntp-notification-lines notice)))
;; c
(let ((icon (gntp-notice-icon-data notice)))
(when icon
(nconc icons (list "" icon)))))
;; icon data must come last
(when icons
(nconc lines (cons "" icons)))
(mapconcat 'identity (remove nil lines) "\r\n")))
(defun gntp-notification-lines (notice)
"Transform NOTICE into a list of strings."
(let ((display-name (gntp-notice-get notice :display))
(enabled (gntp-notice-get notice :enabled))
(icon-uri (gntp-notice-icon-uri notice)))
(list
;; Required - The name (type) of the notification being registered
(concat "Notification-Name: " (gntp-notice-name notice))
;; Optional - The name of the notification that is displayed to
;; the user (defaults to the same value as Notification-Name)
(when display-name
(concat "Notification-Display-Name: " display-name))
;; Optional - Indicates if the notification should be enabled by
;; default (defaults to False)
(when enabled
"Notification-Enabled: True")
;; Optional - The default icon to use for notifications of this type
(when icon-uri
(concat "Notification-Icon: " icon-uri)))))
(defun gntp-build-message-notify (name title text &optional priority icon)
"Build a message of type NAME with TITLE and TEXT."
(format
"GNTP/1.0 NOTIFY NONE\r\n\
Application-Name: %s\r\n\
Notification-Name: %s\r\n\
Notification-Title: %s\r\n\
Notification-Text: %s\r\n\
Notification-Priority: %s\r\n\
Notification-Icon: %s\r\n\
\r\n"
gntp-application-name
(if (symbolp name) (symbol-name name) name)
title
;; no CRLF in the text to avoid accidentel msg end
(replace-regexp-in-string "\r\n" "\n" text)
(if priority priority "0")
(if icon (gntp-icon-uri icon) "")))
;; notice
;;(list name ; everthing else is optional
;; :display "name to display"
;; :enabled nil
;; :icon "url or file")
(defun gntp-notice-icon-uri (notice)
"Get the icon URI from NOTICE."
(gntp-icon-uri (gntp-notice-get notice :icon)))
(defun gntp-notice-icon-data (notice)
"Get icon data from NOTICE."
(gntp-icon-data (gntp-notice-get notice :icon)))
(defun gntp-app-icon-uri ()
"Return the value to be used in the Application-Icon header."
(gntp-icon-uri gntp-application-icon))
(defun gntp-app-icon-data ()
"Return the value to be used in the Application-Icon header."
(gntp-icon-data gntp-application-icon))
(defun gntp-icon-uri (icon)
"Get the URI of ICON."
(when icon
(cond ((string-equal (substring icon 0 7) "http://") icon)
((and (file-exists-p icon) (file-readable-p icon))
(concat "x-growl-resource://" (md5 icon))))))
(defun gntp-icon-data (icon)
"Get the URI of ICON."
(when (and icon (not (string-equal (substring icon 0 7) "http://"))
(file-exists-p icon) (file-readable-p icon))
(let ((id (md5 icon))
(data (gntp-file-string icon)))
(format "Identifier: %s\r\nLength: %d\r\n\r\n%s"
id (length data) data))))
(defun gntp-notice-name (notice)
"Get the name of NOTICE. The name must be either a symbol or string."
(let ((name (car notice)))
(if (symbolp name)
(symbol-name name)
name)))
(defun gntp-notice-get (notice property)
"Get PROPERTY from NOTICE."
(plist-get (cdr notice) property))
(defun gntp-send (message server &optional port)
"Send MESSAGE to SERVER:PORT. PORT defaults to `gntp-server-port'."
(let ((proc (make-network-process
:name "gntp"
:host server
:server nil
:service (if port port gntp-server-port)
;;:sentinel 'gntp-sentinel
:filter 'gntp-filter)))
;; hmm one CRLF too much?
(process-send-string proc (concat message "\r\n\r\n\r\n"))))
(defun gntp-filter (proc string)
"Filter for PROC started by `gntp-send'.
Argument STRING reply from the server."
(when (string-equal "GNTP/1.0 -ERROR" (substring string 0 15))
(error "GNTP: Something went wrong take a look at the reply:\n %s"
string)))
;; (defun gntp-sentinel (proc msg)
;; (when (string= msg "connection broken by remote peer\n")
;; (message (format "client %s has quit" proc))))
(defun gntp-file-string (file)
"Read the contents of a FILE and return as a string."
(with-temp-buffer
(insert-file-contents-literally file)
(buffer-string)))
(provide 'gntp)
;;; gntp.el ends here

15
elpa/ht-20161015.1945/ht-autoloads.el Normal file
View File

@ -0,0 +1,15 @@
;;; ht-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil nil ("ht.el") (22533 17534 488385 459000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; ht-autoloads.el ends here

2
elpa/ht-20161015.1945/ht-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "ht" "20161015.1945" "The missing hash table library for Emacs" '((dash "2.12.0")) :keywords '("hash table" "hash map" "hash"))

288
elpa/ht-20161015.1945/ht.el Normal file
View File

@ -0,0 +1,288 @@
;;; ht.el --- The missing hash table library for Emacs
;; Copyright (C) 2013 Wilfred Hughes
;; Author: Wilfred Hughes <me@wilfred.me.uk>
;; Version: 2.2
;; Package-Version: 20161015.1945
;; Keywords: hash table, hash map, hash
;; Package-Requires: ((dash "2.12.0"))
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; The missing hash table library for Emacs.
;;
;; See documentation at https://github.com/Wilfred/ht.el
;;; Code:
(require 'dash)
(defmacro ht (&rest pairs)
"Create a hash table with the key-value pairs given.
Keys are compared with `equal'.
\(fn (KEY-1 VALUE-1) (KEY-2 VALUE-2) ...)"
(let* ((table-symbol (make-symbol "ht-temp"))
(assignments
(mapcar
(lambda (pair) `(ht-set! ,table-symbol ,@pair))
pairs)))
`(let ((,table-symbol (ht-create)))
,@assignments
,table-symbol)))
(defun ht-create (&optional test)
"Create an empty hash table.
TEST indicates the function used to compare the hash
keys. Default is `equal'. It can be `eq', `eql', `equal' or a
user-supplied test created via `define-hash-table-test'."
(make-hash-table :test (or test 'equal)))
(defun ht<-alist (alist &optional test)
"Create a hash table with initial values according to ALIST.
TEST indicates the function used to compare the hash
keys. Default is `equal'. It can be `eq', `eql', `equal' or a
user-supplied test created via `define-hash-table-test'."
(let ((h (ht-create test)))
;; the first key-value pair in an alist gets precedence, so we
;; start from the end of the list:
(dolist (pair (reverse alist) h)
(let ((key (car pair))
(value (cdr pair)))
(ht-set! h key value)))))
(defalias 'ht-from-alist 'ht<-alist)
(defun ht<-plist (plist &optional test)
"Create a hash table with initial values according to PLIST.
TEST indicates the function used to compare the hash
keys. Default is `equal'. It can be `eq', `eql', `equal' or a
user-supplied test created via `define-hash-table-test'."
(let ((h (ht-create test)))
(dolist (pair (-partition 2 plist) h)
(let ((key (car pair))
(value (cadr pair)))
(ht-set! h key value)))))
(defalias 'ht-from-plist 'ht<-plist)
(defun ht-get (table key &optional default)
"Look up KEY in TABLE, and return the matching value.
If KEY isn't present, return DEFAULT (nil if not specified)."
(gethash key table default))
(defun ht-set! (table key value)
"Associate KEY in TABLE with VALUE."
(puthash key value table)
nil)
(defalias 'ht-set 'ht-set!)
(defun ht-update! (table from-table)
"Update TABLE according to every key-value pair in FROM-TABLE."
(maphash
(lambda (key value) (puthash key value table))
from-table)
nil)
(defalias 'ht-update 'ht-update!)
(defun ht-merge (&rest tables)
"Crete a new tables that includes all the key-value pairs from TABLES.
If multiple have tables have the same key, the value in the last
table is used."
(let ((merged (ht-create)))
(mapc (lambda (table) (ht-update! merged table)) tables)
merged))
(defun ht-remove! (table key)
"Remove KEY from TABLE."
(remhash key table))
(defalias 'ht-remove 'ht-remove!)
(defun ht-clear! (table)
"Remove all keys from TABLE."
(clrhash table)
nil)
(defalias 'ht-clear 'ht-clear!)
(defun ht-map (function table)
"Apply FUNCTION to each key-value pair of TABLE, and make a list of the results.
FUNCTION is called with two arguments, KEY and VALUE."
(let (results)
(maphash
(lambda (key value)
(push (funcall function key value) results))
table)
results))
(defmacro ht-amap (form table)
"Anaphoric version of `ht-map'.
For every key-value pair in TABLE, evaluate FORM with the
variables KEY and VALUE bound."
`(ht-map (lambda (key value) ,form) ,table))
(defun ht-keys (table)
"Return a list of all the keys in TABLE."
(ht-amap key table))
(defun ht-values (table)
"Return a list of all the values in TABLE."
(ht-amap value table))
(defun ht-items (table)
"Return a list of two-element lists '(key value) from TABLE."
(ht-amap (list key value) table))
(defalias 'ht-each 'maphash
"Apply FUNCTION to each key-value pair of TABLE.
Returns nil, used for side-effects only.")
(defmacro ht-aeach (form table)
"Anaphoric version of `ht-each'.
For every key-value pair in TABLE, evaluate FORM with the
variables key and value bound."
`(ht-each (lambda (key value) ,form) ,table))
(defun ht-select-keys (table keys)
"Return a copy of TABLE with only the specified KEYS."
(let (result)
(setq result (make-hash-table :test (hash-table-test table)))
(dolist (key keys result)
(if (not (equal (gethash key table 'key-not-found) 'key-not-found))
(puthash key (gethash key table) result)))))
(defun ht->plist (table)
"Return a flat list '(key1 value1 key2 value2...) from TABLE.
Note that hash tables are unordered, so this cannot be an exact
inverse of `ht<-plist'. The following is not guaranteed:
\(let ((data '(a b c d)))
(equalp data
(ht->plist (ht<-plist data))))"
(apply 'append (ht-items table)))
(defalias 'ht-to-plist 'ht->plist)
(defun ht-copy (table)
"Return a shallow copy of TABLE (keys and values are shared)."
(copy-hash-table table))
(defun ht->alist (table)
"Return a list of two-element lists '(key . value) from TABLE.
Note that hash tables are unordered, so this cannot be an exact
inverse of `ht<-alist'. The following is not guaranteed:
\(let ((data '((a . b) (c . d))))
(equalp data
(ht->alist (ht<-alist data))))"
(ht-amap (cons key value) table))
(defalias 'ht-to-alist 'ht->alist)
(defalias 'ht? 'hash-table-p)
(defalias 'ht-p 'hash-table-p)
(defun ht-contains? (table key)
"Return 't if TABLE contains KEY."
(not (eq (ht-get table key 'ht--not-found) 'ht--not-found)))
(defalias 'ht-contains-p 'ht-contains?)
(defun ht-size (table)
"Return the actual number of entries in TABLE."
(hash-table-count table))
(defun ht-empty? (table)
"Return true if the actual number of entries in TABLE is zero."
(zerop (ht-size table)))
(defun ht-select (function table)
"Return a hash table containing all entries in TABLE for which
FUNCTION returns a truthy value.
FUNCTION is called with two arguments, KEY and VALUE."
(let ((results (ht-create)))
(ht-each
(lambda (key value)
(when (funcall function key value)
(ht-set! results key value)))
table)
results))
(defun ht-reject (function table)
"Return a hash table containing all entries in TABLE for which
FUNCTION returns a falsy value.
FUNCTION is called with two arguments, KEY and VALUE."
(let ((results (ht-create)))
(ht-each
(lambda (key value)
(unless (funcall function key value)
(ht-set! results key value)))
table)
results))
(defun ht-reject! (function table)
"Delete entries from TABLE for which FUNCTION returns a falsy value.
FUNCTION is called with two arguments, KEY and VALUE."
(ht-each
(lambda (key value)
(when (funcall function key value)
(remhash key table)))
table)
nil)
(defalias 'ht-delete-if 'ht-reject!)
(defun ht-find (function table)
"Return (key, value) from TABLE for which FUNCTION returns a truthy value.
Return nil otherwise.
FUNCTION is called with two arguments, KEY and VALUE."
(catch 'break
(ht-each
(lambda (key value)
(when (funcall function key value)
(throw 'break (list key value))))
table)))
(defun ht-equal? (table1 table2)
"Return t if TABLE1 and TABLE2 have the same keys and values.
Does not compare equality predicates."
(let ((keys1 (ht-keys table1))
(keys2 (ht-keys table2))
(sentinel (make-symbol "ht-sentinel")))
(and (equal (length keys1) (length keys2))
(--all?
(equal (ht-get table1 it)
(ht-get table2 it sentinel))
keys1))))
(defalias 'ht-equal-p 'ht-equal?)
(provide 'ht)
;;; ht.el ends here

15
elpa/log4e-20150105.505/log4e-autoloads.el Normal file
View File

@ -0,0 +1,15 @@
;;; log4e-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil nil ("log4e.el") (22533 17537 527454 800000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; log4e-autoloads.el ends here

2
elpa/log4e-20150105.505/log4e-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "log4e" "20150105.505" "provide logging framework for elisp" 'nil :url "https://github.com/aki2o/log4e" :keywords '("log"))

590
elpa/log4e-20150105.505/log4e.el Normal file
View File

@ -0,0 +1,590 @@
;;; log4e.el --- provide logging framework for elisp
;; Copyright (C) 2013 Hiroaki Otsu
;; Author: Hiroaki Otsu <ootsuhiroaki@gmail.com>
;; Keywords: log
;; Package-Version: 20150105.505
;; URL: https://github.com/aki2o/log4e
;; Version: 0.3.0
;; 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 file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This extension provides logging framework for elisp.
;;; Dependency:
;;
;; Nothing.
;;; Installation:
;;
;; Put this to your load-path.
;; And put the following lines in your elisp file.
;;
;; (require 'log4e)
;;; Configuration:
;;
;; See <https://github.com/aki2o/log4e/blob/master/README.md>
;; Otherwise, eval following sexp.
;; (describe-function 'log4e:deflogger)
;;; API:
;;
;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "log4e:" :docstring t)
;; `log4e:next-log'
;; Move to start of next log on log4e-mode.
;; `log4e:previous-log'
;; Move to start of previous log on log4e-mode.
;; `log4e:insert-start-log-quickly'
;; Insert logging statment for trace level log at start of current function/macro.
;;
;; *** END auto-documentation
;;
;; For detail, see <https://github.com/aki2o/log4e/blob/master/README.md>
;;
;; [Note] Other than listed above, Those specifications may be changed without notice.
;;; Tested On:
;;
;; - Emacs ... GNU Emacs 23.3.1 (i386-mingw-nt5.1.2600) of 2011-08-15 on GNUPACK
;; Enjoy!!!
;;; Code:
(eval-when-compile (require 'cl))
(require 'rx)
(defconst log4e-log-level-alist '((fatal . 6)
(error . 5)
(warn . 4)
(info . 3)
(debug . 2)
(trace . 1))
"Alist of log level value.")
(defconst log4e-default-logging-function-name-alist '((fatal . "log-fatal")
(error . "log-error")
(warn . "log-warn")
(info . "log-info")
(debug . "log-debug")
(trace . "log-trace"))
"Alist of logging function name at default.")
(defmacro log4e--def-symmaker (symnm)
`(progn
(defsubst ,(intern (concat "log4e--make-symbol-" symnm)) (prefix)
(intern (concat ,(format "log4e--%s-" symnm) prefix)))))
(log4e--def-symmaker "log-buffer")
(log4e--def-symmaker "msg-buffer")
(log4e--def-symmaker "log-template")
(log4e--def-symmaker "time-template")
(log4e--def-symmaker "min-level")
(log4e--def-symmaker "max-level")
(log4e--def-symmaker "toggle-logging")
(log4e--def-symmaker "toggle-debugging")
(log4e--def-symmaker "buffer-coding-system")
(log4e--def-symmaker "author-mail-address")
(defmacro log4e--def-level-logger (prefix suffix level)
(let ((argform (if suffix
'(msg &rest msgargs)
'(level msg &rest msgargs)))
(buff (log4e--make-symbol-log-buffer prefix))
(codsys (log4e--make-symbol-buffer-coding-system prefix))
(logtmpl (log4e--make-symbol-log-template prefix))
(timetmpl (log4e--make-symbol-time-template prefix))
(minlvl (log4e--make-symbol-min-level prefix))
(maxlvl (log4e--make-symbol-max-level prefix))
(logging-p (log4e--make-symbol-toggle-logging prefix)))
`(progn
;; Define logging function
(defun ,(intern (concat prefix "--" (or suffix "log"))) ,argform
,(format "Do logging for %s level log.
%sMSG/MSGARGS are passed to `format'."
(or (eval level) "any")
(if suffix "" "LEVEL is symbol as a log level in '(trace debug info warn error fatal).\n"))
(let ((log4e--current-msg-buffer ,(log4e--make-symbol-msg-buffer prefix)))
(apply 'log4e--logging ,buff ,codsys ,logtmpl ,timetmpl ,minlvl ,maxlvl ,logging-p ,(if suffix level 'level) msg msgargs)))
;; Define logging macro
(defmacro ,(intern (concat prefix "--" (or suffix "log") "*")) ,argform
,(format "Do logging for %s level log.
%sMSG/MSGARGS are passed to `format'.
Evaluation of MSGARGS is invoked only if %s level log should be printed."
(or (eval level) "any")
(if suffix "" "LEVEL is symbol as a log level in '(trace debug info warn error fatal).\n")
(or (eval level) "the"))
(let ((prefix ,prefix)
(suffix ,suffix)
(level ',level)
(msg msg)
(msgargs msgargs)
(buff (log4e--make-symbol-log-buffer ,prefix))
(codsys (log4e--make-symbol-buffer-coding-system ,prefix))
(logtmpl (log4e--make-symbol-log-template ,prefix))
(timetmpl (log4e--make-symbol-time-template ,prefix))
(minlvl (log4e--make-symbol-min-level ,prefix))
(maxlvl (log4e--make-symbol-max-level ,prefix))
(logging-p (log4e--make-symbol-toggle-logging ,prefix)))
`(let ((log4e--current-msg-buffer ,(log4e--make-symbol-msg-buffer prefix)))
(when (and ,logging-p
(log4e--logging-level-p ,minlvl ,maxlvl ,level))
(log4e--logging ,buff ,codsys ,logtmpl ,timetmpl ,minlvl ,maxlvl ,logging-p ,(if suffix level 'level) ,msg ,@msgargs)))))
)))
(defsubst log4e--logging-level-p (minlevel maxlevel currlevel)
(let ((minlvlvalue (or (assoc-default minlevel log4e-log-level-alist)
1))
(maxlvlvalue (or (assoc-default maxlevel log4e-log-level-alist)
6))
(currlvlvalue (or (assoc-default currlevel log4e-log-level-alist)
0)))
(and (>= currlvlvalue minlvlvalue)
(<= currlvlvalue maxlvlvalue))))
(defsubst log4e--get-or-create-log-buffer (buffnm &optional codesys)
(or (get-buffer buffnm)
(let ((buff (get-buffer-create buffnm)))
(with-current-buffer buff
(log4e-mode)
(when codesys
(setq buffer-file-coding-system codesys)))
buff)))
(defvar log4e--regexp-msg-format
(rx-to-string `(and "%"
(* (any "+#-0")) ; flags
(* (any "0-9")) ; width
(? "." (+ (any "0-9"))) ; precision
(any "a-zA-Z"))))
(defsubst log4e--insert-log (logtmpl timetmpl level msg msgargs propertize-p)
(let ((timetext (format-time-string timetmpl))
(lvltext (format "%-05s" (upcase (symbol-name level))))
(buffer-read-only nil))
(when propertize-p
(put-text-property 0 (length timetext) 'face 'font-lock-doc-face timetext)
(put-text-property 0 (length lvltext) 'face 'font-lock-keyword-face lvltext))
(let* ((logtext logtmpl)
(logtext (replace-regexp-in-string "%t" timetext logtext))
(logtext (replace-regexp-in-string "%l" lvltext logtext))
(logtext (replace-regexp-in-string "%m" msg logtext))
(begin (point)))
(insert logtext "\n")
(when propertize-p
(put-text-property begin (+ begin 1) 'log4e--level level))
(loop initially (goto-char begin)
while (and msgargs
(re-search-forward log4e--regexp-msg-format nil t))
for currtype = (match-string-no-properties 0)
for currarg = (pop msgargs)
for failfmt = nil
for currtext = (condition-case e
(format currtype currarg)
(error (setq failfmt t)
(format "=%s=" (error-message-string e))))
if propertize-p
do (ignore-errors
(cond (failfmt (put-text-property 0 (length currtext) 'face 'font-lock-warning-face currtext))
(t (put-text-property 0 (length currtext) 'face 'font-lock-string-face currtext))))
do (replace-match currtext t t))
(goto-char begin))))
(defvar log4e--current-msg-buffer nil)
;; We needs this signature be stay for other compiled plugins using old version
(defun log4e--logging (buffnm codsys logtmpl timetmpl minlevel maxlevel logging-p level msg &rest msgargs)
(when (and logging-p
(log4e--logging-level-p minlevel maxlevel level))
(save-match-data
(with-current-buffer (log4e--get-or-create-log-buffer buffnm codsys)
(goto-char (point-max))
(let* ((buffer-read-only nil)
(begin (point))
(currlog (progn
(log4e--insert-log logtmpl timetmpl level msg msgargs t)
(goto-char (point-max))
(buffer-substring-no-properties begin (point))))
(msgbuf (or (when (and log4e--current-msg-buffer
(not (eq log4e--current-msg-buffer t)))
(ignore-errors (get-buffer log4e--current-msg-buffer)))
log4e--current-msg-buffer)))
(when msgbuf
(let ((standard-output (if (buffer-live-p msgbuf)
msgbuf
standard-output)))
(princ currlog))))
nil))))
(defun log4e--get-current-log-line-level ()
(save-excursion
(beginning-of-line)
(get-text-property (point) 'log4e--level)))
;; We needs this signature be stay for other plugins compiled with this old version
(defun log4e--clear-log (buffnm)
(with-current-buffer (log4e--get-or-create-log-buffer buffnm)
(setq buffer-read-only nil)
(erase-buffer)))
;; We needs this signature be stay for other plugins compiled with this old version
(defun log4e--open-log (buffnm)
(let* ((buff (get-buffer buffnm)))
(if (not (buffer-live-p buff))
(message "[Log4E] Not exist log buffer.")
(with-current-buffer buff
(setq buffer-read-only t))
(pop-to-buffer buff))))
;; We needs this signature be stay for other plugins compiled with this old version
(defun log4e--open-log-if-debug (buffnm dbg)
(when dbg
(log4e--open-log buffnm)))
;; (defun log4e--send-report-if-not-debug (buffnm dbg addr prefix)
;; (let* ((buff (get-buffer buffnm)))
;; (when (and (not dbg)
;; (stringp addr)
;; (buffer-live-p buff))
;; (reporter-submit-bug-report addr prefix nil nil nil nil))))
(defmacro log4e:deflogger (prefix msgtmpl timetmpl &optional log-function-name-custom-alist)
"Define the functions of logging for your elisp.
Specification:
After eval this, you can use the functions for supporting about logging. They are the following ...
- do logging for each log level. Log level are trace, debug, info, warn, error and fatal.
- set max and min log level.
- switch logging.
- switch debugging.
- open and clear log buffer.
- send bug report for you.
For details, see Functions section.
Argument:
- PREFIX is string as your elisp prefix.
- MSGTMPL is string as format of log. The following words has a special meaning.
- %t ... Replaced with time string. About it, see TIMETMPL argument.
- %l ... Replaced with log level. They are 'TRACE', 'DEBUG', 'INFO', 'WARN', 'ERROR', 'FATAL'.
- %m ... Replaced with log message that passed by you.
- TIMETMPL is string as format of time. This value is passed to `format-time-string'.
- LOG-FUNCTION-NAME-CUSTOM-ALIST is alist as the function name of logging.
- If this value is nil, define the following functions.
yourprefix--log-trace
yourprefix--log-debug
...
yourprefix--log-fatal
- If you want to custom the name of them, give like the following value.
'((fatal . \"fatal\")
(error . \"error\")
(warn . \"warn\")
(info . \"info\")
(debug . \"debug\")
(trace . \"trace\"))
Then, define the following functions.
yourprefix--trace
yourprefix--debug
...
yourprefix--fatal
Functions:
List all functions defined below. PREFIX is your prefix.
- PREFIX--log-fatal ... #1
- PREFIX--log-error ... #1
- PREFIX--log-warn ... #1
- PREFIX--log-info ... #1
- PREFIX--log-debug ... #1
- PREFIX--log-trace ... #1
- PREFIX--log-fatal* ... #2
- PREFIX--log-error* ... #2
- PREFIX--log-warn* ... #2
- PREFIX--log-info* ... #2
- PREFIX--log-debug* ... #2
- PREFIX--log-trace* ... #2
- PREFIX--log
- PREFIX--log-set-level
- PREFIX--log-enable-logging ... #3
- PREFIX--log-disable-logging ... #3
- PREFIX--log-enable-messaging ... #3
- PREFIX--log-disable-messaging ... #3
- PREFIX--log-enable-debugging ... #3
- PREFIX--log-disable-debugging ... #3
- PREFIX--log-debugging-p
- PREFIX--log-set-coding-system
- PREFIX--log-set-author-mail-address
- PREFIX--log-clear-log ... #3
- PREFIX--log-open-log ... #3
- PREFIX--log-open-log-if-debug
#1 : You can customize this name
#2 : Name is a #1 name + \"*\"
#3 : This is command
Example:
;; If you develop elisp that has prefix \"hoge\", write and eval the following sexp in your elisp file.
(require 'log4e)
(log4e:deflogger \"hoge\" \"%t [%l] %m\" \"%H:%M:%S\")
;; Eval the following
(hoge--log-enable-logging)
;; Then, write the following
(defun hoge-do-hoge (hoge)
(if (not (stringp hoge))
(hoge--log-fatal \"failed do hoge : hoge is '%s'\" hoge)
(hoge--log-debug \"start do hoge about '%s'\" hoge)
(message \"hoge!\")
(hoge--log-info \"done hoge about '%s'\" hoge)))
;; Eval the following
(hoge-do-hoge \"HOGEGE\")
;; Do M-x hoge--log-open-log
;; Open the buffer which name is \" *log4e-hoge*\". The buffer string is below
12:34:56 [INFO ] done hoge about 'HOGEGE'
;; Eval the following
(hoge--log-set-level 'trace)
(hoge-do-hoge \"FUGAGA\")
;; Do M-x hoge--log-open-log
;; Open the buffer. its string is below
12:34:56 [INFO ] done hoge about 'HOGEGE'
12:35:43 [DEBUG] start do hoge about 'FUGAGA'
12:35:43 [INFO ] done hoge about 'FUGAGA'
"
(declare (indent 0))
(if (or (not (stringp prefix)) (string= prefix "")
(not (stringp msgtmpl)) (string= msgtmpl "")
(not (stringp timetmpl)) (string= timetmpl ""))
(message "[LOG4E] invalid argument of deflogger")
(let* ((bufsym (log4e--make-symbol-log-buffer prefix))
(msgbufsym (log4e--make-symbol-msg-buffer prefix))
(logtmplsym (log4e--make-symbol-log-template prefix))
(timetmplsym (log4e--make-symbol-time-template prefix))
(minlvlsym (log4e--make-symbol-min-level prefix))
(maxlvlsym (log4e--make-symbol-max-level prefix))
(tglsym (log4e--make-symbol-toggle-logging prefix))
(dbgsym (log4e--make-symbol-toggle-debugging prefix))
(codsyssym (log4e--make-symbol-buffer-coding-system prefix))
(addrsym (log4e--make-symbol-author-mail-address prefix))
(funcnm-alist (loop with custom-alist = (car (cdr log-function-name-custom-alist))
for lvl in '(fatal error warn info debug trace)
for lvlpair = (assq lvl custom-alist)
for fname = (or (cdr-safe lvlpair) "")
collect (or (if (string-match "\*" fname)
(progn
(message "[LOG4E] ignore %s level name in log-function-name-custom-alist. can't use '*' for the name." lvl)
nil)
lvlpair)
(assq lvl log4e-default-logging-function-name-alist)))))
`(progn
;; Define variable for prefix
(defvar ,bufsym (format " *log4e-%s*" ,prefix))
(defvar ,logtmplsym ,msgtmpl)
(defvar ,timetmplsym ,timetmpl)
(defvar ,minlvlsym 'info)
(defvar ,maxlvlsym 'fatal)
(defvar ,tglsym nil)
(defvar ,msgbufsym nil)
(defvar ,dbgsym nil)
(defvar ,codsyssym nil)
(defvar ,addrsym nil)
;; Define level set function
(defun ,(intern (concat prefix "--log-set-level")) (minlevel &optional maxlevel)
"Set range for doing logging.
MINLEVEL is symbol of lowest level for doing logging. its default is 'info.
MAXLEVEL is symbol of highest level for doing logging. its default is 'fatal."
(setq ,minlvlsym minlevel)
(setq ,maxlvlsym maxlevel))
;; Define logging toggle function
(defun ,(intern (concat prefix "--log-enable-logging")) ()
"Enable logging by logging functions."
(interactive)
(setq ,tglsym t))
(defun ,(intern (concat prefix "--log-disable-logging")) ()
"Disable logging by logging functions."
(interactive)
(setq ,tglsym nil))
;; Define messaging toggle function
(defun ,(intern (concat prefix "--log-enable-messaging")) (&optional buffer)
"Enable dump the log into other buffer by logging functions.
BUFFER is a buffer dumped log into. nil means *Messages* buffer."
(interactive)
(setq ,msgbufsym (or buffer t)))
(defun ,(intern (concat prefix "--log-disable-messaging")) ()
"Disable dump the log into other buffer by logging functions."
(interactive)
(setq ,msgbufsym nil))
;; Define debugging toggle function
(defun ,(intern (concat prefix "--log-enable-debugging")) ()
"Enable debugging and logging.
`PREFIX--log-debugging-p' will return t."
(interactive)
(setq ,tglsym t)
(setq ,dbgsym t))
(defun ,(intern (concat prefix "--log-disable-debugging")) ()
"Disable debugging.
`PREFIX--log-debugging-p' will return nil."
(interactive)
(setq ,dbgsym nil))
(defun ,(intern (concat prefix "--log-debugging-p")) ()
,dbgsym)
;; Define coding system set funtion
(defun ,(intern (concat prefix "--log-set-coding-system")) (coding-system)
"Set charset and linefeed of LOG-BUFFER.
CODING-SYSTEM is symbol for setting to `buffer-file-coding-system'.
LOG-BUFFER is a buffer which name is \" *log4e-PREFIX*\"."
(setq ,codsyssym coding-system))
;; ;; Define author mail set function
;; (defun ,(intern (concat prefix "--log-set-author-mail-address")) (before-atmark after-atmark)
;; "Set mail address of author for elisp that has PREFIX. This value is used SEND-REPORT.
;; BEFORE-ATMARK is string as part of mail address. If your address is \"hoge@example.co.jp\", it is \"hoge\".
;; AFTER-ATMARK is string as part of mail address. If your address is \"hoge@example.co.jp\", it is \"example.co.jp\".
;; SEND-REPORT is `PREFIX--log-send-report-if-not-debug'."
;; (setq ,addrsym (concat before-atmark "@" after-atmark)))
;; Define log buffer handle function
(defun ,(intern (concat prefix "--log-clear-log")) ()
"Clear buffer string of buffer which name is \" *log4e-PREFIX*\"."
(interactive)
(log4e--clear-log ,bufsym))
(defun ,(intern (concat prefix "--log-open-log")) ()
"Open buffer which name is \" *log4e-PREFIX*\"."
(interactive)
(log4e--open-log ,bufsym))
(defun ,(intern (concat prefix "--log-open-log-if-debug")) ()
"Open buffer which name is \" *log4e-PREFIX*\" if debugging is enabled."
(log4e--open-log-if-debug ,bufsym ,dbgsym))
;; ;; Define report send function
;; (defun ,(intern (concat prefix "--log-send-report-if-not-debug")) ()
;; "Send bug report to author if debugging is disabled.
;; The author mailaddress is set by `PREFIX--log-set-author-mail-address'.
;; About the way of sending bug report, see `reporter-submit-bug-report'."
;; (log4e--send-report-if-not-debug ,bufsym ,dbgsym ,addrsym ,prefix))
;; Define each level logging function
(log4e--def-level-logger ,prefix nil nil)
(log4e--def-level-logger ,prefix ,(assoc-default 'fatal funcnm-alist) 'fatal)
(log4e--def-level-logger ,prefix ,(assoc-default 'error funcnm-alist) 'error)
(log4e--def-level-logger ,prefix ,(assoc-default 'warn funcnm-alist) 'warn)
(log4e--def-level-logger ,prefix ,(assoc-default 'info funcnm-alist) 'info)
(log4e--def-level-logger ,prefix ,(assoc-default 'debug funcnm-alist) 'debug)
(log4e--def-level-logger ,prefix ,(assoc-default 'trace funcnm-alist) 'trace)
))))
(define-derived-mode log4e-mode view-mode "Log4E"
"Major mode for browsing a buffer made by log4e.
\\<log4e-mode-map>
\\{log4e-mode-map}"
(define-key log4e-mode-map (kbd "J") 'log4e:next-log)
(define-key log4e-mode-map (kbd "K") 'log4e:previous-log))
(defun log4e:next-log ()
"Move to start of next log on log4e-mode."
(interactive)
(let* ((level))
(while (and (not level)
(< (point) (point-max)))
(forward-line 1)
(setq level (log4e--get-current-log-line-level)))
level))
(defun log4e:previous-log ()
"Move to start of previous log on log4e-mode."
(interactive)
(let* ((level))
(while (and (not level)
(> (point) (point-min)))
(forward-line -1)
(setq level (log4e--get-current-log-line-level)))
level))
(defun log4e:insert-start-log-quickly ()
"Insert logging statment for trace level log at start of current function/macro."
(interactive)
(let* ((fstartpt (when (re-search-backward "(\\(?:defun\\|defmacro\\|defsubst\\)\\*? +\\([^ ]+\\) +(\\([^)]*\\))" nil t)
(point)))
(fncnm (when fstartpt (match-string-no-properties 1)))
(argtext (when fstartpt (match-string-no-properties 2)))
(prefix (save-excursion
(goto-char (point-min))
(loop while (re-search-forward "(log4e:deflogger[ \n]+\"\\([^\"]+\\)\"" nil t)
for prefix = (match-string-no-properties 1)
for currface = (get-text-property (match-beginning 0) 'face)
if (not (eq currface 'font-lock-comment-face))
return prefix))))
(when (and fstartpt prefix)
(let* ((fncnm (replace-regexp-in-string (concat "\\`" prefix "[^a-zA-Z0-9]+") "" fncnm))
(fncnm (replace-regexp-in-string "-" " " fncnm))
(argtext (replace-regexp-in-string "\n" " " argtext))
(argtext (replace-regexp-in-string "^ +" "" argtext))
(argtext (replace-regexp-in-string " +$" "" argtext))
(args (split-string argtext " +"))
(args (loop for arg in args
if (and (not (string= arg ""))
(not (string-match "\\`&" arg)))
collect arg))
(logtext (loop with ret = (format "start %s." fncnm)
for arg in args
do (setq ret (concat ret " " arg "[%s]"))
finally return ret))
(sexpformat (loop with ret = "(%s--log 'trace \"%s\""
for arg in args
do (setq ret (concat ret " %s"))
finally return (concat ret ")")))
(inserttext (apply 'format sexpformat prefix logtext args)))
(forward-char)
(forward-sexp 3)
(when (re-search-forward "\\=[ \n]+\"" nil t)
(forward-char -1)
(forward-sexp))
(newline-and-indent)
(insert inserttext)))))
(provide 'log4e)
;;; log4e.el ends here

45
elpa/oauth2-0.11/oauth2-autoloads.el Normal file
View File

@ -0,0 +1,45 @@
;;; oauth2-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "oauth2" "oauth2.el" (22533 17544 732619 192000))
;;; Generated autoloads from oauth2.el
(autoload 'oauth2-refresh-access "oauth2" "\
Refresh OAuth access TOKEN.
TOKEN should be obtained with `oauth2-request-access'.
\(fn TOKEN)" nil nil)
(autoload 'oauth2-auth "oauth2" "\
Authenticate application via OAuth2.
\(fn AUTH-URL TOKEN-URL CLIENT-ID CLIENT-SECRET &optional SCOPE STATE REDIRECT-URI)" nil nil)
(autoload 'oauth2-auth-and-store "oauth2" "\
Request access to a resource and store it using `plstore'.
\(fn AUTH-URL TOKEN-URL RESOURCE-URL CLIENT-ID CLIENT-SECRET &optional REDIRECT-URI)" nil nil)
(autoload 'oauth2-url-retrieve-synchronously "oauth2" "\
Retrieve an URL synchronously using TOKEN to access it.
TOKEN can be obtained with `oauth2-auth'.
\(fn TOKEN URL &optional REQUEST-METHOD REQUEST-DATA REQUEST-EXTRA-HEADERS)" nil nil)
(autoload 'oauth2-url-retrieve "oauth2" "\
Retrieve an URL asynchronously using TOKEN to access it.
TOKEN can be obtained with `oauth2-auth'. CALLBACK gets called with CBARGS
when finished. See `url-retrieve'.
\(fn TOKEN URL CALLBACK &optional CBARGS REQUEST-METHOD REQUEST-DATA REQUEST-EXTRA-HEADERS)" nil nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; oauth2-autoloads.el ends here

2
elpa/oauth2-0.11/oauth2-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "oauth2" "0.11" "OAuth 2.0 Authorization Protocol" 'nil :url "http://elpa.gnu.org/packages/oauth2.html" :keywords '("comm"))

342
elpa/oauth2-0.11/oauth2.el Normal file
View File

@ -0,0 +1,342 @@
;;; oauth2.el --- OAuth 2.0 Authorization Protocol
;; Copyright (C) 2011-2016 Free Software Foundation, Inc
;; Author: Julien Danjou <julien@danjou.info>
;; Version: 0.11
;; Keywords: comm
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Implementation of the OAuth 2.0 draft.
;;
;; The main entry point is `oauth2-auth-and-store' which will return a token
;; structure. This token structure can be then used with
;; `oauth2-url-retrieve-synchronously' or `oauth2-url-retrieve' to retrieve
;; any data that need OAuth authentication to be accessed.
;;
;; If the token needs to be refreshed, the code handles it automatically and
;; store the new value of the access token.
;;; Code:
(eval-when-compile (require 'cl))
(require 'plstore)
(require 'json)
(require 'url-http)
(defun oauth2-request-authorization (auth-url client-id &optional scope state redirect-uri)
"Request OAuth authorization at AUTH-URL by launching `browse-url'.
CLIENT-ID is the client id provided by the provider.
It returns the code provided by the service."
(browse-url (concat auth-url
(if (string-match-p "\?" auth-url) "&" "?")
"client_id=" (url-hexify-string client-id)
"&response_type=code"
"&redirect_uri=" (url-hexify-string (or redirect-uri "urn:ietf:wg:oauth:2.0:oob"))
(if scope (concat "&scope=" (url-hexify-string scope)) "")
(if state (concat "&state=" (url-hexify-string state)) "")))
(read-string "Enter the code your browser displayed: "))
(defun oauth2-request-access-parse ()
"Parse the result of an OAuth request."
(goto-char (point-min))
(when (search-forward-regexp "^$" nil t)
(json-read)))
(defun oauth2-make-access-request (url data)
"Make an access request to URL using DATA in POST."
(let ((url-request-method "POST")
(url-request-data data)
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(with-current-buffer (url-retrieve-synchronously url)
(let ((data (oauth2-request-access-parse)))
(kill-buffer (current-buffer))
data))))
(defstruct oauth2-token
plstore
plstore-id
client-id
client-secret
access-token
refresh-token
token-url
access-response)
(defun oauth2-request-access (token-url client-id client-secret code &optional redirect-uri)
"Request OAuth access at TOKEN-URL.
The CODE should be obtained with `oauth2-request-authorization'.
Return an `oauth2-token' structure."
(when code
(let ((result
(oauth2-make-access-request
token-url
(concat
"client_id=" client-id
"&client_secret=" client-secret
"&code=" code
"&redirect_uri=" (url-hexify-string (or redirect-uri "urn:ietf:wg:oauth:2.0:oob"))
"&grant_type=authorization_code"))))
(make-oauth2-token :client-id client-id
:client-secret client-secret
:access-token (cdr (assoc 'access_token result))
:refresh-token (cdr (assoc 'refresh_token result))
:token-url token-url
:access-response result))))
;;;###autoload
(defun oauth2-refresh-access (token)
"Refresh OAuth access TOKEN.
TOKEN should be obtained with `oauth2-request-access'."
(setf (oauth2-token-access-token token)
(cdr (assoc 'access_token
(oauth2-make-access-request
(oauth2-token-token-url token)
(concat "client_id=" (oauth2-token-client-id token)
"&client_secret=" (oauth2-token-client-secret token)
"&refresh_token=" (oauth2-token-refresh-token token)
"&grant_type=refresh_token")))))
;; If the token has a plstore, update it
(let ((plstore (oauth2-token-plstore token)))
(when plstore
(plstore-put plstore (oauth2-token-plstore-id token)
nil `(:access-token
,(oauth2-token-access-token token)
:refresh-token
,(oauth2-token-refresh-token token)
:access-response
,(oauth2-token-access-response token)
))
(plstore-save plstore)))
token)
;;;###autoload
(defun oauth2-auth (auth-url token-url client-id client-secret &optional scope state redirect-uri)
"Authenticate application via OAuth2."
(oauth2-request-access
token-url
client-id
client-secret
(oauth2-request-authorization
auth-url client-id scope state redirect-uri)
redirect-uri))
(defcustom oauth2-token-file (concat user-emacs-directory "oauth2.plstore")
"File path where store OAuth tokens."
:group 'oauth2
:type 'file)
(defun oauth2-compute-id (auth-url token-url resource-url)
"Compute an unique id based on URLs.
This allows to store the token in an unique way."
(secure-hash 'md5 (concat auth-url token-url resource-url)))
;;;###autoload
(defun oauth2-auth-and-store (auth-url token-url resource-url client-id client-secret &optional redirect-uri)
"Request access to a resource and store it using `plstore'."
;; We store a MD5 sum of all URL
(let* ((plstore (plstore-open oauth2-token-file))
(id (oauth2-compute-id auth-url token-url resource-url))
(plist (cdr (plstore-get plstore id))))
;; Check if we found something matching this access
(if plist
;; We did, return the token object
(make-oauth2-token :plstore plstore
:plstore-id id
:client-id client-id
:client-secret client-secret
:access-token (plist-get plist :access-token)
:refresh-token (plist-get plist :refresh-token)
:token-url token-url
:access-response (plist-get plist :access-response))
(let ((token (oauth2-auth auth-url token-url
client-id client-secret resource-url nil redirect-uri)))
;; Set the plstore
(setf (oauth2-token-plstore token) plstore)
(setf (oauth2-token-plstore-id token) id)
(plstore-put plstore id nil `(:access-token
,(oauth2-token-access-token token)
:refresh-token
,(oauth2-token-refresh-token token)
:access-response
,(oauth2-token-access-response token)))
(plstore-save plstore)
token))))
(defun oauth2-url-append-access-token (token url)
"Append access token to URL."
(concat url
(if (string-match-p "\?" url) "&" "?")
"access_token=" (oauth2-token-access-token token)))
(defvar oauth--url-advice nil)
(defvar oauth--token-data)
(defun oauth2-authz-bearer-header (token)
"Return 'Authoriztions: Bearer' header with TOKEN."
(cons "Authorization" (format "Bearer %s" token)))
(defun oauth2-extra-headers (extra-headers)
"Return EXTRA-HEADERS with 'Authorization: Bearer' added."
(cons (oauth2-authz-bearer-header (oauth2-token-access-token (car oauth--token-data)))
extra-headers))
;; FIXME: We should change URL so that this can be done without an advice.
(defadvice url-http-handle-authentication (around oauth-hack activate)
(if (not oauth--url-advice)
ad-do-it
(let ((url-request-method url-http-method)
(url-request-data url-http-data)
(url-request-extra-headers
(oauth2-extra-headers url-http-extra-headers))))
(oauth2-refresh-access (car oauth--token-data))
(url-retrieve-internal (cdr oauth--token-data)
url-callback-function
url-callback-arguments)
;; This is to make `url' think it's done.
(when (boundp 'success) (setq success t)) ;For URL library in Emacs<24.4.
(setq ad-return-value t))) ;For URL library in Emacs≥24.4.
;;;###autoload
(defun oauth2-url-retrieve-synchronously (token url &optional request-method request-data request-extra-headers)
"Retrieve an URL synchronously using TOKEN to access it.
TOKEN can be obtained with `oauth2-auth'."
(let* ((oauth--token-data (cons token url)))
(let ((oauth--url-advice t) ;Activate our advice.
(url-request-method request-method)
(url-request-data request-data)
(url-request-extra-headers
(oauth2-extra-headers request-extra-headers)))
(url-retrieve-synchronously url))))
;;;###autoload
(defun oauth2-url-retrieve (token url callback &optional
cbargs
request-method request-data request-extra-headers)
"Retrieve an URL asynchronously using TOKEN to access it.
TOKEN can be obtained with `oauth2-auth'. CALLBACK gets called with CBARGS
when finished. See `url-retrieve'."
;; TODO add support for SILENT and INHIBIT-COOKIES. How to handle this in `url-http-handle-authentication'.
(let* ((oauth--token-data (cons token url)))
(let ((oauth--url-advice t) ;Activate our advice.
(url-request-method request-method)
(url-request-data request-data)
(url-request-extra-headers
(oauth2-extra-headers request-extra-headers)))
(url-retrieve url callback cbargs))))
;;;; ChangeLog:
;; 2016-07-09 Julien Danjou <julien@danjou.info>
;;
;; oauth2: send authentication token via Authorization header
;;
;; 2014-01-28 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
;;
;; oauth2.el: Add support for async retrieve.
;;
;; * packages/oauth2/oauth2.el (oauth--tokens-need-renew): Remove.
;; (oauth--token-data): New variable.
;; (url-http-handle-authentication): Call `url-retrieve-internal'
;; directly instead of depending on `oauth--tokens-need-renew'.
;; (oauth2-url-retrieve-synchronously): Call `url-retrieve' once.
;; (oauth2-url-retrieve): New function.
;;
;; Signed-off-by: Rüdiger Sonderfeld <ruediger@c-plusplus.de>
;; Signed-off-by: Julien Danjou <julien@danjou.info>
;;
;; 2013-07-22 Stefan Monnier <monnier@iro.umontreal.ca>
;;
;; * oauth2.el: Only require CL at compile time and avoid flet.
;; (success): Don't defvar.
;; (oauth--url-advice, oauth--tokens-need-renew): New dynbind variables.
;; (url-http-handle-authentication): Add advice.
;; (oauth2-url-retrieve-synchronously): Use the advice instead of flet.
;;
;; 2013-06-29 Julien Danjou <julien@danjou.info>
;;
;; oauth2: release 0.9, require url-http
;;
;; This is needed so that the `flet' calls doesn't restore the overriden
;; function to an unbound one.
;;
;; Signed-off-by: Julien Danjou <julien@danjou.info>
;;
;; 2012-08-01 Julien Danjou <julien@danjou.info>
;;
;; oauth2: upgrade to 0.8, add missing require on cl
;;
;; 2012-07-03 Julien Danjou <julien@danjou.info>
;;
;; oauth2: store access-reponse, bump versino to 0.7
;;
;; 2012-06-25 Julien Danjou <julien@danjou.info>
;;
;; oauth2: add redirect-uri parameter, update to 0.6
;;
;; 2012-05-29 Julien Danjou <julien@danjou.info>
;;
;; * packages/oauth2/oauth2.el: Revert fix URL double escaping, update to
;; 0.5
;;
;; 2012-05-04 Julien Danjou <julien@danjou.info>
;;
;; * packages/oauth2/oauth2.el: Don't use aget, update to 0.4
;;
;; 2012-04-19 Julien Danjou <julien@danjou.info>
;;
;; * packages/oauth2/oauth2.el: Fix URL double escaping, update to 0.3
;;
;; 2011-12-20 Julien Danjou <julien@danjou.info>
;;
;; oauth2: update version 0.2
;;
;; * oauth2: update version to 0.2
;;
;; 2011-12-20 Julien Danjou <julien@danjou.info>
;;
;; oauth2: allow to use any HTTP request type
;;
;; * oauth2: allow to use any HTTP request type
;;
;; 2011-10-08 Julien Danjou <julien@danjou.info>
;;
;; * oauth2.el: Require json.
;; Fix compilation warning with success variable from url.el.
;;
;; 2011-09-26 Julien Danjou <julien@danjou.info>
;;
;; * packages/oauth2/oauth2.el (oauth2-request-authorization): Add missing
;; calls to url-hexify-string.
;;
;; 2011-09-26 Julien Danjou <julien@danjou.info>
;;
;; * packages/oauth2/oauth2.el: Reformat to avoid long lines.
;;
;; 2011-09-23 Julien Danjou <julien@danjou.info>
;;
;; New package oauth2
;;
(provide 'oauth2)
;;; oauth2.el ends here

38
elpa/org-jekyll-20130508.239/org-jekyll-autoloads.el Normal file
View File

@ -0,0 +1,38 @@
;;; org-jekyll-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "org-jekyll" "org-jekyll.el" (22533 17557 381907
;;;;;; 797000))
;;; Generated autoloads from org-jekyll.el
(autoload 'org-jekyll-export-current-entry "org-jekyll" "\
\(fn)" t nil)
(autoload 'org-jekyll-export-blog "org-jekyll" "\
Export all entries in project files that have a :blog: keyword
and an :on: datestamp. Property drawers are exported as
front-matters, outline entry title is the exported document
title.
\(fn)" t nil)
(autoload 'org-jekyll-export-project "org-jekyll" "\
Export all entries in project files that have a :blog: keyword
and an :on: datestamp. Property drawers are exported as
front-matters, outline entry title is the exported document
title.
\(fn PROJECT-NAME)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; org-jekyll-autoloads.el ends here

2
elpa/org-jekyll-20130508.239/org-jekyll-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "org-jekyll" "20130508.239" "Export jekyll-ready posts form org-mode entries" '((org "8.0")) :url "http://juanreyero.com/open/org-jekyll/" :keywords '("hypermedia"))

257
elpa/org-jekyll-20130508.239/org-jekyll.el Normal file
View File

@ -0,0 +1,257 @@
;;; org-jekyll.el --- Export jekyll-ready posts form org-mode entries
;;;
;;; Author: Juan Reyero
;;; Version: 0.4
;; Package-Version: 20130508.239
;;; Keywords: hypermedia
;;; Package-Requires: ((org "8.0"))
;;; Homepage: http://juanreyero.com/open/org-jekyll/
;;; Repository: http://github.com/juanre/org-jekyll
;;; Public clone: git://github.com/juanre/org-jekyll.git
;;;
;;; Commentary:
;;;
;;; Extract subtrees from your org-publish project files that have
;;; a :blog: keyword and an :on: property with a timestamp, and
;;; export them to a subdirectory _posts of your project's publishing
;;; directory in the year-month-day-title.html format that Jekyll
;;; expects. Properties are passed over as yaml front-matter in the
;;; exported files. The title of the subtree is the title of the
;;; entry. The title of the post is a link to the post's page.
;;;
;;; Look at http://orgmode.org/worg/org-tutorials/org-jekyll.html for
;;; more info on how to integrate org-mode with Jekyll, and for the
;;; inspiration of the main function down there.
;;;
;;; Code:
;;(require 'ox-html)
(defvar org-jekyll-category nil
"Specify a property which, if defined in the entry, is used as
a category: the post is written to category/_posts. Ignored if
nil. Use \"lang\" if you want to send posts in different
languages to different directories.")
(defvar org-jekyll-lang-subdirs nil
"Make it an assoc list indexed by language if you want to
bypass the category subdir definition and build blog subdirs per
language.")
(defvar org-jekyll-localize-dir nil
"If non-nil and the lang property is set in the entry,
org-jekyll will look for a lang.yml file in this directory and
include it in the front matter of the exported entry.")
(defvar org-jekyll-new-buffers nil
"Buffers created to visit org-publish project files looking for blog posts.")
(defun org-jekyll-publish-dir (project &optional category)
"Where does the project go, by default a :blog-publishing-directory
entry in the org-publish-project-alist."
(princ category)
(if org-jekyll-lang-subdirs
(let ((pdir (plist-get (cdr project) :blog-publishing-directory))
(langdir (cdr (assoc category org-jekyll-lang-subdirs))))
(if langdir
(concat pdir (cdr (assoc category org-jekyll-lang-subdirs))
"_posts/")
(let ((ppdir (plist-get (cdr project) :blog-publishing-directory)))
(unless ppdir
(setq ppdir (plist-get (cdr project) :publishing-directory)))
(concat ppdir
(if category (concat category "/") "")
"_posts/"))))
(let ((pdir (plist-get (cdr project) :blog-publishing-directory)))
(unless pdir
(setq pdir (plist-get (cdr project) :publishing-directory)))
(concat pdir
(if category (concat category "/") "")
"_posts/"))))
(defun org-jekyll-site-root (project)
"Site root, like http://yoursite.com, from which blog
permalinks follow. Needed to replace entry titles with
permalinks that RSS agregators and google buzz know how to
follow. Looks for a :site-root entry in the org-publish-project-alist."
(or (plist-get (cdr project) :site-root)
""))
(defun org-get-jekyll-file-buffer (file)
"Get a buffer visiting FILE. If the buffer needs to be
created, add it to the list of buffers which might be released
later. Copied from org-get-agenda-file-buffer, and modified
the list that holds buffers to release."
(let ((buf (org-find-base-buffer-visiting file)))
(if buf
buf
(progn (setq buf (find-file-noselect file))
(if buf (push buf org-jekyll-new-buffers))
buf))))
(defun org-jekyll-slurp-yaml (fname)
(remove "---" (if (file-exists-p fname)
(split-string (with-temp-buffer
(insert-file-contents fname)
(buffer-string))
"\n" t))))
(defun ensure-directories-exist (fname)
(let ((dir (file-name-directory fname)))
(unless (file-accessible-directory-p dir)
(make-directory dir t)))
fname)
(defun org-jekyll-sanitize-string (str project)
(if (plist-get (cdr project) :jekyll-sanitize-permalinks)
(progn (setq str (downcase str))
(dolist (c '(("á" . "a")
("é" . "e")
("í" . "i")
("ó" . "o")
("ú" . "u")
("à" . "a")
("è" . "e")
("ì" . "i")
("ò" . "o")
("ù" . "u")
("ñ" . "n")
("ç" . "s")
("\\$" . "S")
("€" . "E")))
(setq str (replace-regexp-in-string (car c) (cdr c) str)))
(replace-regexp-in-string "[^abcdefghijklmnopqrstuvwxyz-]" ""
(replace-regexp-in-string " +" "-" str)))
str))
(defun org-jekyll-export-entry (project)
(let* ((props (org-entry-properties nil 'standard))
(time (cdr (or (assoc "on" props)
(assoc "ON" props))))
(lang (cdr (or (assoc "lang" props)
(assoc "LANG" props))))
(category (if org-jekyll-category
(cdr (assoc org-jekyll-category props))
nil))
(yaml-front-matter (copy-alist props)))
(unless (assoc "layout" yaml-front-matter)
(push '("layout" . "post") yaml-front-matter))
(when time
(let* ((heading (org-get-heading t))
(title (replace-regexp-in-string "[:=\(\)\?]" ""
(replace-regexp-in-string
"[ \t]" "-" heading)))
(str-time (and (string-match "\\([[:digit:]\-]+\\) " time)
(match-string 1 time)))
(to-file (format "%s-%s.html" str-time
(org-jekyll-sanitize-string title project)))
(org-buffer (current-buffer))
(yaml-front-matter (cons (cons "title" heading)
yaml-front-matter))
html)
(org-narrow-to-subtree)
(let ((level (- (org-reduced-level (org-outline-level)) 1))
(top-level org-html-toplevel-hlevel)
(contents (buffer-substring (point-min) (point-max)))
(site-root (org-jekyll-site-root project)))
;; Without the promotion the header with which the headline
;; is exported depends on the level. With the promotion it
;; fails when the entry is not visible (ie, within a folded
;; entry).
(dotimes (n level nil) (org-promote-subtree))
(setq html
(replace-regexp-in-string
(format "<h%d id=\"sec-1\">\\(.+\\)</h%d>"
top-level top-level)
(format
"<h%d id=\"sec-1\"><a href=\"%s{{ page.url }}\">\\1</a></h%d>"
top-level site-root top-level)
(with-current-buffer
(org-html-export-as-html nil t t t
'(:tags nil
:table-of-contents nil))
(buffer-string))))
(set-buffer org-buffer)
(delete-region (point-min) (point-max))
(insert contents)
(save-buffer))
(widen)
(with-temp-file (ensure-directories-exist
(expand-file-name
to-file (org-jekyll-publish-dir project category)))
(when yaml-front-matter
(insert "---\n")
(mapc (lambda (pair)
(insert (format "%s: %s\n" (car pair) (cdr pair))))
yaml-front-matter)
(if (and org-jekyll-localize-dir lang)
(mapc (lambda (line)
(insert (format "%s\n" line)))
(org-jekyll-slurp-yaml (concat org-jekyll-localize-dir
lang ".yml"))))
(insert "---\n\n"))
(insert html))))))
; Evtl. needed to keep compiler happy:
(declare-function org-publish-get-project-from-filename "org-publish"
(filename &optional up))
;;;###autoload
(defun org-jekyll-export-current-entry ()
(interactive)
(save-excursion
(let ((project (org-publish-get-project-from-filename buffer-file-name)))
(org-back-to-heading t)
(org-jekyll-export-entry project))))
;;;###autoload
(defun org-jekyll-export-blog ()
"Export all entries in project files that have a :blog: keyword
and an :on: datestamp. Property drawers are exported as
front-matters, outline entry title is the exported document
title. "
(interactive)
(save-excursion
(setq org-jekyll-new-buffers nil)
(let ((project (org-publish-get-project-from-filename (buffer-file-name))))
(mapc
(lambda (jfile)
(if (string= (file-name-extension jfile) "org")
(with-current-buffer (org-get-jekyll-file-buffer jfile)
;; It fails for non-visible entries, CONTENT visibility
;; mode ensures that all of them are visible.
(message (concat "org-jekyll: publishing " jfile ))
(org-content)
(org-map-entries (lambda () (org-jekyll-export-entry project))
"blog|BLOG"))))
(org-publish-get-base-files project)))
(org-release-buffers org-jekyll-new-buffers)))
;;;###autoload
(defun org-jekyll-export-project (project-name)
"Export all entries in project files that have a :blog: keyword
and an :on: datestamp. Property drawers are exported as
front-matters, outline entry title is the exported document
title. "
(interactive)
(save-excursion
(setq org-jekyll-new-buffers nil)
(let ((project (assoc project-name org-publish-project-alist)))
(mapc
(lambda (jfile)
(if (string= (file-name-extension jfile) (plist-get (cdr project)
:base-extension))
(with-current-buffer (org-get-jekyll-file-buffer jfile)
;; It fails for non-visible entries, CONTENT visibility
;; mode ensures that all of them are visible.
(message (concat "org-jekyll: publishing " jfile ))
(org-content)
(org-map-entries (lambda () (org-jekyll-export-entry project))
"blog|BLOG"))))
(org-publish-get-base-files project)))
(org-release-buffers org-jekyll-new-buffers)))
(provide 'org-jekyll)
;;; org-jekyll.el ends here

39
elpa/org-random-todo-20160208.426/org-random-todo-autoloads.el Normal file
View File

@ -0,0 +1,39 @@
;;; org-random-todo-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "org-random-todo" "org-random-todo.el" (22533
;;;;;; 17556 331883 840000))
;;; Generated autoloads from org-random-todo.el
(autoload 'org-random-todo "org-random-todo" "\
Show a random TODO notification from your agenda files.
See `org-random-todo-files' to change what files are crawled.
Runs `org-random-todo--update-cache' if TODO's are out of date.
\(fn)" t nil)
(defvar org-random-todo-mode nil "\
Non-nil if Org-Random-Todo mode is enabled.
See the `org-random-todo-mode' command
for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `org-random-todo-mode'.")
(custom-autoload 'org-random-todo-mode "org-random-todo" nil)
(autoload 'org-random-todo-mode "org-random-todo" "\
Show a random TODO every so often
\(fn &optional ARG)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; org-random-todo-autoloads.el ends here

2
elpa/org-random-todo-20160208.426/org-random-todo-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "org-random-todo" "20160208.426" "notify of random TODO's" '((emacs "24.3") (alert "1.2")) :keywords '("org" "todo" "notification"))

148
elpa/org-random-todo-20160208.426/org-random-todo.el Normal file
View File

@ -0,0 +1,148 @@
;;; org-random-todo.el --- notify of random TODO's
;; Copyright (C) 2013-2016 Kevin Brubeck Unhammer
;; Author: Kevin Brubeck Unhammer <unhammer@fsfe.org>
;; Version: 0.4.1
;; Package-Version: 20160208.426
;; Package-Requires: ((emacs "24.3") (alert "1.2"))
;; Keywords: org todo notification
;; This file is not part of GNU Emacs.
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Show a random TODO from your org-agenda-files every so often.
;; Requires org-element, which was added fairly recently to org-mode
;; (tested with org-mode version 7.9.3f and later).
;;; Code:
(require 'org-element)
(require 'alert)
(require 'cl-lib)
(unless (fboundp 'cl-mapcan) (defalias 'cl-mapcan 'mapcan))
(defvar org-random-todo-files nil
"Files to grab TODO items from.
If nil, use `org-agenda-files'.")
(defvar org-random-todo--cache nil)
(defun org-random-todo--update-cache ()
"Update the cache of TODO's."
(setq org-random-todo--cache
(cl-mapcan
(lambda (file)
(when (file-exists-p file)
(with-current-buffer (org-get-agenda-file-buffer file)
(org-element-map (org-element-parse-buffer)
'headline
(lambda (hl)
(when (and (org-element-property :todo-type hl)
(not (equal 'done (org-element-property :todo-type hl))))
(cons file hl)))))))
(or org-random-todo-files org-agenda-files))))
(defun org-random-todo--headline-to-msg (elt)
"Create a readable alert-message of this TODO headline.
The `ELT' argument is an org element, see `org-element'."
(format "%s: %s"
(org-element-property :todo-keyword elt)
(org-element-property :raw-value elt)))
(defvar org-random-todo--current nil)
(defun org-random-todo-goto-current ()
"Go to the file/position of last shown TODO."
(interactive)
(find-file (car org-random-todo--current))
(goto-char (cdr org-random-todo--current)))
;;;###autoload
(defun org-random-todo ()
"Show a random TODO notification from your agenda files.
See `org-random-todo-files' to change what files are crawled.
Runs `org-random-todo--update-cache' if TODO's are out of date."
(interactive)
(unless (minibufferp) ; don't run if minibuffer is asking something
(unless org-random-todo--cache
(org-random-todo--update-cache))
(with-temp-buffer
(let* ((todo (nth (random (length org-random-todo--cache))
org-random-todo--cache))
(path (car todo))
(elt (cdr todo)))
(setq org-random-todo--current (cons path (org-element-property :begin elt)))
(alert (org-random-todo--headline-to-msg elt)
:title (file-name-base path)
:severity 'trivial
:mode 'org-mode
:category 'random-todo
:buffer (find-buffer-visiting path))))))
(defvar org-random-todo-how-often 600
"Show a message every this many seconds.
This happens simply by requiring `org-random-todo', as long as
this variable is set to a number.")
(defvar org-random-todo-cache-idletime 600
"Update cache after being idle this many seconds.
See `org-random-todo--update-cache'; only happens if this variable is
a number.")
(defvar org-random-todo--timers nil
"List of timers that need to be cancelled on exiting org-random-todo-mode.")
(defun org-random-todo-unless-idle ()
"Only run `org-random-todo' if we're not idle.
This is to avoid getting a bunch of notification build-up after
e.g. a sleep/resume."
(when (or (not (current-idle-time))
(< (time-to-seconds (current-idle-time))
org-random-todo-how-often))
(org-random-todo)))
(defun org-random-todo--setup ()
"Set up idle timers."
(setq org-random-todo--timers
(list
(when (numberp org-random-todo-how-often)
(run-with-timer org-random-todo-how-often
org-random-todo-how-often
'org-random-todo-unless-idle))
(when (numberp org-random-todo-cache-idletime)
(run-with-idle-timer org-random-todo-cache-idletime
'on-each-idle
'org-random-todo--update-cache)))))
(defun org-random-todo--teardown ()
"Remove idle timers."
(mapc #'cancel-timer (cl-remove-if nil org-random-todo--timers))
(setq org-random-todo--timers nil))
;;;###autoload
(define-minor-mode org-random-todo-mode
"Show a random TODO every so often"
:global t
(if org-random-todo-mode
(org-random-todo--setup)
(org-random-todo--teardown)))
(provide 'org-random-todo)
;;; org-random-todo.el ends here

15
elpa/org-rtm-20160214.436/org-rtm-autoloads.el Normal file
View File

@ -0,0 +1,15 @@
;;; org-rtm-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil nil ("org-rtm.el") (22533 17555 688869 169000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; org-rtm-autoloads.el ends here

2
elpa/org-rtm-20160214.436/org-rtm-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "org-rtm" "20160214.436" "Simple import/export from rememberthemilk to org-mode" '((rtm "0.1")) :url "https://github.com/pmiddend/org-rtm" :keywords '("outlines" "data"))

140
elpa/org-rtm-20160214.436/org-rtm.el Normal file
View File

@ -0,0 +1,140 @@
;;; org-rtm.el --- Simple import/export from rememberthemilk to org-mode
;; Copyright (c) 2016 Philipp Middendorf
;; Author: Philipp Middendorf <pmidden@secure.mailbox.org>
;; Created: 15 Jan 2016
;; Version: 0.1
;; Package-Version: 20160214.436
;; Package-Requires: ((rtm "0.1"))
;; Keywords: outlines, data
;; Homepage: https://github.com/pmiddend/org-rtm
;; This product uses the Remember The Milk API but is not endorsed or
;; certified by Remember The Milk
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the MIT license (see COPYING).
;;; Commentary:
;; Simple import/export from rememberthemilk to org-mode
;;
;; The project is hosted at https://github.com/pmiddend/org-rtm
;; The latest version, and all the relevant information can be found there.
;;; Code:
(require 'rtm)
(require 'org)
(defgroup org-rtm ()
"Retrieve and complete tasks from rememberthemilk.com and convert them to org-mode"
:group 'external
:link '(url-link "https://github.com/pmiddend/org-rtm")
:prefix "org-rtm-")
(defcustom org-rtm-import-file "~/rtm.org"
"Where to export the contents of RTM to when using org-rtm-import."
:group 'org-rtm
:type 'file)
(defcustom org-rtm-complete-after-import nil
"Complete the imported tasks in RTM.
It might be a good idea to set this after you verified that
the import process is working well."
:group 'org-rtm
:type 'boolean)
(defun org-rtm-assoc-value (symbol list)
"Get the value behind SYMBOL in an association LIST (not the pair of key/value)."
(cdr (assoc symbol list)))
(defun org-rtm-print-list (rtml)
"Convert an RTM list RTML to an org mode segment (top level, starting with *)."
(progn
(concat
"* "
(org-rtm-assoc-value 'name (car (cdr rtml))))))
(defun org-rtm-format-note (note)
"Format a single RTM task NOTE."
(nth 2 note))
(defun org-rtm-format-notes (notes-list)
"Format a list NOTES-LIST of RTM task notes and concatenate to string."
(cond ((equal (length notes-list) 0) "")
(t (concat "\n" (mapconcat 'org-rtm-format-note notes-list "\n")))))
(defun org-rtm-format-time-to-org (time-value)
"Convert an ISO date time TIME-VALUE to the org-mode time format.
I didn't find built-in function to accomplish this."
(print (length time-value))
(format-time-string (cdr org-time-stamp-formats) (date-to-time time-value)))
(defun org-rtm-print-entry (e)
"Format a single RTM task E and output as second level org segment (starting with **)."
(let*
((topAssocList (cdr e))
(taskAssocList (car topAssocList))
(due (org-rtm-assoc-value 'due (car (org-rtm-assoc-value 'task topAssocList))))
(notes-list (nthcdr 2 (assoc 'notes topAssocList))))
(progn
(concat
"** TODO "
(org-rtm-assoc-value 'name taskAssocList)
(if (not (or (eq due nil) (string= due ""))) (concat "\nSCHEDULED: " (org-rtm-format-time-to-org due)))
(if (org-rtm-assoc-value 'url taskAssocList) (concat "\n" (org-rtm-assoc-value 'url taskAssocList)) "")
(org-rtm-format-notes notes-list)))))
(defun org-rtm-format-list-entries (list-id)
"Convert a single RTM task list LIST-ID to org mode items."
(mapconcat 'org-rtm-print-entry (nthcdr 2 (car (rtm-tasks-get-list list-id "status:incomplete"))) "\n"))
(defun org-rtm-format-list (list-id list-name)
"Format a single list with LIST-ID and LIST-NAME as a top-level org-mode segment starting with *."
(progn
(concat "* " list-name "\n" (org-rtm-format-list-entries list-id))))
(defun org-rtm-format-lists ()
"Format RTM lists to org mode segments."
(mapconcat (lambda (list) (org-rtm-format-list (org-rtm-assoc-value 'id (nth 1 list)) (org-rtm-assoc-value 'name (nth 1 list)))) (rtm-lists-get-list) "\n"))
(defun org-rtm-complete-items (list-id)
"Complete all items in a given RTM list with LIST-ID (doesn't do any org-mode conversion)."
(mapcar
(lambda (taskseries-w-task)
(rtm-tasks-complete list-id (car taskseries-w-task) (cdr taskseries-w-task)))
(org-rtm-retrieve-taskseries-id-with-task-list list-id)))
(defun org-rtm-retrieve-taskseries-id-with-task-list (list-id)
"Retrieves the taskseries entry for list with LIST-ID."
(mapcar
(lambda (list)
`(,(org-rtm-assoc-value 'id (nth 1 list)) . ,(org-rtm-assoc-value 'id (car (org-rtm-assoc-value 'task (nthcdr 2 list))))))
(nthcdr 2 (car (rtm-tasks-get-list list-id "status:incomplete")))))
(defun org-rtm-retrieve-list-ids ()
"Retrieve a list of RTM list ids."
(mapcar (lambda (list) (org-rtm-assoc-value 'id (nth 1 list))) (rtm-lists-get-list)))
(defun org-rtm-complete-all-lists ()
"Complete all items of RTM all lists."
(mapcar (lambda (list-id) (org-rtm-complete-items list-id)) (org-rtm-retrieve-list-ids)))
(defun org-rtm-import ()
"Import RTM tasks to the given import file (overwriting it), then optionally completing the tasks, then opening the file in Emacs."
(interactive)
(message "Starting RTM import...")
(let
((import-data (org-rtm-format-lists)))
(find-file org-rtm-import-file)
(erase-buffer)
(if
org-rtm-complete-after-import
(progn
(org-rtm-complete-all-lists)
(message "Imported and completed all RTM tasks"))
(message "Imported tasks, not completing RTM tasks because of configuration option"))
(insert import-data)))
(provide 'org-rtm)
;;; org-rtm.el ends here

15
elpa/request-20160822.1659/request-autoloads.el Normal file
View File

@ -0,0 +1,15 @@
;;; request-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil nil ("request.el") (22533 17545 888645 569000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; request-autoloads.el ends here

2
elpa/request-20160822.1659/request-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "request" "20160822.1659" "Compatible layer for URL request in Emacs" '((emacs "24") (cl-lib "0.5")))

1297
elpa/request-20160822.1659/request.el Normal file
View File

File diff suppressed because it is too large Load Diff

15
elpa/rtm-20160116.927/rtm-autoloads.el Normal file
View File

@ -0,0 +1,15 @@
;;; rtm-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil nil ("rtm.el") (22533 17553 387816 669000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; rtm-autoloads.el ends here

2
elpa/rtm-20160116.927/rtm-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "rtm" "20160116.927" "An elisp implementation of the Remember The Milk API" '((cl-lib "1.0")) :url "https://github.com/pmiddend/emacs-rtm" :keywords '("remember" "the" "milk" "productivity" "todo"))

697
elpa/rtm-20160116.927/rtm.el Normal file
View File

@ -0,0 +1,697 @@
;;; rtm.el --- An elisp implementation of the Remember The Milk API
;; Copyright (C) 2009 Friedrich Delgado Friedrichs
;; uses parts of org-rtm.el Copyright (C) 2008 Avdi Grimm
;; Modified by Philipp Middendorf (pmidden@secure.mailbox.org) 2016
;; Author: Friedrich Delgado Friedrichs <frie...@nomaden.org>
;; Created: Oct 18 2009
;; Version: 0.1
;; Package-Version: 20160116.927
;; Package-Requires: ((cl-lib "1.0"))
;; Keywords: remember the milk productivity todo
;; URL: https://github.com/pmiddend/emacs-rtm
;; This product uses the Remember The Milk API but is not endorsed or
;; certified by Remember The Milk
;; This file is NOT part of GNU Emacs.
;; 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 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Note by Philipp: This file was taken from the simple-rtm repository and
;; has some minor modifications so it doesn't give byte-compilation
;; warnings.
;;; Code:
(require 'cl-lib)
(require 'url-http)
(require 'url-util)
(require 'xml)
(require 'custom)
;;;; Customisation
(defgroup rtm nil
"Options for emacs lisp integration of Remember The Milk"
:tag "elisp RTM"
:group 'applications)
(defcustom rtm-api-key "d40eb4df08dd52c1930afa9d79dceda0"
"Your own API key for Remember The Milk."
:type 'string :group 'rtm)
(defcustom rtm-api-shared-secret "39d8e367fdce977c"
"Your shared secret for your Remember The Milk API Key.
Note that in an open source application it is not easily possible to
hide the secret. That's why it's probably the best solution for every
user to register their own API key.
See also
http://groups.google.com/group/rememberthemilk-api/browse_thread/thread/dcb035f162d4dcc8%3Fpli%3D1
You can register your own API key and secret under
http://www.rememberthemilk.com/services/api/requestkey.rtm
In the description just tell them you're going to use the emacs lisp
API Kit"
:type 'string :group 'rtm)
;;;; constants and variables
(defconst rtm-rest-uri "http://api.rememberthemilk.com/services/rest/"
"Endpoint URL for REST requests. See
http://www.rememberthemilk.com/services/api/request.rest.rtm")
(defconst rtm-auth-uri "http://www.rememberthemilk.com/services/auth/"
"Authentication service URL, see
http://www.rememberthemilk.com/services/api/authentication.rtm")
(defvar rtm-auth-token ""
"Auth token received from RTM Website, after the user authenticated
your app")
(defvar rtm-auth-token-valid nil
"Set to t after the auth token has been validated.")
(defconst rtm-ui-buffer-name "*rtm*"
"Name for the rtm user interface buffer")
(defconst rtm-auth-token-file ".rtm-auth-token"
"Name for storing the auth token for the current session")
(defvar rtm-current-timeline nil
"The current timeline")
(defvar rtm-debug nil
"debug level")
(make-variable-buffer-local 'rtm-auth-token-valid)
(put 'rtm-auth-token-valid 'permanent-local t)
;;;; API wrappers
(defmacro def-rtm-method (methodname rtm-method-name call-func result-func
result-path &rest parms)
(declare (indent 1))
`(defun ,methodname ,parms
(,result-func ,result-path
(,call-func ',rtm-method-name
,@(mapcar (lambda (sym)
`(cons ,(symbol-name sym) ,sym))
;; remove lambda keywords
(cl-remove-if (lambda (sym)
(or (eq sym '&optional)
(eq sym '&rest)))
parms))))))
(defmacro def-rtm-macro (macro-name call-func result-func)
(declare (indent 0))
`(defmacro ,macro-name (methodname rtm-method-name result-path &rest parms)
(declare (indent 1))
`(def-rtm-method ,methodname ,rtm-method-name ,',call-func
,',result-func
',result-path ,@parms)))
(def-rtm-macro def-rtm-signed-scalar-method
rtm-call-signed rtm-get-scalar-from-response)
(def-rtm-macro def-rtm-authenticated-scalar-method
rtm-call-authenticated rtm-get-scalar-from-response)
(def-rtm-macro def-rtm-timeline-scalar-method
rtm-call-timeline rtm-get-scalar-from-response)
(def-rtm-macro def-rtm-signed-list-method
rtm-call-signed rtm-get-list-from-response)
(def-rtm-macro def-rtm-authenticated-list-method
rtm-call-authenticated rtm-get-list-from-response)
(def-rtm-macro def-rtm-timeline-list-method
rtm-call-timeline rtm-get-list-from-response)
;; awfully brief aliases, but those long names mess up indentation
;; recomendation: use only the authenticated aliases, and the long
;; names for those (rarely used) methods that are only signed
(defalias 'def-rtm-si-sca 'def-rtm-signed-scalar-method)
(defalias 'def-rtm-authenticated-scalar-method 'def-rtm-authenticated-scalar-method)
(defalias 'def-rtm-authenticated-scalar-method! 'def-rtm-timeline-scalar-method)
(defalias 'def-rtm-si-lis 'def-rtm-signed-list-method)
(defalias 'def-rtm-list 'def-rtm-authenticated-list-method)
(defalias 'def-rtm-list! 'def-rtm-timeline-list-method)
;; TODO: I removed the usages of the aliases above - do I have to rewrite
;; these calls as well?
(put 'def-rtm-si-sca 'lisp-indent-function 1)
(put 'def-rtm-authenticated-scalar-method 'lisp-indent-function 1)
(put 'def-rtm-authenticated-scalar-method! 'lisp-indent-function 1)
(put 'def-rtm-si-lis 'lisp-indent--function 1)
(put 'def-rtm-list 'lisp-indent-function 1)
(put 'def-rtm-list! 'lisp-indent-function 1)
;; note that, for modifying functions, it's mostly better to define
;; them via define-rtm-list!, since you will receive the transaction
;; *and* the result, while a function defined via define-rtm-scalar!
;; will only return the transaction
(defun rtm-call-unsigned (method &rest params)
(let ((request (rtm-construct-request-url rtm-rest-uri
(rtm-prepare-params method
params))))
(rtm-do-request request)))
(defun rtm-call-signed (method &rest params)
(let* ((unsigned-params (rtm-prepare-params method params))
(all-params (append-api-sig unsigned-params))
(request (rtm-construct-request-url rtm-rest-uri
all-params)))
(rtm-do-request request)))
(defun rtm-call-authenticated (method &rest params)
(apply #'rtm-call-signed
method
`("auth_token" . ,(rtm-authenticate))
params))
(defun rtm-call-timeline (method &rest params)
(apply #'rtm-call-authenticated
method
`("timeline" . ,(rtm-timeline))
params))
(defun rtm-get-nodes-from-node-list (node-name node-list)
(cl-remove-if-not (lambda (el) (eq node-name
(xml-node-name el)))
node-list))
(defun rtm-get-node-content-from-response (node-name response)
(xml-node-children (car (rtm-get-nodes-from-node-list node-name
response))))
(defun rtm-get-list-from-response (path response)
(let ((rst path)
(content response))
(while rst
(setq content (rtm-get-node-content-from-response (car rst) content))
(setq rst (cdr rst)))
content))
(defun rtm-get-scalar-from-response (path response)
(car (rtm-get-list-from-response path response)))
;;;;; Actual api wrappers from
;; http://www.rememberthemilk.com/services/api/methods/
;;;;;; auth
(def-rtm-signed-scalar-method rtm-auth-check-token rtm.auth.checkToken
(auth token) auth_token)
;; api call response (without post-processing):
;; ((auth nil
;; (token nil "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
;; (perms nil "delete")
;; (user
;; ((id . "xxxxxxx")
;; (username . "johndoe")
;; (fullname . "John Doe")))))
(def-rtm-signed-scalar-method rtm-auth-get-frob rtm.auth.getFrob (frob))
(def-rtm-signed-scalar-method rtm-auth-get-token rtm.auth.getToken
(auth token) frob)
;; api call response (without post-processing):
;; ((auth nil (token nil "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX")
;; (perms nil "delete") (user (... ... ...))))
;;;;;; contacts
(def-rtm-timeline-list-method rtm-contacts-add rtm.contacts.add (contact) contact)
(def-rtm-timeline-list-method rtm-contacts-delete rtm.contacts.delete () contact_id)
(def-rtm-authenticated-list-method rtm-contacts-get-list rtm.contacts.getList (contacts))
;;;;;; groups
(def-rtm-timeline-list-method rtm-groups-add rtm.groups.add () group)
(def-rtm-timeline-list-method rtm-groups-add-contact rtm.groups.addContact ()
group_id contact_id)
(def-rtm-timeline-list-method rtm-groups-delete rtm.groups.delete () group_id)
(def-rtm-authenticated-list-method rtm-groups-get-list rtm.groups.getList ())
(def-rtm-timeline-list-method rtm-groups-remove-contact rtm.groups.removeContact ()
group_id contact_id)
;;;;;; lists
(def-rtm-timeline-list-method rtm-lists-add rtm.lists.add ()
name &optional filter)
(def-rtm-timeline-list-method rtm-lists-archive rtm.lists.archive ()
list_id)
(def-rtm-timeline-list-method rtm-lists-delete rtm.lists.delete ()
list_id)
(def-rtm-authenticated-list-method rtm-lists-get-list rtm.lists.getList (lists))
;; example response (after result function):
;; ((list
;; ((id . "7781815")
;; (name . "Inbox")
;; (deleted . "0")
;; (locked . "1")
;; (archived . "0")
;; (position . "-1")
;; (smart . "0")
;; (sort_order . "0")))
;; (list
;; ((id . "7781820")
;; (name . "All Tasks")
;; (deleted . "0")
;; (locked . "0")
;; (archived . "0")
;; (position . "0")
;; (smart . "1")
;; (sort_order . "0"))
;; (filter nil))
;; (list
;; ((id . "7781818")
;; (name . "Work")
;; (deleted . "0")
;; (locked . "0")
;; (archived . "0")
;; (position . "0")
;; (smart . "0")
;; (sort_order . "0")))
;; (list
;; ((id . "7781816")
;; (name . "Private")
;; (deleted . "0")
;; (locked . "0")
;; (archived . "0")
;; (position . "0")
;; (smart . "0")
;; (sort_order . "0")))
;; (list
;; ((id . "7781819")
;; (name . "Sent")
;; (deleted . "0")
;; (locked . "1")
;; (archived . "0")
;; (position . "1")
;; (smart . "0")
;; (sort_order . "0"))))
(def-rtm-timeline-list-method rtm-lists-set-default-list rtm.lists.setDefaultList ()
list_id)
(def-rtm-timeline-list-method rtm-lists-set-name rtm.lists.setName ()
list_id name)
(def-rtm-timeline-list-method rtm-lists-unarchive rtm.lists.unarchive ()
list_id)
;;;;;; locations
(def-rtm-authenticated-list-method rtm-locations-get-list rtm.locations.getList (locations))
;;;;;; reflection
(def-rtm-signed-list-method rtm-reflection-get-methods rtm.reflection.getMethods
(methods))
(def-rtm-signed-scalar-method rtm-reflection-get-method-info
rtm.reflection.getMethodInfo () method_name)
;;;;;; settings
(def-rtm-authenticated-list-method rtm-settings-get-list rtm.settings.getList (settings))
;;;;;; tasks
(def-rtm-timeline-list-method rtm-tasks-add rtm.tasks.add ()
name &optional parse list_id)
(def-rtm-timeline-list-method rtm-tasks-add-tags rtm.tasks.addTags ()
list_id taskseries_id task_id tags)
(def-rtm-timeline-list-method rtm-tasks-complete rtm.tasks.complete ()
list_id taskseries_id task_id)
(def-rtm-timeline-list-method rtm-tasks-delete rtm.tasks.delete ()
list_id taskseries_id task_id)
(def-rtm-authenticated-list-method rtm-tasks-get-list rtm.tasks.getList (tasks)
&optional list_id filter last_sync)
;; example response (after result function):
;; ((list
;; ((id . "7781819")))
;; (list
;; ((id . "7781817")))
;; (list
;; ((id . "7781816"))
;; (taskseries
;; ((id . "35272531")
;; (created . "2009-03-08T20:57:45Z")
;; (modified . "2009-03-08T21:52:18Z")
;; (name . "Try Remember The Milk")
;; (source . "js")
;; (url . "")
;; (location_id . ""))
;; (tags nil)
;; (participants nil)
;; (notes nil)
;; (task
;; ((id . "49791364")
;; (due . "2009-03-08T20:57:00Z")
;; (has_due_time . "1")
;; (added . "2009-03-08T20:57:45Z")
;; (completed . "2009-03-08T21:52:16Z")
;; (deleted . "")
;; (priority . "1")
;; (postponed . "0")
;; (estimate . "")))))
;; (list
;; ((id . "7781818")))
;; (list
;; ((id . "7781820"))))
(def-rtm-timeline-list-method rtm-tasks-move-priority rtm.tasks.movePriority ()
list_id taskseries_id task_id direction)
(def-rtm-timeline-list-method rtm-tasks-move-to rtm.tasks.moveTo ()
from_list_id to_list_id taskseries_id task_id)
(def-rtm-timeline-list-method rtm-tasks-postpone rtm.tasks.postpone ()
list_id taskseries_id task_id)
(def-rtm-timeline-list-method rtm-tasks-remove-tags rtm.tasks.removeTags ()
list_id taskseries_id task_id tags)
(def-rtm-timeline-list-method rtm-tasks-set-due-date rtm.tasks.setDueDate ()
list_id taskseries_id task_id &optional due has_due_time parse)
(def-rtm-timeline-list-method rtm-tasks-set-estimate rtm.tasks.setEstimate ()
list_id taskseries_id task_id &optional estimate)
(def-rtm-timeline-list-method rtm-tasks-set-location rtm.tasks.setLocation ()
list_id taskseries_id task_id &optional location_id)
(def-rtm-timeline-list-method rtm-tasks-set-name rtm.tasks.setName ()
list_id taskseries_id task_id name)
(def-rtm-timeline-list-method rtm-tasks-set-priority rtm.tasks.setPriority ()
list_id taskseries_id task_id &optional priority)
(def-rtm-timeline-list-method rtm-tasks-set-recurrence rtm.tasks.setRecurrence ()
list_id taskseries_id task_id &optional repeat)
(def-rtm-timeline-list-method rtm-tasks-set-tags rtm.tasks.setTags ()
list_id taskseries_id task_id &optional tags)
(def-rtm-timeline-list-method rtm-tasks-set-url rtm.tasks.setURL ()
list_id taskseries_id task_id &optional url)
(def-rtm-timeline-list-method rtm-tasks-uncomplete rtm.tasks.uncomplete ()
list_id taskseries_id task_id)
;;;;;; tasks.notes
(def-rtm-timeline-list-method rtm-tasks-notes-add rtm.tasks.notes.add ()
list_id taskseries_id task_id note_title note_text)
(def-rtm-timeline-list-method rtm-tasks-notes-delete rtm.tasks.notes.delete ()
note_id)
(def-rtm-timeline-list-method rtm-tasks-notes-edit rtm.tasks.notes.edit ()
note_id note_title note_text)
;;;;;; test
(defun rtm-test-echo ()
(rtm-call-unsigned 'rtm.test.echo))
(def-rtm-authenticated-list-method rtm-test-login rtm.test.login ())
;;;;;; time
(def-rtm-signed-list-method rtm-time-convert rtm.time.convert ()
to_timezone &optional from_timezone time)
;;;;;; timelines
(def-rtm-authenticated-scalar-method rtm-timelines-create rtm.timelines.create (timeline))
(defun rtm-timeline ()
(unless rtm-current-timeline
(progn
(setq rtm-current-timeline (rtm-timelines-create))))
rtm-current-timeline)
;;;;;; timezones
(def-rtm-signed-list-method rtm-timezones-get-list rtm.timezones.getList ())
;;;;;; transactions
(def-rtm-timeline-list-method rtm-transactions-undo rtm.transactions.undo () transaction_id)
;;;; User authentication
(defun rtm-authenticate ()
"Always use this function to call an authenticated method, it's the only one
that will update rtm-auth-token"
(setq rtm-auth-token
(let ((auth-token (or (rtm-get-stored-auth-token)
rtm-auth-token)))
(if (and auth-token
(rtm-auth-token-valid auth-token))
auth-token
(rtm-get-new-auth-token))))
rtm-auth-token)
(defun rtm-auth-token-valid (auth-token)
(if rtm-auth-token-valid
t
(let ((token (ignore-errors (rtm-auth-check-token auth-token))))
(if (and token
(string-equal auth-token token))
(setq rtm-auth-token-valid t)
nil))))
(defun rtm-get-new-auth-token ()
(let* ((frob (rtm-auth-get-frob))
(auth-url (rtm-authentication-url 'delete frob))
(auth-token nil))
(while (not auth-token)
(browse-url auth-url)
(rtm-authentication-dialog auth-url)
(setq auth-token
(rtm-auth-get-token frob))
(if (rtm-auth-token-valid auth-token)
(rtm-store-auth-token auth-token)
(setq auth-token nil)))
auth-token))
(defun rtm-store-auth-token (auth-token)
(let ((token-file (locate-user-emacs-file rtm-auth-token-file)))
(unless (file-exists-p token-file)
(with-temp-file token-file))
(set-file-modes token-file #o600)
(with-temp-file token-file
(insert auth-token)))
auth-token)
(defun rtm-get-stored-auth-token ()
(let ((token-file (locate-user-emacs-file rtm-auth-token-file)))
(if (file-exists-p token-file)
(if (file-readable-p token-file)
(with-temp-buffer
(insert-file-contents token-file)
(buffer-string))
(error "Auth token store %s exists, but is not readable."
token-file))
nil)))
(defun rtm-authentication-dialog (auth-url)
(let ((rtm-buffer (generate-new-buffer rtm-ui-buffer-name)))
(with-current-buffer rtm-buffer
(insert "Please visit the following url to authenticate this
application:\n\n")
(insert-text-button auth-url 'type 'rtm-url)
(display-buffer rtm-buffer)
;; (redisplay)
(read-from-minibuffer
"Press RETURN if after authentication was granted")
(kill-buffer rtm-buffer))))
(define-button-type 'rtm-url
'action (lambda (x)
(let ((button (button-at (point))))
(browse-url
(button-label button))))
'follow-link t)
(define-button-type 'rtm-button
'follow-link t)
(defun rtm-authentication-url (perms frob)
(let* ((unsigned-params `(("api_key" . ,rtm-api-key)
("perms" . ,(maybe-string perms))
("frob" . ,frob)))
(all-params (append-api-sig unsigned-params)))
(rtm-construct-request-url rtm-auth-uri
all-params)))
;;;; WebAPI handling
(defun rtm-do-request (request)
(if rtm-debug
(message "request: %s" request))
(rtm-parse-response (url-retrieve-synchronously request)))
;; adapted from avdi's code:
(defun rtm-api-sig (params)
(let* ((param-copy (cl-copy-list params))
(sorted-params (sort param-copy
(lambda (lhs rhs) (string< (car lhs) (car rhs)))))
(joined-params (mapcar (lambda (param)
(concat (car param) (cdr param)))
sorted-params))
(params-str (cl-reduce 'concat joined-params))
(with-secret (concat rtm-api-shared-secret params-str)))
(md5 with-secret)))
(defun rtm-prepare-params (method params)
(rtm-add-method+api method
(rtm-stringify-params (rtm-weed-empty-params params))))
(defun rtm-stringify-params (params)
(mapcar #'rtm-stringify-param params))
(defun rtm-stringify-param (param)
(let* ((name (car param))
(value (cdr param)))
(cons (rtm-stringify-param-name name)
(rtm-stringify-value value))))
(defun rtm-stringify-param-name (name)
(cond ((stringp name)
name)
((symbolp name)
(symbol-name name))))
;; note: because we can't really tell between parameter wasn't given
;; and explicitly set as nil (see rtm-weed-empty-params below), you
;; should give 'false rather than nil if you mean false
(defun rtm-stringify-value (value)
(cond ((stringp value)
value)
((eq t value)
"true")
((null value)
"false")
((listp value)
(rtm-comma-separated-list value))
((symbolp value)
(symbol-name value))
((numberp value)
(number-to-string value))))
(defun rtm-comma-separated-list (lis)
"turn a list into a comma separated string (and flatten it)"
(cl-labels ((comsep (lis first)
(if (null lis)
""
(concat (if first "" ",")
(rtm-stringify-value (car lis))
(comsep (cdr lis) nil)))))
(comsep lis t)))
(defun rtm-weed-empty-params (params)
(cl-remove-if (lambda (param)
(and (listp param)
(not (null param))
(null (cdr param))))
params))
(defun rtm-add-method+api (method params)
(append `(("method" . ,(maybe-string method))
("api_key" . ,rtm-api-key))
params))
;; adapted from avdi's code:
(defun rtm-construct-request-url (base-uri params)
"Construct a URL for calling a method from params"
(let* ((param-pairs (mapcar 'rtm-format-param params))
(query (rtm-join-params param-pairs)))
(string-to-unibyte (concat base-uri "?" query))))
;; adapted from avdi's code:
(defun rtm-format-param (param)
(let ((key (car param))
(value (cdr param)))
;; it's important that we sign the unencoded parameters, but of
;; course the request must be url-encoded
(concat key "=" (url-hexify-string value))))
;; from avdi's code:
(defun rtm-join-params (params)
(cl-reduce (lambda (left right) (concat left "&" right)) params))
;; adapted from avdi's code:
(defun rtm-construct-url (method)
(concat rtm-rest-uri
"?"
"method=" method
"&"
"api_key=" rtm-api-key))
;; from avdi's code:
;; TODO Interpret the stat attribute and throw an error if it's not ok
(defun rtm-parse-response (response)
(with-current-buffer response
(let* ((node-list (xml-parse-region (point-min) (point-max)))
(rsps (rtm-get-nodes-from-node-list 'rsp node-list)))
(when (> (length rsps) 1)
(warn
"Got more than one <rsp> node in response, please examine!
Response:%s" (pp node-list)))
(let* ((rsp (car rsps))
(children (xml-node-children rsp))
(stat (rtm-stat rsp)))
(unless stat
(warn "Weird, got no stat attribute in <rsp> node.
%s" (pp node-list)))
(if (eq stat 'ok)
children
(let* ((err (car (rtm-get-nodes-from-node-list 'err children)))
(code (xml-get-attribute err 'code))
(msg (xml-get-attribute err 'msg)))
(error "Error in server response: Code: %s\n
Message: \"%s\"" code msg)))))))
(defun rtm-stat (rsp)
(let ((stat (xml-get-attribute-or-nil rsp 'stat)))
(if stat
(intern (downcase stat))
stat)))
;;; example responses
;; failure:
;; ((rsp
;; ((stat . "fail"))
;; (err
;; ((code . "97")
;; (msg . "Missing signature")))))
;; success:
;; rtm.auth.getFrob:
;; ((rsp
;; ((stat . "ok"))
;; (frob nil "cce8d04e182212cddd5cdc815e09648fecd18e0e")))
;; rtm.test.echo:
;; ((rsp ((stat . "ok"))
;; (api_key nil "00000000000000000000000000000000")
;; (method nil "rtm.test.echo")))
(defun append-api-sig (unsigned-params)
(let ((api-sig (rtm-api-sig unsigned-params)))
(append unsigned-params
`(("api_sig" . ,api-sig)))))
;;;; Misc/Helper functions
(defun maybe-string (symbol-or-string)
(if (stringp symbol-or-string) symbol-or-string
(symbol-name symbol-or-string)))
(provide 'rtm)
;;; rtm.el ends here

49
elpa/simple-rtm-20160222.734/simple-rtm-autoloads.el Normal file
View File

@ -0,0 +1,49 @@
;;; simple-rtm-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "simple-rtm" "simple-rtm.el" (22533 17554 588844
;;;;;; 77000))
;;; Generated autoloads from simple-rtm.el
(put 'simple-rtm-mode-line-string 'risky-local-variable t)
(autoload 'simple-rtm-mode "simple-rtm" "\
An interactive \"do everything right now\" mode for Remember The Milk
Display all of your lists and tasks in a new buffer or switch to
that buffer if it already exists.
Each action will be sent to the Remember The Milk web interface
immediately.
\\{simple-rtm-mode-map}
\(fn)" t nil)
(defvar display-simple-rtm-tasks-mode nil "\
Non-nil if Display-Simple-Rtm-Tasks mode is enabled.
See the `display-simple-rtm-tasks-mode' command
for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `display-simple-rtm-tasks-mode'.")
(custom-autoload 'display-simple-rtm-tasks-mode "simple-rtm" nil)
(autoload 'display-simple-rtm-tasks-mode "simple-rtm" "\
Display SimpleRTM task statistics in the mode line.
The text being displayed in the mode line is controlled by the variables
`simple-rtm-mode-line-format'.
The mode line will be updated automatically when a task is modified.
\(fn &optional ARG)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; simple-rtm-autoloads.el ends here

2
elpa/simple-rtm-20160222.734/simple-rtm-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "simple-rtm" "20160222.734" "Interactive Emacs mode for Remember The Milk" '((rtm "0.1") (dash "2.0.0")) :keywords '("remember" "the" "milk" "productivity" "todo"))

1355
elpa/simple-rtm-20160222.734/simple-rtm.el Normal file
View File

File diff suppressed because it is too large Load Diff

47
elpa/slack-20160928.2036/slack-autoloads.el Normal file
View File

@ -0,0 +1,47 @@
;;; slack-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "slack" "slack.el" (22533 17549 313723 713000))
;;; Generated autoloads from slack.el
(autoload 'slack-start "slack" "\
\(fn &optional TEAM)" t nil)
;;;***
;;;### (autoloads nil "slack-team" "slack-team.el" (22533 17549 403725
;;;;;; 767000))
;;; Generated autoloads from slack-team.el
(autoload 'slack-register-team "slack-team" "\
PLIST must contain :name :client-id :client-secret with value.
setting :token will reduce your configuration step.
you will notified when receive message with channel included in subscribed-chennels.
if :default is t and `slack-prefer-current-team' is t, skip selecting team when channels listed.
you can change current-team with `slack-change-current-team'
\(fn &rest PLIST)" t nil)
;;;***
;;;### (autoloads nil nil ("slack-bot-message.el" "slack-buffer.el"
;;;;;; "slack-channel.el" "slack-file.el" "slack-group.el" "slack-im.el"
;;;;;; "slack-message-editor.el" "slack-message-formatter.el" "slack-message-notification.el"
;;;;;; "slack-message-reaction.el" "slack-message-sender.el" "slack-message.el"
;;;;;; "slack-pkg.el" "slack-reaction.el" "slack-reminder.el" "slack-reply.el"
;;;;;; "slack-request.el" "slack-room.el" "slack-search.el" "slack-user-message.el"
;;;;;; "slack-user.el" "slack-util.el" "slack-websocket.el") (22533
;;;;;; 17549 504728 72000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; slack-autoloads.el ends here

89
elpa/slack-20160928.2036/slack-bot-message.el Normal file
View File

@ -0,0 +1,89 @@
;;; slack-bot-message.el --- bot message class -*- lexical-binding: t; -*-
;; Copyright (C) 2015 yuya.minami
;; Author: yuya.minami <yuya.minami@yuyaminami-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-message)
(require 'slack-message-formatter)
(defun slack-find-bot (id team)
(with-slots (bots) team
(cl-find-if (lambda (bot)
(string= id (plist-get bot :id)))
bots)))
(defmethod slack-bot-name ((m slack-bot-message) team)
(if (slot-boundp m 'bot-id)
(let ((bot (slack-find-bot (oref m bot-id) team)))
(if bot
(plist-get bot :name)
(oref m username)))
(oref m username)))
(defmethod slack-message-to-alert ((m slack-bot-message) team)
(let ((text (if (slot-boundp m 'text)
(oref m text))))
(with-slots (attachments) m
(if (and text (< 0 (length text)))
(slack-message-unescape-string text team)
(let ((attachment-string (mapconcat #'slack-attachment-to-alert attachments " ")))
(slack-message-unescape-string attachment-string team))))))
(defmethod slack-message-sender-name ((m slack-bot-message) team)
(slack-bot-name m team))
(defmethod slack-attachment-to-string ((a slack-attachment))
(with-slots (fallback text pretext title title-link) a
(if (and pretext title text)
(mapconcat #'identity
(cl-remove-if #'null (list pretext title title-link text))
"\n")
fallback)))
(defmethod slack-attachment-to-string((a slack-shared-message))
(with-slots (fallback text author-name ts channel-name color from-url) a
(let* ((header-property '(:weight bold))
(footer-property '(:height 0.8))
(pad-property '(:weight ultra-bold))
(pad (propertize "|" 'face pad-property))
(header (concat pad "\t"
(propertize author-name 'face header-property)))
(body (format "%s\t%s" pad (mapconcat #'identity
(split-string text "\n")
(format "\n\t%s\t" pad))))
(footer (concat pad "\t"
(propertize
(format "%s %s" channel-name (slack-message-time-to-string ts))
'face footer-property))))
(format "\t%s\n \t%s\n \t%s"
header
body
footer))))
(defmethod slack-attachment-to-alert ((a slack-attachment))
(oref a fallback))
(provide 'slack-bot-message)
;;; slack-bot-message.el ends here

327
elpa/slack-20160928.2036/slack-buffer.el Normal file
View File

@ -0,0 +1,327 @@
;;; slack-buffer.el --- slack buffer -*- lexical-binding: t; -*-
;; Copyright (C) 2015 南優也
;; Author: 南優也 <yuyaminami@minamiyuunari-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'lui)
(require 'slack-room)
(defvar lui-prompt-string "> ")
(defvar slack-mode-map
(let ((map (make-sparse-keymap)))
;; (define-key map (kbd "C-s C-r") #'slack-room-update-messages)
;; (define-key map (kbd "C-s C-b") #'slack-message-write-another-buffer)
map))
(define-derived-mode slack-mode lui-mode "Slack"
""
(lui-set-prompt lui-prompt-string)
(setq lui-input-function 'slack-message--send))
(define-derived-mode slack-info-mode lui-mode "Slack Info"
""
(lui-set-prompt lui-prompt-string))
(defvar slack-current-room-id)
(defvar slack-current-team-id)
(defvar slack-current-message nil)
(defcustom slack-buffer-emojify nil
"Show emoji with `emojify' if true."
:group 'slack)
(defmacro slack-buffer-widen (&rest body)
`(save-excursion
(save-restriction
(widen)
,@body)))
(defun slack-get-buffer-create (room)
(let* ((buf-name (slack-room-buffer-name room))
(buffer (get-buffer buf-name)))
(unless buffer
(setq buffer (generate-new-buffer buf-name))
(with-current-buffer buffer
(slack-mode)
(slack-buffer-insert-previous-link room)
(add-hook 'kill-buffer-hook 'slack-reset-room-last-read nil t)
(add-hook 'lui-pre-output-hook 'slack-buffer-add-last-ts-property nil t)
(add-hook 'lui-post-output-hook 'slack-buffer-add-ts-property nil t)))
buffer))
(defmethod slack-buffer-set-current-room-id ((room slack-room))
(set (make-local-variable 'slack-current-room-id) (oref room id)))
(defun slack-buffer-set-current-team-id (team)
(set (make-local-variable 'slack-current-team-id) (oref team id)))
(defun slack-buffer-enable-emojify ()
(if slack-buffer-emojify
(let ((emojify (require 'emojify nil t)))
(unless emojify
(error "Emojify is not installed"))
(emojify-mode t))))
(defun slack-buffer-goto (ts)
(let ((point (slack-buffer-ts-eq (point-min) (point-max) ts)))
(when point
(goto-char point))))
(defmethod slack-buffer-insert-previous-link ((room slack-room))
(let ((oldest (slack-room-prev-link-info room)))
(if oldest
(slack-buffer-widen
(let ((inhibit-read-only t))
(goto-char (point-min))
(insert
(concat
(propertize "(load more message)"
'face '(:underline t)
'oldest oldest
'keymap (let ((map (make-sparse-keymap)))
(define-key map (kbd "RET")
#'slack-room-load-prev-messages)
map))
"\n\n"))
(set-marker lui-output-marker (point)))))))
(defmethod slack-buffer-insert-prev-messages ((room slack-room) team oldest-ts)
(slack-buffer-widen
(let ((messages (slack-room-prev-messages room oldest-ts)))
(if messages
(progn
(slack-buffer-insert-previous-link room)
(cl-loop for m in messages
do (slack-buffer-insert m team t)))
(set-marker lui-output-marker (point-min))
(lui-insert "(no more messages)\n"))
(slack-buffer-recover-lui-output-marker))))
(cl-defun slack-buffer-create (room team
&key
(insert-func
#'slack-buffer-insert-messages)
(type 'message))
(cl-labels
((get-buffer (type room)
(cl-ecase type
(message (slack-get-buffer-create room))
(info (slack-get-info-buffer-create room)))))
(let* ((buffer (get-buffer type room)))
(with-current-buffer buffer
(if insert-func
(funcall insert-func room team))
(slack-buffer-set-current-room-id room)
(slack-buffer-set-current-team-id team)
(slack-buffer-enable-emojify))
buffer)))
(defun slack-buffer-add-last-ts-property ()
(when slack-current-message
(add-text-properties
(point-min) (point-max)
`(slack-last-ts ,lui-time-stamp-last))))
(defun slack-buffer-add-ts-property ()
(when slack-current-message
(add-text-properties
(point-min) (point-max)
`(ts ,(oref slack-current-message ts)))))
(defun slack-buffer-insert (message team &optional not-tracked-p)
(let ((lui-time-stamp-time (slack-message-time-stamp message))
(beg lui-input-marker)
(inhibit-read-only t))
(let ((slack-current-message message))
(lui-insert (slack-message-to-string message team) not-tracked-p))))
(defun slack-buffer-insert-messages (room team)
(let* ((sorted (slack-room-sorted-messages room))
(messages (slack-room-latest-messages room sorted)))
(if messages
(progn
;; (slack-buffer-insert-previous-link room)
(cl-loop for m in messages
do (slack-buffer-insert m team t))
(let ((latest-message (car (last messages))))
(slack-room-update-last-read room latest-message)
(slack-room-update-mark room team latest-message)))
(unless (eq 0 (oref room unread-count-display))
(let ((latest-message (car (last sorted))))
(slack-room-update-mark room team latest-message))))))
(defun slack-buffer-show-typing-p (buffer)
(cl-case slack-typing-visibility
('frame (slack-buffer-in-current-frame buffer))
('buffer (slack-buffer-current-p buffer))
('never nil)))
(defun slack-buffer-current-p (buffer)
(if buffer
(string= (buffer-name buffer)
(buffer-name (current-buffer)))))
(defun slack-buffer-in-current-frame (buffer)
(if buffer
(cl-member (buffer-name buffer)
(mapcar #'buffer-name
(mapcar #'window-buffer (window-list)))
:test #'string=)))
(cl-defun slack-buffer-update (room msg team &key replace)
(let* ((buf-name (slack-room-buffer-name room))
(buffer (get-buffer buf-name)))
(if buffer
(progn
(if (slack-buffer-in-current-frame buffer)
(slack-room-update-mark room team msg)
(slack-room-inc-unread-count room))
(if replace
(slack-buffer-replace buffer msg)
(with-current-buffer buffer
(slack-room-update-last-read room msg)
(slack-buffer-insert msg team))))
(slack-room-inc-unread-count room))))
(defmacro slack-buffer-goto-char (find-point &rest else)
`(let* ((cur-point (point))
(ts (get-text-property cur-point 'ts)))
(let ((next-point ,find-point))
(if next-point
(goto-char next-point)
(if (< 0 (length ',else))
,@else)))))
(defun slack-buffer-goto-next-message ()
(interactive)
(slack-buffer-goto-char
(slack-buffer-next-point cur-point (point-max) ts)
(slack-buffer-goto-first-message)))
(defun slack-buffer-goto-prev-message ()
(interactive)
(slack-buffer-goto-char
(slack-buffer-prev-point cur-point (point-min) ts)
(slack-buffer-goto-last-message)))
(defun slack-buffer-goto-first-message ()
(interactive)
(goto-char
(slack-buffer-next-point (point-min) (point-max) "0")))
(defun slack-buffer-goto-last-message ()
(interactive)
(goto-char
(slack-buffer-prev-point (point-max) (point-min) (format-time-string "%s"))))
(defun slack-buffer-header-p (point)
(let ((face (get-text-property point 'face)))
(string= (format "%s" face) "slack-message-output-header")))
(defun slack-buffer-next-point (start end ts)
(cl-loop for i from start to end
if (and (string< ts
(get-text-property i 'ts))
(slack-buffer-header-p i))
return i))
(defun slack-buffer-prev-point (start end ts)
(cl-loop for i from start downto end
if (and (string< (get-text-property i 'ts)
ts)
(slack-buffer-header-p i))
return i))
(defun slack-buffer-ts-eq (start end ts)
(if (and start end)
(cl-loop for i from start to end
if (string= (get-text-property i 'ts)
ts)
return i)))
(defun slack-buffer-ts-not-eq (start end ts)
(if (and start end)
(cl-loop for i from start to end
if (not (string= (get-text-property i 'ts)
ts))
return i)))
(defun slack-buffer-replace (buffer msg)
(with-current-buffer buffer
(slack-buffer-widen
(let* ((cur-point (point))
(ts (oref msg ts))
(beg (slack-buffer-ts-eq (point-min) (point-max) ts))
(end (slack-buffer-ts-not-eq beg (point-max) ts)))
(if (and beg end)
(let ((inhibit-read-only t)
(lui-time-stamp-last (get-text-property beg 'slack-last-ts)))
(delete-region beg end)
(set-marker lui-output-marker beg)
(slack-buffer-insert msg
(slack-team-find slack-current-team-id))
(slack-buffer-recover-lui-output-marker)
(slack-buffer-goto ts)))))))
(defun slack-buffer-recover-lui-output-marker ()
(set-marker lui-output-marker (- (marker-position
lui-input-marker)
(length lui-prompt-string))))
(defun slack-get-info-buffer-create (room)
(let* ((buf-name (slack-room-buffer-name room))
(buffer (get-buffer buf-name)))
(unless buffer
(setq buffer (generate-new-buffer buf-name))
(with-current-buffer buffer
(slack-info-mode)
(slack-buffer-insert-previous-link room)
(add-hook 'kill-buffer-hook 'slack-reset-room-last-read nil t)
(add-hook 'lui-pre-output-hook 'slack-buffer-add-last-ts-property nil t)
(add-hook 'lui-post-output-hook 'slack-buffer-add-ts-property nil t)))
buffer))
(defun slack-buffer-create-info (buf-name insert-func)
(let ((buf (slack-get-info-buffer-create buf-name)))
(with-current-buffer buf
(setq buffer-read-only nil)
(erase-buffer)
(goto-char (point-min))
(funcall insert-func)
(goto-char (point-max))
(setq buffer-read-only t)
(slack-buffer-enable-emojify))
buf))
(defun slack-reset-room-last-read ()
(let ((room (slack-room-find slack-current-room-id
(slack-team-find slack-current-team-id))))
(slack-room-update-last-read room
(slack-message "msg" :ts "0"))))
(provide 'slack-buffer)
;;; slack-buffer.el ends here

236
elpa/slack-20160928.2036/slack-channel.el Normal file
View File

@ -0,0 +1,236 @@
;;; slack-channel.el ---slack channel implement -*- lexical-binding: t; -*-
;; Copyright (C) 2015 yuya.minami
;; Author: yuya.minami <yuya.minami@yuyaminami-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-group)
(require 'slack-buffer)
(require 'slack-util)
(defvar slack-buffer-function)
(defconst slack-channel-history-url "https://slack.com/api/channels.history")
(defconst slack-channel-list-url "https://slack.com/api/channels.list")
(defconst slack-channel-buffer-name "*Slack - Channel*")
(defconst slack-channel-update-mark-url "https://slack.com/api/channels.mark")
(defconst slack-create-channel-url "https://slack.com/api/channels.create")
(defconst slack-channel-rename-url "https://slack.com/api/channels.rename")
(defconst slack-channel-invite-url "https://slack.com/api/channels.invite")
(defconst slack-channel-leave-url "https://slack.com/api/channels.leave")
(defconst slack-channel-join-url "https://slack.com/api/channels.join")
(defconst slack-channel-info-url "https://slack.com/api/channels.info")
(defconst slack-channel-archive-url "https://slack.com/api/channels.archive")
(defconst slack-channel-unarchive-url "https://slack.com/api/channels.unarchive")
(defclass slack-channel (slack-group)
((is-member :initarg :is_member)
(num-members :initarg :num_members)))
(defmethod slack-room-buffer-name ((room slack-channel))
(concat slack-channel-buffer-name
" : "
(slack-room-name-with-team-name room)))
(defun slack-channel-names (team &optional filter)
(with-slots (channels) team
(slack-room-names channels filter)))
(defmethod slack-room-member-p ((room slack-channel))
(oref room is-member))
(defun slack-channel-select ()
(interactive)
(let ((team (slack-team-select)))
(slack-room-select
(cl-loop for team in (list team)
for channels = (oref team channels)
nconc channels))))
(defun slack-channel-list-update ()
(interactive)
(let ((team (slack-team-select)))
(cl-labels ((on-list-update
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-channel-list-update")
(oset team channels
(mapcar #'(lambda (d)
(slack-room-create d team 'slack-channel))
(plist-get data :channels)))
(message "Slack Channel List Updated"))))
(slack-room-list-update slack-channel-list-url
#'on-list-update
team
:sync nil))))
(defmethod slack-room-update-mark-url ((_room slack-channel))
slack-channel-update-mark-url)
(defun slack-create-channel ()
(interactive)
(let ((team (slack-team-select)))
(cl-labels
((on-create-channel (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-channel-create"))))
(slack-create-room slack-create-channel-url
team
#'on-create-channel))))
(defun slack-channel-rename ()
(interactive)
(slack-room-rename slack-channel-rename-url
#'slack-channel-names))
(defun slack-channel-invite ()
(interactive)
(slack-room-invite slack-channel-invite-url
#'slack-channel-names))
(defun slack-channel-leave ()
(interactive)
(let* ((team (slack-team-select))
(channel (slack-current-room-or-select
#'(lambda ()
(slack-channel-names
team
#'(lambda (channels)
(cl-remove-if-not #'slack-room-member-p
channels)))))))
(cl-labels
((on-channel-leave (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-channel-leave")
(oset channel is-member nil)
(message "Left Channel: %s"
(slack-room-name channel)))))
(slack-room-request-with-id slack-channel-leave-url
(oref channel id)
team
#'on-channel-leave))))
(defun slack-channel-join ()
(interactive)
(cl-labels
((filter-channel (channels)
(cl-remove-if
#'(lambda (c)
(or (slack-room-member-p c)
(slack-room-archived-p c)))
channels)))
(let* ((team (slack-team-select))
(channel (slack-current-room-or-select
#'(lambda ()
(slack-channel-names team
#'filter-channel)))))
(cl-labels
((on-channel-join (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-channel-join"))))
(slack-request
slack-channel-join-url
team
:params (list (cons "name" (slack-room-name channel)))
:sync nil
:success #'on-channel-join))))
)
(defun slack-channel-create-from-info (id team)
(cl-labels
((on-create-from-info
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-channel-create-from-info")
(let* ((c-data (plist-get data :channel))
(latest (plist-get c-data :latest)))
(if latest
(plist-put c-data :latest
(slack-message-create latest)))
(if (plist-get c-data :is_channel)
(let ((channel
(slack-room-create c-data team 'slack-channel)))
(with-slots (channels) team
(push channel channels))
(message "Channel: %s created"
(slack-room-name-with-team-name channel))))))))
(slack-channel-fetch-info id team #'on-create-from-info)))
(defun slack-channel-fetch-info (id team success)
(slack-request
slack-channel-info-url
team
:sync nil
:params (list (cons "channel" id))
:success success))
(defun slack-channel-archive ()
(interactive)
(let* ((team (slack-team-select))
(channel (slack-current-room-or-select
#'(lambda ()
(slack-channel-names
team
#'(lambda (channels)
(cl-remove-if #'slack-room-archived-p
channels)))))))
(cl-labels
((on-channel-archive (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-channel-archive"))))
(slack-room-request-with-id slack-channel-archive-url
(oref channel id)
team
#'on-channel-archive))))
(defun slack-channel-unarchive ()
(interactive)
(let* ((team (slack-team-select))
(channel (slack-current-room-or-select
#'(lambda ()
(slack-channel-names
team
#'(lambda (channels)
(cl-remove-if-not #'slack-room-archived-p
channels)))))))
(cl-labels
((on-channel-unarchive (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-channel-unarchive"))))
(slack-room-request-with-id slack-channel-unarchive-url
(oref channel id)
team
#'on-channel-unarchive))))
(defmethod slack-room-history-url ((_room slack-channel))
slack-channel-history-url)
(defmethod slack-room-subscribedp ((room slack-channel) team)
(with-slots (subscribed-channels) team
(let ((name (slack-room-name room)))
(and name
(memq (intern name) subscribed-channels)))))
(provide 'slack-channel)
;;; slack-channel.el ends here

244
elpa/slack-20160928.2036/slack-file.el Normal file
View File

@ -0,0 +1,244 @@
;;; slack-file.el --- handle files -*- lexical-binding: t; -*-
;; Copyright (C) 2016 南優也
;; Author: 南優也 <yuyaminami@minamiyuunari-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-room)
(defconst slack-file-list-url "https://slack.com/api/files.list")
(defconst slack-file-upload-url "https://slack.com/api/files.upload")
(defconst slack-file-delete-url "https://slack.com/api/files.delete")
(defclass slack-file (slack-message)
((id :initarg :id)
(created :initarg :created)
(name :initarg :name)
(size :initarg :size)
(public :initarg :public)
(filetype :initarg :filetype)
(user :initarg :user)
(preview :initarg :preview)
(initial-comment :initarg :initial_comment :initform nil)
(permalink :initarg :permalink)
(channels :initarg :channels :type list)
(groups :initarg :groups :type list)
(ims :initarg :ims :type list)
(username :initarg :username)))
(defclass slack-file-room (slack-room) ())
(defun slack-file-room-obj (team)
(with-slots (file-room) team
(if file-room
file-room
(setq file-room (slack-file-room "file-room"
:name "Files"
:id "F"
:team-id (oref team id)
:created (format-time-string "%s")
:last_read "0"
:latest nil
:unread_count 0
:unread_count_display 0
:messages '())))))
(defun slack-file-create (payload)
(plist-put payload :channels (append (plist-get payload :channels) nil))
(plist-put payload :groups (append (plist-get payload :groups) nil))
(plist-put payload :ims (append (plist-get payload :ims) nil))
(plist-put payload :reactions (append (plist-get payload :reactions) nil))
(plist-put payload :pinned_to (append (plist-get payload :pinned_to) nil))
(plist-put payload :ts (number-to-string (plist-get payload :timestamp)))
(let ((file (apply #'slack-file "file"
(slack-collect-slots 'slack-file payload))))
(oset file reactions
(mapcar #'slack-reaction-create (plist-get payload :reactions)))
file))
(defmethod slack-message-equal ((f slack-file) other)
(string= (oref f id) (oref other id)))
(defmethod slack-file-pushnew ((f slack-file) team)
(let ((room (slack-file-room-obj team)))
(with-slots (messages) room
(cl-pushnew f messages
:test #'slack-message-equal))))
(defmethod slack-message-body ((file slack-file) team)
(with-slots (initial-comment) file
(let ((body (plist-get initial-comment :comment)))
(slack-message-unescape-string body team))))
(defmethod slack-message-to-string ((file slack-file) team)
(with-slots (ts name size filetype permalink user initial-comment reactions)
file
(let* ((header (slack-user-name user team))
(body (format "name: %s\nsize: %s\ntype: %s\n%s\n"
name size filetype permalink))
(reactions-str (slack-message-reactions-to-string
reactions)))
(slack-message-put-header-property header)
(slack-message-put-text-property body)
(slack-message-put-reactions-property reactions-str)
(let ((message
(concat header "\n" body
(if initial-comment
(format "comment: %s\n%s\n"
(slack-user-name
(plist-get initial-comment :user)
team)
(slack-message-body file team)))
(if reactions-str
(concat "\n" reactions-str "\n")))))
(put-text-property 0 (length message) 'ts ts message)
message))))
(defmethod slack-room-update-mark ((_room slack-file-room) _team _msg))
(defun slack-file-create-buffer (team)
(funcall slack-buffer-function
(slack-buffer-create (slack-file-room-obj team)
team
:type 'info)))
(defun slack-file-list ()
(interactive)
(let* ((team (slack-team-select))
(room (slack-file-room-obj team)))
(with-slots (messages) room
(if messages
(slack-file-create-buffer team)
(slack-room-history room team nil
#'(lambda ()
(slack-file-create-buffer team)))))))
(defmethod slack-room-history ((room slack-file-room) team
&optional
oldest
after-success
async)
(cl-labels
((on-file-list
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-file-list")
(let ((files (cl-loop for e across (plist-get data :files)
collect (slack-file-create e))))
(if oldest
(slack-room-set-prev-messages room files)
(slack-room-update-last-read room
(make-instance 'slack-message
:ts "0"))
(slack-room-set-messages room files)))
(if after-success
(funcall after-success)))))
(slack-request
slack-file-list-url
team
:params (list (if oldest
(cons "ts_to" oldest)))
:success #'on-file-list
:sync (if async nil t))))
(defun slack-file-upload ()
(interactive)
(cl-labels
((on-file-upload (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-file-upload")))
(select-channels (channels acc)
(let ((selected (completing-read "Select Channel: "
channels nil t)))
(if (< 0 (length selected))
(select-channels channels (push selected acc))
acc)))
(channel-id (selected channels)
(oref (cdr (cl-assoc selected channels :test #'string=))
id)))
(let* ((team (slack-team-select))
(channels (slack-room-names
(append (oref team ims)
(oref team channels)
(oref team groups))))
(target-channels (select-channels channels '()))
(channel-ids (mapconcat #'(lambda (selected)
(channel-id selected channels))
(cl-delete-if #'null target-channels)
","))
(buf (find-file-noselect
(car (find-file-read-args
"Select File: "
(confirm-nonexistent-file-or-buffer)))))
(filename (read-from-minibuffer "Filename: "
(file-name-nondirectory
(buffer-file-name buf))))
(filetype (read-from-minibuffer "Filetype: "
(file-name-extension
(buffer-file-name buf))))
(initial-comment (read-from-minibuffer "Message: ")))
(slack-request
slack-file-upload-url
team
:type "POST"
:params (list (cons "filename" filename)
(cons "channels" channel-ids)
(cons "filetype" filetype)
(if initial-comment
(cons "initial_comment" initial-comment)))
:files (list (cons "file" buf))
:headers (list (cons "Content-Type" "multipart/form-data"))
:success #'on-file-upload
:sync nil))))
(defun slack-file-delete ()
(interactive)
(cl-labels
((on-file-delete (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-file-delete"))))
(let* ((team (slack-team-select))
(files (oref (slack-file-room-obj team) messages))
(your-files (cl-remove-if #'(lambda (f)
(not (string= (oref f user)
(oref team self-id))))
files))
(candidates (mapcar #'(lambda (f)
(cons (concat
(slack-message-time-to-string (oref f ts))
" "
(oref f name))
f))
your-files))
(selected (completing-read "Select File: " candidates))
(deleting-file (cdr (cl-assoc selected candidates :test #'string=))))
(slack-request
slack-file-delete-url
team
:params (list (cons "file" (oref deleting-file id)))
:sync nil
:success #'on-file-delete))))
(provide 'slack-file)
;;; slack-file.el ends here

192
elpa/slack-20160928.2036/slack-group.el Normal file
View File

@ -0,0 +1,192 @@
;;; slack-group.el --- slack private group interface -*- lexical-binding: t; -*-
;; Copyright (C) 2015 Yuya Minami
;; Author: Yuya Minami
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-room)
(require 'slack-util)
(require 'slack-buffer)
(defconst slack--group-open-url "https://slack.com/api/groups.open")
(defconst slack-group-history-url "https://slack.com/api/groups.history")
(defconst slack-group-buffer-name "*Slack - Private Group*")
(defconst slack-group-list-url "https://slack.com/api/groups.list")
(defconst slack-group-update-mark-url "https://slack.com/api/groups.mark")
(defconst slack-create-group-url "https://slack.com/api/groups.create")
(defconst slack-group-rename-url "https://slack.com/api/groups.rename")
(defconst slack-group-invite-url "https://slack.com/api/groups.invite")
(defconst slack-group-leave-url "https://slack.com/api/groups.leave")
(defconst slack-group-archive-url "https://slack.com/api/groups.archive")
(defconst slack-group-unarchive-url "https://slack.com/api/groups.unarchive")
(defvar slack-buffer-function)
(defclass slack-group (slack-room)
((name :initarg :name :type string)
(is-group :initarg :is_group)
(creator :initarg :creator)
(is-archived :initarg :is_archived)
(is-mpim :initarg :is_mpim)
(members :initarg :members :type list)
(topic :initarg :topic)
(unread-count-display :initarg :unread_count_display :initform 0 :type integer)
(purpose :initarg :purpose)))
(defun slack-group-names (team &optional filter)
(with-slots (groups) team
(slack-room-names groups filter)))
(defmethod slack-room-subscribedp ((room slack-group) team)
(with-slots (subscribed-channels) team
(let ((name (slack-room-name room)))
(and name
(memq (intern name) subscribed-channels)))))
(defmethod slack-room-buffer-name ((room slack-group))
(concat slack-group-buffer-name
" : "
(slack-room-name-with-team-name room)))
(defun slack-group-select ()
(interactive)
(let ((team (slack-team-select)))
(slack-room-select
(cl-loop for team in (list team)
for groups = (oref team groups)
nconc groups))))
(defun slack-group-list-update ()
(interactive)
(let ((team (slack-team-select)))
(cl-labels ((on-list-update
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-group-list-update")
(with-slots (groups) team
(setq groups
(mapcar #'(lambda (g)
(slack-room-create g team 'slack-group))
(plist-get data :groups))))
(message "Slack Group List Updated"))))
(slack-room-list-update slack-group-list-url
#'on-list-update
:sync nil))))
(defmethod slack-room-update-mark-url ((_room slack-group))
slack-group-update-mark-url)
(defun slack-create-group ()
(interactive)
(let ((team (slack-team-select)))
(cl-labels
((on-create-group (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-create-group"))))
(slack-create-room slack-create-group-url
team
#'on-create-group))))
(defun slack-group-rename ()
(interactive)
(slack-room-rename slack-group-rename-url
#'slack-group-names))
(defun slack-group-invite ()
(interactive)
(slack-room-invite slack-group-invite-url
#'slack-group-names))
(defun slack-group-leave ()
(interactive)
(let* ((team (slack-team-select))
(group (slack-current-room-or-select
#'(lambda ()
(slack-group-names team)))))
(cl-labels
((on-group-leave
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-group-leave")
(with-slots (groups) team
(setq groups
(cl-delete-if #'(lambda (g)
(slack-room-equal-p group g))
groups)))
(message "Left Group: %s"
(slack-room-name-with-team-name group)))))
(slack-room-request-with-id slack-group-leave-url
(oref group id)
team
#'on-group-leave))))
(defmethod slack-room-archived-p ((room slack-group))
(oref room is-archived))
(defun slack-group-archive ()
(interactive)
(let* ((team (slack-team-select))
(group (slack-current-room-or-select
#'(lambda ()
(slack-group-names
team
#'(lambda (groups)
(cl-remove-if #'slack-room-archived-p
groups)))))))
(cl-labels
((on-group-archive (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-group-archive"))))
(slack-room-request-with-id slack-group-archive-url
(oref group id)
team
#'on-group-archive))))
(defun slack-group-unarchive ()
(interactive)
(let* ((team (slack-team-select))
(group (slack-current-room-or-select
#'(lambda ()
(slack-group-names
team
#'(lambda (groups)
(cl-remove-if-not #'slack-room-archived-p
groups)))))))
(cl-labels
((on-group-unarchive (&key _data &allow-other-keys)
(data "slack-group-unarchive")))
(slack-room-request-with-id slack-group-unarchive-url
(oref group id)
team
#'on-group-unarchive))))
(defmethod slack-mpim-p ((room slack-group))
(oref room is-mpim))
(defmethod slack-room-history-url ((_room slack-group))
slack-group-history-url)
(provide 'slack-group)
;;; slack-group.el ends here

184
elpa/slack-20160928.2036/slack-im.el Normal file
View File

@ -0,0 +1,184 @@
;;; slack-im.el ---slack direct message interface -*- lexical-binding: t; -*-
;; Copyright (C) 2015 南優也
;; Author: 南優也 <yuyaminami@minamiyuunari-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-util)
(require 'slack-room)
(require 'slack-buffer)
(require 'slack-user)
(defvar slack-buffer-function)
(defconst slack-im-history-url "https://slack.com/api/im.history")
(defconst slack-im-buffer-name "*Slack - Direct Messages*")
(defconst slack-user-list-url "https://slack.com/api/users.list")
(defconst slack-im-list-url "https://slack.com/api/im.list")
(defconst slack-im-close-url "https://slack.com/api/im.close")
(defconst slack-im-open-url "https://slack.com/api/im.open")
(defconst slack-im-update-mark-url "https://slack.com/api/im.mark")
(defclass slack-im (slack-room)
((user :initarg :user)
(is-open :initarg :is_open :initform nil)))
(defmethod slack-room-open-p ((room slack-im))
(oref room is-open))
(defmethod slack-room-name-with-team-name ((room slack-im))
(with-slots (team-id user) room
(let* ((team (slack-team-find team-id))
(user-name (slack-user-name user team)))
(format "%s - %s" (oref team name) user-name))))
(defmethod slack-im-user-presence ((room slack-im))
(with-slots ((user-id user) team-id) room
(let* ((team (slack-team-find team-id))
(user (slack-user-find user-id team)))
(slack-user-presence-to-string user))))
(defmethod slack-room-name ((room slack-im))
(with-slots (user team-id) room
(slack-user-name user (slack-team-find team-id))))
(defun slack-im-user-name (im team)
(with-slots (user) im
(slack-user-name user team)))
(defun slack-im-names (team)
(with-slots (ims) team
(mapcar #'(lambda (im) (cons (slack-im-user-name im team) im))
ims)))
(defmethod slack-room-buffer-name ((room slack-im))
(concat slack-im-buffer-name
" : "
(slack-room-name-with-team-name room)))
(defun slack-im-select ()
(interactive)
(let ((team (slack-team-select)))
(slack-room-select
(cl-loop for team in (list team)
for ims = (cl-remove-if #'(lambda (im) (not (oref im is-open)))
(oref team ims))
nconc ims))))
(defun slack-user-equal-p (a b)
(string= (plist-get a :id) (plist-get b :id)))
(defun slack-user-pushnew (user team)
(with-slots (users) team
(cl-pushnew user users :test #'slack-user-equal-p)))
(defun slack-im-update-room-list (users team)
(cl-labels ((on-update-room-list
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-im-update-room-list")
(mapc #'(lambda (u) (slack-user-pushnew u team))
(append users nil))
(oset team ims
(mapcar #'(lambda (d)
(slack-room-create d team 'slack-im))
(plist-get data :ims)))
(message "Slack Im List Updated"))))
(slack-room-list-update slack-im-list-url
#'on-update-room-list
team
:sync nil)))
(defun slack-im-list-update ()
(interactive)
(let ((team (slack-team-select)))
(slack-request
slack-user-list-url
team
:success (cl-function (lambda (&key data &allow-other-keys)
(slack-request-handle-error (data "slack-im-list-update")
(let ((users (plist-get data :members)))
(slack-im-update-room-list users team)))))
:sync nil)))
(defmethod slack-room-update-mark-url ((_room slack-im))
slack-im-update-mark-url)
(defmethod slack-room-history-url ((_room slack-im))
slack-im-history-url)
(defun slack-im-close ()
(interactive)
(let* ((team (slack-team-select))
(alist (cl-remove-if #'(lambda (im-names)
(not (oref (cdr im-names) is-open)))
(slack-im-names team))))
(slack-select-from-list
(alist "Select User: ")
(cl-labels
((on-success
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-im-close")
(if (plist-get data :already_closed)
(let ((im (slack-room-find (oref selected id) team)))
(oset im is-open nil)
(message "Direct Message Channel with %s Already Closed"
(slack-user-name (oref im user) team)))))))
(slack-request
slack-im-close-url
team
:type "POST"
:params (list (cons "channel" (oref selected id)))
:success #'on-success
:sync nil)))))
(defun slack-im-open ()
(interactive)
(let* ((team (slack-team-select))
(alist (cl-remove-if #'(lambda (im-names)
(oref (cdr im-names) is-open))
(slack-im-names team))))
(slack-select-from-list
(alist "Select User: ")
(cl-labels
((on-success
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-im-open")
(if (plist-get data :already_open)
(let ((im (slack-room-find (oref selected id) team)))
(oset im is-open t)
(message "Direct Message Channel with %s Already Open"
(slack-user-name (oref im user) team)))))))
(slack-request
slack-im-open-url
team
:type "POST"
:params (list (cons "user" (oref selected user)))
:success #'on-success
:sync nil)))))
(provide 'slack-im)
;;; slack-im.el ends here

141
elpa/slack-20160928.2036/slack-message-editor.el Normal file
View File

@ -0,0 +1,141 @@
;;; slack-message-editor.el --- edit message interface -*- lexical-binding: t; -*-
;; Copyright (C) 2015 南優也
;; Author: 南優也 <yuyaminami@minamiyuunari-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'slack-message-sender)
(defconst slack-message-edit-url "https://slack.com/api/chat.update")
(defconst slack-message-edit-buffer-name "*Slack - Edit message*")
(defconst slack-message-write-buffer-name "*Slack - Write message*")
(defvar slack-buffer-function)
(defvar slack-target-ts)
(make-local-variable 'slack-target-ts)
(defvar slack-message-edit-buffer-type)
(make-local-variable 'slack-message-edit-buffer-type)
(defvar slack-current-room-id)
(defvar slack-current-team-id)
(defvar slack-edit-message-mode-map
(let ((keymap (make-sparse-keymap)))
(define-key keymap (kbd "C-s C-m") #'slack-message-embed-mention)
(define-key keymap (kbd "C-s C-c") #'slack-message-embed-channel)
(define-key keymap (kbd "C-c C-k") #'slack-message-cancel-edit)
(define-key keymap (kbd "C-c C-c") #'slack-message-send-from-buffer)
keymap))
(define-derived-mode slack-edit-message-mode fundamental-mode "Slack Edit Msg"
""
(slack-buffer-enable-emojify))
(defun slack-message-write-another-buffer ()
(interactive)
(let* ((team (slack-team-find slack-current-team-id))
(target-room (if (boundp 'slack-current-room-id)
(slack-room-find slack-current-room-id
team)
(slack-message-read-room team)))
(buf (get-buffer-create slack-message-write-buffer-name)))
(with-current-buffer buf
(slack-message-setup-edit-buf target-room 'new
:team team))
(funcall slack-buffer-function buf)))
(defun slack-message-edit ()
(interactive)
(let* ((team (slack-team-find slack-current-team-id))
(room (slack-room-find slack-current-room-id
team))
(target (thing-at-point 'word))
(ts (get-text-property 0 'ts target))
(msg (slack-room-find-message room ts)))
(unless msg
(error "Can't find original message"))
(unless (string= (oref team self-id) (oref msg user))
(error "Cant't edit other user's message"))
(slack-message-edit-text msg room)))
(defun slack-message-edit-text (msg room)
(let ((buf (get-buffer-create slack-message-edit-buffer-name))
(team (slack-team-find slack-current-team-id)))
(with-current-buffer buf
(slack-edit-message-mode)
(slack-message-setup-edit-buf room 'edit
:ts (oref msg ts)
:team team)
(insert (oref msg text)))
(funcall slack-buffer-function buf)))
(cl-defun slack-message-setup-edit-buf (room buf-type &key ts team)
(slack-edit-message-mode)
(setq buffer-read-only nil)
(erase-buffer)
(if (and (eq buf-type 'edit) ts)
(set (make-local-variable 'slack-target-ts) ts))
(set (make-local-variable 'slack-message-edit-buffer-type) buf-type)
(slack-buffer-set-current-room-id room)
(slack-buffer-set-current-team-id team)
(message "C-c C-c to send edited msg"))
(defun slack-message-cancel-edit ()
(interactive)
(let* ((team (slack-team-find slack-current-team-id))
(room (slack-room-find slack-current-room-id
team)))
(erase-buffer)
(delete-window)
(slack-room-make-buffer-with-room room team)))
(defun slack-message-send-from-buffer ()
(interactive)
(let ((buf-string (buffer-substring (point-min) (point-max))))
(cl-case slack-message-edit-buffer-type
('edit
(let* ((team (slack-team-find slack-current-team-id))
(room (slack-room-find slack-current-room-id
team)))
(slack-message--edit (oref room id)
team
slack-target-ts
buf-string)))
('new (slack-message--send buf-string)))
(kill-buffer)
(delete-window)))
(defun slack-message--edit (channel team ts text)
(cl-labels ((on-edit (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-message--edit"))))
(slack-request
slack-message-edit-url
team
:type "POST"
:sync nil
:params (list (cons "channel" channel)
(cons "ts" ts)
(cons "text" text))
:success #'on-edit)))
(provide 'slack-message-editor)
;;; slack-message-editor.el ends here

182
elpa/slack-20160928.2036/slack-message-formatter.el Normal file
View File

@ -0,0 +1,182 @@
;;; slack-message-formatter.el --- format message text -*- lexical-binding: t; -*-
;; Copyright (C) 2015 yuya.minami
;; Author: yuya.minami <yuya.minami@yuyaminami-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-user)
(require 'slack-room)
(defface slack-message-output-text
'((t (:weight normal :height 0.9)))
"Face used to text message."
:group 'slack)
(defface slack-message-output-header
'((t (:foreground "#FFA000"
:weight bold
:height 1.0
:underline t)))
"Face used to text message."
:group 'slack)
(defface slack-message-output-reaction
'((t (:overline t)))
"Face used to reactions."
:group 'slack)
(defface slack-message-deleted-face
'((t (:strike-through t)))
"Face used to deleted message."
:group 'slack)
(defun slack-message-put-header-property (header)
(if header
(propertize header 'face 'slack-message-output-header)))
(defun slack-message-put-text-property (text)
(if text
(propertize text 'face 'slack-message-output-text)))
(defun slack-message-put-reactions-property (text)
(if text
(propertize text 'face 'slack-message-output-reaction)))
(defun slack-message-put-hard (text)
(if text
(propertize text 'hard t)))
(defun slack-message-put-deleted-property (text)
(if text
(propertize text 'face 'slack-message-deleted-face)))
(defmethod slack-message-propertize ((m slack-message) text)
text)
(defun slack-message-time-to-string (ts)
(if ts
(format-time-string "%Y-%m-%d %H:%M:%S"
(seconds-to-time (string-to-number ts)))))
(defun slack-message-reactions-to-string (reactions)
(if reactions
(concat "\n" (mapconcat #'slack-reaction-to-string reactions " "))))
(defmethod slack-message-header ((m slack-message) team)
(slack-message-sender-name m team))
(defun slack-format-message (header body attachment-body reactions)
(let ((messages (list header body attachment-body reactions)))
(concat (mapconcat #'identity
(cl-remove-if #'(lambda (e) (< (length e) 1)) messages)
"\n")
"\n")))
(defmethod slack-message-to-string ((m slack-message) team)
(let ((text (if (slot-boundp m 'text)
(oref m text))))
(let* ((header (slack-message-put-header-property
(slack-message-header m team)))
(row-body (slack-message-body m team))
(attachment-body (slack-message-attachment-body m team))
(body (if (oref m deleted-at)
(slack-message-put-deleted-property row-body)
(slack-message-put-text-property row-body)))
(reactions-str
(slack-message-put-reactions-property
(slack-message-reactions-to-string (oref m reactions)))))
(slack-message-propertize
m (slack-format-message header body attachment-body reactions-str)))))
(defmethod slack-message-body ((m slack-message) team)
(with-slots (text) m
(slack-message-unescape-string text team)))
(defmethod slack-message-attachment-body ((m slack-message) team)
(with-slots (attachments) m
(let ((body (mapconcat #'slack-attachment-to-string attachments "\n")))
(if (< 0 (length body))
(slack-message-unescape-string body team)))))
(defmethod slack-message-to-alert ((m slack-message) team)
(with-slots (text) m
(slack-message-unescape-string text team)))
(defun slack-message-unescape-string (text team)
(when text
(let* ((and-unescpaed
(replace-regexp-in-string "&amp;" "&" text))
(lt-unescaped
(replace-regexp-in-string "&lt;" "<" and-unescpaed))
(gt-unescaped
(replace-regexp-in-string "&gt;" ">" lt-unescaped)))
(slack-message-unescape-command
(slack-message-unescape-user-id
(slack-message-unescape-channel gt-unescaped)
team)))))
(defun slack-message-unescape-user-id (text team)
(let ((user-regexp "<@\\(U.*?\\)>"))
(cl-labels ((unescape-user-id
(text)
(concat "@" (or
(slack-message-replace-user-name text)
(slack-user-name (match-string 1 text) team)
(match-string 1 text)))))
(replace-regexp-in-string user-regexp
#'unescape-user-id
text t))))
(defun slack-message-replace-user-name (text)
(let ((user-name-regexp "<@U.*?|\\(.*?\\)>"))
(cl-labels ((replace-user-id-with-name (text)
(match-string 1 text)))
(if (string-match-p user-name-regexp text)
(replace-regexp-in-string user-name-regexp
#'replace-user-id-with-name
text)))))
(defun slack-message-unescape-command (text)
(let ((command-regexp "<!\\(.*?\\)>"))
(cl-labels ((unescape-command
(text)
(concat "@" (match-string 1 text))))
(replace-regexp-in-string command-regexp
#'unescape-command
text))))
(defun slack-message-unescape-channel (text)
(let ((channel-regexp "<#\\(C.*?\\)|\\(.*?\\)>"))
(cl-labels ((unescape-channel
(text)
(concat "#" (or (match-string 2 text)
(slack-room-find
(match-string 1 text))
(match-string 1 text)))))
(replace-regexp-in-string channel-regexp
#'unescape-channel
text t))))
(provide 'slack-message-formatter)
;;; slack-message-formatter.el ends here

79
elpa/slack-20160928.2036/slack-message-notification.el Normal file
View File

@ -0,0 +1,79 @@
;;; slack-message-notification.el --- message notification -*- lexical-binding: t; -*-
;; Copyright (C) 2015 yuya.minami
;; Author: yuya.minami <yuya.minami@yuyaminami-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-room)
(require 'slack-message)
(require 'slack-message-formatter)
(require 'slack-buffer)
(require 'slack-im)
(require 'alert)
(defvar alert-default-style)
(defcustom slack-message-custom-notifier nil
"Custom notification function.\ntake 3 Arguments.\n(lambda (MESSAGE ROOM TEAM) ...)."
:group 'slack)
(defun slack-message-notify (message room team)
(if slack-message-custom-notifier
(funcall slack-message-custom-notifier message room team)
(slack-message-notify-alert message room team)))
(defun slack-message-notify-alert (message room team)
(if (and (not (slack-message-minep message team))
(or (slack-im-p room)
(and (slack-group-p room) (slack-mpim-p room))
(slack-room-subscribedp room team)
(string-match (format "@%s" (plist-get (oref team self) :name))
(slack-message-body message team))))
(let ((team-name (oref team name))
(room-name (slack-room-name room))
(text (slack-message-to-alert message team))
(user-name (slack-message-sender-name message team)))
(if (and (eq alert-default-style 'notifier)
(slack-im-p room)
(or (eq (aref text 0) ?\[)
(eq (aref text 0) ?\{)
(eq (aref text 0) ?\<)
(eq (aref text 0) ?\()))
(setq text (concat "\\" text)))
(alert (if (slack-im-p room) text (format "%s: %s" user-name text))
:title (if (slack-im-p room)
(format "%s - %s" team-name room-name)
(format "%s - #%s" team-name room-name))
:category 'slack))))
(defmethod slack-message-sender-equalp ((_m slack-message) _sender-id)
nil)
(defmethod slack-message-minep ((m slack-message) team)
(if team
(with-slots (self-id) team
(slack-message-sender-equalp m self-id))
(slack-message-sender-equalp m (oref team self-id))))
(provide 'slack-message-notification)
;;; slack-message-notification.el ends here

155
elpa/slack-20160928.2036/slack-message-reaction.el Normal file
View File

@ -0,0 +1,155 @@
;;; slack-message-reaction.el --- adding, removing reaction from message -*- lexical-binding: t; -*-
;; Copyright (C) 2015 yuya.minami
;; Author: yuya.minami <yuya.minami@yuyaminami-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'slack-message)
(require 'slack-reaction)
(require 'slack-room)
(defconst slack-message-reaction-add-url "https://slack.com/api/reactions.add")
(defconst slack-message-reaction-remove-url "https://slack.com/api/reactions.remove")
(defvar slack-current-team-id)
(defvar slack-current-room-id)
(defvar slack-emojify-comp-list)
(defcustom slack-invalid-emojis '("^:flag_" "tone[[:digit:]]:$" "-" "^[^:].*[^:]$" "\\Ca")
"Invalid emoji regex. Slack server treated some emojis as Invalid."
:group 'slack)
(defun slack-message-reaction-load-emojify-comp-list ()
(if (and (bound-and-true-p emojify-emojis)
(not (bound-and-true-p slack-emojify-comp-list)))
(setq slack-emojify-comp-list
(let ((invalid-regex (mapconcat #'identity
slack-invalid-emojis
"\\|")))
(cl-remove-if (lambda (s) (string-match invalid-regex s))
(hash-table-keys emojify-emojis))))))
(defun slack-message-add-reaction ()
(interactive)
(let* ((word (thing-at-point 'word))
(ts (get-text-property 0 'ts word))
(reaction (slack-message-reaction-input))
(team (slack-team-find slack-current-team-id))
(room (slack-room-find slack-current-room-id
team)))
(slack-message-reaction-add reaction ts room team)))
(defun slack-message-remove-reaction ()
(interactive)
(let* ((team (slack-team-find slack-current-team-id))
(room (slack-room-find slack-current-room-id
team))
(word (thing-at-point 'word))
(ts (get-text-property 0 'ts word))
(msg (slack-room-find-message room ts))
(reactions (oref msg reactions))
(reaction (slack-message-reaction-select reactions)))
(slack-message-reaction-remove reaction ts room team)))
(defun slack-message-show-reaction-users ()
(interactive)
(let* ((team (slack-team-find slack-current-team-id))
(reaction (ignore-errors (get-text-property (point) 'reaction))))
(if reaction
(let ((user-names (slack-reaction-user-names reaction team)))
(message "reacted users: %s" (mapconcat #'identity user-names ", ")))
(message "Can't get reaction:"))))
(defun slack-message-reaction-select (reactions)
(let ((list (mapcar #'(lambda (r)
(cons (oref r name)
(oref r name)))
reactions)))
(slack-select-from-list
(list "Select Reaction: ")
selected)))
(defun slack-message-reaction-input ()
(slack-message-reaction-load-emojify-comp-list)
(let ((reaction (if (bound-and-true-p slack-emojify-comp-list)
(completing-read "Select Emoji: " slack-emojify-comp-list)
(read-from-minibuffer "Emoji: "))))
(if (and (string-prefix-p ":" reaction)
(string-suffix-p ":" reaction))
(substring reaction 1 -1)
reaction)))
(defun slack-message-reaction-add (reaction ts room team)
(cl-labels ((on-reaction-add
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-message-reaction-add"))))
(slack-request
slack-message-reaction-add-url
team
:type "POST"
:sync nil
:params (list (cons "channel" (oref room id))
(cons "timestamp" ts)
(cons "name" reaction))
:success #'on-reaction-add)))
(defun slack-message-reaction-remove (reaction ts room team)
(cl-labels ((on-reaction-remove
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-message-reaction-remove"))))
(slack-request
slack-message-reaction-remove-url
team
:type "POST"
:sync nil
:params (list (cons "channel" (oref room id))
(cons "timestamp" ts)
(cons "name" reaction))
:success #'on-reaction-remove)))
(cl-defmacro slack-message-find-reaction ((m reaction) &body body)
`(let ((same-reaction (cl-find-if #'(lambda (r) (slack-reaction-equalp r ,reaction))
(oref ,m reactions))))
,@body))
(defmethod slack-message-append-reaction ((m slack-message) reaction)
(slack-message-find-reaction
(m reaction)
(if same-reaction
(slack-reaction-join same-reaction reaction)
(push reaction (oref m reactions)))))
(defmethod slack-message-pop-reaction ((m slack-message) reaction)
(slack-message-find-reaction
(m reaction)
(if same-reaction
(if (eq 1 (oref same-reaction count))
(with-slots (reactions) m
(setq reactions
(cl-delete-if #'(lambda (r)
(slack-reaction-equalp same-reaction r))
reactions)))
(cl-decf (oref same-reaction count))))))
(provide 'slack-message-reaction)
;;; slack-message-reaction.el ends here

170
elpa/slack-20160928.2036/slack-message-sender.el Normal file
View File

@ -0,0 +1,170 @@
;;; slack-message-sender.el --- slack message concern message sending -*- lexical-binding: t; -*-
;; Copyright (C) 2015 yuya.minami
;; Author: yuya.minami <yuya.minami@yuyaminami-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'json)
(require 'slack-websocket)
(require 'slack-im)
(require 'slack-group)
(require 'slack-message)
(require 'slack-channel)
(defvar slack-message-minibuffer-local-map nil)
(defvar slack-buffer-function)
(defun slack-message-send ()
(interactive)
(slack-message--send (slack-message-read-from-minibuffer)))
(defun slack-message-inc-id (team)
(with-slots (message-id) team
(if (eq message-id (1- most-positive-fixnum))
(setq message-id 1)
(cl-incf message-id))))
(defun slack-escape-message (message)
"Escape '<,' '>' & '&' in MESSAGE."
(replace-regexp-in-string
">" "&gt;"
(replace-regexp-in-string
"<" "&lt;"
(replace-regexp-in-string "&" "&amp;" message))))
(defun slack-link-users (message team)
"Add links to all references to valid users in MESSAGE."
(replace-regexp-in-string
"@\\<\\([A-Za-z0-9.-_]+\\)"
#'(lambda (text)
(let* ((username (match-string 1 text))
(id (slack-user-get-id username team)))
(if id
(format "<@%s|%s>" id username)
(cond
((string= username "here") "<!here|here>")
((find username '("channel" "group") :test #'string=) "<!channel>")
((string= username "everyone") "<!everyone>")
(t text)))))
message t))
(defun slack-link-channels (message team)
"Add links to all references to valid channels in MESSAGE."
(let ((channel-ids
(mapcar #'(lambda (x)
(let ((channel (cdr x)))
(cons (slack-room-name channel) (slot-value channel 'id))))
(slack-channel-names team))))
(replace-regexp-in-string
"#\\<\\([A-Za-z0-9.-_]+\\)"
#'(lambda (text)
(let* ((channel (match-string 1 text))
(id (cdr (assoc channel channel-ids))))
(if id
(format "<#%s|%s>" id channel)
text)))
message t)))
(defun slack-message--send (message)
(if slack-current-team-id
(let* ((team (slack-team-find slack-current-team-id))
(message (slack-link-channels
(slack-link-users
(slack-escape-message message)
team)
team)))
(slack-message-inc-id team)
(with-slots (message-id sent-message self-id) team
(let* ((m (list :id message-id
:channel (slack-message-get-room-id)
:type "message"
:user self-id
:text message))
(json (json-encode m))
(obj (slack-message-create m)))
(slack-ws-send json team)
(puthash message-id obj sent-message))))
(error "Call from Slack Buffer")))
(defun slack-message-get-room-id ()
(if (and (boundp 'slack-current-room-id)
(boundp 'slack-current-team-id))
(oref (slack-room-find slack-current-room-id
(slack-team-find slack-current-team-id))
id)
(oref (slack-message-read-room (slack-team-select)) id)))
(defun slack-message-read-room (team)
(let* ((list (slack-message-room-list team))
(choices (mapcar #'car list))
(room-name (slack-message-read-room-list "Select Room: " choices))
(room (cdr (cl-assoc room-name list :test #'string=))))
room))
(defun slack-message-read-room-list (prompt choices)
(let ((completion-ignore-case t))
(completing-read (format "%s" prompt)
choices nil t nil nil choices)))
(defun slack-message-room-list (team)
(append (slack-group-names team)
(slack-im-names team)
(slack-channel-names team)))
(defun slack-message-read-from-minibuffer ()
(let ((prompt "Message: "))
(slack-message-setup-minibuffer-keymap)
(read-from-minibuffer
prompt
nil
slack-message-minibuffer-local-map)))
(defun slack-message-setup-minibuffer-keymap ()
(unless slack-message-minibuffer-local-map
(setq slack-message-minibuffer-local-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'newline)
(set-keymap-parent map minibuffer-local-map)
map))))
(defun slack-message-embed-channel ()
(interactive)
(let ((team (slack-team-select)))
(let* ((alist (slack-channel-names team)))
(slack-select-from-list
(alist "Select Channel: ")
(insert (concat "#" (slack-room-name selected)))))))
(defun slack-message-embed-mention ()
(interactive)
(let ((team (slack-team-select)))
(let* ((pre-defined (list (list "here" :name "here")
(list "channel" :name "channel")))
(alist (append pre-defined (slack-user-names team))))
(slack-select-from-list
(alist "Select User: ")
(insert (concat "@" (plist-get selected :name)))))))
(provide 'slack-message-sender)
;;; slack-message-sender.el ends here

295
elpa/slack-20160928.2036/slack-message.el Normal file
View File

@ -0,0 +1,295 @@
;;; slack-message.el --- slack-message -*- lexical-binding: t; -*-
;; Copyright (C) 2015 yuya.minami
;; Author: yuya.minami <yuya.minami@yuyaminami-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-util)
(require 'slack-reaction)
(defvar slack-current-room-id)
(defvar slack-current-team-id)
(defconst slack-message-pins-add-url "https://slack.com/api/pins.add")
(defconst slack-message-pins-remove-url "https://slack.com/api/pins.remove")
(defconst slack-message-delete-url "https://slack.com/api/chat.delete")
(defclass slack-message ()
((type :initarg :type :type string)
(subtype :initarg :subtype)
(channel :initarg :channel :initform nil)
(ts :initarg :ts :type string :initform "")
(text :initarg :text :type (or null string) :initform nil)
(item-type :initarg :item_type)
(attachments :initarg :attachments :type (or null list) :initform nil)
(reactions :initarg :reactions :type (or null list))
(is-starred :initarg :is_starred :type boolean)
(pinned-to :initarg :pinned_to :type (or null list))
(edited-at :initarg :edited-at :initform nil)
(deleted-at :initarg :deleted-at :initform nil)))
(defclass slack-file-message (slack-message)
((file :initarg :file)
;; (bot-id :initarg :bot_id :type (or null string))
;; (username :initarg :username)
;; (display-as-bot :initarg :display_as_bot)
(upload :initarg :upload)
(user :initarg :user :initform nil)))
(defclass slack-reply (slack-message)
((user :initarg :user :initform nil)
(reply-to :initarg :reply_to :type integer)
(id :initarg :id :type integer)))
(defclass slack-user-message (slack-message)
((user :initarg :user :type string)
(edited :initarg :edited)
(id :initarg :id)
(inviter :initarg :inviter)))
(defclass slack-bot-message (slack-message)
((bot-id :initarg :bot_id :type string)
(username :initarg :username :type string :initform "")
(icons :initarg :icons)))
(defclass slack-attachment ()
((fallback :initarg :fallback :initform nil)
(title :initarg :title :initform nil)
(title-link :initarg :title_link :initform nil)
(pretext :initarg :pretext :initform nil)
(text :initarg :text :initform nil)
(author-name :initarg :author_name)
(author-link :initarg :author_link)
(author-icon :initarg :author_icon)
(fields :initarg :fields :type (or null list))
(image-url :initarg :image_url)
(thumb-url :initarg :thumb_url)
(is-share :initarg :is_share :initform nil)))
(defclass slack-shared-message (slack-attachment)
((ts :initarg :ts :initform nil)
(color :initarg :color :initform nil)
(channel-id :initarg :channel_id :initform nil)
(channel-name :initarg :channel_name :initform nil)
(from-url :initarg :from_url :initform nil)))
(defgeneric slack-message-sender-name (slack-message team))
(defgeneric slack-message-to-string (slack-message))
(defgeneric slack-message-to-alert (slack-message))
(defgeneric slack-room-buffer-name (room))
(defun slack-room-find (id team)
(if (and id team)
(cl-labels ((find-room (room)
(string= id (oref room id))))
(cond
((string-prefix-p "F" id) (slack-file-room-obj team))
((string-prefix-p "C" id) (cl-find-if #'find-room
(oref team channels)))
((string-prefix-p "G" id) (cl-find-if #'find-room
(oref team groups)))
((string-prefix-p "D" id) (cl-find-if #'find-room
(oref team ims)))
((string-prefix-p "Q" id) (cl-find-if #'find-room
(oref team search-results)))))))
(defun slack-reaction-create (payload)
(apply #'slack-reaction "reaction"
(slack-collect-slots 'slack-reaction payload)))
(defmethod slack-message-set-reactions ((m slack-message) payload)
(let ((reactions (plist-get payload :reactions)))
(if (< 0 (length reactions))
(oset m reactions (mapcar #'slack-reaction-create reactions))))
m)
(defun slack-attachment-create (payload)
(plist-put payload :fields
(append (plist-get payload :fields) nil))
(if (plist-get payload :is_share)
(apply #'slack-shared-message "shared-attachment"
(slack-collect-slots 'slack-shared-message payload))
(apply #'slack-attachment "attachment"
(slack-collect-slots 'slack-attachment payload))))
(defmethod slack-message-set-attachments ((m slack-message) payload)
(let ((attachments (plist-get payload :attachments)))
(if (< 0 (length attachments))
(oset m attachments
(mapcar #'slack-attachment-create attachments))))
m)
(cl-defun slack-message-create (payload &key room)
(when payload
(plist-put payload :reactions (append (plist-get payload :reactions) nil))
(plist-put payload :attachments (append (plist-get payload :attachments) nil))
(plist-put payload :pinned_to (append (plist-get payload :pinned_to) nil))
(if room
(plist-put payload :channel (oref room id)))
(cl-labels ((create
(m)
(let ((subtype (plist-get m :subtype)))
(cond
((plist-member m :reply_to)
(apply #'slack-reply "reply"
(slack-collect-slots 'slack-reply m)))
((and subtype (string-prefix-p "file" subtype))
(apply #'slack-file-message "file-msg"
(slack-collect-slots 'slack-file-message m)))
((plist-member m :user)
(apply #'slack-user-message "user-msg"
(slack-collect-slots 'slack-user-message m)))
((and subtype (string= "bot_message" subtype))
(apply #'slack-bot-message "bot-msg"
(slack-collect-slots 'slack-bot-message m)))))))
(let ((message (create payload)))
(when message
(slack-message-set-attachments message payload)
(slack-message-set-reactions message payload))))))
(defmethod slack-message-equal ((m slack-message) n)
(string= (oref m ts) (oref n ts)))
(defmethod slack-message-update ((m slack-message) team &optional replace no-notify)
(cl-labels
((push-message-to (room msg)
(with-slots (messages) room
(when (< 0 (length messages))
(cl-pushnew msg messages
:test #'slack-message-equal))
(update-latest room msg)))
(update-latest (room msg)
(with-slots (latest) room
(if (or (null latest)
(string< (oref latest ts) (oref msg ts)))
(setq latest msg)))))
(with-slots (channel) m
(let ((room (slack-room-find channel team)))
(when room
(push-message-to room m)
(slack-buffer-update room m team :replace replace)
(unless no-notify
(slack-message-notify m room team)))))))
(defun slack-message-edited (payload team)
(let* ((edited-message (slack-decode (plist-get payload :message)))
(room (slack-room-find (plist-get payload :channel) team))
(message (slack-room-find-message room
(plist-get edited-message :ts)))
(edited-info (plist-get edited-message :edited)))
(if message
(progn
(with-slots (text edited-at attachments) message
(setq text (plist-get edited-message :text))
(setq edited-at (plist-get edited-info :ts))
(if (plist-get edited-message :attachments)
(setq attachments
(mapcar #'slack-attachment-create
(plist-get edited-message :attachments)))))
(slack-message-update message team t)))))
(defmethod slack-message-sender-name ((m slack-message) team)
(slack-user-name (oref m user) team))
(defun slack-message-pins-add ()
(interactive)
(slack-message-pins-request slack-message-pins-add-url))
(defun slack-message-pins-remove ()
(interactive)
(slack-message-pins-request slack-message-pins-remove-url))
(defun slack-message-pins-request (url)
(unless (and (bound-and-true-p slack-current-team-id)
(bound-and-true-p slack-current-room-id))
(error "Call From Slack Room Buffer"))
(let* ((team (slack-team-find slack-current-team-id))
(room (slack-room-find slack-current-room-id
team))
(word (thing-at-point 'word))
(ts (ignore-errors (get-text-property 0 'ts word))))
(unless ts
(error "Call From Slack Room Buffer"))
(cl-labels ((on-pins-add
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-message-pins-request"))))
(slack-request
url
team
:params (list (cons "channel" (oref room id))
(cons "timestamp" ts))
:success #'on-pins-add
:sync nil))))
(defun slack-message-time-stamp (message)
(seconds-to-time (string-to-number (oref message ts))))
(defun slack-message-delete ()
(interactive)
(unless (and (boundp 'slack-current-team-id)
(boundp 'slack-current-room-id))
(error "Call From Slack Room Buffer"))
(let* ((team (slack-team-find slack-current-team-id))
(channel (slack-room-find slack-current-room-id
team))
(ts (ignore-errors (get-text-property (point) 'ts))))
(unless ts
(error "Call With Cursor On Message"))
(let ((message (slack-room-find-message channel ts)))
(when message
(cl-labels
((on-delete
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-message-delete"))))
(if (yes-or-no-p "Are you sure you want to delete this message?")
(slack-request
slack-message-delete-url
team
:type "POST"
:params (list (cons "ts" (oref message ts))
(cons "channel" (oref channel id)))
:success #'on-delete
:sync nil)
(message "Canceled")))))))
(defun slack-message-deleted (payload team)
(let* ((channel-id (plist-get payload :channel))
(ts (plist-get payload :deleted_ts))
(deleted-ts (plist-get payload :ts))
(channel (slack-room-find channel-id team))
(message (slack-room-find-message channel ts)))
(when message
(oset message deleted-at deleted-ts)
(alert "message deleted"
:title (format "\\[%s] from %s"
(slack-room-name-with-team-name channel)
(slack-message-sender-name message team))
:category 'slack)
(slack-buffer-update channel message team :replace t))))
(provide 'slack-message)
;;; slack-message.el ends here

11
elpa/slack-20160928.2036/slack-pkg.el Normal file
View File

@ -0,0 +1,11 @@
(define-package "slack" "20160928.2036" "Slack client for Emacs"
'((websocket "1.5")
(request "0.2.0")
(oauth2 "0.10")
(circe "2.2")
(alert "1.2")
(emojify "0.2"))
:url "https://github.com/yuya373/emacs-slack")
;; Local Variables:
;; no-byte-compile: t
;; End:

66
elpa/slack-20160928.2036/slack-reaction.el Normal file
View File

@ -0,0 +1,66 @@
;;; slack-reaction.el --- deal with reactions -*- lexical-binding: t; -*-
;; Copyright (C) 2015 yuya.minami
;; Author: yuya.minami <yuya.minami@yuyaminami-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(defclass slack-reaction ()
((name :initarg :name :type string)
(count :initarg :count :type integer)
(users :initarg :users :initform ())))
(defmethod slack-reaction-join ((r slack-reaction) other)
(if (string= (oref r name) (oref other name))
(progn
(cl-incf (oref r count))
(oset r users (nconc (oref other users) (oref r users)))
r)))
(defmethod slack-reaction-user-names ((r slack-reaction) team)
(with-slots (users) r
(mapcar #'(lambda (u) (slack-user-name u team))
users)))
(defmethod slack-reaction-equalp ((r slack-reaction) other)
(string= (oref r name) (oref other name)))
(defmethod slack-reaction-to-string ((r slack-reaction))
(let ((text (format ":%s:: %d" (oref r name) (oref r count))))
(put-text-property 0 (length text) 'reaction r text)
text))
(defun slack-reaction-notify (payload team)
(let* ((user-id (plist-get payload :user))
(room (slack-room-find (plist-get (plist-get payload :item) :channel)
team))
(reaction (plist-get payload :reaction))
(msg (slack-user-message "msg"
:text (format "added reaction %s" reaction)
:user user-id)))
(slack-message-notify msg room team)))
(provide 'slack-reaction)
;;; slack-reaction.el ends here

264
elpa/slack-20160928.2036/slack-reminder.el Normal file
View File

@ -0,0 +1,264 @@
;;; slack-reminder.el --- -*- lexical-binding: t; -*-
;; Copyright (C) 2016 南優也
;; Author: 南優也 <yuyaminami@minamiyuuya-no-MacBook.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-team)
(defconst slack-reminder-list-url "https://slack.com/api/reminders.list")
(defconst slack-reminder-add-url "https://slack.com/api/reminders.add")
(defconst slack-reminder-delete-url "https://slack.com/api/reminders.delete")
(defconst slack-reminder-complete-url "https://slack.com/api/reminders.complete")
(defconst slack-reminder-info-url "https://slack.com/api/reminders.info")
(defclass slack-reminder-base ()
((id :initarg :id :type string)
(creator :initarg :creator :type string)
(user :initarg :user :type string)
(text :initarg :text :type string)))
(defclass slack-recurring-reminder (slack-reminder-base)
())
(defclass slack-reminder (slack-reminder-base)
((time :initarg :time :type integer)
(complete-ts :initarg :complete_ts :type integer)))
(defmethod slack-reminder-user ((r slack-reminder-base) team)
(slack-user-find (oref r user) team))
(defmethod slack-reminder-creator ((r slack-reminder-base) team)
(slack-user-find (oref r creator) team))
(defmethod slack-team-add-reminder ((team slack-team) reminder)
(with-slots (reminders) team
(cl-pushnew reminder reminders
:test #'(lambda (a b) (string= (oref a id) (oref b id))))))
(defmethod slack-reminder-completedp ((r slack-reminder))
(not (eq 0 (oref r complete-ts))))
(defmethod slack-reminder-completedp ((_r slack-recurring-reminder))
nil)
(defun slack-reminder-create (payload)
(let ((klass (if (eq :json-false (plist-get payload :recurring))
'slack-reminder
'slack-recurring-reminder)))
(apply #'make-instance klass
(slack-collect-slots klass payload))))
(defun slack-reminder-add ()
(interactive)
(let* ((team (slack-team-select))
(user (slack-select-from-list
((slack-user-names team) "Select Target User: ")))
(time (read-from-minibuffer
"Time (Ex. \"in 15 minutes,\" or \"every Thursday\"): "))
(text (read-from-minibuffer "Text: ")))
(cl-labels
((on-reminder-add (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-reminder-add")
(let ((reminder (slack-reminder-create
(slack-decode
(plist-get data :reminder)))))
(slack-team-add-reminder team reminder)
(message "Reminder Created!")))))
(slack-request
slack-reminder-add-url
team
:sync nil
:params (list (cons "text" text)
(cons "time" time)
(and user (cons "user" (plist-get user :id))))
:success #'on-reminder-add))))
(defmethod slack-reminder-to-body ((r slack-reminder))
(with-slots (text time complete-ts) r
(let ((time-str (format "Remind At: %s"
(slack-message-time-to-string
(number-to-string time))))
(completed (format "Completed: %s"
(if (eq complete-ts 0)
"Not Yet"
(slack-message-time-to-string
(number-to-string complete-ts))))))
(format "%s\n%s\n\n%s" time-str completed text))))
(defmethod slack-reminder-to-body ((r slack-recurring-reminder))
(oref r text))
(defmethod slack-reminder-to-string ((r slack-reminder-base) team)
(with-slots (creator user) r
(let* ((header (slack-message-put-header-property
(format "From: %s To: %s"
(slack-user-name creator team)
(slack-user-name user team))))
(body (slack-reminder-to-body r)))
(format "%s\n%s\n\n" header body))))
(defmethod slack-create-reminder-buffer ((team slack-team))
(let* ((buf-name "*Slack - Reminders*")
(buf (get-buffer-create buf-name)))
(with-current-buffer buf
(setq buffer-read-only nil)
(erase-buffer)
(goto-char (point-min))
(with-slots (reminders) team
(cl-loop for reminder in reminders
do (insert (slack-reminder-to-string reminder team))))
(setq buffer-read-only t))
buf))
(defmethod slack-reminder-sort-key ((r slack-reminder))
(oref r time))
(defmethod slack-reminder-sort-key ((r slack-recurring-reminder))
0)
(defun slack-reminder-sort (team)
(with-slots (reminders) team
(setq reminders
(cl-sort reminders #'<
:key #'(lambda (r) (slack-reminder-sort-key r))))))
(defun slack-reminder-list ()
(interactive)
(let ((team (slack-team-select)))
(cl-labels
((on-reminder-list
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-reminder-list")
(oset team reminders
(cl-loop
for payload in (slack-decode
(append (plist-get data :reminders)
nil))
collect (slack-reminder-create payload)))
(slack-reminder-sort team)
(if (< 0 (length (oref team reminders)))
(funcall
slack-buffer-function
(slack-create-reminder-buffer team))
(message "No Reminders!")))))
(slack-request
slack-reminder-list-url
team
:sync nil
:success #'on-reminder-list))))
(defmethod slack-reminders-alist ((team slack-team) &optional filter)
(cl-labels ((text (r)
(with-slots (creator user text) r
(format "Creator: %s Target: %s Content: %s"
(slack-user-name creator team)
(slack-user-name user team)
text))))
(with-slots (reminders) team
(mapcar #'(lambda (r) (cons (text r) r))
(if filter
(cl-remove-if-not #'(lambda (r) (funcall filter r))
reminders)
reminders)))))
(defmethod slack-team-delete-reminder ((team slack-team) r)
(with-slots (reminders) team
(setq reminders
(cl-remove-if #'(lambda (e)
(string= (oref e id) (oref r id)))
reminders))))
(defun slack-reminder-select (team &optional filter)
(slack-select-from-list
((slack-reminders-alist team filter) "Select: ")))
(defun slack-reminder-delete ()
(interactive)
(let* ((team (slack-team-select))
(reminder (slack-reminder-select team)))
(cl-labels
((on-reminder-delete (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-reminder-delete")
(slack-team-delete-reminder team reminder)
(message "Reminder Deleted!"))))
(slack-request
slack-reminder-delete-url
team
:sync nil
:params (list (cons "reminder" (oref reminder id)))
:success #'on-reminder-delete))))
(defmethod slack-reminder-info ((r slack-reminder-base) team callback)
(cl-labels
((on-reminder-info (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-reminder-info")
(let ((reminder (slack-reminder-create
(plist-get (slack-decode data)
:reminder))))
(funcall callback reminder)))))
(slack-request
slack-reminder-info-url
team
:sync nil
:params (list (cons "reminder" (oref r id)))
:success #'on-reminder-info)))
(defmethod slack-reminder-refresh ((r slack-reminder-base) team)
(slack-reminder-info
r team
#'(lambda (reminder)
(with-slots (reminders) team
(setq reminders
(cl-remove-if #'(lambda (e) (string= (oref e id)
(oref reminder id)))
reminders))
(push reminder reminders))
(message "Reminder Updated!"))))
(defun slack-reminder-complete ()
(interactive)
(let* ((team (slack-team-select))
(reminder (slack-reminder-select
team
#'(lambda (r)
(not (slack-reminder-completedp r))))))
(cl-labels
((on-reminder-complete (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-reminder-complete")
(slack-reminder-refresh reminder team))))
(slack-request
slack-reminder-complete-url
team
:sync nil
:params (list (cons "reminder" (oref reminder id)))
:success #'on-reminder-complete))))
(provide 'slack-reminder)
;;; slack-reminder.el ends here

49
elpa/slack-20160928.2036/slack-reply.el Normal file
View File

@ -0,0 +1,49 @@
;;; slack-reply.el ---handle reply from slack -*- lexical-binding: t; -*-
;; Copyright (C) 2015 yuya.minami
;; Author: yuya.minami <yuya.minami@yuyaminami-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-message)
(defmethod slack-message-handle-reply ((m slack-reply) team)
(with-slots (reply-to) m
(let ((sent-msg (slack-message-find-sent m team)))
(if sent-msg
(progn
(oset sent-msg ts (oref m ts))
(slack-message-update sent-msg team))))))
(defmethod slack-message-find-sent ((m slack-reply) team)
(with-slots (reply-to) m
(with-slots (sent-message) team
(let ((found (gethash reply-to sent-message)))
(remhash reply-to sent-message)
found))))
(defmethod slack-message-sender-equalp ((m slack-reply) sender-id)
(string= (oref m user) sender-id))
(provide 'slack-reply)
;;; slack-reply.el ends here

80
elpa/slack-20160928.2036/slack-request.el Normal file
View File

@ -0,0 +1,80 @@
;;; slack-request.el ---slack request function -*- lexical-binding: t; -*-
;; Copyright (C) 2015 南優也
;; Author: 南優也 <yuyaminami@minamiyuunari-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'json)
(require 'request)
(defcustom slack-request-timeout 5
"Request Timeout in seconds."
:group 'slack)
(defun slack-parse-to-hash ()
(let ((json-object-type 'hash-table))
(let ((res (json-read-from-string (buffer-string))))
res)))
(defun slack-parse-to-plist ()
(let ((json-object-type 'plist))
(json-read)))
(defun slack-request-parse-payload (payload)
(let ((json-object-type 'plist))
(json-read-from-string payload)))
(cl-defun slack-request (url team &key
(type "GET")
(success)
(error nil)
(params nil)
(parser #'slack-parse-to-plist)
(sync t)
(files nil)
(headers nil)
(timeout slack-request-timeout))
(request
url
:type type
:sync sync
:params (cons (cons "token" (oref team token))
params)
:files files
:headers headers
:parser parser
:success success
:error error
:timeout timeout))
(cl-defmacro slack-request-handle-error ((data req-name) &body body)
"Bind error to e if present in DATA."
`(if (eq (plist-get ,data :ok) :json-false)
(message "Failed to request %s: %s"
,req-name
(plist-get ,data :error))
(progn
,@body)))
(provide 'slack-request)
;;; slack-request.el ends here

472
elpa/slack-20160928.2036/slack-room.el Normal file
View File

@ -0,0 +1,472 @@
;;; slack-room.el --- slack generic room interface -*- lexical-binding: t; -*-
;; Copyright (C) 2015 南優也
;; Author: 南優也 <yuyaminami@minamiyuunari-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-request)
(require 'slack-message)
(defvar slack-current-room-id)
(defvar slack-current-team-id)
(defvar slack-buffer-function)
(defconst slack-room-pins-list-url "https://slack.com/api/pins.list")
(defclass slack-room ()
((name :initarg :name :type string)
(id :initarg :id)
(created :initarg :created)
(has-pins :initarg :has_pins)
(last-read :initarg :last_read :type string :initform "0")
(latest :initarg :latest)
(oldest :initarg :oldest)
(unread-count :initarg :unread_count)
(unread-count-display :initarg :unread_count_display :initform 0 :type integer)
(messages :initarg :messages :initform ())
(team-id :initarg :team-id)))
(defgeneric slack-room-name (room))
(defgeneric slack-room-history (room team &optional oldest after-success sync))
(defgeneric slack-room-update-mark-url (room))
(defun slack-room-create (payload team class)
(cl-labels
((prepare (p)
(plist-put p :members
(append (plist-get p :members) nil))
(plist-put p :latest
(slack-message-create (plist-get p :latest)))
(plist-put p :team-id (oref team id))
p))
(let ((attributes (slack-collect-slots class (prepare payload))))
(apply #'make-instance class attributes))))
(defmethod slack-room-subscribedp ((_room slack-room) _team)
nil)
(defmethod slack-room-buffer-name ((room slack-room))
(concat "*Slack*"
" : "
(slack-room-name-with-team-name room)))
(cl-defmacro slack-room-request-update (room team url latest after-success sync)
`(cl-labels
((on-request-update
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-room-request-update")
(let* ((datum (plist-get data :messages))
(messages
(cl-loop for data across datum
collect (slack-message-create data :room ,room))))
(if ,latest
(slack-room-set-prev-messages ,room messages)
(slack-room-set-messages ,room messages)
(slack-room-update-last-read
room
(make-instance 'slack-message :ts "0")))
(if (and ,after-success
(functionp ,after-success))
(funcall ,after-success))))))
(slack-request
,url
,team
:params (list (cons "channel" (oref ,room id))
(if ,latest
(cons "latest" ,latest)))
:success #'on-request-update
:sync (if ,sync t nil))))
(cl-defun slack-room-make-buffer-with-room (room team &key update)
(with-slots (messages latest) room
(if (or update (< (length messages) 1))
(slack-room-history room team))
(funcall slack-buffer-function
(slack-buffer-create room team))))
(cl-defmacro slack-select-from-list ((alist prompt) &body body)
"Bind candidates from selected."
(let ((key (cl-gensym)))
`(let* ((,key (let ((completion-ignore-case t))
(completing-read (format "%s" ,prompt)
,alist nil t)))
(selected (cdr (cl-assoc ,key ,alist :test #'string=))))
,@body
selected)))
(defun slack-room-select (rooms)
(let* ((alist (slack-room-names
rooms
#'(lambda (rs)
(cl-remove-if #'(lambda (r)
(or (not (slack-room-member-p r))
(slack-room-archived-p r)
(not (slack-room-open-p r))))
rs)))))
(slack-select-from-list
(alist "Select Channel: ")
(slack-room-make-buffer-with-room
selected
(slack-team-find (oref selected team-id))
:update nil))))
(cl-defun slack-room-list-update (url success team &key (sync t))
(slack-request
url
team
:success success
:sync sync))
(defun slack-room-update-messages ()
(interactive)
(unless (and (boundp 'slack-current-room-id)
(boundp 'slack-current-team-id))
(error "Call From Slack Room Buffer"))
(let* ((team (slack-team-find slack-current-team-id))
(room (slack-room-find slack-current-room-id team))
(cur-point (point)))
(slack-room-history room team)
(slack-buffer-create
room team :insert-func
#'(lambda (room team)
(slack-buffer-widen
(let ((inhibit-read-only t))
(delete-region (point-min) (marker-position lui-output-marker))))
(slack-buffer-insert-previous-link room)
(slack-buffer-insert-messages room team)
(goto-char cur-point)))))
(defmethod slack-room-render-prev-messages ((room slack-room) team
oldest ts)
(slack-buffer-create
room team
:insert-func
#'(lambda (room team)
(slack-buffer-widen
(let ((inhibit-read-only t)
(loading-message-end
(slack-buffer-ts-eq (point-min) (point-max) oldest)))
(delete-region (point-min) loading-message-end)
(slack-buffer-insert-prev-messages room team oldest)))
(slack-buffer-goto ts))))
(defmethod slack-room-prev-link-info ((room slack-room))
(with-slots (oldest) room
(if oldest
(oref oldest ts))))
(defun slack-room-load-prev-messages ()
(interactive)
(let* ((cur-point (point))
(ts (get-text-property (next-single-property-change cur-point 'ts)
'ts))
(oldest (ignore-errors (get-text-property 0 'oldest
(thing-at-point 'line))))
(current-team (slack-team-find slack-current-team-id))
(current-room (slack-room-find slack-current-room-id
current-team)))
(slack-room-history current-room
current-team
oldest
#'(lambda ()
(slack-room-render-prev-messages current-room
current-team
oldest ts)))))
(defun slack-room-find-message (room ts)
(cl-find-if #'(lambda (m) (string= ts (oref m ts)))
(oref room messages)
:from-end t))
(defmethod slack-room-name-with-team-name ((room slack-room))
(with-slots (team-id name) room
(let ((team (slack-team-find team-id)))
(format "%s - %s" (oref team name) name))))
(defmacro slack-room-names (rooms &optional filter)
`(cl-labels
((latest-ts (room)
(with-slots (latest) room
(if latest (oref latest ts) "0")))
(unread-count (room)
(with-slots (unread-count-display) room
(if (< 0 unread-count-display)
(concat "("
(number-to-string unread-count-display)
")")
"")))
(sort-rooms (rooms)
(nreverse
(cl-sort rooms #'string<
:key #'(lambda (name-with-room) (latest-ts (cdr name-with-room))))))
(build-label (room)
(concat (im-presence room)
(format "%s %s"
(slack-room-name-with-team-name room)
(unread-count room))))
(im-presence (room)
(if (object-of-class-p room 'slack-im)
(slack-im-user-presence room)
" "))
(build-cons (room)
(cons (build-label room) room)))
(sort-rooms
(cl-loop for room in (if ,filter
(funcall ,filter ,rooms)
,rooms)
collect (cons (build-label room) room)))))
(defmethod slack-room-name ((room slack-room))
(oref room name))
(defmethod slack-room-update-last-read ((room slack-room) msg)
(with-slots (ts) msg
(oset room last-read ts)))
(defmethod slack-room-latest-messages ((room slack-room) messages)
(with-slots (last-read) room
(cl-remove-if #'(lambda (m)
(or (string< (oref m ts) last-read)
(string= (oref m ts) last-read)))
messages)))
(defun slack-room-sort-messages (messages)
(cl-sort messages
#'string<
:key #'(lambda (m) (oref m ts))))
(defmethod slack-room-sorted-messages ((room slack-room))
(with-slots (messages) room
(slack-room-sort-messages (copy-sequence messages))))
(defmethod slack-room-set-prev-messages ((room slack-room) prev-messages)
(slack-room-set-messages
room
(cl-delete-duplicates (append (oref room messages)
prev-messages)
:test #'slack-message-equal)))
(defmethod slack-room-set-messages ((room slack-room) m)
(let ((sorted (slack-room-sort-messages m)))
(oset room oldest (car sorted))
(oset room messages sorted)
(oset room latest (car (last sorted)))))
(defmethod slack-room-prev-messages ((room slack-room) from)
(with-slots (messages) room
(cl-remove-if #'(lambda (m)
(or (string< from (oref m ts))
(string= from (oref m ts))))
(slack-room-sort-messages (copy-sequence messages)))))
(defmethod slack-room-update-mark ((room slack-room) team msg)
(cl-labels ((on-update-mark (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-room-update-mark"))))
(with-slots (ts) msg
(with-slots (id) room
(slack-request
(slack-room-update-mark-url room)
team
:type "POST"
:params (list (cons "channel" id)
(cons "ts" ts))
:success #'on-update-mark
:sync nil)))))
(defun slack-room-pins-list ()
(interactive)
(unless (and (bound-and-true-p slack-current-room-id)
(bound-and-true-p slack-current-team-id))
(error "Call from slack room buffer"))
(let* ((team (slack-team-find slack-current-team-id))
(room (slack-room-find slack-current-room-id
team))
(channel (oref room id)))
(cl-labels ((on-pins-list (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-room-pins-list")
(slack-room-on-pins-list
(plist-get data :items)
room team))))
(slack-request
slack-room-pins-list-url
team
:params (list (cons "channel" channel))
:success #'on-pins-list
:sync nil))))
(defun slack-room-on-pins-list (items room team)
(cl-labels ((buffer-name (room)
(concat "*Slack - Pinned Items*"
" : "
(slack-room-name-with-team-name room))))
(let* ((messages (mapcar #'slack-message-create
(mapcar #'(lambda (i)
(plist-get i :message))
items)))
(buf-header (propertize "Pinned Items"
'face '(:underline
t
:weight bold))))
(funcall slack-buffer-function
(slack-buffer-create-info
(buffer-name room)
#'(lambda ()
(insert buf-header)
(insert "\n\n")
(mapc #'(lambda (m) (insert
(slack-message-to-string m)))
messages)))
team))))
(defun slack-select-rooms ()
(interactive)
(let ((team (slack-team-select)))
(slack-room-select
(cl-loop for team in (list team)
append (with-slots (groups ims channels) team
(append ims groups channels))))))
(defun slack-create-room (url team success)
(slack-request
url
team
:type "POST"
:params (list (cons "name" (read-from-minibuffer "Name: ")))
:success success
:sync nil))
(defun slack-room-rename (url room-alist-func)
(cl-labels
((on-rename-success (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-room-rename"))))
(let* ((team (slack-team-select))
(room-alist (funcall room-alist-func team))
(room (slack-select-from-list
(room-alist "Select Channel: ")))
(name (read-from-minibuffer "New Name: ")))
(slack-request
url
team
:params (list (cons "channel" (oref room id))
(cons "name" name))
:success #'on-rename-success
:sync nil))))
(defmacro slack-current-room-or-select (room-alist-func)
`(if (and (boundp 'slack-current-room-id)
(boundp 'slack-current-team-id))
(slack-room-find slack-current-room-id
(slack-team-find slack-current-team-id))
(let* ((room-alist (funcall ,room-alist-func)))
(slack-select-from-list
(room-alist "Select Channel: ")))))
(defmacro slack-room-invite (url room-alist-func)
`(cl-labels
((on-group-invite (&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-room-invite")
(if (plist-get data :already_in_group)
(message "User already in group")
(message "Invited!")))))
(let* ((team (slack-team-select))
(room (slack-current-room-or-select
#'(lambda ()
(funcall ,room-alist-func team
#'(lambda (rooms)
(cl-remove-if #'slack-room-archived-p
rooms))))))
(user-id (plist-get (slack-select-from-list
((slack-user-names team)
"Select User: ")) :id)))
(slack-request
,url
team
:params (list (cons "channel" (oref room id))
(cons "user" user-id))
:success #'on-group-invite
:sync nil))))
(defmethod slack-room-member-p ((_room slack-room))
t)
(defmethod slack-room-archived-p ((_room slack-room))
nil)
(defmethod slack-room-open-p ((_room slack-room))
t)
(defmethod slack-room-equal-p ((room slack-room) other)
(with-slots (id) room
(with-slots ((other-id id)) other
(string= id other-id))))
(defun slack-room-deleted (id team)
(let ((room (slack-room-find id team)))
(cond
((object-of-class-p room 'slack-channel)
(with-slots (channels) team
(setq channels (cl-delete-if #'(lambda (c) (slack-room-equal-p room c))
channels)))
(message "Channel: %s deleted"
(slack-room-name-with-team-name room))))))
(cl-defun slack-room-request-with-id (url id team success)
(slack-request
url
team
:params (list (cons "channel" id))
:success success
:sync nil))
(defmethod slack-room-history ((room slack-room) team
&optional
oldest
after-success
async)
(slack-room-request-update room
team
(slack-room-history-url room)
oldest
after-success
(if async nil t)))
(defmethod slack-room-inc-unread-count ((room slack-room))
(cl-incf (oref room unread-count-display)))
(defun slack-room-find-by-name (name team)
(cl-labels
((find-by-name (rooms name)
(cl-find-if #'(lambda (e) (string= name
(slack-room-name e)))
rooms)))
(or (find-by-name (oref team groups) name)
(find-by-name (oref team channels) name)
(find-by-name (oref team ims) name))))
(provide 'slack-room)
;;; slack-room.el ends here

459
elpa/slack-20160928.2036/slack-search.el Normal file
View File

@ -0,0 +1,459 @@
;;; slack-search.el --- -*- lexical-binding: t; -*-
;; Copyright (C) 2016 南優也
;; Author: 南優也 <yuyaminami@minamiyuunari-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-room)
(defclass slack-search-result (slack-room)
((type :initarg :type :type symbol)
(query :initarg :query :type string)
(per-page :initarg :per-page :type integer)
(total-page :initarg :total-page :type integer)
(current-page :initarg :current-page :type integer)
(total-messages :initarg :total-messages :type integer)
(sort :initarg :sort :type string)
(sort-dir :initarg :sort-dir :type string)
(last-channel-id :initarg :last-channel-id :type string :initform "")))
(defclass slack-file-search-result (slack-search-result) ())
(defclass slack-search-message ()
((user-id :initarg :user-id :type string)
(username :initarg :username :type string)
(ts :initarg :ts :type string)
(text :initarg :text :type string)
(previous-2 :initarg :previous-2)
(previous :initarg :previous)
(next :initarg :next)
(next-2 :initarg :next-2)
(info :initarg :info)))
(defclass slack-search-message-info ()
((channel-id :initarg :channel-id :type string)
(channel-name :initarg :channel-name :type string)
(permalink :initarg :permalink :type string :initform "")
(result-id :initarg :result-id :type string)))
(defun slack-search-result-id (type query sort sort-dir)
(format "Q%s%s%s%s" type query sort sort-dir))
(defun slack-search-create-message-info (payload)
(let ((channel (plist-get payload :channel)))
(make-instance 'slack-search-message-info
:channel-id (plist-get channel :id)
:channel-name (plist-get channel :name)
:permalink (plist-get payload :permalink))))
(defmethod slack-search-create-message ((room slack-search-result) payload)
(cl-labels ((create-message
(params info)
(let ((previous-2 (if (plist-get params :previous_2)
(create-message (plist-get params :previous_2)
info)))
(previous (if (plist-get params :previous)
(create-message (plist-get params :previous)
info)))
(next (if (plist-get params :next)
(create-message (plist-get params :next)
info)))
(next-2 (if (plist-get params :next_2)
(create-message (plist-get params :next_2)
info))))
(make-instance 'slack-search-message
:info info
:user-id (plist-get params :user)
:username (plist-get params :username)
:text (plist-get params :text)
:ts (plist-get params :ts)
:previous-2 previous-2
:previous previous
:next next
:next-2 next-2)))
(create-info
(params result)
(let ((channel (plist-get params :channel)))
(make-instance 'slack-search-message-info
:result-id (oref result id)
:channel-id (plist-get channel :id)
:channel-name (plist-get channel :name)
:permalink (plist-get params :permalink)))))
(let ((info (create-info payload room)))
(create-message payload info))))
(defmethod slack-search-create-message ((_room slack-file-search-result) payload)
(slack-file-create payload))
(defun slack-create-search-result (plist team type)
(let* ((result (cl-case type
('message (apply #'make-instance 'slack-search-result
(slack-collect-slots 'slack-search-result
plist)))
('file (apply #'make-instance 'slack-file-search-result
(slack-collect-slots 'slack-file-search-result
plist)))))
(result-messages (cl-loop
for message in (plist-get plist :messages)
collect (slack-search-create-message result message))))
(slack-room-set-messages result result-messages)
(with-slots (search-results) team
(setq search-results
(cl-remove-if #'(lambda (other)
(slack-room-equal-p result other))
search-results))
(push result search-results))
result))
(defun slack-search-create-result-params (data team type sort sort-dir)
(let* ((messages (cl-case type
('message (plist-get data :messages))
('file (plist-get data :files))))
(paging (plist-get messages :paging))
(query (plist-get data :query))
(plist (list :type type
:team-id (oref team id)
:id (slack-search-result-id
type query sort sort-dir)
:sort sort
:sort-dir sort-dir
:query query
:per-page (plist-get paging :count)
:total-page (plist-get paging :pages)
:current-page (plist-get paging :page)
:total-messages (plist-get paging :total)
:messages
(append (plist-get messages :matches)
nil))))
plist))
(defun slack-search-query-params ()
(let ((team (slack-team-select))
(query (read-from-minibuffer "Query: "))
(sort (completing-read "Sort: " `("score" "timestamp")
nil t))
(sort-dir (completing-read "Direction: " `("desc" "asc")
nil t)))
(list team query sort sort-dir)))
(defun slack-search-pushnew (search-result team)
(cl-pushnew search-result (oref team search-results)
:test #'slack-room-equal-p))
(defun slack-search-from-messages ()
(interactive)
(cl-destructuring-bind (team query sort sort-dir) (slack-search-query-params)
(let ((type 'message))
(cl-labels
((on-search
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-search-from-messages")
(let* ((params (slack-search-create-result-params
data team type sort sort-dir))
(search-result (slack-create-search-result params team 'message)))
(slack-search-pushnew search-result team)
(funcall slack-buffer-function
(slack-buffer-create search-result
team :type 'info))))))
(let ((same-search (slack-room-find (slack-search-result-id
type query sort sort-dir)
team)))
(if same-search
(progn
(message "Same Query Already Exist")
(funcall slack-buffer-function
(slack-buffer-create same-search
team
:type 'info)))
(slack-search-request-message team
query
sort
sort-dir
#'on-search)))))
))
(defun slack-search-from-files ()
(interactive)
(cl-destructuring-bind (team query sort sort-dir) (slack-search-query-params)
(let ((type 'file))
(cl-labels
((on-search
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-search-from-files")
(let* ((params (slack-search-create-result-params
data team type sort sort-dir))
(search-result (slack-create-search-result params team 'file)))
(slack-search-pushnew search-result team)
(funcall slack-buffer-function
(slack-buffer-create search-result
team :type 'info))))))
(let ((same-search (slack-room-find (slack-search-result-id type query
sort sort-dir)
team)))
(if same-search
(progn
(message "Same Query Already Exist")
(funcall slack-buffer-function
(slack-buffer-create same-search
team
:type 'info)))
(slack-search-request-file team
query
sort
sort-dir
#'on-search)))))))
(cl-defun slack-search-request-message (team query sort sort-dir success
&optional
(page 1)
(async t))
(slack-search-request team query sort sort-dir success page async
"https://slack.com/api/search.messages"))
(cl-defun slack-search-request-file (team query sort sort-dir success
&optional
(page 1)
(async t))
(slack-search-request team query sort sort-dir success page async
"https://slack.com/api/search.files"))
(defun slack-search-request (team query sort sort-dir success page async url)
(if (< 0 (length query))
(slack-request
url
team
:type "POST"
:params (list (cons "query" query)
(cons "sort" sort)
(cons "sort_dir" sort-dir)
(cons "page" (number-to-string page)))
:success success
:sync (not async))))
(defun slack-search-alist (team)
(with-slots (search-results) team
(cl-loop for s in search-results
collect (cons (slack-room-buffer-name s) s))))
(defun slack-search-select ()
(interactive)
(let* ((team (slack-team-select))
(alist (slack-search-alist team)))
(slack-select-from-list
(alist "Select Search: ")
(funcall slack-buffer-function
(slack-buffer-create selected
team
:type 'info)))))
;; protocols
(defmethod slack-room-update-mark ((_room slack-search-result) _team _msg))
(defmethod slack-room-sorted-messages ((room slack-search-result))
(copy-sequence (oref room messages)))
(defmethod slack-room-update-last-read ((room slack-search-result) msg)
(if (not (slot-exists-p msg 'info))
(progn
(oset room last-read (oref msg ts))
(oset room last-channel-id ""))
(with-slots (ts info) msg
(with-slots (channel-id) info
(oset room last-read ts)
(oset room last-channel-id channel-id)))))
(defmethod slack-search-get-index ((_search-result slack-file-search-result)
messages last-read &optional _last-chanel-id)
(cl-loop for i from 0 upto (1- (length messages))
for m = (nth i messages)
if (string= (oref m ts) last-read)
return i))
(defmethod slack-search-get-index ((_search-result slack-search-result)
messages last-read &optional last-channel-id)
(cl-loop for i from 0 upto (1- (length messages))
for m = (nth i messages)
if (and (string= (oref m ts) last-read)
(string= (oref (oref m info) channel-id)
last-channel-id))
return i))
(defmethod slack-room-latest-messages ((room slack-search-result) messages)
(with-slots (type last-read last-channel-id) room
(let* ((r-messages (reverse messages))
(nth (slack-search-get-index room r-messages
last-read last-channel-id)))
(if nth
(nreverse
(nthcdr (1+ nth) r-messages))
(copy-sequence messages)))))
(defmethod slack-room-prev-messages ((room slack-file-search-result) oldest)
(let* ((messages (reverse (oref room messages)))
(nth (slack-search-get-index room messages oldest)))
(if nth
(nreverse (nthcdr (1+ nth) messages)))))
(defmethod slack-room-prev-messages ((room slack-search-result) param)
(let* ((oldest (car param))
(channel-id (cdr param))
(messages (reverse (oref room messages)))
(nth (slack-search-get-index room messages
oldest channel-id)))
(if nth
(nreverse (nthcdr (1+ nth) messages)))))
(defmethod slack-room-render-prev-messages ((room slack-search-result)
team oldest ts)
(slack-buffer-create
room team
:insert-func
#'(lambda (room team)
(slack-buffer-widen
(let* ((inhibit-read-only t)
(oldest-ts (if (listp oldest) (car oldest) oldest))
(loading-message-end (slack-buffer-ts-eq (point-min)
(point-max)
oldest-ts)))
(delete-region (point-min) loading-message-end)
(slack-buffer-insert-prev-messages room team oldest)))
(slack-buffer-goto ts))
:type 'info))
(defmethod slack-buffer-insert-prev-messages ((room slack-search-result) team oldest)
(slack-buffer-widen
(let ((messages (slack-room-prev-messages room oldest)))
(if messages
(progn
(slack-buffer-insert-previous-link room)
(cl-loop for m in messages
do (slack-buffer-insert m team t)))
(set-marker lui-output-marker (point-min))
(lui-insert "(no more messages)\n"))
(slack-buffer-recover-lui-output-marker))))
(defmethod slack-room-prev-link-info ((room slack-file-search-result))
(with-slots (oldest) room
(oref oldest ts)))
(defmethod slack-room-prev-link-info ((room slack-search-result))
(with-slots (oldest) room
(with-slots (info ts) oldest
(cons ts (oref info channel-id)))))
(defmethod slack-message-equal ((m slack-search-message) n)
(with-slots ((m-info info) (m-ts ts)) m
(with-slots ((m-channel-id channel-id)) m-info
(with-slots ((n-info info) (n-ts ts)) n
(with-slots ((n-channel-id channel-id)) n-info
(and (string= m-channel-id n-channel-id)
(string= m-ts n-ts)))))))
(defmethod slack-room-buffer-name ((room slack-search-result))
(with-slots (query sort sort-dir team-id type) room
(let ((team (slack-team-find team-id)))
(format "%s - %s Query: %s Sort: %s Order: %s"
(oref team name)
(eieio-object-class room)
query sort sort-dir))))
(defmethod slack-message-to-string ((message slack-search-message) team)
(with-slots (info text username) message
(with-slots (channel-id permalink) info
(let* ((header (format "%s" username))
(channel (slack-room-find channel-id team))
(body (slack-message-unescape-string
(format "%s\n\n------------\nChanel: %s\nPermalink: %s"
text
(slack-room-name channel)
permalink)
team)))
(slack-message-put-header-property header)
(slack-message-put-text-property body)
(format "%s\n%s\n" header body)))))
(defmethod slack-room-set-prev-messages ((room slack-search-result) prev)
(slack-room-set-messages room (nreverse
(nconc (nreverse prev) (oref room messages)))))
(defmethod slack-room-set-messages ((room slack-search-result) messages)
(let ((msgs (nreverse messages)))
(oset room messages msgs)
(oset room latest (car (last msgs)))
(oset room oldest (car msgs))))
(defmethod slack-room-history ((room slack-search-result) team
&optional
oldest after-success async)
(cl-labels
((on-history
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-room-history")
(let* ((matches (cl-case (eieio-object-class room)
('slack-search-result (plist-get data :messages))
('slack-file-search-result (plist-get data :files))))
(messages (cl-loop
for match across (plist-get matches :matches)
collect (slack-search-create-message room match))))
(oset room current-page
(plist-get (plist-get matches :paging) :page))
(if oldest
(slack-room-set-prev-messages room messages)
(let ((init-msg (make-instance 'slack-search-message
:ts "0" :info
(make-instance 'slack-search-message-info
:channel-id ""))))
(slack-room-update-last-read room init-msg))
(slack-room-set-messages room messages))
(if after-success
(funcall after-success))))))
(let* ((current-page (oref room current-page))
(total-page (oref room total-page))
(next-page (if oldest
(1+ current-page)
1)))
(with-slots (query sort sort-dir) room
(cl-case (eieio-object-class room)
('slack-search-result
(slack-search-request-message team
query
sort
sort-dir
#'on-history
next-page
async))
('slack-file-search-result
(slack-search-request-file team
query
sort
sort-dir
#'on-history
next-page
async)))))))
(provide 'slack-search)
;;; slack-search.el ends here

202
elpa/slack-20160928.2036/slack-team.el Normal file
View File

@ -0,0 +1,202 @@
;;; slack-team.el --- team class -*- lexical-binding: t; -*-
;; Copyright (C) 2016 南優也
;; Author: 南優也 <yuyaminami@minamiyuunari-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-util)
(defvar slack-teams nil)
(defvar slack-current-team nil)
(defcustom slack-prefer-current-team nil
"If set to t, using `slack-current-team' for interactive function.
use `slack-change-current-team' to change `slack-current-team'"
:group 'slack)
(defclass slack-team ()
((id :initarg :id)
(token :initarg :token :initform nil)
(client-id :initarg :client-id)
(client-secret :initarg :client-secret)
(name :initarg :name :initform nil)
(domain :initarg :domain)
(self :initarg :self)
(self-id :initarg :self-id)
(self-name :initarg :self-name)
(channels :initarg :channels)
(groups :initarg :groups)
(ims :initarg :ims)
(file-room :initform nil)
(search-results :initform nil)
(users :initarg :users)
(bots :initarg :bots)
(ws-url :initarg :ws-url)
(ws-conn :initarg :ws-conn :initform nil)
(ping-timer :initform nil)
(check-ping-timeout-timer :initform nil)
(check-ping-timeout-sec :initarg :check-ping-timeout-sec
:initform 20)
(reconnect-auto :initarg :reconnect-auto :initform t)
(reconnect-timer :initform nil)
(reconnect-after-sec :initform 10)
(reconnect-count :initform 0)
(reconnect-count-max :initform 360)
(last-pong :initform nil)
(waiting-send :initform nil)
(sent-message :initform (make-hash-table))
(message-id :initform 0)
(connected :initform nil)
(subscribed-channels :initarg :subscribed-channels
:type list :initform nil)
(typing :initform nil)
(typing-timer :initform nil)
(reminders :initform nil :type list)
(ping-check-timers :initform (slack-ws-init-ping-check-timers))))
(defun slack-team-find (id)
(cl-find-if #'(lambda (team) (string= id (oref team id)))
slack-teams))
(defmethod slack-team-disconnect ((team slack-team))
(slack-ws-close team))
(defmethod slack-team-equalp ((team slack-team) other)
(with-slots (client-id) team
(string= client-id (oref other client-id))))
(defmethod slack-team-name ((team slack-team))
(oref team name))
;;;###autoload
(defun slack-register-team (&rest plist)
"PLIST must contain :name :client-id :client-secret with value.
setting :token will reduce your configuration step.
you will notified when receive message with channel included in subscribed-chennels.
if :default is t and `slack-prefer-current-team' is t, skip selecting team when channels listed.
you can change current-team with `slack-change-current-team'"
(interactive
(let ((name (read-from-minibuffer "Team Name: "))
(client-id (read-from-minibuffer "Client Id: "))
(client-secret (read-from-minibuffer "Cliend Secret: "))
(token (read-from-minibuffer "Token: ")))
(list :name name :client-id client-id :client-secret client-secret
:token token)))
(cl-labels ((same-client-id
(client-id)
(cl-find-if #'(lambda (team)
(string= client-id (oref team client-id)))
slack-teams))
(missing (plist)
(cl-remove-if
#'null
(mapcar #'(lambda (key)
(unless (plist-member plist key)
key))
'(:name :client-id :client-secret)))))
(let ((missing (missing plist)))
(if missing
(error "Missing Keyword: %s" missing)))
(let ((team (apply #'slack-team "team"
(slack-collect-slots 'slack-team plist))))
(let ((same-team (cl-find-if
#'(lambda (o) (slack-team-equalp team o))
slack-teams)))
(if same-team
(progn
(slack-team-disconnect same-team)
(slack-start team))))
(setq slack-teams
(cons team
(cl-remove-if #'(lambda (other)
(slack-team-equalp team other))
slack-teams)))
(if (plist-get plist :default)
(setq slack-current-team team)))))
(defun slack-team-find-by-name (name)
(if name
(cl-find-if #'(lambda (team) (string= name (oref team name)))
slack-teams)))
(cl-defun slack-team-select (&optional no-default)
(cl-labels ((select-team ()
(slack-team-find-by-name
(completing-read
"Select Team: "
(mapcar #'(lambda (team) (oref team name))
(slack-team-connected-list))))))
(let ((team (if (and slack-prefer-current-team
slack-current-team
(not no-default))
slack-current-team
(select-team))))
;; (if (and slack-prefer-current-team
;; (not slack-current-team)
;; (not no-default))
;; (if (yes-or-no-p (format "Set %s to current-team?"
;; (oref team name)))
;; (setq slack-current-team team)))
team)))
(defmethod slack-team-connectedp ((team slack-team))
(oref team connected))
(defun slack-team-connected-list ()
(cl-remove-if #'null
(mapcar #'(lambda (team)
(if (slack-team-connectedp team) team))
slack-teams)))
(defun slack-change-current-team ()
(interactive)
(let ((team (slack-team-find-by-name
(completing-read
"Select Team: "
(mapcar #'(lambda (team) (oref team name))
slack-teams)))))
(setq slack-current-team team)
(message "Set slack-current-team to %s" (or (and team (oref team name))
"nil"))
(if team
(slack-team-connect team))))
(defmethod slack-team-connect ((team slack-team))
(unless (slack-team-connectedp team)
(slack-start team)))
(defun slack-team-delete ()
(interactive)
(let ((selected (slack-team-select t)))
(if (yes-or-no-p (format "Delete %s from `slack-teams'?"
(oref selected name)))
(progn
(setq slack-teams
(cl-remove-if #'(lambda (team)
(slack-team-equalp selected team))
slack-teams))
(slack-team-disconnect selected)
(message "Delete %s from `slack-teams'" (oref selected name))))))
(provide 'slack-team)
;;; slack-team.el ends here

36
elpa/slack-20160928.2036/slack-user-message.el Normal file
View File

@ -0,0 +1,36 @@
;;; package --- Summary
;;; Commentary:
;;; Code:
(require 'eieio)
(require 'slack-message-formatter)
(require 'slack-message-reaction)
(require 'slack-message-editor)
(defvar slack-user-message-keymap
(let ((keymap (make-sparse-keymap)))
keymap))
(defmethod slack-message-sender-equalp ((m slack-user-message) sender-id)
(string= (oref m user) sender-id))
(defmethod slack-message-header ((m slack-user-message) team)
(with-slots (ts edited-at deleted-at) m
(let* ((name (slack-message-sender-name m team))
(time (slack-message-time-to-string ts))
(edited-at (slack-message-time-to-string edited-at))
(deleted-at (slack-message-time-to-string deleted-at))
(header (format "%s" name)))
(if deleted-at
(format "%s deleted_at: %s" header deleted-at)
(if edited-at
(format "%s edited_at: %s" header edited-at)
header)))))
(defmethod slack-message-propertize ((m slack-user-message) text)
(put-text-property 0 (length text) 'keymap slack-user-message-keymap text)
text)
(provide 'slack-user-message)
;;; slack-user-message.el ends here

63
elpa/slack-20160928.2036/slack-user.el Normal file
View File

@ -0,0 +1,63 @@
;;; slack-user.el ---slack user interface -*- lexical-binding: t; -*-
;; Copyright (C) 2015 南優也
;; Author: 南優也 <yuyaminami@minamiyuunari-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'slack-request)
(require 'slack-room)
(defun slack-user-find (id team)
(with-slots (users) team
(cl-find-if (lambda (user)
(string= id (plist-get user :id)))
users)))
(defun slack-user-find-by-name (name team)
(with-slots (users) team
(cl-find-if (lambda (user)
(string= name (plist-get user :name)))
users)))
(defun slack-user-get-id (name team)
(let ((user (slack-user-find-by-name name team)))
(if user
(plist-get user :id))))
(defun slack-user-name (id team)
(let ((user (slack-user-find id team)))
(if user
(plist-get user :name))))
(defun slack-user-names (team)
(with-slots (users) team
(mapcar (lambda (u) (cons (plist-get u :name) u))
users)))
(defun slack-user-presence-to-string (user)
(if (string= (plist-get user :presence) "active")
"* "
" "))
(provide 'slack-user)
;;; slack-user.el ends here

88
elpa/slack-20160928.2036/slack-util.el Normal file
View File

@ -0,0 +1,88 @@
;;; slack-util.el ---utility functions -*- lexical-binding: t; -*-
;; Copyright (C) 2015 yuya.minami
;; Author: yuya.minami <yuya.minami@yuyaminami-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(defun slack-seq-to-list (seq)
(if (listp seq) seq (append seq nil)))
(defun slack-decode (seq)
(cl-loop for e in (slack-seq-to-list seq)
collect (if (stringp e)
(decode-coding-string e 'utf-8)
e)))
(defun slack-class-have-slot-p (class slot)
(and (symbolp slot)
(let* ((stripped (substring (symbol-name slot) 1))
(replaced (replace-regexp-in-string "_" "-"
stripped))
(symbolized (intern replaced)))
(slot-exists-p class symbolized))))
(defun slack-collect-slots (class seq)
(let ((plist (slack-seq-to-list seq)))
(cl-loop for p in plist
if (and (slack-class-have-slot-p class p)
(plist-member plist p))
nconc (let ((value (plist-get plist p)))
(list p (if (stringp value)
(decode-coding-string value 'utf-8)
(if (eq :json-false value)
nil
value)))))))
(defun company-slack-backend (command &optional arg &rest ignored)
"Completion backend for slack chats. It currently understands
@USER; adding #CHANNEL should be a simple matter of programming."
(interactive (list 'interactive))
(cl-labels
((prefix-type (str) (cond
((string-prefix-p "@" str) 'user)
((string-prefix-p "#" str) 'channel)))
(content (str) (substring str 1 nil)))
(cl-case command
(interactive (company-begin-backend 'company-slack-backend))
(prefix (when (cl-find major-mode '(slack-mode
slack-edit-message-mode))
(company-grab-line "\\(\\W\\|^\\)\\(@\\w*\\|#\\w*\\)"
2)))
(candidates (let ((content (content arg)))
(cl-case (prefix-type arg)
(user
(cl-loop for user in (oref slack-current-team users)
if (string-prefix-p content
(plist-get user :name))
collect (concat "@" (plist-get user :name))))
(channel
(cl-loop for team in (oref slack-current-team channels)
if (string-prefix-p content
(oref team name))
collect (concat "#" (oref team name)))))))
)))
(provide 'slack-util)
;;; slack-util.el ends here

510
elpa/slack-20160928.2036/slack-websocket.el Normal file
View File

@ -0,0 +1,510 @@
;;; slack-websocket.el --- slack websocket interface -*- lexical-binding: t; -*-
;; Copyright (C) 2015 南優也
;; Author: 南優也 <yuyaminami@minamiyuunari-no-MacBook-Pro.local>
;; Keywords:
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'websocket)
(require 'slack-request)
(require 'slack-message)
(require 'slack-reply)
(defclass slack-typing ()
((room :initarg :room :initform nil)
(limit :initarg :limit :initform nil)
(users :initarg :users :initform nil)))
(defclass slack-typing-user ()
((limit :initarg :limit :initform nil)
(user-name :initarg :user-name :initform nil)))
(defun slack-ws-open (team)
(with-slots (ws-url ws-conn reconnect-count) team
(unless ws-conn
(setq ws-conn
(websocket-open
ws-url
:on-message
#'(lambda (websocket frame)
(slack-ws-on-message websocket frame team))))
(setq reconnect-count 0))))
(defun slack-ws-close (&optional team)
(interactive)
(unless team
(setq team slack-teams))
(cl-labels
((close (team)
(let ((team-name (oref team name)))
(with-slots (connected ws-conn last-pong) team
(if ws-conn
(progn
(websocket-close ws-conn)
(setq ws-conn nil)
(setq connected nil)
(slack-ws-cancel-ping-timer team)
(slack-ws-cancel-ping-check-timers team)
(message "Slack Websocket Closed - %s" team-name))
(message "Slack Websocket is not open - %s" team-name))))))
(if (listp team)
(mapc #'close team)
(close team))))
(defun slack-ws-send (payload team)
(with-slots (waiting-send ws-conn) team
(push payload waiting-send)
(condition-case _e
(progn
(websocket-send-text ws-conn payload)
(setq waiting-send
(cl-remove-if #'(lambda (p) (string= payload p))
waiting-send)))
(websocket-closed (slack-ws-reconnect team))
(websocket-illegal-frame (message "Sent illegal frame.")
(slack-ws-close team))
(error (slack-ws-reconnect team)))))
(defun slack-ws-resend (team)
(with-slots (waiting-send) team
(let ((candidate waiting-send))
(setq waiting-send nil)
(cl-loop for msg in candidate
do (sleep-for 1) (slack-ws-send msg team)))))
(defun slack-ws-on-message (_websocket frame team)
;; (message "%s" (slack-request-parse-payload
;; (websocket-frame-payload frame)))
(when (websocket-frame-completep frame)
(let* ((payload (slack-request-parse-payload
(websocket-frame-payload frame)))
(decoded-payload (slack-decode payload))
(type (plist-get decoded-payload :type)))
;; (message "%s" decoded-payload)
(condition-case err
(cond
((string= type "pong")
(slack-ws-handle-pong decoded-payload team))
((string= type "hello")
(slack-ws-cancel-reconnect-timer team)
(slack-cancel-notify-adandon-reconnect)
(slack-ws-set-ping-timer team)
(slack-ws-resend team)
(message "Slack Websocket Is Ready! - %s"
(oref team name)))
((plist-get decoded-payload :reply_to)
(slack-ws-handle-reply decoded-payload team))
((string= type "message")
(slack-ws-handle-message decoded-payload team))
((string= type "reaction_added")
(slack-ws-handle-reaction-added decoded-payload team))
((string= type "reaction_removed")
(slack-ws-handle-reaction-removed decoded-payload team))
((string= type "channel_created")
(slack-ws-handle-channel-created decoded-payload team))
((or (string= type "channel_archive")
(string= type "group_archive"))
(slack-ws-handle-room-archive decoded-payload team))
((or (string= type "channel_unarchive")
(string= type "group_unarchive"))
(slack-ws-handle-room-unarchive decoded-payload team))
((string= type "channel_deleted")
(slack-ws-handle-channel-deleted decoded-payload team))
((or (string= type "channel_rename")
(string= type "group_rename"))
(slack-ws-handle-room-rename decoded-payload team))
((or (string= type "channel_joined")
(string= type "group_joined"))
(slack-ws-handle-room-joined decoded-payload team))
((string= type "presence_change")
(slack-ws-handle-presence-change decoded-payload team))
((or (string= type "bot_added")
(string= type "bot_changed"))
(slack-ws-handle-bot decoded-payload team))
((or (string= type "file_deleted")
(string= type "file_unshared"))
(slack-ws-handle-file-deleted decoded-payload team))
((or (string= type "im_marked")
(string= type "channel_marked")
(string= type "group_marked"))
(slack-ws-handle-room-marked decoded-payload team))
((string= type "im_open")
(slack-ws-handle-im-open decoded-payload team))
((string= type "im_close")
(slack-ws-handle-im-close decoded-payload team))
((string= type "team_join")
(slack-ws-handle-team-join decoded-payload team))
((string= type "user_typing")
(slack-ws-handle-user-typing decoded-payload team)))
(error (progn
(warn "%s payload: %s" err decoded-payload)
(signal (car err) (cdr err))))))))
(defun slack-user-typing (team)
(with-slots (typing typing-timer) team
(with-slots (limit users room) typing
(let ((current (float-time)))
(if (and typing-timer (timerp typing-timer)
(< limit current))
(progn
(cancel-timer typing-timer)
(setq typing-timer nil)
(setq typing nil))
(if (slack-buffer-show-typing-p
(get-buffer (slack-room-buffer-name room)))
(let ((team-name (slack-team-name team))
(room-name (slack-room-name room))
(visible-users (cl-remove-if
#'(lambda (u) (< (oref u limit) current))
users)))
(message "Slack [%s - %s] %s is typing..."
team-name room-name
(mapconcat #'(lambda (u) (oref u user-name))
visible-users
", ")))))))))
(defun slack-ws-handle-user-typing (payload team)
(let* ((user (slack-user-name (plist-get payload :user) team))
(room (slack-room-find (plist-get payload :channel) team)))
(if (slack-buffer-show-typing-p
(get-buffer (slack-room-buffer-name room)))
(let ((limit (+ 3 (float-time))))
(with-slots (typing typing-timer) team
(if (and typing (equal room (oref typing room)))
(with-slots ((typing-limit limit)
(typing-room room) users) typing
(setq typing-limit limit)
(let ((typing-user (make-instance 'slack-typing-user
:limit limit
:user-name user)))
(setq users
(cons typing-user
(cl-remove-if #'(lambda (u)
(string= (oref u user-name)
user))
users))))))
(unless typing
(let ((new-typing (make-instance 'slack-typing
:room room :limit limit))
(typing-user (make-instance 'slack-typing-user
:limit limit :user-name user)))
(oset new-typing users (list typing-user))
(setq typing new-typing))
(setq typing-timer
(run-with-timer t 1 #'slack-user-typing team))))))))
(defun slack-ws-handle-team-join (payload team)
(let ((user (slack-decode (plist-get payload :user))))
(with-slots (users) team
(setq users
(cons user
(cl-remove-if #'(lambda (u)
(string= (plist-get u :id)
(plist-get user :id)))
users))))
(message "User %s Joind Team: %s"
(plist-get (slack-user-find (plist-get user :id)
team)
:name)
(slack-team-name team))))
(defun slack-ws-handle-im-open (payload team)
(cl-labels
((notify
(im)
(slack-room-history
im team nil
#'(lambda ()
(message "Direct Message Channel with %s is Open"
(slack-user-name (oref im user) team)))
t)))
(let ((exist (slack-room-find (plist-get payload :channel) team)))
(if exist
(progn
(oset exist is-open t)
(notify exist))
(with-slots (ims) team
(let ((im (slack-room-create
(list :id (plist-get payload :channel)
:user (plist-get payload :user))
team 'slack-im)))
(setq ims (cons im ims))
(notify im)))))))
(defun slack-ws-handle-im-close (payload team)
(let ((im (slack-room-find (plist-get payload :channel) team)))
(oset im is-open nil)
(message "Direct Message Channel with %s is Closed"
(slack-user-name (oref im user) team))))
(defun slack-ws-handle-message (payload team)
(let ((subtype (plist-get payload :subtype)))
(cond
((and subtype (string= subtype "file_share"))
(slack-ws-handle-file-share payload team)
(slack-ws-update-message payload team))
((and subtype (string= subtype "message_changed"))
(slack-message-edited payload team))
((and subtype (string= subtype "message_deleted"))
(slack-message-deleted payload team))
(t
(slack-ws-update-message payload team)))))
(defun slack-ws-update-message (payload team)
(let ((m (slack-message-create payload)))
(when m
(slack-message-update m team))))
(defun slack-ws-handle-reply (payload team)
(let ((ok (plist-get payload :ok)))
(if (eq ok :json-false)
(let ((err (plist-get payload :error)))
(message "Error code: %s msg: %s"
(plist-get err :code)
(plist-get err :msg)))
(let ((message-id (plist-get payload :reply_to)))
(if (integerp message-id)
(slack-message-handle-reply
(slack-message-create payload)
team))))))
(cl-defmacro slack-ws-handle-reaction ((payload team) &body body)
`(let* ((item (plist-get ,payload :item))
(room (slack-room-find (plist-get item :channel)
,team)))
(if room
(let ((msg (slack-room-find-message room (plist-get item :ts))))
(if msg
(let* ((r-name (plist-get ,payload :reaction))
(r-count 1)
(r-users (list (plist-get ,payload :user)))
(reaction (make-instance 'slack-reaction
:name r-name
:count r-count
:users r-users)))
,@body
(slack-message-update msg ,team t t)))))))
(defun slack-ws-handle-reaction-added (payload team)
(slack-ws-handle-reaction
(payload team)
(slack-message-append-reaction msg reaction)
(slack-reaction-notify payload team)))
(defun slack-ws-handle-reaction-removed (payload team)
(slack-ws-handle-reaction
(payload team)
(slack-message-pop-reaction msg reaction)))
(defun slack-ws-handle-channel-created (payload team)
;; (let ((id (plist-get (plist-get payload :channel) :id)))
;; (slack-channel-create-from-info id team))
)
(defun slack-ws-handle-room-archive (payload team)
(let* ((id (plist-get payload :channel))
(room (slack-room-find id team)))
(oset room is-archived t)
(message "Channel: %s is archived"
(slack-room-name-with-team-name room))))
(defun slack-ws-handle-room-unarchive (payload team)
(let* ((id (plist-get payload :channel))
(room (slack-room-find id team)))
(oset room is-archived nil)
(message "Channel: %s is unarchived"
(slack-room-name-with-team-name room))))
(defun slack-ws-handle-channel-deleted (payload team)
(let ((id (plist-get payload :channel)))
(slack-room-deleted id team)))
(defun slack-ws-handle-room-rename (payload team)
(let* ((c (plist-get payload :channel))
(room (slack-room-find (plist-get c :id) team))
(old-name (slack-room-name room))
(new-name (plist-get c :name)))
(oset room name new-name)
(message "Renamed channel from %s to %s"
old-name
new-name)))
(defun slack-ws-handle-room-joined (payload team)
(cl-labels
((replace-room (room rooms)
(cons room (cl-delete-if
#'(lambda (r)
(slack-room-equal-p room r))
rooms))))
(let* ((c (plist-get payload :channel)))
(if (plist-get c :is_channel)
(let ((channel (slack-room-create c team 'slack-channel)))
(with-slots (channels) team
(setq channels
(replace-room channel channels)))
(message "Joined channel %s"
(slack-room-name-with-team-name channel)))
(let ((group (slack-room-create c team 'slack-group)))
(with-slots (groups) team
(setq groups
(replace-room group groups)))
(message "Joined group %s"
(slack-room-name-with-team-name group)))))))
(defun slack-ws-handle-presence-change (payload team)
(let* ((id (plist-get payload :user))
(user (slack-user-find id team))
(presence (plist-get payload :presence)))
(plist-put user :presence presence)))
(defun slack-ws-handle-bot (payload team)
(let ((bot (plist-get payload :bot)))
(with-slots (bots) team
(push bot bots))))
(defun slack-ws-handle-file-share (payload team)
(let ((file (slack-file-create (plist-get payload :file))))
(slack-file-pushnew file team)))
(defun slack-ws-handle-file-deleted (payload team)
(let ((file-id (plist-get payload :file_id))
(room (slack-file-room-obj team)))
(with-slots (messages last-read) room
(setq messages (cl-remove-if #'(lambda (f)
(string= file-id (oref f id)))
messages)))))
(defun slack-log-time ()
(format-time-string "%Y-%m-%d %H:%M:%S"))
(defun slack-ws-set-ping-timer (team)
(with-slots (ping-timer) team
(unless ping-timer
(setq ping-timer
(run-at-time t 10 #'(lambda () (slack-ws-ping team)))))))
(defun slack-ws-current-time-str ()
(number-to-string (time-to-seconds (current-time))))
(defun slack-ws-ping (team)
(slack-message-inc-id team)
(with-slots (message-id) team
(let* ((time (slack-ws-current-time-str))
(m (list :id message-id
:type "ping"
:time time))
(json (json-encode m)))
(slack-ws-set-check-ping-timer team time)
(slack-ws-send json team))))
(defun slack-ws-set-check-ping-timer (team time)
(with-slots (ping-check-timers check-ping-timeout-sec) team
(let ((team-id (oref team id)))
(puthash time (run-at-time check-ping-timeout-sec nil
#'(lambda () (slack-ws-ping-timeout team-id)))
ping-check-timers))))
(defun slack-ws-ping-timeout (team-id)
(message "Slack Websocket PING Timeout.")
(let ((team (slack-team-find team-id)))
(slack-ws-cancel-ping-check-timers team)
(slack-ws-close team)
(slack-ws-cancel-ping-timer team)
(if (oref team reconnect-auto)
(with-slots (reconnect-timer reconnect-after-sec) team
(setq reconnect-timer
(run-at-time t reconnect-after-sec
#'(lambda () (slack-ws-reconnect team))))))))
(defun slack-ws-init-ping-check-timers ()
(make-hash-table :test 'equal))
(defun slack-ws-cancel-ping-check-timers (team)
(with-slots (ping-check-timers) team
(maphash #'(lambda (key value)
(if (timerp value)
(cancel-timer value)))
ping-check-timers)
(setq ping-check-timers (slack-ws-init-ping-check-timers))))
(defun slack-ws-cancel-ping-timer (team)
(with-slots (ping-timer) team
(if (timerp ping-timer)
(cancel-timer ping-timer))
(setq ping-timer nil)))
(defvar slack-disconnected-timer nil)
(defun slack-notify-abandon-reconnect ()
(unless slack-disconnected-timer
(setq slack-disconnected-timer
(run-with-idle-timer 5 t
#'(lambda ()
(message "Reconnect Count Exceeded. Manually invoke `slack-start'."))))))
(defun slack-cancel-notify-adandon-reconnect ()
(if (and slack-disconnected-timer
(timerp slack-disconnected-timer))
(progn
(cancel-timer slack-disconnected-timer)
(setq slack-disconnected-timer nil))))
(defun slack-ws-reconnect (team &optional force)
(message "Slack Websocket Try To Reconnect")
(with-slots
(reconnect-count (reconnect-max reconnect-count-max)) team
(if (and (not force) reconnect-max (< reconnect-max reconnect-count))
(progn
(slack-notify-abandon-reconnect)
(slack-ws-cancel-reconnect-timer team))
(incf reconnect-count)
(slack-ws-close team)
(slack-authorize
team
(cl-function
(lambda
(&key error-thrown &allow-other-keys)
(message "Slack Reconnect Failed: %s" (cdr error-thrown))))))))
(defun slack-ws-cancel-reconnect-timer (team)
(with-slots (reconnect-timer) team
(if (timerp reconnect-timer)
(cancel-timer reconnect-timer))
(setq reconnect-timer nil)))
(defun slack-ws-handle-pong (payload team)
(let ((key (plist-get payload :time)))
(with-slots (ping-check-timers) team
(let ((timer (gethash key ping-check-timers)))
(when timer
(cancel-timer timer)
(remhash key ping-check-timers))))))
(defun slack-ws-handle-room-marked (payload team)
(let ((room (slack-room-find (plist-get payload :channel)
team))
(new-unread-count-display (plist-get payload :unread_count_display)))
(with-slots (unread-count-display) room
(setq unread-count-display new-unread-count-display))))
(provide 'slack-websocket)
;;; slack-websocket.el ends here

191
elpa/slack-20160928.2036/slack.el Normal file
View File

@ -0,0 +1,191 @@
;;; slack.el --- slack client for emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2015 yuya.minami
;; Author: yuya.minami <yuya.minami@yuyaminami-no-MacBook-Pro.local>
;; Keywords: tools
;; Version: 0.0.2
;; Package-Requires: ((websocket "1.5") (request "0.2.0") (oauth2 "0.10") (circe "2.3") (alert "1.2") (emojify "0.4") (emacs "24.3"))
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'cl-lib)
(require 'oauth2)
(require 'slack-team)
(require 'slack-channel)
(require 'slack-im)
(require 'slack-file)
(require 'slack-message-notification)
(require 'slack-message-sender)
(require 'slack-message-editor)
(require 'slack-message-reaction)
(require 'slack-user-message)
(require 'slack-bot-message)
(require 'slack-search)
(require 'slack-reminder)
(require 'slack-websocket)
(require 'slack-request)
(defgroup slack nil
"Emacs Slack Client"
:prefix "slack-"
:group 'tools)
(defcustom slack-redirect-url "http://localhost:8080"
"Redirect url registered for Slack.")
(defcustom slack-buffer-function #'switch-to-buffer-other-window
"Function to print buffer.")
(defvar slack-use-register-team-string
"use `slack-register-team' instead.")
(defcustom slack-client-id nil
"Client ID provided by Slack.")
(make-obsolete-variable
'slack-client-id slack-use-register-team-string
"0.0.2")
(defcustom slack-client-secret nil
"Client Secret Provided by Slack.")
(make-obsolete-variable
'slack-client-secret slack-use-register-team-string
"0.0.2")
(defcustom slack-token nil
"Slack token provided by Slack.
set this to save request to Slack if already have.")
(make-obsolete-variable
'slack-token slack-use-register-team-string
"0.0.2")
(defcustom slack-room-subscription '()
"Group or Channel list to subscribe notification."
:group 'slack)
(make-obsolete-variable
'slack-room-subscription slack-use-register-team-string
"0.0.2")
(defcustom slack-typing-visibility 'frame
"When to show typing indicator.
frame means typing slack buffer is in the current frame, show typing indicator.
buffer means typing slack buffer is the current buffer, show typing indicator.
never means never show typing indicator."
:type '(choice (const frame)
(const buffer)
(const never)))
(defconst slack-oauth2-authorize "https://slack.com/oauth/authorize")
(defconst slack-oauth2-access "https://slack.com/api/oauth.access")
(defconst slack-authorize-url "https://slack.com/api/rtm.start")
(defvar slack-authorize-requests nil)
(defun slack-authorize (team &optional error-callback)
(cl-labels
((abort-previous () (cl-loop for r in (reverse slack-authorize-requests)
do (request-abort r))))
(setq slack-authorize-requests nil)
(let ((request (slack-request
slack-authorize-url
team
:success (cl-function (lambda (&key data &allow-other-keys)
(slack-on-authorize data team)))
:sync nil
:error error-callback)))
(push request slack-authorize-requests))))
(defun slack-update-team (data team)
(cl-labels
((create-rooms
(datum team class)
(mapcar #'(lambda (data)
(slack-room-create data team class))
(append datum nil))))
(let ((self (plist-get data :self))
(team-data (plist-get data :team)))
(oset team id (plist-get team-data :id))
(oset team name (plist-get team-data :name))
(oset team channels
(create-rooms (plist-get data :channels)
team 'slack-channel))
(oset team groups
(create-rooms (plist-get data :groups)
team 'slack-group))
(oset team ims
(create-rooms (plist-get data :ims)
team 'slack-im))
(oset team self self)
(oset team self-id (plist-get self :id))
(oset team self-name (plist-get self :name))
(oset team users (append (plist-get data :users) nil))
(oset team bots (append (plist-get data :bots) nil))
(oset team ws-url (plist-get data :url))
(oset team connected t)
team)))
(cl-defun slack-on-authorize (data team)
(slack-request-handle-error
(data "slack-authorize")
(message "Slack Authorization Finished - %s"
(oref team name))
(let ((team (slack-update-team data team)))
(with-slots (groups ims channels) team
(cl-loop for room in (append groups ims channels)
do (let ((bufname (slack-room-buffer-name room)))
(when (get-buffer bufname)
(kill-buffer bufname)))))
(slack-ws-open team))))
(defun slack-on-authorize-e
(&key error-thrown &allow-other-keys &rest_)
(error "slack-authorize: %s" error-thrown))
(defun slack-oauth2-auth (team)
(with-slots (client-id client-secret) team
(oauth2-auth
slack-oauth2-authorize
slack-oauth2-access
client-id
client-secret
"client"
nil
slack-redirect-url)))
(defun slack-request-token (team)
(with-slots (token) team
(setq token
(oauth2-token-access-token
(slack-oauth2-auth team)))))
;;;###autoload
(defun slack-start (&optional team)
(interactive)
(cl-labels ((start
(team)
(with-slots (ws-conn token) team
(if ws-conn
(slack-ws-close team))
(unless token
(slack-request-token team)))
(slack-authorize team)))
(if team
(start team)
(if slack-teams
(cl-loop for team in slack-teams
do (start team))
(slack-start (call-interactively #'slack-register-team))))))
(provide 'slack)
;;; slack.el ends here

15
elpa/websocket-20160720.2051/websocket-autoloads.el Normal file
View File

@ -0,0 +1,15 @@
;;; websocket-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil nil ("websocket.el") (22533 17547 135674 20000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; websocket-autoloads.el ends here

2
elpa/websocket-20160720.2051/websocket-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "websocket" "20160720.2051" "Emacs WebSocket client and server" 'nil :keywords '("communication" "websocket" "server"))

1035
elpa/websocket-20160720.2051/websocket.el Normal file
View File

File diff suppressed because it is too large Load Diff

5
init.el
View File

@ -103,11 +103,16 @@
nyan-prompt
org
org-bullets
org-jekyll
org-projectile
org-random-todo
org-rtm
origami
plantuml-mode
projectile
sass-mode
simple-rtm
slack
smart-mode-line
smart-mode-line-powerline-theme
smartparens