first customize options.
fixing variable names.
Signed-off-by: Andreas Gerler <baronNOSPAMbundesbrandschatzamt.de>
--- /dev/null
+;;; alert-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
+\f
+;;;### (autoloads nil "alert" "alert.el" (22555 30981 0 0))
+;;; 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)
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; alert-autoloads.el ends here
--- /dev/null
+;;; -*- 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"))
--- /dev/null
+;;; alert.el --- Growl-style notification system for Emacs
+
+;; Copyright (C) 2011-2013 John Wiegley
+
+;; Author: John Wiegley <jwiegleyNOSPAMgmail.com>
+;; Created: 24 Aug 2011
+;; Updated: 16 Mar 2015
+;; Version: 1.2
+;; Package-Version: 20160824.821
+;; Package-Requires: ((gntp "0.1") (log4e "0.3.0"))
+;; Keywords: notification emacs message
+;; X-URL: https://github.com/jwiegley/alert
+
+;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+\f
+;;; Commentary:
+
+;; Alert is a Growl-workalike for Emacs which uses a common notification
+;; interface and multiple, selectable "styles", whose use is fully
+;; customizable by the user.
+;;
+;; * For module writers
+;;
+;; Just use `alert' instead of `message' as follows:
+;;
+;; (require 'alert)
+;;
+;; ;; 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 'debug)
+;;
+;; * For users
+;;
+;; For the user, there are several variables to control when and how alerts
+;; are presented. By default, they appear in the minibuffer much the same
+;; as a normal Emacs message. But there are many more possibilities:
+;;
+;; `alert-fade-time'
+;; Normally alerts disappear after this many seconds, if the style
+;; supports it. The default is 5 seconds.
+;;
+;; `alert-default-style'
+;; Pick the style to use if no other config rule matches. The
+;; default is `message', but `growl' works well too.
+;;
+;; `alert-reveal-idle-time'
+;; If a config rule choose to match on `idle', this is how many
+;; seconds idle the user has to be. Defaults to 5 so that users
+;; don't miss any alerts, but 120 is also good.
+;;
+;; `alert-persist-idle-time'
+;; After this many idle seconds, alerts will become sticky, and not
+;; fade away more. The default is 15 minutes.
+;;
+;; `alert-log-messages'
+;; By default, all alerts are logged to *Alerts* (and to *Messages*,
+;; if the `message' style is being used). Set to nil to disable.
+;;
+;; `alert-hide-all-notifications'
+;; Want alerts off entirely? They still get logged, however, unless
+;; you've turned that off too.
+;;
+;; `alert-user-configuration'
+;; This variable lets you control exactly how and when a particular
+;; alert, a class of alerts, or all alerts, get reported -- or if at
+;; all. Use this to make some alerts use Growl, while others are
+;; completely silent.
+;;
+;; * Programmatically adding rules
+;;
+;; Users can also programmatically add configuration rules, in addition to
+;; customizing `alert-user-configuration'. Here is one that 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)
+;;
+;; * Builtin alert styles
+;;
+;; There are several builtin styles, and it is trivial to create new ones.
+;; The builtins are:
+;;
+;; fringe - Changes the current frame's fringe background color
+;; mode-line - Changes the current frame's mode-line background color
+;; gntp - Uses gntp, it requires gntp.el (see https://github.com/tekai/gntp.el)
+;; growl - Uses Growl on OS X, if growlnotify is on the PATH
+;; ignore - Ignores the alert entirely
+;; libnotify - Uses libnotify if notify-send is on the PATH
+;; log - Logs the alert text to *Alerts*, with a timestamp
+;; message - Uses the Emacs `message' facility
+;; notifications - Uses notifications library via D-Bus
+;; notifier - Uses terminal-notifier on OS X, if it is on the PATH
+;; osx-notifier - Native OSX notifier using AppleScript
+;; toaster - Use the toast notification system
+;;
+;; * Defining new styles
+;;
+;; To create a new style, you need to at least write a "notifier", which is
+;; a function that receives the details of the alert. These details are
+;; given in a plist which uses various keyword to identify the parts of the
+;; alert. Here is a prototypical style definition:
+;;
+;; (alert-define-style 'style-name :title "My Style's title"
+;; :notifier
+;; (lambda (info)
+;; ;; The message text is :message
+;; (plist-get info :message)
+;; ;; The :title of the alert
+;; (plist-get info :title)
+;; ;; The :category of the alert
+;; (plist-get info :category)
+;; ;; The major-mode this alert relates to
+;; (plist-get info :mode)
+;; ;; The buffer the alert relates to
+;; (plist-get info :buffer)
+;; ;; Severity of the alert. It is one of:
+;; ;; `urgent'
+;; ;; `high'
+;; ;; `moderate'
+;; ;; `normal'
+;; ;; `low'
+;; ;; `trivial'
+;; (plist-get info :severity)
+;; ;; Whether this alert should persist, or fade away
+;; (plist-get info :persistent)
+;; ;; Data which was passed to `alert'. Can be
+;; ;; anything.
+;; (plist-get info :data))
+;;
+;; ;; Removers are optional. Their job is to remove
+;; ;; the visual or auditory effect of the alert.
+;; :remover
+;; (lambda (info)
+;; ;; It is the same property list that was passed to
+;; ;; the notifier function.
+;; ))
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'gntp nil t)
+(require 'notifications nil t)
+(require 'log4e nil t)
+
+(defgroup alert nil
+ "Notification system for Emacs similar to Growl"
+ :group 'emacs)
+\f
+(defcustom alert-severity-faces
+ '((urgent . alert-urgent-face)
+ (high . alert-high-face)
+ (moderate . alert-moderate-face)
+ (normal . alert-normal-face)
+ (low . alert-low-face)
+ (trivial . alert-trivial-face))
+ "Faces associated by default with alert severities."
+ :type '(alist :key-type symbol :value-type color)
+ :group 'alert)
+
+(defcustom alert-severity-colors
+ '((urgent . "red")
+ (high . "orange")
+ (moderate . "yellow")
+ (normal . "green")
+ (low . "blue")
+ (trivial . "purple"))
+ "Colors associated by default with alert severities.
+This is used by styles external to Emacs that don't understand faces."
+ :type '(alist :key-type symbol :value-type color)
+ :group 'alert)
+
+(defcustom alert-log-severity-functions
+ '((urgent . alert--log-fatal)
+ (high . alert--log-error)
+ (moderate . alert--log-warn)
+ (normal . alert--log-info)
+ (low . alert--log-debug)
+ (trivial . alert--log-trace))
+ "Log4e logging functions"
+ :type '(alist :key-type symbol :value-type color)
+ :group 'alert)
+
+(defcustom alert-log-level
+ 'normal
+ "Minimum level of messages to log"
+ :type 'symbol
+ :group 'alert)
+
+(defcustom alert-reveal-idle-time 15
+ "If idle this many seconds, rules will match the `idle' property."
+ :type 'integer
+ :group 'alert)
+
+(defcustom alert-persist-idle-time 900
+ "If idle this many seconds, all alerts become persistent.
+This can be overriden with the Never Persist option (:never-persist)."
+ :type 'integer
+ :group 'alert)
+
+(defcustom alert-fade-time 5
+ "If not idle, alerts disappear after this many seconds.
+The amount of idle time is governed by `alert-persist-idle-time'."
+ :type 'integer
+ :group 'alert)
+
+(defcustom alert-hide-all-notifications nil
+ "If non-nil, no alerts are ever shown to the user."
+ :type 'boolean
+ :group 'alert)
+
+(defcustom alert-log-messages t
+ "If non-nil, all alerts are logged to the *Alerts* buffer."
+ :type 'boolean
+ :group 'alert)
+
+(defcustom alert-default-icon
+ (concat data-directory
+ "images/icons/hicolor/scalable/apps/emacs.svg")
+ "Filename of default icon to show for libnotify-alerts."
+ :type 'string
+ :group 'alert)
+
+(defvar alert-styles nil)
+
+(defun alert-styles-radio-type (widget-name)
+ (append
+ (list widget-name :tag "Style")
+ (mapcar #'(lambda (style)
+ (list 'const
+ :tag (or (plist-get (cdr style) :title)
+ (symbol-name (car style)))
+ (car style)))
+ (setq alert-styles
+ (sort alert-styles
+ #'(lambda (l r)
+ (string< (symbol-name (car l))
+ (symbol-name (car r)))))))))
+
+(defcustom alert-default-style 'message
+ "The style to use if no rules match in the current configuration.
+If a configured rule does match an alert, this style is not used;
+it is strictly a fallback."
+ :type (alert-styles-radio-type 'radio)
+ :group 'alert)
+
+(defun alert-configuration-type ()
+ (list 'repeat
+ (list
+ 'list :tag "Select style if alert matches selector"
+ '(repeat
+ :tag "Selector"
+ (choice
+ (cons :tag "Severity"
+ (const :format "" :severity)
+ (set (const :tag "Urgent" urgent)
+ (const :tag "High" high)
+ (const :tag "Moderate" moderate)
+ (const :tag "Normal" normal)
+ (const :tag "Low" low)
+ (const :tag "Trivial" trivial)))
+ (cons :tag "User Status"
+ (const :format "" :status)
+ (set (const :tag "Buffer not visible" buried)
+ (const :tag "Buffer visible" visible)
+ (const :tag "Buffer selected" selected)
+ (const :tag "Buffer selected, user idle" idle)))
+ (cons :tag "Major Mode"
+ (const :format "" :mode)
+ regexp)
+ (cons :tag "Category"
+ (const :format "" :category)
+ regexp)
+ (cons :tag "Title"
+ (const :format "" :title)
+ regexp)
+ (cons :tag "Message"
+ (const :format "" :message)
+ regexp)
+ (cons :tag "Predicate"
+ (const :format "" :predicate)
+ function)
+ (cons :tag "Icon"
+ (const :format "" :icon)
+ regexp)))
+ (alert-styles-radio-type 'choice)
+ '(set :tag "Options"
+ (cons :tag "Make alert persistent"
+ (const :format "" :persistent)
+ (choice :value t (const :tag "Yes" t)
+ (function :tag "Predicate")))
+ (cons :tag "Never persist"
+ (const :format "" :never-persist)
+ (choice :value t (const :tag "Yes" t)
+ (function :tag "Predicate")))
+ (cons :tag "Continue to next rule"
+ (const :format "" :continue)
+ (choice :value t (const :tag "Yes" t)
+ (function :tag "Predicate")))
+ ;;(list :tag "Change Severity"
+ ;; (radio :tag "From"
+ ;; (const :tag "Urgent" urgent)
+ ;; (const :tag "High" high)
+ ;; (const :tag "Moderate" moderate)
+ ;; (const :tag "Normal" normal)
+ ;; (const :tag "Low" low)
+ ;; (const :tag "Trivial" trivial))
+ ;; (radio :tag "To"
+ ;; (const :tag "Urgent" urgent)
+ ;; (const :tag "High" high)
+ ;; (const :tag "Moderate" moderate)
+ ;; (const :tag "Normal" normal)
+ ;; (const :tag "Low" low)
+ ;; (const :tag "Trivial" trivial)))
+ ))))
+
+(defcustom alert-user-configuration nil
+ "Rules that determine how and when alerts get displayed."
+ :type (alert-configuration-type)
+ :group 'alert)
+
+(defvar alert-internal-configuration nil
+ "Rules added by `alert-add-rule'.
+For user customization, see `alert-user-configuration'.")
+\f
+(defface alert-urgent-face
+ '((t (:foreground "Red" :bold t)))
+ "Urgent alert face."
+ :group 'alert)
+
+(defface alert-high-face
+ '((t (:foreground "Dark Orange" :bold t)))
+ "High alert face."
+ :group 'alert)
+
+(defface alert-moderate-face
+ '((t (:foreground "Gold" :bold t)))
+ "Moderate alert face."
+ :group 'alert)
+
+(defface alert-normal-face
+ '((t))
+ "Normal alert face."
+ :group 'alert)
+
+(defface alert-low-face
+ '((t (:foreground "Dark Blue")))
+ "Low alert face."
+ :group 'alert)
+
+(defface alert-trivial-face
+ '((t (:foreground "Dark Purple")))
+ "Trivial alert face."
+ :group 'alert)
+\f
+(defun alert-define-style (name &rest plist)
+ "Define a new style for notifying the user of alert messages.
+To create a new style, you need to at least write a \"notifier\",
+which is a function that receives the details of the alert.
+These details are given in a plist which uses various keyword to
+identify the parts of the alert. Here is a prototypical style
+definition:
+
+\(alert-define-style 'style-name :title \"My Style's title\"
+ :notifier
+ (lambda (info)
+ ;; The message text is :message
+ (plist-get info :message)
+ ;; The :title of the alert
+ (plist-get info :title)
+ ;; The :category of the alert
+ (plist-get info :category)
+ ;; The major-mode this alert relates to
+ (plist-get info :mode)
+ ;; The buffer the alert relates to
+ (plist-get info :buffer)
+ ;; Severity of the alert. It is one of:
+ ;; `urgent'
+ ;; `high'
+ ;; `moderate'
+ ;; `normal'
+ ;; `low'
+ ;; `trivial'
+ (plist-get info :severity)
+ ;; Whether this alert should persist, or fade away
+ (plist-get info :persistent)
+ ;; Data which was passed to `alert'. Can be
+ ;; anything.
+ (plist-get info :data))
+
+ ;; Removers are optional. Their job is to remove
+ ;; the visual or auditory effect of the alert.
+ :remover
+ (lambda (info)
+ ;; It is the same property list that was passed to
+ ;; the notifier function.
+ ))"
+ (add-to-list 'alert-styles (cons name plist))
+ (put 'alert-user-configuration 'custom-type (alert-configuration-type))
+ (put 'alert-define-style 'custom-type (alert-styles-radio-type 'radio)))
+
+(alert-define-style 'ignore :title "Ignore Alert"
+ :notifier #'ignore
+ :remover #'ignore)
+\f
+;;;###autoload
+(defun* alert-add-rule (&key severity status mode category title
+ message predicate icon (style alert-default-style)
+ persistent continue never-persist append)
+ "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)"
+ (let ((rule (list (list t) style (list t))))
+ (if severity
+ (nconc (nth 0 rule)
+ (list (cons :severity
+ (if (listp severity)
+ severity
+ (list severity))))))
+ (if status
+ (nconc (nth 0 rule)
+ (list (cons :status
+ (if (listp status)
+ status
+ (list status))))))
+ (if mode
+ (nconc (nth 0 rule)
+ (list (cons :mode
+ (if (stringp mode)
+ mode
+ (concat "\\`" (symbol-name mode)
+ "\\'"))))))
+ (if category
+ (nconc (nth 0 rule) (list (cons :category category))))
+ (if title
+ (nconc (nth 0 rule) (list (cons :title title))))
+ (if message
+ (nconc (nth 0 rule) (list (cons :message message))))
+ (if predicate
+ (nconc (nth 0 rule) (list (cons :predicate predicate))))
+ (if icon
+ (nconc (nth 0 rule) (list (cons :icon icon))))
+ (setcar rule (cdr (nth 0 rule)))
+
+ (if persistent
+ (nconc (nth 2 rule) (list (cons :persistent persistent))))
+ (if never-persist
+ (nconc (nth 2 rule) (list (cons :never-persist never-persist))))
+ (if continue
+ (nconc (nth 2 rule) (list (cons :continue continue))))
+ (setcdr (cdr rule) (list (cdr (nth 2 rule))))
+
+ (if (null alert-internal-configuration)
+ (setq alert-internal-configuration (list rule))
+ (if append
+ (nconc alert-internal-configuration (list rule))
+ (setq alert-internal-configuration
+ (cons rule alert-internal-configuration))))
+
+ rule))
+\f
+(alert-define-style 'ignore :title "Don't display alerts")
+\f
+(defun alert-log-notify (info)
+ (let* ((mes (plist-get info :message))
+ (sev (plist-get info :severity))
+ (len (length mes))
+ (func (cdr (assoc sev alert-log-severity-functions))))
+ (if (not (featurep 'log4e))
+ (alert-legacy-log-notify mes sev len)
+ ;; when we get here you better be using log4e or have your logging
+ ;; functions defined
+ (if (fboundp func)
+ (apply func (list mes))
+ (when (fboundp 'log4e:deflogger)
+ (log4e:deflogger "alert" "%t [%l] %m" "%H:%M:%S")
+ (when (functionp 'alert--log-set-level)
+ (alert--log-set-level alert-log-level)))))))
+
+(defun alert-legacy-log-notify (mes sev len)
+ (with-current-buffer
+ (get-buffer-create "*Alerts*")
+ (goto-char (point-max))
+ (insert (format-time-string "%H:%M %p - "))
+ (insert mes)
+ (set-text-properties (- (point) len) (point)
+ (list 'face (cdr (assq sev
+ alert-severity-faces))))
+ (insert ?\n)))
+
+(defun alert-log-clear (info)
+ (if (functionp 'alert--log-clear-log)
+ (alert--log-clear-log)
+ (if (bufferp "*Alerts*")
+ (with-current-buffer
+ (get-buffer-create "*Alerts*")
+ (goto-char (point-max))
+ (insert (format-time-string "%H:%M %p - ")
+ "Clear: " (plist-get info :message)
+ ?\n)))))
+
+(alert-define-style 'log :title "Log to *Alerts* buffer"
+ :notifier #'alert-log-notify
+ ;;:remover #'alert-log-clear
+ )
+\f
+(defun alert-message-notify (info)
+ ;; the message text might contain `%' and we don't want them to be
+ ;; interpreted as format specifiers:
+ (message "%s" (plist-get info :message))
+ ;;(if (memq (plist-get info :severity) '(high urgency))
+ ;; (ding))
+ )
+
+(defun alert-message-remove (info)
+ (message ""))
+
+(alert-define-style 'message :title "Display message in minibuffer"
+ :notifier #'alert-message-notify
+ :remover #'alert-message-remove)
+\f
+(copy-face 'fringe 'alert-saved-fringe-face)
+
+(defun alert-fringe-notify (info)
+ (set-face-background 'fringe (cdr (assq (plist-get info :severity)
+ alert-severity-colors))))
+
+(defun alert-fringe-restore (info)
+ (copy-face 'alert-saved-fringe-face 'fringe))
+
+(alert-define-style 'fringe :title "Change the fringe color"
+ :notifier #'alert-fringe-notify
+ :remover #'alert-fringe-restore)
+\f
+
+(defun alert-mode-line-notify (info)
+ (copy-face 'mode-line 'alert-saved-mode-line-face)
+ (set-face-background 'mode-line (cdr (assq (plist-get info :severity)
+ alert-severity-colors)))
+ (set-face-foreground 'mode-line "white"))
+
+(defun alert-mode-line-restore (info)
+ (copy-face 'alert-saved-mode-line-face 'mode-line))
+
+(alert-define-style 'mode-line :title "Change the mode-line color"
+ :notifier #'alert-mode-line-notify
+ :remover #'alert-mode-line-restore)
+
+\f
+
+(defcustom alert-growl-command (executable-find "growlnotify")
+ "Path to the growlnotify command.
+This is found in the Growl Extras: http://growl.info/extras.php."
+ :type 'file
+ :group 'alert)
+
+(defcustom alert-growl-priorities
+ '((urgent . 2)
+ (high . 2)
+ (moderate . 1)
+ (normal . 0)
+ (low . -1)
+ (trivial . -2))
+ "A mapping of alert severities onto Growl priority values."
+ :type '(alist :key-type symbol :value-type integer)
+ :group 'alert)
+
+(defsubst alert-encode-string (str)
+ (encode-coding-string str (keyboard-coding-system)))
+
+(defun alert-growl-notify (info)
+ (if alert-growl-command
+ (let ((args
+ (list "--appIcon" "Emacs"
+ "--name" "Emacs"
+ "--title" (alert-encode-string (plist-get info :title))
+ "--message" (alert-encode-string (plist-get info :message))
+ "--priority" (number-to-string
+ (cdr (assq (plist-get info :severity)
+ alert-growl-priorities))))))
+ (if (and (plist-get info :persistent)
+ (not (plist-get info :never-persist)))
+ (nconc args (list "--sticky")))
+ (apply #'call-process alert-growl-command nil nil nil args))
+ (alert-message-notify info)))
+
+(alert-define-style 'growl :title "Notify using Growl"
+ :notifier #'alert-growl-notify)
+
+\f
+(defcustom alert-libnotify-command (executable-find "notify-send")
+ "Path to the notify-send command.
+This is found in the libnotify-bin package in Debian based
+systems."
+ :type 'file
+ :group 'alert)
+
+(defcustom alert-libnotify-priorities
+ '((urgent . critical)
+ (high . critical)
+ (moderate . normal)
+ (normal . normal)
+ (low . low)
+ (trivial . low))
+ "A mapping of alert severities onto libnotify priority values."
+ :type '(alist :key-type symbol :value-type symbol)
+ :group 'alert)
+
+(defun alert-libnotify-notify (info)
+ "Send INFO using notify-send.
+Handles :ICON, :CATEGORY, :SEVERITY, :PERSISTENT, :NEVER-PERSIST, :TITLE
+and :MESSAGE keywords from the INFO plist. :CATEGORY can be
+passed as a single symbol, a string or a list of symbols or
+strings."
+ (if alert-libnotify-command
+ (let* ((args
+ (list "--icon" (or (plist-get info :icon)
+ alert-default-icon)
+ "--app-name" "Emacs"
+ "--hint" "int:transient:1"
+ "--urgency" (let ((urgency (cdr (assq
+ (plist-get info :severity)
+ alert-libnotify-priorities))))
+ (if urgency
+ (symbol-name urgency)
+ "normal"))))
+ (category (plist-get info :category)))
+ (if (and (plist-get info :persistent)
+ (not (plist-get info :never-persist)))
+ (nconc args (list "--expire-time 0")))
+ (when category
+ (nconc args
+ (list "--category"
+ (cond ((symbolp category)
+ (symbol-name category))
+ ((stringp category) category)
+ ((listp category)
+ (mapconcat (if (symbolp (car category))
+ #'symbol-name
+ #'identity)
+ category ","))))))
+ (nconc args (list
+ (alert-encode-string (plist-get info :title))
+ (alert-encode-string (plist-get info :message))))
+ (apply #'call-process alert-libnotify-command nil
+ (list (get-buffer-create " *libnotify output*") t) nil args))
+ (alert-message-notify info)))
+
+(alert-define-style 'libnotify :title "Notify using libnotify"
+ :notifier #'alert-libnotify-notify)
+
+\f
+(defcustom alert-gntp-icon
+ "http://cvs.savannah.gnu.org/viewvc/*checkout*/emacs/emacs/etc/images/icons/hicolor/48x48/apps/emacs.png"
+ "Icon file using gntp."
+ :type 'string
+ :group 'alert)
+
+(when (featurep 'gntp)
+(defun alert-gntp-notify (info)
+ (gntp-notify 'alert
+ (alert-encode-string (plist-get info :title))
+ (alert-encode-string (plist-get info :message))
+ gntp-server nil
+ (number-to-string
+ (cdr (assq (plist-get info :severity)
+ alert-growl-priorities)))
+ (if (eq (plist-get info :icon) nil)
+ alert-gntp-icon
+ (plist-get info :icon)))
+ (alert-message-notify info))
+
+(alert-define-style 'gntp :title "Notify using gntp"
+ :notifier #'alert-gntp-notify))
+
+\f
+(defcustom alert-notifications-priorities
+ '((urgent . critical)
+ (high . critical)
+ (moderate . normal)
+ (normal . normal)
+ (low . low)
+ (trivial . low))
+ "A mapping of alert severities onto Growl priority values."
+ :type '(alist :key-type symbol :value-type integer)
+ :group 'alert)
+
+(when (featurep 'notifications)
+(defun alert-notifications-notify (info)
+ (notifications-notify :title (plist-get info :title)
+ :body (plist-get info :message)
+ :app-icon (plist-get info :icon)
+ :urgency (cdr (assq (plist-get info :severity)
+ alert-notifications-priorities))
+)
+ (alert-message-notify info))
+
+(alert-define-style 'notifications :title "Notify using notifications"
+ :notifier #'alert-notifications-notify))
+
+\f
+(defcustom alert-notifier-command (executable-find "terminal-notifier")
+ "Path to the terminal-notifier command.
+From https://github.com/alloy/terminal-notifier."
+ :type 'file
+ :group 'alert)
+
+(defun alert-notifier-notify (info)
+ (if alert-notifier-command
+ (let ((args
+ (list "-title" (alert-encode-string (plist-get info :title))
+ "-sender" "org.gnu.Emacs"
+ "-message" (alert-encode-string (plist-get info :message)))))
+ (apply #'call-process alert-notifier-command nil nil nil args))
+ (alert-message-notify info)))
+
+(alert-define-style 'notifier :title "Notify using terminal-notifier"
+ :notifier #'alert-notifier-notify)
+
+(defun alert-osx-notifier-notify (info)
+ (apply #'call-process (format "osascript -e 'display notification %S with title %S'"
+ (alert-encode-string (plist-get info :message))
+ (alert-encode-string (plist-get info :title))))
+ (alert-message-notify info))
+
+(alert-define-style 'osx-notifier :title "Notify using native OSX notification" :notifier #'alert-osx-notifier-notify)
+
+(defun alert-frame-notify (info)
+ (let ((buf (plist-get info :buffer)))
+ (if (eq (alert-buffer-status buf) 'buried)
+ (let ((current-frame (selected-frame)))
+ (with-selected-frame
+ (make-frame '((width . 80)
+ (height . 20)
+ (top . -1)
+ (left . 0)
+ (left-fringe . 0)
+ (right-fringe . 0)
+ (tool-bar-lines . nil)
+ (menu-bar-lines . nil)
+ (vertical-scroll-bars . nil)
+ (unsplittable . t)
+ (has-modeline-p . nil)
+ (minibuffer . nil)))
+ (switch-to-buffer buf)
+ ;;(set (make-local-variable 'mode-line-format) nil)
+ (nconc info (list :frame (selected-frame))))
+ (select-frame current-frame)))))
+
+(defun alert-frame-remove (info)
+ (unless (eq this-command 'handle-switch-frame)
+ (delete-frame (plist-get info :frame) t)))
+
+(defcustom alert-toaster-default-icon
+ (let ((exec-bin (executable-find "emacs.exe")))
+ (cond (exec-bin
+ (concat (file-name-directory exec-bin) "../share/icons/hicolor/128x128/apps/emacs.png"))
+ (t nil)))
+ "Icon file using toaster."
+ :type 'string
+ :group 'alert
+ )
+
+(defcustom alert-toaster-command (executable-find "toast")
+ "Path to the toast command.
+This is found at https://github.com/nels-o/toaster."
+ :type 'file
+ :group 'alert
+ )
+
+(defun alert-toaster-notify (info)
+ (if alert-toaster-command
+ (let ((args (list
+ "-t" (alert-encode-string (plist-get info :title))
+ "-m" (alert-encode-string (plist-get info :message))
+ "-p" (expand-file-name (or (plist-get info :icon) alert-toaster-default-icon))
+ )))
+ (apply #'call-process alert-toaster-command nil nil nil args))
+ (alert-message-notify info)))
+
+(alert-define-style 'toaster :title "Notify using Toaster"
+ :notifier #'alert-toaster-notify)
+
+;; jww (2011-08-25): Not quite working yet
+;;(alert-define-style 'frame :title "Popup buffer in a frame"
+;; :notifier #'alert-frame-notify
+;; :remover #'alert-frame-remove)
+\f
+(defun alert-buffer-status (&optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (let ((wind (get-buffer-window)))
+ (if wind
+ (if (eq wind (selected-window))
+ (if (and (current-idle-time)
+ (> (float-time (current-idle-time))
+ alert-reveal-idle-time))
+ 'idle
+ 'selected)
+ 'visible)
+ 'buried))))
+
+(defvar alert-active-alerts nil)
+
+(defun alert-remove-when-active (remover info)
+ (let ((idle-time (and (current-idle-time)
+ (float-time (current-idle-time)))))
+ (cond
+ ((and idle-time (> idle-time alert-persist-idle-time)))
+ ((and idle-time (> idle-time alert-reveal-idle-time))
+ (run-with-timer alert-fade-time nil
+ #'alert-remove-when-active remover info))
+ (t
+ (funcall remover info)))))
+
+(defun alert-remove-on-command ()
+ (let (to-delete)
+ (dolist (alert alert-active-alerts)
+ (when (eq (current-buffer) (nth 0 alert))
+ (push alert to-delete)
+ (if (nth 2 alert)
+ (funcall (nth 2 alert) (nth 1 alert)))))
+ (dolist (alert to-delete)
+ (setq alert-active-alerts (delq alert alert-active-alerts)))))
+\f
+(defun alert-send-notification
+ (alert-buffer info style-def &optional persist never-per)
+ (let ((notifier (plist-get style-def :notifier)))
+ (if notifier
+ (funcall notifier info)))
+ (let ((remover (plist-get style-def :remover)))
+ (add-to-list 'alert-active-alerts (list alert-buffer info remover))
+ (with-current-buffer alert-buffer
+ (add-hook 'post-command-hook #'alert-remove-on-command nil t))
+ (if (and remover (or (not persist) never-per))
+ (run-with-timer alert-fade-time nil
+ #'alert-remove-when-active
+ remover info))))
+
+;;;###autoload
+(defun* alert (message &key (severity 'normal) title icon category
+ buffer mode data style persistent never-persist)
+ "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)"
+ (destructuring-bind
+ (alert-buffer current-major-mode current-buffer-status
+ current-buffer-name)
+ (with-current-buffer (or buffer (current-buffer))
+ (list (current-buffer)
+ (or mode major-mode)
+ (alert-buffer-status)
+ (buffer-name)))
+
+ (let ((base-info (list :message message
+ :title (or title current-buffer-name)
+ :icon icon
+ :severity severity
+ :category category
+ :buffer alert-buffer
+ :mode current-major-mode
+ :data data))
+ matched)
+
+ (if alert-log-messages
+ (alert-log-notify base-info))
+
+ (unless alert-hide-all-notifications
+ (catch 'finish
+ (dolist (config (append alert-user-configuration
+ alert-internal-configuration))
+ (let* ((style-def (cdr (assq (or style (nth 1 config))
+ alert-styles)))
+ (options (nth 2 config))
+ (persist-p (or persistent
+ (cdr (assq :persistent options))))
+ (persist (if (functionp persist-p)
+ (funcall persist-p base-info)
+ persist-p))
+ (never-persist-p
+ (or never-persist
+ (cdr (assq :never-persist options))))
+ (never-per (if (functionp never-persist-p)
+ (funcall never-persist-p base-info)
+ never-persist-p))
+ (continue (cdr (assq :continue options)))
+ info)
+ (setq info (if (not (memq :persistent base-info))
+ (append base-info (list :persistent persist))
+ base-info)
+ info (if (not (memq :never-persist info))
+ (append info (list :never-persist never-per))
+ info))
+ (when
+ (or style ; :style always "matches", for testing
+ (not
+ (memq
+ nil
+ (mapcar
+ #'(lambda (condition)
+ (case (car condition)
+ (:severity
+ (memq severity (cdr condition)))
+ (:status
+ (memq current-buffer-status (cdr condition)))
+ (:mode
+ (string-match
+ (cdr condition)
+ (symbol-name current-major-mode)))
+ (:category
+ (and category (string-match
+ (cdr condition)
+ (if (stringp category)
+ category
+ (symbol-name category)))))
+ (:title
+ (and title
+ (string-match (cdr condition) title)))
+ (:message
+ (string-match (cdr condition) message))
+ (:predicate
+ (funcall (cdr condition) info))
+ (:icon
+ (string-match (cdr condition) icon))))
+ (nth 0 config)))))
+
+ (alert-send-notification alert-buffer info style-def
+ persist never-per)
+ (setq matched t)
+ (if (or style (not (if (functionp continue)
+ (funcall continue info)
+ continue)))
+ (throw 'finish t)))))))
+
+ (if (and (not matched) alert-default-style)
+ (alert-send-notification alert-buffer base-info
+ (cdr (assq alert-default-style
+ alert-styles)))))))
+\f
+(provide 'alert)
+
+;;; alert.el ends here
:group 'aws-snippets
)
+(defconst aws-snippets--default-filters
+ '("tag:Name" "tag:Project" "tag:Type" "tag:Cluster" "instance.group-id" "ip-address" "private-ip-address" "network-interface.subnet-id" "description" ))
+
+(defcustom aws-snippets-filters aws-snippets--default-filters
+ "List of AWS filters for selections."
+ :type '(choice (string :tag "Filter")
+ (repeat :tag "List of Filters"
+ (string :tag "Filter")))
+ :set #'(lambda (symbol new)
+ (let ((old (and (boundp symbol)
+ (symbol-value symbol))))
+ (set-default symbol new)
+ ))
+ :group 'aws-snippets
+ )
+
+
+
+(defconst aws-snippets--ec2-list-instances-query
+ '"Reservations[].Instances[].[join(\`,\`,Tags[?Key==\`Name\`].Value),join(\`,\`,Tags[?Key==\`Schedule\`].Value),InstanceId, State.Name, PublicDnsName, InstanceType,Placement.AvailabilityZone,LaunchTime]")
+
+(defcustom aws-snippets-ec2-list-instances-query aws-snippets--ec2-list-instances-query
+ "Query string used for ec2 describe-instances."
+ :group 'aws-snippets
+ :type 'string
+ )
;;;###autoload
(defun aws-snippets-initialize ()
+ "Initialize package."
(let ((snip-dir (expand-file-name "snippets" aws-snippets-dir)))
- (add-to-list 'yas-snippet-dirs snip-dir t)
+ (when (boundp 'yas-snippet-dirs)(add-to-list 'yas-snippet-dirs snip-dir t))
(yas-load-directory snip-dir)))
;;;###autoload
# -*- mode: snippet -*-
# name: ami-ls
# key: ami-ls
+# group: aws
# --
aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} ec2 describe-images --owners \$`(if (string-equal major-mode "eshell-mode")(message "{")(message "("))` aws --profile=$1 ec2 describe-security-groups --group-names 'Default' --query 'SecurityGroups[0].OwnerId' --output text `(if (string-equal major-mode "eshell-mode")(message "}")(message ")"))` --query "reverse(sort_by(Images, &CreationDate)[].{CreationDate:CreationDate,Name:Name,ImageId:ImageId,Public:Public,Description:Description})" --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
# -*- mode: snippet -*-
# name: aws-autoscaling-describe-auto-scaling-groups
# key: asg-ls
+# group: aws
# --
aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} autoscaling describe-auto-scaling-groups --query 'AutoScalingGroups[].{Name: AutoScalingGroupName, Desired: DesiredCapacity,Min: MinSize, Max: MaxSize}' --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-autoscaling-describe-launch-configurations
+# key: asl-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} autoscaling describe-launch-configurations --query 'reverse(sort_by(LaunchConfigurations &CreatedTime)[*].[LaunchConfigurationName, CreatedTime])' --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-autoscaling-update-auto-scaling-group-min-max
+# key: aws-autoscaling-update-auto-scaling-group-min-max
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} autoscaling update-auto-scaling-group --auto-scaling-group-name ${4:`(yank)`} --min-size $5 --max-size $6 $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-cloudformation-change-ls
+# key: cloud-change-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} cloudformation list-change-sets --stack-name ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-cloudformation-create-change-set
+# key: cloud-createchange
+# expand-env: ((yas/indent-line 'auto) (yas/wrap-around-region 't))
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} \
+${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} \
+cloudformation create-change-set \
+${4:--capabilities CAPABILITY_NAMED_IAM} \
+--stack-name '$5' \
+--change-set-name '$6' \
+--description '$7' \
+--parameters ${8:file://} \
+${9:--change-set-type=${10:$$(yas-choose-value '("CREATE" "UPDATE"))}}$0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-cloudformation-describe-change-set
+# key: cloud-descchange
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} cloudformation describe-change-set --stack-name ${4:`(yank)`} --change-set-name $5 --output ${6:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-cloudformation-describe-stack
+# key: cloud-desc
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} cloudformation describe-stacks --stack-name ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-cloudformation-describe-stack-events
+# key: cloud-events-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} cloudformation describe-stack-events --stack-name ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-cloudformation-ls
+# key: cloud-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} cloudformation list-stacks --stack-status-filter ${4:$$(yas-choose-value '(
+"CREATE_COMPLETE"
+"CREATE_IN_PROGRESS"
+"CREATE_FAILED"
+"ROLLBACK_IN_PROGRESS"
+"ROLLBACK_FAILED"
+"ROLLBACK_COMPLETE"
+"DELETE_IN_PROGRESS"
+"DELETE_FAILED"
+"DELETE_COMPLETE"
+"UPDATE_IN_PROGRESS"
+"UPDATE_COMPLETE_CLEANUP_IN_PROGRESS"
+"UPDATE_COMPLETE"
+"UPDATE_ROLLBACK_IN_PROGRESS"
+"UPDATE_ROLLBACK_FAILED"
+"UPDATE_ROLLBACK_COMPLETE_CLEANUP_IN_PROGRESS"
+"UPDATE_ROLLBACK_COMPLETE"
+"REVIEW_IN_PROGRESS"
+))} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-cloudformation-validate-template
+# key: cloud-val-temp
+# group: aws
+# --
+aws --profile=test --region=us-east-1 cloudformation validate-template --template-body file://${1:`(yank)`} --output ${2:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-cloudtrail-lookup-events
+# key: cloudtrail-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} cloudtrail lookup-events --max-items ${4:100} --lookup-attributes AttributeKey=${5:$$(yas-choose-value '("ResourceType,AttributeValue=AWS::EC2::Instance" "ResourceName,AttributeValue="))}$6 --output ${7:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-delete-snapshot (yank)
+# key: snap-del
+# group: aws
+# --
+# aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 delete-snapshot --snapshot-id ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-delete-volume (yank)
+# key: ebs-del
+# group: aws
+# --
+# aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 delete-volume --volume-id ${4:`(yank)`} $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-describe-instance-attribute (yank)
+# key: ec2-attribute
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} ec2 describe-instance-attribute --instance-id ${4:`(yank)`} --attribute ${5:$$(yas-choose-value '("instanceType" "kernel" "ramdisk" "userData" "disableApiTermination" "instanceInitiatedShutdownBehavior" "rootDeviceName" "blockDeviceMapping" "productCodes" "sourceDestCheck" "groupSet" "ebsOptimized" "sriovNetSupport"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-describe-instance-status (yank)
+# key: aws-ec2-describe-instance-status
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} ec2 describe-instance-status --instance-ids ${4:`(yank)`} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-describe-userdata (yank)
+# key: ec2-userdata
+# group: aws
+# --
+(base64-decode-string (shell-command-to-string "aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} ec2 describe-instance-attribute --instance-id ${4:`(yank)`} --attribute userData --query 'UserData.Value' --output text"))$0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-get-console-output (yank)
+# key: ec2-console
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} ec2 get-console-output --output text --instance-id ${4:`(yank)`} >#<buffer *$4-console-output*> $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-get-dns-names
+# key: aws-ec2-get-dns-names
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} ec2 describe-instances --filters "Name=tag:Name,Values=$4" --query "Reservations[].Instances[?State.Name=='running'].[InstanceId, PublicDnsName]" --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-get-instance-details (yank)
+# key: ec2-det
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} ec2 describe-instances --instance-ids ${4:`(yank)`} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-get-instance-volumes
+# key: ec2-vol
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 describe-instances --query "Reservations[].Instances[].[join(\`,\`,Tags[?Key==\`Name\`].Value),join(' ', BlockDeviceMappings[].Ebs.VolumeId)]" --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-get-instances
-# key: ec2-ls
-# --
-aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 describe-instances --query 'Reservations[].Instances[].[join(\`,\`,Tags[?Key==\`Name\`].Value),join(\`,\`,Tags[?Key==\`Schedule\`].Value),InstanceId, State.Name, PublicDnsName, InstanceType,Placement.AvailabilityZone,LaunchTime]' --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-get-securitygroup-details (yank)
+# key: aws-ec2-get-securitygroup-details
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 describe-security-groups --group-ids ${4:`(yank)`} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-get-securitygroup-references (yank)
+# key: aws-ec2-get-securitygroup-references
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 describe-security-group-references --group-id ${4:`(yank)`} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-get-securitygroups
+# key: aws-ec2-get-securitygroups
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 describe-security-groups --query "sort_by(SecurityGroups, &GroupName)[*].[GroupName, GroupId, Description]" --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-get-snapshot-details (yank)
+# key: snap-det
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 describe-snapshots --snapshot-id ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
# -*- mode: snippet -*-
# name: aws-ec2-get-snapshots
# key: snap-ls
+# group: aws
# --
aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 describe-snapshots --query 'Snapshots[].[join(\`,\`,Tags[?Key==\`Name\`].Value),StartTime,Description,SnapshotId,VolumeId,VolumeSize,Progress]' --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-get-volumes
+# key: ebs-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 describe-volumes --query 'Volumes[].[VolumeId,State,SnapshotId,join(\`,\`,Tags[?Key==\`Name\`].Value)]' --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-get-volumes-unused
+# key: ebs-ls-avail
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 describe-volumes --query 'Volumes[].[VolumeId,Size,VolumeType,CreateTime,State,SnapshotId]' --filters Name=status,Values=available --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-instance-running
+# key: aws-ec2-instance-running
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} ec2 describe-instances --instance-ids $4 --query "Reservations[].Instances[].[InstanceId, State.Name]" --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-list-instances
+# key: ec2-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 describe-instances --query '`(print aws-snippets-ec2-list-instances-query)`' --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-list-subnets
+# key: sub-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} ec2 describe-subnets --query "sort_by(sort_by(Subnets[].{VpcId:VpcId, SubnetId:SubnetId, State:State, AvailabilityZone:AvailabilityZone, CidrBlock:CidrBlock, AvailableIpAddressCount:AvailableIpAddressCount Tags:to_string(Tags[].[Key, Value])}, &SubnetId), &VpcId)" --output ${4:$$(yas-choose-value '("table" "text" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-list-vpcs
+# key: vpc-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} ec2 describe-vpcs --query "sort_by(Vpcs[].{VpcId:VpcId, State:State, AvailabilityZone:AvailabilityZone, CidrBlock:CidrBlock, AvailableIpAddressCount:AvailableIpAddressCount Tags:to_string(Tags[].[Key, Value])}, &VpcId)" --output ${4:$$(yas-choose-value '("table" "text" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-start-stop-instance (yank)
+# key: ec2-start
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} ec2 ${4:$$(yas-choose-value '("start-instances" "stop-instances" "reboot-instances"))} --instance-ids ${5:`(current-kill 0)`} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-ec2-volume-details (yank)
+# key: ebs-det
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} ec2 describe-volumes --volume-ids ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-elb-describe-instance-health (yank)
+# key: aws-elb-describe-instance-health
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} elb describe-instance-health --load-balancer-name ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-elb-describe-load-balancer (yank)
+# key: aws-elb-describe-load-balancer
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} elb describe-load-balancers --load-balancer-name ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-elb-describe-load-balancer-attributes (yank)
+# key: aws-elb-describe-load-balancer-attributes
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} elb describe-load-balancer-attributes --load-balancer-name ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-elb-get-list
+# key: elb-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} elb describe-load-balancers --query "reverse(sort_by(LoadBalancerDescriptions, &CreatedTime)[].[LoadBalancerName, CreatedTime])" --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-elb-search
+# key: aws-elb-search
+# group: aws
+# --
+for REGION in `(mapconcat 'identity aws-snippets-regions " ")`; do
+ for BALANCER in \`aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} --region=\${REGION} elb describe-load-balancers --query "reverse(sort_by(LoadBalancerDescriptions, &CreatedTime)[].[LoadBalancerName])" --output text\`; do
+ aws --profile=$1 --region=\${REGION} elb describe-load-balancers --load-balancer-name \${BALANCER} --output text | awk "{print \\"\${REGION}:\${BALANCER}:\\"\\\$0}"
+ done
+done $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-emr-describe-cluster (yank)
+# key: aws-emr-describe-cluster
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} --region=${2:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)} emr describe-cluster --cluster-id ${3: `(yank)`} --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-emr-list-clusters
+# key: emr-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} --region=${2:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)} emr list-clusters --active --query 'Clusters[*].{ID: Id, NAME: Name}' --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
# -*- mode: snippet -*-
# name: aws-filters
# key: awsfil
+# group: aws
# --
---filters "Name=${1:$$(yas-choose-value '("tag:Name" "tag:Project" "tag:Type" "tag:Cluster" "instance.group-id" "ip-address" "private-ip-address" "network-interface.subnet-id" "description"))},Values=$2" $0
\ No newline at end of file
+--filters "Name=${1:$$(yas-choose-value aws-snippets-filters)},Values=$2" $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-logs-get-groups
+# key: logs-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} logs describe-log-groups --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-logs-set-retention
+# key: logs-set-ret
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)}} logs put-retention-policy --log-group-name ${4:`(yank)`} --retention-in-days ${5:$$(yas-choose-value '( "60" "1" "3" "5" "7" "14" "30" "90" "120" "150" "180" "365" "400" "545" "731" "1827" "3653"))} $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-rds-describe-db-instance-details (yank)
+# key: aws-rds-describe-db-instance-details
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} rds describe-db-instances --db-instance-identifier ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-rds-describe-db-instances
+# key: rds-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} rds describe-db-instances --query "DBInstances[*].[DBInstanceIdentifier,DbiResourceId, Endpoint.Address]" --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-rds-describe-db-parameter-groups
+# key: aws-rds-describe-db-parameter-groups
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} rds describe-db-parameter-groups --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-rds-describe-parameters (yank)
+# key: aws-rds-describe-parameters
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} rds describe-db-parameters --db-parameter-group-name ${4:`(yank)`} --query "Parameters[*][ParameterName, ParameterValue]" --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-region-loop
+# key: aws-region-loop
+# group: aws
+# --
+for REGION in `(mapconcat 'identity aws-snippets-regions " ")`; do
+$0
+done
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-regions
+# key: awsreg
+# group: aws
+# --
+--region=${1:$$(yas-choose-value "\$\{REGION\}" aws-snippets-regions)} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-route53-list-hosted-zones
+# key: r53-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} route53 list-hosted-zones --query 'HostedZones[].[Id, Name]' --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-route53-list-resource-record-sets (yank)
+# key: aws-route53-list-resource-record-sets
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} route53 list-resource-record-sets --hosted-zone-id ${2:`(yank)`} --query \"ResourceRecordSets[?contains(Name, '$3')]\" --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-sns-ls
+# key: sns-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} sns list-topics --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-support-describe
+# key: support-desc
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} support describe-communications --case-id ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-support-ls
+# key: support-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} support describe-cases --no-include-communications --query "reverse(sort_by(cases, &timeCreated)[].[subject, timeCreated, displayId])" --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: aws-support-ls
+# key: support-ls
+# group: aws
+# --
+aws --profile=${1:$$(yas-choose-value aws-snippets-profiles)} ${2:--region=${3:$$(yas-choose-value aws-snippets-regions)}} support describe-cases --no-include-communications --query "reverse(sort_by(cases, &timeCreated)[].[caseId, subject, timeCreated, displayId])" --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
--- /dev/null
+;;; clojure-mode-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
+\f
+;;;### (autoloads nil "clojure-mode" "clojure-mode.el" (22692 30285
+;;;;;; 0 0))
+;;; Generated autoloads from clojure-mode.el
+
+(autoload 'clojure-mode "clojure-mode" "\
+Major mode for editing Clojure code.
+
+\\{clojure-mode-map}
+
+\(fn)" t nil)
+
+(autoload 'clojure-unwind "clojure-mode" "\
+Unwind thread at point or above point by one level.
+Return nil if there are no more levels to unwind.
+
+\(fn)" t nil)
+
+(autoload 'clojure-unwind-all "clojure-mode" "\
+Fully unwind thread at point or above point.
+
+\(fn)" t nil)
+
+(autoload 'clojure-thread "clojure-mode" "\
+Thread by one more level an existing threading macro.
+
+\(fn)" t nil)
+
+(autoload 'clojure-thread-first-all "clojure-mode" "\
+Fully thread the form at point using ->.
+When BUT-LAST is passed the last expression is not threaded.
+
+\(fn BUT-LAST)" t nil)
+
+(autoload 'clojure-thread-last-all "clojure-mode" "\
+Fully thread the form at point using ->>.
+When BUT-LAST is passed the last expression is not threaded.
+
+\(fn BUT-LAST)" t nil)
+
+(autoload 'clojure-cycle-privacy "clojure-mode" "\
+Make public the current private def, or vice-versa.
+See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-privacy
+
+\(fn)" t nil)
+
+(autoload 'clojure-convert-collection-to-list "clojure-mode" "\
+Convert collection at (point) to list.
+
+\(fn)" t nil)
+
+(autoload 'clojure-convert-collection-to-quoted-list "clojure-mode" "\
+Convert collection at (point) to quoted list.
+
+\(fn)" t nil)
+
+(autoload 'clojure-convert-collection-to-map "clojure-mode" "\
+Convert collection at (point) to map.
+
+\(fn)" t nil)
+
+(autoload 'clojure-convert-collection-to-vector "clojure-mode" "\
+Convert collection at (point) to vector.
+
+\(fn)" t nil)
+
+(autoload 'clojure-convert-collection-to-set "clojure-mode" "\
+Convert collection at (point) to set.
+
+\(fn)" t nil)
+
+(autoload 'clojure-cycle-if "clojure-mode" "\
+Change a surrounding if to if-not, or vice-versa.
+
+See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-if
+
+\(fn)" t nil)
+
+(autoload 'clojure-cycle-when "clojure-mode" "\
+Change a surrounding when to when-not, or vice-versa.
+
+\(fn)" t nil)
+
+(autoload 'clojure-let-backward-slurp-sexp "clojure-mode" "\
+Slurp the s-expression before the let form into the let form.
+With a numberic prefix argument slurp the previous N s-expression into the let form.
+
+\(fn &optional N)" t nil)
+
+(autoload 'clojure-let-forward-slurp-sexp "clojure-mode" "\
+Slurp the next s-expression after the let form into the let form.
+With a numeric prefix argument slurp the next N s-expressions into the let form.
+
+\(fn &optional N)" t nil)
+
+(autoload 'clojure-introduce-let "clojure-mode" "\
+Create a let form, binding the form at point.
+With a numeric prefix argument the let is introduced N lists up.
+
+\(fn &optional N)" t nil)
+
+(autoload 'clojure-move-to-let "clojure-mode" "\
+Move the form at point to a binding in the nearest let.
+
+\(fn)" t nil)
+
+(autoload 'clojurescript-mode "clojure-mode" "\
+Major mode for editing ClojureScript code.
+
+\\{clojurescript-mode-map}
+
+\(fn)" t nil)
+
+(autoload 'clojurec-mode "clojure-mode" "\
+Major mode for editing ClojureC code.
+
+\\{clojurec-mode-map}
+
+\(fn)" t nil)
+
+(autoload 'clojurex-mode "clojure-mode" "\
+Major mode for editing ClojureX code.
+
+\\{clojurex-mode-map}
+
+\(fn)" t nil)
+
+(add-to-list 'auto-mode-alist '("\\.\\(clj\\|dtm\\|edn\\)\\'" . clojure-mode))
+
+(add-to-list 'auto-mode-alist '("\\.cljc\\'" . clojurec-mode))
+
+(add-to-list 'auto-mode-alist '("\\.cljx\\'" . clojurex-mode))
+
+(add-to-list 'auto-mode-alist '("\\.cljs\\'" . clojurescript-mode))
+
+(add-to-list 'auto-mode-alist '("\\(?:build\\|profile\\)\\.boot\\'" . clojure-mode))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; clojure-mode-autoloads.el ends here
--- /dev/null
+;;; -*- no-byte-compile: t -*-
+(define-package "clojure-mode" "20170120.2239" "Major mode for Clojure code" '((emacs "24.4")) :url "http://github.com/clojure-emacs/clojure-mode" :keywords '("languages" "clojure" "clojurescript" "lisp"))
--- /dev/null
+;;; clojure-mode.el --- Major mode for Clojure code -*- lexical-binding: t; -*-
+
+;; Copyright © 2007-2016 Jeffrey Chu, Lennart Staflin, Phil Hagelberg
+;; Copyright © 2013-2016 Bozhidar Batsov, Artur Malabarba
+;;
+;; Authors: Jeffrey Chu <jochu0NOSPAMgmail.com>
+;; Lennart Staflin <lenstNOSPAMlysator.liu.se>
+;; Phil Hagelberg <technomancyNOSPAMgmail.com>
+;; Bozhidar Batsov <bozhidarNOSPAMbatsov.com>
+;; Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+;; URL: http://github.com/clojure-emacs/clojure-mode
+;; Package-Version: 20170120.2239
+;; Keywords: languages clojure clojurescript lisp
+;; Version: 5.7.0-snapshot
+;; Package-Requires: ((emacs "24.4"))
+
+;; This file is not part of GNU Emacs.
+
+;;; Commentary:
+
+;; Provides font-lock, indentation, navigation and basic refactoring for the
+;; Clojure programming language (http://clojure.org).
+
+;; Using clojure-mode with paredit or smartparens is highly recommended.
+
+;; Here are some example configurations:
+
+;; ;; require or autoload paredit-mode
+;; (add-hook 'clojure-mode-hook #'paredit-mode)
+
+;; ;; require or autoload smartparens
+;; (add-hook 'clojure-mode-hook #'smartparens-strict-mode)
+
+;; See inf-clojure (http://github.com/clojure-emacs/inf-clojure) for
+;; basic interaction with Clojure subprocesses.
+
+;; See CIDER (http://github.com/clojure-emacs/cider) for
+;; better interaction with subprocesses via nREPL.
+
+;;; License:
+
+;; 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 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.
+
+;;; Code:
+
+\f
+(eval-when-compile
+ (defvar calculate-lisp-indent-last-sexp)
+ (defvar font-lock-beg)
+ (defvar font-lock-end)
+ (defvar paredit-space-for-delimiter-predicates)
+ (defvar paredit-version)
+ (defvar paredit-mode))
+
+(require 'cl-lib)
+(require 'imenu)
+(require 'newcomment)
+(require 'align)
+(require 'subr-x)
+
+(declare-function lisp-fill-paragraph "lisp-mode" (&optional justify))
+
+(defgroup clojure nil
+ "Major mode for editing Clojure code."
+ :prefix "clojure-"
+ :group 'languages
+ :link '(url-link :tag "Github" "https://github.com/clojure-emacs/clojure-mode")
+ :link '(emacs-commentary-link :tag "Commentary" "clojure-mode"))
+
+(defconst clojure-mode-version "5.7.0-snapshot"
+ "The current version of `clojure-mode'.")
+
+(defface clojure-keyword-face
+ '((t (:inherit font-lock-constant-face)))
+ "Face used to font-lock Clojure keywords (:something)."
+ :package-version '(clojure-mode . "3.0.0"))
+
+(defface clojure-character-face
+ '((t (:inherit font-lock-string-face)))
+ "Face used to font-lock Clojure character literals."
+ :package-version '(clojure-mode . "3.0.0"))
+
+(defface clojure-interop-method-face
+ '((t (:inherit font-lock-preprocessor-face)))
+ "Face used to font-lock interop method names (camelCase)."
+ :package-version '(clojure-mode . "3.0.0"))
+
+(defcustom clojure-indent-style :always-align
+ "Indentation style to use for function forms and macro forms.
+There are two cases of interest configured by this variable.
+
+- Case (A) is when at least one function argument is on the same
+ line as the function name.
+- Case (B) is the opposite (no arguments are on the same line as
+ the function name). Note that the body of macros is not
+ affected by this variable, it is always indented by
+ `lisp-body-indent' (default 2) spaces.
+
+Note that this variable configures the indentation of function
+forms (and function-like macros), it does not affect macros that
+already use special indentation rules.
+
+The possible values for this variable are keywords indicating how
+to indent function forms.
+
+ `:always-align' - Follow the same rules as `lisp-mode'. All
+ args are vertically aligned with the first arg in case (A),
+ and vertically aligned with the function name in case (B).
+ For instance:
+ (reduce merge
+ some-coll)
+ (reduce
+ merge
+ some-coll)
+
+ `:always-indent' - All args are indented like a macro body.
+ (reduce merge
+ some-coll)
+ (reduce
+ merge
+ some-coll)
+
+ `:align-arguments' - Case (A) is indented like `lisp', and
+ case (B) is indented like a macro body.
+ (reduce merge
+ some-coll)
+ (reduce
+ merge
+ some-coll)"
+ :safe #'keywordp
+ :type '(choice (const :tag "Same as `lisp-mode'" :always-align)
+ (const :tag "Indent like a macro body" :always-indent)
+ (const :tag "Indent like a macro body unless first arg is on the same line"
+ :align-arguments))
+ :package-version '(clojure-mode . "5.2.0"))
+
+(define-obsolete-variable-alias 'clojure-defun-style-default-indent
+ 'clojure-indent-style "5.2.0")
+
+(defcustom clojure-use-backtracking-indent t
+ "When non-nil, enable context sensitive indentation."
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom clojure-max-backtracking 3
+ "Maximum amount to backtrack up a list to check for context."
+ :type 'integer
+ :safe 'integerp)
+
+(defcustom clojure-docstring-fill-column fill-column
+ "Value of `fill-column' to use when filling a docstring."
+ :type 'integer
+ :safe 'integerp)
+
+(defcustom clojure-docstring-fill-prefix-width 2
+ "Width of `fill-prefix' when filling a docstring.
+The default value conforms with the de facto convention for
+Clojure docstrings, aligning the second line with the opening
+double quotes on the third column."
+ :type 'integer
+ :safe 'integerp)
+
+(defcustom clojure-omit-space-between-tag-and-delimiters '(?\[ ?\{)
+ "Allowed opening delimiter characters after a reader literal tag.
+For example, \[ is allowed in :db/id[:db.part/user]."
+ :type '(set (const :tag "[" ?\[)
+ (const :tag "{" ?\{)
+ (const :tag "(" ?\()
+ (const :tag "\"" ?\"))
+ :safe (lambda (value)
+ (and (listp value)
+ (cl-every 'characterp value))))
+
+(defcustom clojure-build-tool-files '("project.clj" "build.boot" "build.gradle")
+ "A list of files, which identify a Clojure project's root.
+Out-of-the box clojure-mode understands lein, boot and gradle."
+ :type '(repeat string)
+ :package-version '(clojure-mode . "5.0.0")
+ :safe (lambda (value)
+ (and (listp value)
+ (cl-every 'stringp value))))
+
+(defcustom clojure-refactor-map-prefix (kbd "C-c C-r")
+ "Clojure refactor keymap prefix."
+ :type 'string
+ :package-version '(clojure-mode . "5.6.0"))
+
+(defvar clojure-refactor-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-t") #'clojure-thread)
+ (define-key map (kbd "t") #'clojure-thread)
+ (define-key map (kbd "C-u") #'clojure-unwind)
+ (define-key map (kbd "u") #'clojure-unwind)
+ (define-key map (kbd "C-f") #'clojure-thread-first-all)
+ (define-key map (kbd "f") #'clojure-thread-first-all)
+ (define-key map (kbd "C-l") #'clojure-thread-last-all)
+ (define-key map (kbd "l") #'clojure-thread-last-all)
+ (define-key map (kbd "C-a") #'clojure-unwind-all)
+ (define-key map (kbd "a") #'clojure-unwind-all)
+ (define-key map (kbd "C-p") #'clojure-cycle-privacy)
+ (define-key map (kbd "p") #'clojure-cycle-privacy)
+ (define-key map (kbd "C-(") #'clojure-convert-collection-to-list)
+ (define-key map (kbd "(") #'clojure-convert-collection-to-list)
+ (define-key map (kbd "C-'") #'clojure-convert-collection-to-quoted-list)
+ (define-key map (kbd "'") #'clojure-convert-collection-to-quoted-list)
+ (define-key map (kbd "C-{") #'clojure-convert-collection-to-map)
+ (define-key map (kbd "{") #'clojure-convert-collection-to-map)
+ (define-key map (kbd "C-[") #'clojure-convert-collection-to-vector)
+ (define-key map (kbd "[") #'clojure-convert-collection-to-vector)
+ (define-key map (kbd "C-#") #'clojure-convert-collection-to-set)
+ (define-key map (kbd "#") #'clojure-convert-collection-to-set)
+ (define-key map (kbd "C-i") #'clojure-cycle-if)
+ (define-key map (kbd "i") #'clojure-cycle-if)
+ (define-key map (kbd "C-w") #'clojure-cycle-when)
+ (define-key map (kbd "w") #'clojure-cycle-when)
+ (define-key map (kbd "C-o") #'clojure-cycle-not)
+ (define-key map (kbd "o") #'clojure-cycle-not)
+ (define-key map (kbd "n i") #'clojure-insert-ns-form)
+ (define-key map (kbd "n h") #'clojure-insert-ns-form-at-point)
+ (define-key map (kbd "n u") #'clojure-update-ns)
+ (define-key map (kbd "n s") #'clojure-sort-ns)
+ (define-key map (kbd "s i") #'clojure-introduce-let)
+ (define-key map (kbd "s m") #'clojure-move-to-let)
+ (define-key map (kbd "s f") #'clojure-let-forward-slurp-sexp)
+ (define-key map (kbd "s b") #'clojure-let-backward-slurp-sexp)
+ map)
+ "Keymap for Clojure refactoring commands.")
+(fset 'clojure-refactor-map clojure-refactor-map)
+
+(defvar clojure-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-:") #'clojure-toggle-keyword-string)
+ (define-key map (kbd "C-c SPC") #'clojure-align)
+ (define-key map clojure-refactor-map-prefix 'clojure-refactor-map)
+ (easy-menu-define clojure-mode-menu map "Clojure Mode Menu"
+ '("Clojure"
+ ["Toggle between string & keyword" clojure-toggle-keyword-string]
+ ["Align expression" clojure-align]
+ ["Cycle privacy" clojure-cycle-privacy]
+ ["Cycle if, if-not" clojure-cycle-if]
+ ["Cycle when, when-not" clojure-cycle-when]
+ ["Cycle not" clojure-cycle-not]
+ ("ns forms"
+ ["Insert ns form at the top" clojure-insert-ns-form]
+ ["Insert ns form here" clojure-insert-ns-form-at-point]
+ ["Update ns form" clojure-update-ns]
+ ["Sort ns form" clojure-sort-ns])
+ ("Convert collection"
+ ["Convert to list" clojure-convert-collection-to-list]
+ ["Convert to quoted list" clojure-convert-collection-to-quoted-list]
+ ["Convert to map" clojure-convert-collection-to-map]
+ ["Convert to vector" clojure-convert-collection-to-vector]
+ ["Convert to set" clojure-convert-collection-to-set])
+ ("Refactor -> and ->>"
+ ["Thread once more" clojure-thread]
+ ["Fully thread a form with ->" clojure-thread-first-all]
+ ["Fully thread a form with ->>" clojure-thread-last-all]
+ "--"
+ ["Unwind once" clojure-unwind]
+ ["Fully unwind a threading macro" clojure-unwind-all])
+ ("Let expression"
+ ["Introduce let" clojure-introduce-let]
+ ["Move to let" clojure-move-to-let]
+ ["Forward slurp form into let" clojure-let-forward-slurp-sexp]
+ ["Backward slurp form into let" clojure-let-backward-slurp-sexp])
+ ("Documentation"
+ ["View a Clojure guide" clojure-view-guide]
+ ["View a Clojure reference section" clojure-view-reference-section]
+ ["View the Clojure cheatsheet" clojure-view-cheatsheet]
+ ["View the Clojure Grimoire" clojure-view-grimoire]
+ ["View the Clojure style guide" clojure-view-style-guide])
+ "--"
+ ["Report a clojure-mode bug" clojure-mode-report-bug]
+ ["Clojure-mode version" clojure-mode-display-version]))
+ map)
+ "Keymap for Clojure mode.")
+
+(defvar clojure-mode-syntax-table
+ (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
+ (modify-syntax-entry ?\{ "(}" table)
+ (modify-syntax-entry ?\} "){" table)
+ (modify-syntax-entry ?\[ "(]" table)
+ (modify-syntax-entry ?\] ")[" table)
+ (modify-syntax-entry ?? "_ p" table) ; ? is a prefix outside symbols
+ (modify-syntax-entry ?# "_ p" table) ; # is allowed inside keywords (#399)
+ (modify-syntax-entry ?~ "'" table)
+ (modify-syntax-entry ?^ "'" table)
+ (modify-syntax-entry ?@ "'" table)
+ table)
+ "Syntax table for Clojure mode.
+Inherits from `emacs-lisp-mode-syntax-table'.")
+
+(defconst clojure--prettify-symbols-alist
+ '(("fn" . ?λ)))
+
+(defvar-local clojure-expected-ns-function nil
+ "The function used to determine the expected namespace of a file.
+`clojure-mode' ships a basic function named `clojure-expected-ns'
+that does basic heuristics to figure this out.
+CIDER provides a more complex version which does classpath analysis.")
+
+(defun clojure-mode-display-version ()
+ "Display the current `clojure-mode-version' in the minibuffer."
+ (interactive)
+ (message "clojure-mode (version %s)" clojure-mode-version))
+
+(defconst clojure-mode-report-bug-url "https://github.com/clojure-emacs/clojure-mode/issues/new"
+ "The URL to report a clojure-mode issue.")
+
+(defun clojure-mode-report-bug ()
+ "Report a bug in your default browser."
+ (interactive)
+ (browse-url clojure-mode-report-bug-url))
+
+(defconst clojure-guides-base-url "https://clojure.org/guides/"
+ "The base URL for official Clojure guides.")
+
+(defconst clojure-guides '(("Getting Started" . "getting_started")
+ ("FAQ" . "faq")
+ ("spec" . "spec")
+ ("Destructuring" . "destructuring")
+ ("Threading Macros" . "threading_macros")
+ ("Comparators" . "comparators")
+ ("Reader Conditionals" . "reader_conditionals"))
+ "A list of all official Clojure guides.")
+
+(defun clojure-view-guide ()
+ "Open a Clojure guide in your default browser.
+
+The command will prompt you to select one of the available guides."
+ (interactive)
+ (let ((guide (completing-read "Select a guide: " (mapcar #'car clojure-guides))))
+ (when guide
+ (let ((guide-url (concat clojure-guides-base-url (cdr (assoc guide clojure-guides)))))
+ (browse-url guide-url)))))
+
+(defconst clojure-reference-base-url "https://clojure.org/reference/"
+ "The base URL for the official Clojure reference.")
+
+(defconst clojure-reference-sections '(("The Reader" . "reader")
+ ("The REPL and main" . "repl_and_main")
+ ("Evaluation" . "evaluation")
+ ("Special Forms" . "special_forms")
+ ("Macros" . "macros")
+ ("Other Functions" . "other_functions")
+ ("Data Structures" . "data_structures")
+ ("Datatypes" . "datatypes")
+ ("Sequences" . "sequences")
+ ("Transients" . "transients")
+ ("Transducers" . "transducers")
+ ("Multimethods and Hierarchies" . "multimethods")
+ ("Protocols" . "protocols")
+ ("Metadata" . "metadata")
+ ("Namespaces" . "namespaces")
+ ("Libs" . "libs")
+ ("Vars and Environments" . "vars")
+ ("Refs and Transactions" . "refs")
+ ("Agents" . "agents")
+ ("Atoms" . "atoms")
+ ("Reducers" . "reducers")
+ ("Java Interop" . "java_interop")
+ ("Compilation and Class Generation" . "compilation")
+ ("Other Libraries" . "other_libraries")
+ ("Differences with Lisps" . "lisps")))
+
+(defun clojure-view-reference-section ()
+ "Open a Clojure reference section in your default browser.
+
+The command will prompt you to select one of the available sections."
+ (interactive)
+ (let ((section (completing-read "Select a reference section: " (mapcar #'car clojure-reference-sections))))
+ (when section
+ (let ((section-url (concat clojure-reference-base-url (cdr (assoc section clojure-reference-sections)))))
+ (browse-url section-url)))))
+
+(defconst clojure-cheatsheet-url "http://clojure.org/api/cheatsheet"
+ "The URL of the official Clojure cheatsheet.")
+
+(defun clojure-view-cheatsheet ()
+ "Open the Clojure cheatsheet in your default browser."
+ (interactive)
+ (browse-url clojure-cheatsheet-url))
+
+(defconst clojure-grimoire-url "https://www.conj.io/"
+ "The URL of the Grimoire community documentation site.")
+
+(defun clojure-view-grimoire ()
+ "Open the Clojure Grimoire in your default browser."
+ (interactive)
+ (browse-url clojure-grimoire-url))
+
+(defconst clojure-style-guide-url "https://github.com/bbatsov/clojure-style-guide"
+ "The URL of the Clojure style guide.")
+
+(defun clojure-view-style-guide ()
+ "Open the Clojure style guide in your default browser."
+ (interactive)
+ (browse-url clojure-style-guide-url))
+
+(defun clojure-space-for-delimiter-p (endp delim)
+ "Prevent paredit from inserting useless spaces.
+See `paredit-space-for-delimiter-predicates' for the meaning of
+ENDP and DELIM."
+ (or endp
+ (not (memq delim '(?\" ?{ ?\( )))
+ (not (or (derived-mode-p 'clojure-mode)
+ (derived-mode-p 'cider-repl-mode)))
+ (save-excursion
+ (backward-char)
+ (cond ((eq (char-after) ?#)
+ (and (not (bobp))
+ (or (char-equal ?w (char-syntax (char-before)))
+ (char-equal ?_ (char-syntax (char-before))))))
+ ((and (eq delim ?\()
+ (eq (char-after) ??)
+ (eq (char-before) ?#))
+ nil)
+ (t)))))
+
+(defun clojure-no-space-after-tag (endp delimiter)
+ "Prevent inserting a space after a reader-literal tag?
+
+When a reader-literal tag is followed be an opening delimiter
+listed in `clojure-omit-space-between-tag-and-delimiters', this
+function returns t.
+
+This allows you to write things like #db/id[:db.part/user]
+without inserting a space between the tag and the opening
+bracket.
+
+See `paredit-space-for-delimiter-predicates' for the meaning of
+ENDP and DELIMITER."
+ (if endp
+ t
+ (or (not (member delimiter clojure-omit-space-between-tag-and-delimiters))
+ (save-excursion
+ (let ((orig-point (point)))
+ (not (and (re-search-backward
+ "#\\([a-zA-Z0-9._-]+/\\)?[a-zA-Z0-9._-]+"
+ (line-beginning-position)
+ t)
+ (= orig-point (match-end 0)))))))))
+
+(declare-function paredit-open-curly "ext:paredit")
+(declare-function paredit-close-curly "ext:paredit")
+(declare-function paredit-convolute-sexp "ext:paredit")
+
+(defun clojure--replace-let-bindings-and-indent (orig-fun &rest args)
+ "Advise `paredit-convolute-sexp' to replace s-expressions with their bound name if a let form was convoluted."
+ (save-excursion
+ (backward-sexp)
+ (when (looking-back clojure--let-regexp)
+ (clojure--replace-sexps-with-bindings-and-indent))))
+
+(defun clojure-paredit-setup (&optional keymap)
+ "Make \"paredit-mode\" play nice with `clojure-mode'.
+
+If an optional KEYMAP is passed the changes are applied to it,
+instead of to `clojure-mode-map'.
+Also advice `paredit-convolute-sexp' when used on a let form as drop in
+replacement for `cljr-expand-let`."
+ (when (>= paredit-version 21)
+ (let ((keymap (or keymap clojure-mode-map)))
+ (define-key keymap "{" #'paredit-open-curly)
+ (define-key keymap "}" #'paredit-close-curly))
+ (add-to-list 'paredit-space-for-delimiter-predicates
+ #'clojure-space-for-delimiter-p)
+ (add-to-list 'paredit-space-for-delimiter-predicates
+ #'clojure-no-space-after-tag)
+ (advice-add 'paredit-convolute-sexp :after #'clojure--replace-let-bindings-and-indent)))
+
+(defun clojure-mode-variables ()
+ "Set up initial buffer-local variables for Clojure mode."
+ (add-to-list 'imenu-generic-expression '(nil clojure-match-next-def 0))
+ (setq-local indent-tabs-mode nil)
+ (setq-local paragraph-ignore-fill-prefix t)
+ (setq-local outline-regexp ";;;\\(;* [^ \t\n]\\)\\|(")
+ (setq-local outline-level 'lisp-outline-level)
+ (setq-local comment-start ";")
+ (setq-local comment-start-skip ";+ *")
+ (setq-local comment-add 1) ; default to `;;' in comment-region
+ (setq-local comment-column 40)
+ (setq-local comment-use-syntax t)
+ (setq-local multibyte-syntax-as-symbol t)
+ (setq-local electric-pair-skip-whitespace 'chomp)
+ (setq-local electric-pair-open-newline-between-pairs nil)
+ (setq-local fill-paragraph-function #'clojure-fill-paragraph)
+ (setq-local adaptive-fill-function #'clojure-adaptive-fill-function)
+ (setq-local normal-auto-fill-function #'clojure-auto-fill-function)
+ (setq-local comment-start-skip
+ "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
+ (setq-local indent-line-function #'clojure-indent-line)
+ (setq-local indent-region-function #'clojure-indent-region)
+ (setq-local lisp-indent-function #'clojure-indent-function)
+ (setq-local lisp-doc-string-elt-property 'clojure-doc-string-elt)
+ (setq-local clojure-expected-ns-function #'clojure-expected-ns)
+ (setq-local parse-sexp-ignore-comments t)
+ (setq-local prettify-symbols-alist clojure--prettify-symbols-alist)
+ (setq-local open-paren-in-column-0-is-defun-start nil))
+
+;;;###autoload
+(define-derived-mode clojure-mode prog-mode "Clojure"
+ "Major mode for editing Clojure code.
+
+\\{clojure-mode-map}"
+ (clojure-mode-variables)
+ (clojure-font-lock-setup)
+ (add-hook 'paredit-mode-hook #'clojure-paredit-setup))
+
+(defcustom clojure-verify-major-mode t
+ "If non-nil, warn when activating the wrong major-mode."
+ :type 'boolean
+ :safe #'booleanp
+ :package-version '(clojure-mode "5.3.0"))
+
+(defun clojure--check-wrong-major-mode ()
+ "Check if the current major-mode matches the file extension.
+If it doesn't, issue a warning if `clojure-verify-major-mode' is
+non-nil."
+ (when (and clojure-verify-major-mode
+ (stringp (buffer-file-name)))
+ (let* ((case-fold-search t)
+ (problem (cond ((and (string-match "\\.clj\\'" (buffer-file-name))
+ (not (eq major-mode 'clojure-mode)))
+ 'clojure-mode)
+ ((and (string-match "\\.cljs\\'" (buffer-file-name))
+ (not (eq major-mode 'clojurescript-mode)))
+ 'clojurescript-mode)
+ ((and (string-match "\\.cljc\\'" (buffer-file-name))
+ (not (eq major-mode 'clojurec-mode)))
+ 'clojurec-mode)
+ ((and (string-match "\\.cljx\\'" (buffer-file-name))
+ (not (eq major-mode 'clojurex-mode)))
+ 'clojurex-mode))))
+ (when problem
+ (message "[WARNING] %s activated `%s' instead of `%s' in this buffer.
+This could cause problems.
+\(See `clojure-verify-major-mode' to disable this message.)"
+ (if (eq major-mode real-this-command)
+ "You have"
+ "Something in your configuration")
+ major-mode
+ problem)))))
+
+(add-hook 'clojure-mode-hook #'clojure--check-wrong-major-mode)
+
+(defsubst clojure-in-docstring-p ()
+ "Check whether point is in a docstring."
+ (eq (get-text-property (point) 'face) 'font-lock-doc-face))
+
+(defsubst clojure-docstring-fill-prefix ()
+ "The prefix string used by `clojure-fill-paragraph'.
+
+It is simply `clojure-docstring-fill-prefix-width' number of spaces."
+ (make-string clojure-docstring-fill-prefix-width ? ))
+
+(defun clojure-adaptive-fill-function ()
+ "Clojure adaptive fill function.
+This only takes care of filling docstring correctly."
+ (when (clojure-in-docstring-p)
+ (clojure-docstring-fill-prefix)))
+
+(defun clojure-fill-paragraph (&optional justify)
+ "Like `fill-paragraph', but can handle Clojure docstrings.
+
+If JUSTIFY is non-nil, justify as well as fill the paragraph."
+ (if (clojure-in-docstring-p)
+ (let ((paragraph-start
+ (concat paragraph-start
+ "\\|\\s-*\\([(;:\"[]\\|~@\\|`(\\|#'(\\)"))
+ (paragraph-separate
+ (concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
+ (fill-column (or clojure-docstring-fill-column fill-column))
+ (fill-prefix (clojure-docstring-fill-prefix)))
+ (fill-paragraph justify))
+ (let ((paragraph-start (concat paragraph-start
+ "\\|\\s-*\\([(;:\"[]\\|`(\\|#'(\\)"))
+ (paragraph-separate
+ (concat paragraph-separate "\\|\\s-*\".*[,\\.[]$")))
+ (or (fill-comment-paragraph justify)
+ (fill-paragraph justify))
+ ;; Always return `t'
+ t)))
+
+(defun clojure-auto-fill-function ()
+ "Clojure auto-fill function."
+ ;; Check if auto-filling is meaningful.
+ (let ((fc (current-fill-column)))
+ (when (and fc (> (current-column) fc))
+ (let ((fill-column (if (clojure-in-docstring-p)
+ clojure-docstring-fill-column
+ fill-column))
+ (fill-prefix (clojure-adaptive-fill-function)))
+ (do-auto-fill)))))
+
+\f
+;;; #_ comments font-locking
+;; Code heavily borrowed from Slime.
+;; https://github.com/slime/slime/blob/master/contrib/slime-fontifying-fu.el#L186
+(defvar clojure--comment-macro-regexp
+ (rx "#_" (* " ") (group-n 1 (not (any " "))))
+ "Regexp matching the start of a comment sexp.
+The beginning of match-group 1 should be before the sexp to be
+marked as a comment. The end of sexp is found with
+`clojure-forward-logical-sexp'.
+
+By default, this only applies to code after the `#_' reader
+macro. In order to also font-lock the `(comment ...)' macro as a
+comment, you can set the value to:
+ \"#_ *\\\\(?1:[^ ]\\\\)\\\\|\\\\(?1:(comment\\\\_>\\\\)\"")
+
+(defun clojure--search-comment-macro-internal (limit)
+ (when (search-forward-regexp clojure--comment-macro-regexp limit t)
+ (let* ((md (match-data))
+ (start (match-beginning 1))
+ (state (syntax-ppss start)))
+ ;; inside string or comment?
+ (if (or (nth 3 state)
+ (nth 4 state))
+ (clojure--search-comment-macro-internal limit)
+ (goto-char start)
+ (clojure-forward-logical-sexp 1)
+ ;; Data for (match-end 1).
+ (setf (elt md 3) (point))
+ (set-match-data md)
+ t))))
+
+(defun clojure--search-comment-macro (limit)
+ "Find comment macros and set the match data.
+Search from point up to LIMIT. The region that should be
+considered a comment is between `(match-beginning 1)'
+and `(match-end 1)'."
+ (let ((result 'retry))
+ (while (and (eq result 'retry) (<= (point) limit))
+ (condition-case nil
+ (setq result (clojure--search-comment-macro-internal limit))
+ (end-of-file (setq result nil))
+ (scan-error (setq result 'retry))))
+ result))
+
+\f
+;;; General font-locking
+(defun clojure-match-next-def ()
+ "Scans the buffer backwards for the next \"top-level\" definition.
+Called by `imenu--generic-function'."
+ ;; we have to take into account namespace-definition forms
+ ;; e.g. s/defn
+ (when (re-search-backward "^(\\([a-z0-9.-]+/\\)?def\\sw*" nil t)
+ (save-excursion
+ (let (found?
+ (start (point)))
+ (down-list)
+ (forward-sexp)
+ (while (not found?)
+ (forward-sexp)
+ (or (if (char-equal ?[ (char-after (point)))
+ (backward-sexp))
+ (if (char-equal ?) (char-after (point)))
+ (backward-sexp)))
+ (cl-destructuring-bind (def-beg . def-end) (bounds-of-thing-at-point 'sexp)
+ (if (char-equal ?^ (char-after def-beg))
+ (progn (forward-sexp) (backward-sexp))
+ (setq found? t)
+ (set-match-data (list def-beg def-end)))))
+ (goto-char start)))))
+
+(eval-and-compile
+ (defconst clojure--sym-forbidden-rest-chars "][\";\'@\\^`~\(\)\{\}\\,\s\t\n\r"
+ "A list of chars that a Clojure symbol cannot contain.
+See definition of 'macros': URL `http://git.io/vRGLD'.")
+ (defconst clojure--sym-forbidden-1st-chars (concat clojure--sym-forbidden-rest-chars "0-9:")
+ "A list of chars that a Clojure symbol cannot start with.
+See the for-loop: URL `http://git.io/vRGTj' lines: URL
+`http://git.io/vRGIh', URL `http://git.io/vRGLE' and value
+definition of 'macros': URL `http://git.io/vRGLD'.")
+ (defconst clojure--sym-regexp
+ (concat "[^" clojure--sym-forbidden-1st-chars "][^" clojure--sym-forbidden-rest-chars "]*")
+ "A regexp matching a Clojure symbol or namespace alias.
+Matches the rule `clojure--sym-forbidden-1st-chars' followed by
+any number of matches of `clojure--sym-forbidden-rest-chars'."))
+
+(defconst clojure-font-lock-keywords
+ (eval-when-compile
+ `( ;; Top-level variable definition
+ (,(concat "(\\(?:clojure.core/\\)?\\("
+ (regexp-opt '("def" "defonce"))
+ ;; variable declarations
+ "\\)\\>"
+ ;; Any whitespace
+ "[ \r\n\t]*"
+ ;; Possibly type or metadata
+ "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*"
+ "\\(\\sw+\\)?")
+ (1 font-lock-keyword-face)
+ (2 font-lock-variable-name-face nil t))
+ ;; Type definition
+ (,(concat "(\\(?:clojure.core/\\)?\\("
+ (regexp-opt '("defstruct" "deftype" "defprotocol"
+ "defrecord"))
+ ;; type declarations
+ "\\)\\>"
+ ;; Any whitespace
+ "[ \r\n\t]*"
+ ;; Possibly type or metadata
+ "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*"
+ "\\(\\sw+\\)?")
+ (1 font-lock-keyword-face)
+ (2 font-lock-type-face nil t))
+ ;; Function definition (anything that starts with def and is not
+ ;; listed above)
+ (,(concat "(\\(?:" clojure--sym-regexp "/\\)?"
+ "\\(def[^ \r\n\t]*\\)"
+ ;; Function declarations
+ "\\>"
+ ;; Any whitespace
+ "[ \r\n\t]*"
+ ;; Possibly type or metadata
+ "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*"
+ "\\(\\sw+\\)?")
+ (1 font-lock-keyword-face)
+ (2 font-lock-function-name-face nil t))
+ ;; (fn name? args ...)
+ (,(concat "(\\(?:clojure.core/\\)?\\(fn\\)[ \t]+"
+ ;; Possibly type
+ "\\(?:#?^\\sw+[ \t]*\\)?"
+ ;; Possibly name
+ "\\(\\sw+\\)?" )
+ (1 font-lock-keyword-face)
+ (2 font-lock-function-name-face nil t))
+ ;; lambda arguments - %, %&, %1, %2, etc
+ ("\\<%[&1-9]?" (0 font-lock-variable-name-face))
+ ;; Special forms
+ (,(concat
+ "("
+ (regexp-opt
+ '("def" "do" "if" "let" "let*" "var" "fn" "fn*" "loop" "loop*"
+ "recur" "throw" "try" "catch" "finally"
+ "set!" "new" "."
+ "monitor-enter" "monitor-exit" "quote") t)
+ "\\>")
+ 1 font-lock-keyword-face)
+ ;; Built-in binding and flow of control forms
+ (,(concat
+ "(\\(?:clojure.core/\\)?"
+ (regexp-opt
+ '("letfn" "case" "cond" "cond->" "cond->>" "condp"
+ "for" "when" "when-not" "when-let" "when-first" "when-some"
+ "if-let" "if-not" "if-some"
+ ".." "->" "->>" "as->" "doto" "and" "or"
+ "dosync" "doseq" "dotimes" "dorun" "doall"
+ "ns" "in-ns"
+ "with-open" "with-local-vars" "binding"
+ "with-redefs" "with-redefs-fn"
+ "declare") t)
+ "\\>")
+ 1 font-lock-keyword-face)
+ ;; Macros similar to let, when, and while
+ (,(rx symbol-start
+ (or "let" "when" "while") "-"
+ (1+ (or (syntax word) (syntax symbol)))
+ symbol-end)
+ 0 font-lock-keyword-face)
+ (,(concat
+ "\\<"
+ (regexp-opt
+ '("*1" "*2" "*3" "*agent*"
+ "*allow-unresolved-vars*" "*assert*" "*clojure-version*"
+ "*command-line-args*" "*compile-files*"
+ "*compile-path*" "*data-readers*" "*default-data-reader-fn*"
+ "*e" "*err*" "*file*" "*flush-on-newline*"
+ "*in*" "*macro-meta*" "*math-context*" "*ns*" "*out*"
+ "*print-dup*" "*print-length*" "*print-level*"
+ "*print-meta*" "*print-readably*"
+ "*read-eval*" "*source-path*"
+ "*unchecked-math*"
+ "*use-context-classloader*" "*warn-on-reflection*")
+ t)
+ "\\>")
+ 0 font-lock-builtin-face)
+ ;; Dynamic variables - *something* or @*something*
+ ("\\(?:\\<\\|/\\)@?\\(\\*[a-z-]*\\*\\)\\>" 1 font-lock-variable-name-face)
+ ;; Global constants - nil, true, false
+ (,(concat
+ "\\<"
+ (regexp-opt
+ '("true" "false" "nil") t)
+ "\\>")
+ 0 font-lock-constant-face)
+ ;; Character literals - \1, \a, \newline, \u0000
+ ("\\\\\\([[:punct:]]\\|[a-z0-9]+\\>\\)" 0 'clojure-character-face)
+ ;; foo/ Foo/ @Foo/ /FooBar
+ (,(concat "\\(?:\\<:?\\|\\.\\)@?\\(" clojure--sym-regexp "\\)\\(/\\)")
+ (1 font-lock-type-face) (2 'default))
+ ;; Constant values (keywords), including as metadata e.g. ^:static
+ ("\\<^?\\(:\\(\\sw\\|\\s_\\)+\\(\\>\\|\\_>\\)\\)" 1 'clojure-keyword-face append)
+ ;; Java interop highlighting
+ ;; CONST SOME_CONST (optionally prefixed by /)
+ ("\\(?:\\<\\|/\\)\\([A-Z]+\\|\\([A-Z]+_[A-Z1-9_]+\\)\\)\\>" 1 font-lock-constant-face)
+ ;; .foo .barBaz .qux01 .-flibble .-flibbleWobble
+ ("\\<\\.-?[a-z][a-zA-Z0-9]*\\>" 0 'clojure-interop-method-face)
+ ;; Foo Bar$Baz Qux_ World_OpenUDP Foo. Babylon15.
+ ("\\(?:\\<\\|\\.\\|/\\|#?^\\)\\([A-Z][a-zA-Z0-9_]*[a-zA-Z0-9$_]+\\.?\\>\\)" 1 font-lock-type-face)
+ ;; foo.bar.baz
+ ("\\<^?\\([a-z][a-z0-9_-]+\\.\\([a-z][a-z0-9_-]*\\.?\\)+\\)" 1 font-lock-type-face)
+ ;; (ns namespace) - special handling for single segment namespaces
+ (,(concat "(\\<ns\\>[ \r\n\t]*"
+ ;; Possibly metadata
+ "\\(?:\\^?{[^}]+}[ \r\n\t]*\\)*"
+ ;; namespace
+ "\\([a-z0-9-]+\\)")
+ (1 font-lock-type-face nil t))
+ ;; fooBar
+ ("\\(?:\\<\\|/\\)\\([a-z]+[A-Z]+[a-zA-Z0-9$]*\\>\\)" 1 'clojure-interop-method-face)
+ ;; #_ and (comment ...) macros.
+ (clojure--search-comment-macro 1 font-lock-comment-face t)
+ ;; Highlight `code` marks, just like `elisp'.
+ (,(rx "`" (group-n 1 (optional "#'")
+ (+ (or (syntax symbol) (syntax word)))) "`")
+ (1 'font-lock-constant-face prepend))
+ ;; Highlight escaped characters in strings.
+ (clojure-font-lock-escaped-chars 0 'bold prepend)
+ ;; Highlight grouping constructs in regular expressions
+ (clojure-font-lock-regexp-groups
+ (1 'font-lock-regexp-grouping-construct prepend))))
+ "Default expressions to highlight in Clojure mode.")
+
+(defun clojure-font-lock-syntactic-face-function (state)
+ "Find and highlight text with a Clojure-friendly syntax table.
+
+This function is passed to `font-lock-syntactic-face-function',
+which is called with a single parameter, STATE (which is, in
+turn, returned by `parse-partial-sexp' at the beginning of the
+highlighted region)."
+ (if (nth 3 state)
+ ;; This might be a (doc)string or a |...| symbol.
+ (let ((startpos (nth 8 state)))
+ (if (eq (char-after startpos) ?|)
+ ;; This is not a string, but a |...| symbol.
+ nil
+ (let* ((listbeg (nth 1 state))
+ (firstsym (and listbeg
+ (save-excursion
+ (goto-char listbeg)
+ (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
+ (match-string 1)))))
+ (docelt (and firstsym
+ (function-get (intern-soft firstsym)
+ lisp-doc-string-elt-property))))
+ (if (and docelt
+ ;; It's a string in a form that can have a docstring.
+ ;; Check whether it's in docstring position.
+ (save-excursion
+ (when (functionp docelt)
+ (goto-char (match-end 1))
+ (setq docelt (funcall docelt)))
+ (goto-char listbeg)
+ (forward-char 1)
+ (condition-case nil
+ (while (and (> docelt 0) (< (point) startpos)
+ (progn (forward-sexp 1) t))
+ ;; ignore metadata and type hints
+ (unless (looking-at "[ \n\t]*\\(\\^[A-Z:].+\\|\\^?{.+\\)")
+ (setq docelt (1- docelt))))
+ (error nil))
+ (and (zerop docelt) (<= (point) startpos)
+ (progn (forward-comment (point-max)) t)
+ (= (point) (nth 8 state)))))
+ font-lock-doc-face
+ font-lock-string-face))))
+ font-lock-comment-face))
+
+(defun clojure-font-lock-setup ()
+ "Configures font-lock for editing Clojure code."
+ (setq-local font-lock-multiline t)
+ (add-to-list 'font-lock-extend-region-functions
+ #'clojure-font-lock-extend-region-def t)
+ (setq font-lock-defaults
+ '(clojure-font-lock-keywords ; keywords
+ nil nil
+ (("+-*/.<>=!?$%_&:" . "w")) ; syntax alist
+ nil
+ (font-lock-mark-block-function . mark-defun)
+ (font-lock-syntactic-face-function
+ . clojure-font-lock-syntactic-face-function))))
+
+(defun clojure-font-lock-def-at-point (point)
+ "Range between the top-most def* and the fourth element after POINT.
+Note that this means that there is no guarantee of proper font
+locking in def* forms that are not at top level."
+ (goto-char point)
+ (condition-case nil
+ (beginning-of-defun)
+ (error nil))
+
+ (let ((beg-def (point)))
+ (when (and (not (= point beg-def))
+ (looking-at "(def"))
+ (condition-case nil
+ (progn
+ ;; move forward as much as possible until failure (or success)
+ (forward-char)
+ (dotimes (_ 4)
+ (forward-sexp)))
+ (error nil))
+ (cons beg-def (point)))))
+
+(defun clojure-font-lock-extend-region-def ()
+ "Set region boundaries to include the first four elements of def* forms."
+ (let ((changed nil))
+ (let ((def (clojure-font-lock-def-at-point font-lock-beg)))
+ (when def
+ (cl-destructuring-bind (def-beg . def-end) def
+ (when (and (< def-beg font-lock-beg)
+ (< font-lock-beg def-end))
+ (setq font-lock-beg def-beg
+ changed t)))))
+ (let ((def (clojure-font-lock-def-at-point font-lock-end)))
+ (when def
+ (cl-destructuring-bind (def-beg . def-end) def
+ (when (and (< def-beg font-lock-end)
+ (< font-lock-end def-end))
+ (setq font-lock-end def-end
+ changed t)))))
+ changed))
+
+(defun clojure--font-locked-as-string-p (&optional regexp)
+ "Non-nil if the char before point is font-locked as a string.
+If REGEXP is non-nil, also check whether current string is
+preceeded by a #."
+ (let ((face (get-text-property (1- (point)) 'face)))
+ (and (or (and (listp face)
+ (memq 'font-lock-string-face face))
+ (eq 'font-lock-string-face face))
+ (or (clojure-string-start t)
+ (unless regexp
+ (clojure-string-start nil))))))
+
+(defun clojure-font-lock-escaped-chars (bound)
+ "Highlight \escaped chars in strings.
+BOUND denotes a buffer position to limit the search."
+ (let ((found nil))
+ (while (and (not found)
+ (re-search-forward "\\\\." bound t))
+
+ (setq found (clojure--font-locked-as-string-p)))
+ found))
+
+(defun clojure-font-lock-regexp-groups (bound)
+ "Highlight grouping constructs in regular expression.
+
+BOUND denotes the maximum number of characters (relative to the
+point) to check."
+ (let ((found nil))
+ (while (and (not found)
+ (re-search-forward (eval-when-compile
+ (concat
+ ;; A group may start using several alternatives:
+ "\\(\\(?:"
+ ;; 1. (? special groups
+ "(\\?\\(?:"
+ ;; a) non-capturing group (?:X)
+ ;; b) independent non-capturing group (?>X)
+ ;; c) zero-width positive lookahead (?=X)
+ ;; d) zero-width negative lookahead (?!X)
+ "[:=!>]\\|"
+ ;; e) zero-width positive lookbehind (?<=X)
+ ;; f) zero-width negative lookbehind (?<!X)
+ "<[=!]\\|"
+ ;; g) named capturing group (?<name>X)
+ "<[[:alnum:]]+>"
+ "\\)\\|" ;; end of special groups
+ ;; 2. normal capturing groups (
+ ;; 3. we also highlight alternative
+ ;; separarators |, and closing parens )
+ "[|()]"
+ "\\)\\)"))
+ bound t))
+ (setq found (clojure--font-locked-as-string-p 'regexp)))
+ found))
+
+;; Docstring positions
+(put 'ns 'clojure-doc-string-elt 2)
+(put 'def 'clojure-doc-string-elt 2)
+(put 'defn 'clojure-doc-string-elt 2)
+(put 'defn- 'clojure-doc-string-elt 2)
+(put 'defmulti 'clojure-doc-string-elt 2)
+(put 'defmacro 'clojure-doc-string-elt 2)
+(put 'definline 'clojure-doc-string-elt 2)
+(put 'defprotocol 'clojure-doc-string-elt 2)
+
+;;; Vertical alignment
+(defcustom clojure-align-forms-automatically nil
+ "If non-nil, vertically align some forms automatically.
+Automatically means it is done as part of indenting code. This
+applies to binding forms (`clojure-align-binding-forms'), to cond
+forms (`clojure-align-cond-forms') and to map literals. For
+instance, selecting a map a hitting \\<clojure-mode-map>`\\[indent-for-tab-command]'
+will align the values like this:
+ {:some-key 10
+ :key2 20}"
+ :package-version '(clojure-mode . "5.1")
+ :safe #'booleanp
+ :type 'boolean)
+
+(defcustom clojure-align-binding-forms
+ '("let" "when-let" "when-some" "if-let" "if-some" "binding" "loop"
+ "doseq" "for" "with-open" "with-local-vars" "with-redefs")
+ "List of strings matching forms that have binding forms."
+ :package-version '(clojure-mode . "5.1")
+ :safe #'listp
+ :type '(repeat string))
+
+(defcustom clojure-align-cond-forms '("condp" "cond" "cond->" "cond->>" "case" "are")
+ "List of strings identifying cond-like forms."
+ :package-version '(clojure-mode . "5.1")
+ :safe #'listp
+ :type '(repeat string))
+
+(defun clojure--position-for-alignment ()
+ "Non-nil if the sexp around point should be automatically aligned.
+This function expects to be called immediately after an
+open-brace or after the function symbol in a function call.
+
+First check if the sexp around point is a map literal, or is a
+call to one of the vars listed in `clojure-align-cond-forms'. If
+it isn't, return nil. If it is, return non-nil and place point
+immediately before the forms that should be aligned.
+
+For instance, in a map literal point is left immediately before
+the first key; while, in a let-binding, point is left inside the
+binding vector and immediately before the first binding
+construct."
+ ;; Are we in a map?
+ (or (and (eq (char-before) ?{)
+ (not (eq (char-before (1- (point))) ?\#)))
+ ;; Are we in a cond form?
+ (let* ((fun (car (member (thing-at-point 'symbol) clojure-align-cond-forms)))
+ (method (and fun (clojure--get-indent-method fun)))
+ ;; The number of special arguments in the cond form is
+ ;; the number of sexps we skip before aligning.
+ (skip (cond ((numberp method) method)
+ ((null method) 0)
+ ((sequencep method) (elt method 0)))))
+ (when (and fun (numberp skip))
+ (clojure-forward-logical-sexp skip)
+ (comment-forward (point-max))
+ fun)) ; Return non-nil (the var name).
+ ;; Are we in a let-like form?
+ (when (member (thing-at-point 'symbol)
+ clojure-align-binding-forms)
+ ;; Position inside the binding vector.
+ (clojure-forward-logical-sexp)
+ (backward-sexp)
+ (when (eq (char-after) ?\[)
+ (forward-char 1)
+ (comment-forward (point-max))
+ ;; Return non-nil.
+ t))))
+
+(defun clojure--find-sexp-to-align (end)
+ "Non-nil if there's a sexp ahead to be aligned before END.
+Place point as in `clojure--position-for-alignment'."
+ ;; Look for a relevant sexp.
+ (let ((found))
+ (while (and (not found)
+ (search-forward-regexp
+ (concat "{\\|(" (regexp-opt
+ (append clojure-align-binding-forms
+ clojure-align-cond-forms)
+ 'symbols))
+ end 'noerror))
+
+ (let ((ppss (syntax-ppss)))
+ ;; If we're in a string or comment.
+ (unless (or (elt ppss 3)
+ (elt ppss 4))
+ ;; Only stop looking if we successfully position
+ ;; the point.
+ (setq found (clojure--position-for-alignment)))))
+ found))
+
+(defun clojure--search-whitespace-after-next-sexp (&optional bound _noerror)
+ "Move point after all whitespace after the next sexp.
+Set the match data group 1 to be this region of whitespace and
+return point."
+ (unwind-protect
+ (ignore-errors
+ (clojure-forward-logical-sexp 1)
+ (search-forward-regexp "\\([,\s\t]*\\)" bound)
+ (pcase (syntax-after (point))
+ ;; End-of-line, try again on next line.
+ (`(12) (clojure--search-whitespace-after-next-sexp bound))
+ ;; Closing paren, stop here.
+ (`(5 . ,_) nil)
+ ;; Anything else is something to align.
+ (_ (point))))
+ (when (and bound (> (point) bound))
+ (goto-char bound))))
+
+(defun clojure-align (beg end)
+ "Vertically align the contents of the sexp around point.
+If region is active, align it. Otherwise, align everything in the
+current \"top-level\" sexp.
+When called from lisp code align everything between BEG and END."
+ (interactive (if (use-region-p)
+ (list (region-beginning) (region-end))
+ (save-excursion
+ (let ((end (progn (end-of-defun)
+ (point))))
+ (clojure-backward-logical-sexp)
+ (list (point) end)))))
+ (setq end (copy-marker end))
+ (save-excursion
+ (goto-char beg)
+ (while (clojure--find-sexp-to-align end)
+ (let ((sexp-end (save-excursion
+ (backward-up-list)
+ (forward-sexp 1)
+ (point-marker)))
+ (clojure-align-forms-automatically nil)
+ (count 1))
+ ;; For some bizarre reason, we need to `align-region' once for each
+ ;; group.
+ (save-excursion
+ (while (search-forward-regexp "^ *\n" sexp-end 'noerror)
+ (cl-incf count)))
+ (dotimes (_ count)
+ (align-region (point) sexp-end nil
+ '((clojure-align (regexp . clojure--search-whitespace-after-next-sexp)
+ (group . 1)
+ (separate . "^ *$")
+ (repeat . t)))
+ nil))
+ ;; Reindent after aligning because of #360.
+ (indent-region (point) sexp-end)))))
+
+;;; Indentation
+(defun clojure-indent-region (beg end)
+ "Like `indent-region', but also maybe align forms.
+Forms between BEG and END are aligned according to
+`clojure-align-forms-automatically'."
+ (prog1 (let ((indent-region-function nil))
+ (indent-region beg end))
+ (when clojure-align-forms-automatically
+ (condition-case nil
+ (clojure-align beg end)
+ (scan-error nil)))))
+
+(defun clojure-indent-line ()
+ "Indent current line as Clojure code."
+ (if (clojure-in-docstring-p)
+ (save-excursion
+ (beginning-of-line)
+ (when (and (looking-at "^\\s-*")
+ (<= (string-width (match-string-no-properties 0))
+ (string-width (clojure-docstring-fill-prefix))))
+ (replace-match (clojure-docstring-fill-prefix))))
+ (lisp-indent-line)))
+
+(defvar clojure-get-indent-function nil
+ "Function to get the indent spec of a symbol.
+This function should take one argument, the name of the symbol as
+a string. This name will be exactly as it appears in the buffer,
+so it might start with a namespace alias.
+
+This function is analogous to the `clojure-indent-function'
+symbol property, and its return value should match one of the
+allowed values of this property. See `clojure-indent-function'
+for more information.")
+
+(defun clojure--get-indent-method (function-name)
+ "Return the indent spec for the symbol named FUNCTION-NAME.
+FUNCTION-NAME is a string. If it contains a `/', also try only
+the part after the `/'.
+
+Look for a spec using `clojure-get-indent-function', then try the
+`clojure-indent-function' and `clojure-backtracking-indent'
+symbol properties."
+ (or (when (functionp clojure-get-indent-function)
+ (funcall clojure-get-indent-function function-name))
+ (get (intern-soft function-name) 'clojure-indent-function)
+ (get (intern-soft function-name) 'clojure-backtracking-indent)
+ (when (string-match "/\\([^/]+\\)\\'" function-name)
+ (or (get (intern-soft (match-string 1 function-name))
+ 'clojure-indent-function)
+ (get (intern-soft (match-string 1 function-name))
+ 'clojure-backtracking-indent)))
+ (when (string-match (rx (or "let" "when" "while") (syntax symbol))
+ function-name)
+ (clojure--get-indent-method (substring (match-string 0 function-name) 0 -1)))))
+
+(defvar clojure--current-backtracking-depth 0)
+
+(defun clojure--find-indent-spec-backtracking ()
+ "Return the indent sexp that applies to the sexp at point.
+Implementation function for `clojure--find-indent-spec'."
+ (when (and (>= clojure-max-backtracking clojure--current-backtracking-depth)
+ (not (looking-at "^")))
+ (let ((clojure--current-backtracking-depth (1+ clojure--current-backtracking-depth))
+ (pos 0))
+ ;; Count how far we are from the start of the sexp.
+ (while (ignore-errors (clojure-backward-logical-sexp 1)
+ (not (or (bobp)
+ (eq (char-before) ?\n))))
+ (cl-incf pos))
+ (let* ((function (thing-at-point 'symbol))
+ (method (or (when function ;; Is there a spec here?
+ (clojure--get-indent-method function))
+ (ignore-errors
+ ;; Otherwise look higher up.
+ (pcase (syntax-ppss)
+ (`(,(pred (< 0)) ,start . ,_)
+ (goto-char start)
+ (clojure--find-indent-spec-backtracking)))))))
+ (when (numberp method)
+ (setq method (list method)))
+ (pcase method
+ ((pred functionp)
+ (when (= pos 0)
+ method))
+ ((pred sequencep)
+ (pcase (length method)
+ (`0 nil)
+ (`1 (let ((head (elt method 0)))
+ (when (or (= pos 0) (sequencep head))
+ head)))
+ (l (if (>= pos l)
+ (elt method (1- l))
+ (elt method pos)))))
+ ((or `defun `:defn)
+ (when (= pos 0)
+ :defn))
+ (_
+ (message "Invalid indent spec for `%s': %s" function method)
+ nil))))))
+
+(defun clojure--find-indent-spec ()
+ "Return the indent spec that applies to current sexp.
+If `clojure-use-backtracking-indent' is non-nil, also do
+backtracking up to a higher-level sexp in order to find the
+spec."
+ (if clojure-use-backtracking-indent
+ (save-excursion
+ (clojure--find-indent-spec-backtracking))
+ (let ((function (thing-at-point 'symbol)))
+ (clojure--get-indent-method function))))
+
+(defun clojure--normal-indent (last-sexp indent-mode)
+ "Return the normal indentation column for a sexp.
+Point should be after the open paren of the _enclosing_ sexp, and
+LAST-SEXP is the start of the previous sexp (immediately before
+the sexp being indented). INDENT-MODE is any of the values
+accepted by `clojure-indent-style'."
+ (goto-char last-sexp)
+ (forward-sexp 1)
+ (clojure-backward-logical-sexp 1)
+ (let ((last-sexp-start nil))
+ (if (ignore-errors
+ ;; `backward-sexp' until we reach the start of a sexp that is the
+ ;; first of its line (the start of the enclosing sexp).
+ (while (string-match
+ "[^[:blank:]]"
+ (buffer-substring (line-beginning-position) (point)))
+ (setq last-sexp-start (prog1 (point)
+ (forward-sexp -1))))
+ t)
+ ;; Here we have found an arg before the arg we're indenting which is at
+ ;; the start of a line. Every mode simply aligns on this case.
+ (current-column)
+ ;; Here we have reached the start of the enclosing sexp (point is now at
+ ;; the function name), so the behaviour depends on INDENT-MODE and on
+ ;; whether there's also an argument on this line (case A or B).
+ (let ((case-a ; The meaning of case-a is explained in `clojure-indent-style'.
+ (and last-sexp-start
+ (< last-sexp-start (line-end-position)))))
+ (cond
+ ;; For compatibility with the old `clojure-defun-style-default-indent', any
+ ;; value other than these 3 is equivalent to `always-body'.
+ ((not (memq indent-mode '(:always-align :align-arguments nil)))
+ (+ (current-column) lisp-body-indent -1))
+ ;; There's an arg after the function name, so align with it.
+ (case-a (goto-char last-sexp-start)
+ (current-column))
+ ;; Not same line.
+ ((eq indent-mode :align-arguments)
+ (+ (current-column) lisp-body-indent -1))
+ ;; Finally, just align with the function name.
+ (t (current-column)))))))
+
+(defun clojure--not-function-form-p ()
+ "Non-nil if form at point doesn't represent a function call."
+ (or (member (char-after) '(?\[ ?\{))
+ (save-excursion ;; Catch #?@ (:cljs ...)
+ (skip-chars-backward "\r\n[:blank:]")
+ (when (eq (char-before) ?@)
+ (forward-char -1))
+ (and (eq (char-before) ?\?)
+ (eq (char-before (1- (point))) ?\#)))
+ ;; Car of form is not a symbol.
+ (not (looking-at ".\\(?:\\sw\\|\\s_\\)"))))
+
+;; Check the general context, and provide indentation for data structures and
+;; special macros. If current form is a function (or non-special macro),
+;; delegate indentation to `clojure--normal-indent'.
+(defun clojure-indent-function (indent-point state)
+ "When indenting a line within a function call, indent properly.
+
+INDENT-POINT is the position where the user typed TAB, or equivalent.
+Point is located at the point to indent under (for default indentation);
+STATE is the `parse-partial-sexp' state for that position.
+
+If the current line is in a call to a Clojure function with a
+non-nil property `clojure-indent-function', that specifies how to do
+the indentation.
+
+The property value can be
+
+- `defun', meaning indent `defun'-style;
+- an integer N, meaning indent the first N arguments specially
+ like ordinary function arguments and then indent any further
+ arguments like a body;
+- a function to call just as this function was called.
+ If that function returns nil, that means it doesn't specify
+ the indentation.
+- a list, which is used by `clojure-backtracking-indent'.
+
+This function also returns nil meaning don't specify the indentation."
+ ;; Goto to the open-paren.
+ (goto-char (elt state 1))
+ ;; Maps, sets, vectors and reader conditionals.
+ (if (clojure--not-function-form-p)
+ (1+ (current-column))
+ ;; Function or macro call.
+ (forward-char 1)
+ (let ((method (clojure--find-indent-spec))
+ (last-sexp calculate-lisp-indent-last-sexp)
+ (containing-form-column (1- (current-column))))
+ (pcase method
+ ((or (pred integerp) `(,method))
+ (let ((pos -1))
+ (condition-case nil
+ (while (and (<= (point) indent-point)
+ (not (eobp)))
+ (clojure-forward-logical-sexp 1)
+ (cl-incf pos))
+ ;; If indent-point is _after_ the last sexp in the
+ ;; current sexp, we detect that by catching the
+ ;; `scan-error'. In that case, we should return the
+ ;; indentation as if there were an extra sexp at point.
+ (scan-error (cl-incf pos)))
+ (cond
+ ;; The first non-special arg. Rigidly reduce indentation.
+ ((= pos (1+ method))
+ (+ lisp-body-indent containing-form-column))
+ ;; Further non-special args, align with the arg above.
+ ((> pos (1+ method))
+ (clojure--normal-indent last-sexp :always-align))
+ ;; Special arg. Rigidly indent with a large indentation.
+ (t
+ (+ (* 2 lisp-body-indent) containing-form-column)))))
+ (`:defn
+ (+ lisp-body-indent containing-form-column))
+ ((pred functionp)
+ (funcall method indent-point state))
+ ;; No indent spec, do the default.
+ (`nil
+ (let ((function (thing-at-point 'symbol)))
+ (cond
+ ;; Preserve useful alignment of :require (and friends) in `ns' forms.
+ ((and function (string-match "^:" function))
+ (clojure--normal-indent last-sexp :always-align))
+ ;; This is should be identical to the :defn above.
+ ((and function
+ (string-match "\\`\\(?:\\S +/\\)?\\(def[a-z]*\\|with-\\)"
+ function)
+ (not (string-match "\\`default" (match-string 1 function))))
+ (+ lisp-body-indent containing-form-column))
+ ;; Finally, nothing special here, just respect the user's
+ ;; preference.
+ (t (clojure--normal-indent last-sexp clojure-indent-style)))))))))
+
+;;; Setting indentation
+(defun put-clojure-indent (sym indent)
+ "Instruct `clojure-indent-function' to indent the body of SYM by INDENT."
+ (put sym 'clojure-indent-function indent))
+
+(defmacro define-clojure-indent (&rest kvs)
+ "Call `put-clojure-indent' on a series, KVS."
+ `(progn
+ ,@(mapcar (lambda (x) `(put-clojure-indent
+ (quote ,(car x)) ,(cadr x)))
+ kvs)))
+
+(defun add-custom-clojure-indents (name value)
+ "Allow `clojure-defun-indents' to indent user-specified macros.
+
+Requires the macro's NAME and a VALUE."
+ (custom-set-default name value)
+ (mapcar (lambda (x)
+ (put-clojure-indent x 'defun))
+ value))
+
+(defcustom clojure-defun-indents nil
+ "List of additional symbols with defun-style indentation in Clojure.
+
+You can use this to let Emacs indent your own macros the same way
+that it indents built-in macros like with-open. This variable
+only works when set via the customize interface (`setq' won't
+work). To set it from Lisp code, use
+ (put-clojure-indent \\='some-symbol :defn)."
+ :type '(repeat symbol)
+ :set 'add-custom-clojure-indents)
+
+(define-clojure-indent
+ ;; built-ins
+ (ns 1)
+ (fn :defn)
+ (def :defn)
+ (defn :defn)
+ (bound-fn :defn)
+ (if 1)
+ (if-not 1)
+ (case 1)
+ (cond 0)
+ (condp 2)
+ (cond-> 1)
+ (cond->> 1)
+ (when 1)
+ (while 1)
+ (when-not 1)
+ (when-first 1)
+ (do 0)
+ (future 0)
+ (comment 0)
+ (doto 1)
+ (locking 1)
+ (proxy '(2 nil nil (:defn)))
+ (as-> 2)
+
+ (reify '(:defn (1)))
+ (deftype '(2 nil nil (:defn)))
+ (defrecord '(2 nil nil (:defn)))
+ (defprotocol '(1 (:defn)))
+ (definterface '(1 (:defn)))
+ (extend 1)
+ (extend-protocol '(1 :defn))
+ (extend-type '(1 :defn))
+ ;; specify and specify! are from ClojureScript
+ (specify '(1 :defn))
+ (specify! '(1 :defn))
+ (try 0)
+ (catch 2)
+ (finally 0)
+
+ ;; binding forms
+ (let 1)
+ (letfn '(1 ((:defn)) nil))
+ (binding 1)
+ (loop 1)
+ (for 1)
+ (doseq 1)
+ (dotimes 1)
+ (when-let 1)
+ (if-let 1)
+ (when-some 1)
+ (if-some 1)
+ (this-as 1) ; ClojureScript
+
+ (defmethod :defn)
+
+ ;; clojure.test
+ (testing 1)
+ (deftest :defn)
+ (are 2)
+ (use-fixtures :defn)
+
+ ;; core.logic
+ (run :defn)
+ (run* :defn)
+ (fresh :defn)
+
+ ;; core.async
+ (alt! 0)
+ (alt!! 0)
+ (go 0)
+ (go-loop 1)
+ (thread 0))
+
+\f
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Better docstring filling for clojure-mode
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun clojure-string-start (&optional regex)
+ "Return the position of the \" that begins the string at point.
+If REGEX is non-nil, return the position of the # that begins the
+regex at point. If point is not inside a string or regex, return
+nil."
+ (when (nth 3 (syntax-ppss)) ;; Are we really in a string?
+ (save-excursion
+ (save-match-data
+ ;; Find a quote that appears immediately after whitespace,
+ ;; beginning of line, hash, or an open paren, brace, or bracket
+ (re-search-backward "\\(\\s-\\|^\\|#\\|(\\|\\[\\|{\\)\\(\"\\)")
+ (let ((beg (match-beginning 2)))
+ (when beg
+ (if regex
+ (and (char-before beg) (eq ?# (char-before beg)) (1- beg))
+ (when (not (eq ?# (char-before beg)))
+ beg))))))))
+
+(defun clojure-char-at-point ()
+ "Return the char at point or nil if at buffer end."
+ (when (not (= (point) (point-max)))
+ (buffer-substring-no-properties (point) (1+ (point)))))
+
+(defun clojure-char-before-point ()
+ "Return the char before point or nil if at buffer beginning."
+ (when (not (= (point) (point-min)))
+ (buffer-substring-no-properties (point) (1- (point)))))
+
+(defun clojure-toggle-keyword-string ()
+ "Convert the string or keyword at point to keyword or string."
+ (interactive)
+ (let ((original-point (point)))
+ (while (and (> (point) 1)
+ (not (equal "\"" (buffer-substring-no-properties (point) (+ 1 (point)))))
+ (not (equal ":" (buffer-substring-no-properties (point) (+ 1 (point))))))
+ (backward-char))
+ (cond
+ ((equal 1 (point))
+ (error "Beginning of file reached, this was probably a mistake"))
+ ((equal "\"" (buffer-substring-no-properties (point) (+ 1 (point))))
+ (insert ":" (substring (clojure-delete-and-extract-sexp) 1 -1)))
+ ((equal ":" (buffer-substring-no-properties (point) (+ 1 (point))))
+ (insert "\"" (substring (clojure-delete-and-extract-sexp) 1) "\"")))
+ (goto-char original-point)))
+
+(defun clojure-delete-and-extract-sexp ()
+ "Delete the surrounding sexp and return it."
+ (let ((begin (point)))
+ (forward-sexp)
+ (let ((result (buffer-substring begin (point))))
+ (delete-region begin (point))
+ result)))
+
+\f
+
+(defun clojure-project-dir (&optional dir-name)
+ "Return the absolute path to the project's root directory.
+
+Use `default-directory' if DIR-NAME is nil.
+Return nil if not inside a project."
+ (let* ((dir-name (or dir-name default-directory))
+ (choices (delq nil
+ (mapcar (lambda (fname)
+ (locate-dominating-file dir-name fname))
+ clojure-build-tool-files))))
+ (when (> (length choices) 0)
+ (car (sort choices #'file-in-directory-p)))))
+
+(defun clojure-project-relative-path (path)
+ "Denormalize PATH by making it relative to the project root."
+ (file-relative-name path (clojure-project-dir)))
+
+\f
+;;; ns manipulation
+(defun clojure-expected-ns (&optional path)
+ "Return the namespace matching PATH.
+
+PATH is expected to be an absolute file path.
+
+If PATH is nil, use the path to the file backing the current buffer."
+ (let* ((path (or path (file-truename (buffer-file-name))))
+ (relative (clojure-project-relative-path path))
+ (sans-file-type (substring relative 0 (- (length (file-name-extension path t)))))
+ (sans-file-sep (mapconcat 'identity (cdr (split-string sans-file-type "/")) "."))
+ (sans-underscores (replace-regexp-in-string "_" "-" sans-file-sep)))
+ ;; Drop prefix from ns for projects with structure src/{clj,cljs,cljc}
+ (replace-regexp-in-string "\\`clj[scx]?\\." "" sans-underscores)))
+
+(defun clojure-insert-ns-form-at-point ()
+ "Insert a namespace form at point."
+ (interactive)
+ (insert (format "(ns %s)" (funcall clojure-expected-ns-function))))
+
+(defun clojure-insert-ns-form ()
+ "Insert a namespace form at the beginning of the buffer."
+ (interactive)
+ (widen)
+ (goto-char (point-min))
+ (clojure-insert-ns-form-at-point))
+
+(defun clojure-update-ns ()
+ "Update the namespace of the current buffer.
+Useful if a file has been renamed."
+ (interactive)
+ (let ((nsname (funcall clojure-expected-ns-function)))
+ (when nsname
+ (save-excursion
+ (save-match-data
+ (if (clojure-find-ns)
+ (progn (replace-match nsname nil nil nil 4)
+ (message "ns form updated"))
+ (error "Namespace not found")))))))
+
+(defun clojure--sort-following-sexps ()
+ "Sort sexps between point and end of current sexp.
+Comments at the start of a line are considered part of the
+following sexp. Comments at the end of a line (after some other
+content) are considered part of the preceding sexp."
+ ;; Here we're after the :require/:import symbol.
+ (save-restriction
+ (narrow-to-region (point) (save-excursion
+ (up-list)
+ (1- (point))))
+ (skip-chars-forward "\r\n[:blank:]")
+ (sort-subr nil
+ (lambda () (skip-chars-forward "\r\n[:blank:]"))
+ ;; Move to end of current top-level thing.
+ (lambda ()
+ (condition-case nil
+ (while t (up-list))
+ (scan-error nil))
+ ;; We could be inside a symbol instead of a sexp.
+ (unless (looking-at "\\s-\\|$")
+ (clojure-forward-logical-sexp))
+ ;; move past comments at the end of the line.
+ (search-forward-regexp "$"))
+ ;; Move to start of ns name.
+ (lambda ()
+ (comment-forward)
+ (skip-chars-forward "[:blank:]\n\r[(")
+ (clojure-forward-logical-sexp)
+ (forward-sexp -1)
+ nil)
+ ;; Move to end of ns name.
+ (lambda ()
+ (clojure-forward-logical-sexp)))
+ (goto-char (point-max))
+ ;; Does the last line now end in a comment?
+ (when (nth 4 (parse-partial-sexp (point-min) (point)))
+ (insert "\n"))))
+
+(defun clojure-sort-ns ()
+ "Internally sort each sexp inside the ns form."
+ (interactive)
+ (comment-normalize-vars)
+ (if (clojure-find-ns)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (redisplay)
+ (let ((beg (point))
+ (ns))
+ (forward-sexp 1)
+ (setq ns (buffer-substring beg (point)))
+ (forward-char -1)
+ (while (progn (forward-sexp -1)
+ (looking-at "(:[a-z]"))
+ (save-excursion
+ (forward-char 1)
+ (forward-sexp 1)
+ (clojure--sort-following-sexps)))
+ (goto-char beg)
+ (if (looking-at (regexp-quote ns))
+ (message "ns form is already sorted")
+ (sleep-for 0.1)
+ (redisplay)
+ (message "ns form has been sorted")
+ (sleep-for 0.1))))
+ (user-error "Namespace not found")))
+
+(defconst clojure-namespace-name-regex
+ (rx line-start
+ "("
+ (zero-or-one (group (regexp "clojure.core/")))
+ (zero-or-one (submatch "in-"))
+ "ns"
+ (zero-or-one "+")
+ (one-or-more (any whitespace "\n"))
+ (zero-or-more (or (submatch (zero-or-one "#")
+ "^{"
+ (zero-or-more (not (any "}")))
+ "}")
+ (zero-or-more "^:"
+ (one-or-more (not (any whitespace)))))
+ (one-or-more (any whitespace "\n")))
+ (zero-or-one (any ":'")) ;; (in-ns 'foo) or (ns+ :user)
+ (group (one-or-more (not (any "()\"" whitespace))) symbol-end)))
+
+(defun clojure-find-ns ()
+ "Return the namespace of the current Clojure buffer.
+Return the namespace closest to point and above it. If there are
+no namespaces above point, return the first one in the buffer."
+ (save-excursion
+ (save-restriction
+ (widen)
+ ;; The closest ns form above point.
+ (when (or (re-search-backward clojure-namespace-name-regex nil t)
+ ;; Or any form at all.
+ (and (goto-char (point-min))
+ (re-search-forward clojure-namespace-name-regex nil t)))
+ (match-string-no-properties 4)))))
+
+(defconst clojure-def-type-and-name-regex
+ (concat "(\\(?:\\(?:\\sw\\|\\s_\\)+/\\)?"
+ ;; Declaration
+ "\\(def\\(?:\\sw\\|\\s_\\)*\\)\\>"
+ ;; Any whitespace
+ "[ \r\n\t]*"
+ ;; Possibly type or metadata
+ "\\(?:#?^\\(?:{[^}]*}\\|\\(?:\\sw\\|\\s_\\)+\\)[ \r\n\t]*\\)*"
+ ;; Symbol name
+ "\\(\\(?:\\sw\\|\\s_\\)+\\)"))
+
+(defun clojure-find-def ()
+ "Find the var declaration macro and symbol name of the current form.
+Returns a list pair, e.g. (\"defn\" \"abc\") or (\"deftest\" \"some-test\")."
+ (save-excursion
+ (unless (looking-at clojure-def-type-and-name-regex)
+ (beginning-of-defun))
+ (when (search-forward-regexp clojure-def-type-and-name-regex nil t)
+ (list (match-string-no-properties 1)
+ (match-string-no-properties 2)))))
+
+\f
+;;; Sexp navigation
+(defun clojure--looking-at-non-logical-sexp ()
+ "Return non-nil if sexp after point represents code.
+Sexps that don't represent code are ^metadata or #reader.macros."
+ (comment-normalize-vars)
+ (comment-forward (point-max))
+ (looking-at-p "\\^\\|#[?[:alpha:]]"))
+
+(defun clojure-forward-logical-sexp (&optional n)
+ "Move forward N logical sexps.
+This will skip over sexps that don't represent objects, so that ^hints and
+#reader.macros are considered part of the following sexp."
+ (interactive "p")
+ (unless n (setq n 1))
+ (if (< n 0)
+ (clojure-backward-logical-sexp (- n))
+ (let ((forward-sexp-function nil))
+ (while (> n 0)
+ (while (clojure--looking-at-non-logical-sexp)
+ (forward-sexp 1))
+ ;; The actual sexp
+ (forward-sexp 1)
+ (skip-chars-forward ",")
+ (setq n (1- n))))))
+
+(defun clojure-backward-logical-sexp (&optional n)
+ "Move backward N logical sexps.
+This will skip over sexps that don't represent objects, so that ^hints and
+#reader.macros are considered part of the following sexp."
+ (interactive "p")
+ (unless n (setq n 1))
+ (if (< n 0)
+ (clojure-forward-logical-sexp (- n))
+ (let ((forward-sexp-function nil))
+ (while (> n 0)
+ ;; The actual sexp
+ (backward-sexp 1)
+ ;; Non-logical sexps.
+ (while (and (not (bobp))
+ (ignore-errors
+ (save-excursion
+ (backward-sexp 1)
+ (clojure--looking-at-non-logical-sexp))))
+ (backward-sexp 1))
+ (setq n (1- n))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Refactoring support
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Threading macros related
+(defcustom clojure-thread-all-but-last nil
+ "Non-nil means do not thread the last expression.
+This means that `clojure-thread-first-all' and
+`clojure-thread-last-all' not thread the deepest sexp inside the
+current sexp."
+ :package-version '(clojure-mode . "5.4.0")
+ :safe #'booleanp
+ :type 'boolean)
+
+(defun clojure--point-after (&rest actions)
+ "Return POINT after performing ACTIONS.
+
+An action is either the symbol of a function or a two element
+list of (fn args) to pass to `apply''"
+ (save-excursion
+ (dolist (fn-and-args actions)
+ (let ((f (if (listp fn-and-args) (car fn-and-args) fn-and-args))
+ (args (if (listp fn-and-args) (cdr fn-and-args) nil)))
+ (apply f args)))
+ (point)))
+
+(defun clojure--maybe-unjoin-line ()
+ "Undo a `join-line' done by a threading command."
+ (when (get-text-property (point) 'clojure-thread-line-joined)
+ (remove-text-properties (point) (1+ (point)) '(clojure-thread-line-joined t))
+ (insert "\n")))
+
+(defun clojure--unwind-last ()
+ (forward-sexp)
+ (save-excursion
+ (let ((beg (point))
+ (contents (clojure-delete-and-extract-sexp)))
+ (when (looking-at " *\n")
+ (join-line 'following))
+ (clojure--ensure-parens-around-function-names)
+ (let* ((sexp-beg-line (line-number-at-pos))
+ (sexp-end-line (progn (forward-sexp)
+ (line-number-at-pos)))
+ (multiline-sexp-p (not (= sexp-beg-line sexp-end-line))))
+ (down-list -1)
+ (if multiline-sexp-p
+ (insert "\n")
+ ;; `clojure--maybe-unjoin-line' only works when unwinding sexps that were
+ ;; threaded in the same Emacs session, but it also catches cases that
+ ;; `multiline-sexp-p' doesn't.
+ (clojure--maybe-unjoin-line))
+ (insert contents))))
+ (forward-char))
+
+(defun clojure--ensure-parens-around-function-names ()
+ (clojure--looking-at-non-logical-sexp)
+ (unless (looking-at "(")
+ (insert-parentheses 1)
+ (backward-up-list)))
+
+(defun clojure--unwind-first ()
+ "Unwind a thread first macro once.
+Point must be between the opening paren and the -> symbol."
+ (forward-sexp)
+ (save-excursion
+ (let ((contents (clojure-delete-and-extract-sexp)))
+ (when (looking-at " *\n")
+ (join-line 'following))
+ (clojure--ensure-parens-around-function-names)
+ (down-list)
+ (forward-sexp)
+ (insert contents)
+ (forward-sexp -1)
+ (clojure--maybe-unjoin-line)))
+ (forward-char))
+
+(defun clojure--pop-out-of-threading ()
+ (save-excursion
+ (down-list 2)
+ (backward-up-list)
+ (raise-sexp)))
+
+(defun clojure--nothing-more-to-unwind ()
+ (save-excursion
+ (let ((beg (point)))
+ (forward-sexp)
+ (down-list -1)
+ (backward-sexp 2) ;; the last sexp, the threading macro
+ (when (looking-back "(\\s-*" (line-beginning-position))
+ (backward-up-list)) ;; and the paren
+ (= beg (point)))))
+
+(defun clojure--fix-sexp-whitespace (&optional move-out)
+ (save-excursion
+ (when move-out (backward-up-list))
+ (let ((sexp (bounds-of-thing-at-point 'sexp)))
+ (clojure-indent-region (car sexp) (cdr sexp))
+ (delete-trailing-whitespace (car sexp) (cdr sexp)))))
+
+;;;###autoload
+(defun clojure-unwind ()
+ "Unwind thread at point or above point by one level.
+Return nil if there are no more levels to unwind."
+ (interactive)
+ (save-excursion
+ (let ((limit (save-excursion
+ (beginning-of-defun)
+ (point))))
+ (ignore-errors
+ (when (looking-at "(")
+ (forward-char 1)
+ (forward-sexp 1)))
+ (search-backward-regexp "([^-]*->" limit)
+ (if (clojure--nothing-more-to-unwind)
+ (progn (clojure--pop-out-of-threading)
+ (clojure--fix-sexp-whitespace)
+ nil)
+ (down-list)
+ (prog1 (cond
+ ((looking-at "[^-]*->\\_>") (clojure--unwind-first))
+ ((looking-at "[^-]*->>\\_>") (clojure--unwind-last)))
+ (clojure--fix-sexp-whitespace 'move-out))
+ t))))
+
+;;;###autoload
+(defun clojure-unwind-all ()
+ "Fully unwind thread at point or above point."
+ (interactive)
+ (while (clojure-unwind)))
+
+(defun clojure--remove-superfluous-parens ()
+ (when (looking-at "([^ )]+)")
+ (delete-pair)))
+
+(defun clojure--thread-first ()
+ (down-list)
+ (forward-symbol 1)
+ (unless (looking-at ")")
+ (let ((contents (clojure-delete-and-extract-sexp)))
+ (backward-up-list)
+ (just-one-space 0)
+ (save-excursion
+ (insert contents "\n")
+ (clojure--remove-superfluous-parens))
+ (when (looking-at "\\s-*\n")
+ (join-line 'following)
+ (forward-char 1)
+ (put-text-property (point) (1+ (point))
+ 'clojure-thread-line-joined t))
+ t)))
+
+(defun clojure--thread-last ()
+ (forward-sexp 2)
+ (down-list -1)
+ (backward-sexp)
+ (unless (eq (char-before) ?\()
+ (let ((contents (clojure-delete-and-extract-sexp)))
+ (just-one-space 0)
+ (backward-up-list)
+ (insert contents "\n")
+ (clojure--remove-superfluous-parens)
+ ;; cljr #255 Fix dangling parens
+ (forward-sexp)
+ (when (looking-back "^\\s-*\\()+\\)\\s-*" (line-beginning-position))
+ (let ((pos (match-beginning 1)))
+ (put-text-property pos (1+ pos) 'clojure-thread-line-joined t))
+ (join-line))
+ t)))
+
+(defun clojure--threadable-p ()
+ (save-excursion
+ (forward-symbol 1)
+ (looking-at "[\n\r\t ]*(")))
+
+;;;###autoload
+(defun clojure-thread ()
+ "Thread by one more level an existing threading macro."
+ (interactive)
+ (ignore-errors
+ (when (looking-at "(")
+ (forward-char 1)
+ (forward-sexp 1)))
+ (search-backward-regexp "([^-]*->")
+ (down-list)
+ (when (clojure--threadable-p)
+ (prog1 (cond
+ ((looking-at "[^-]*->\\_>") (clojure--thread-first))
+ ((looking-at "[^-]*->>\\_>") (clojure--thread-last)))
+ (clojure--fix-sexp-whitespace 'move-out))))
+
+(defun clojure--thread-all (first-or-last-thread but-last)
+ (save-excursion
+ (insert-parentheses 1)
+ (insert first-or-last-thread))
+ (while (save-excursion (clojure-thread)))
+ (when (or but-last clojure-thread-all-but-last)
+ (clojure-unwind)))
+
+;;;###autoload
+(defun clojure-thread-first-all (but-last)
+ "Fully thread the form at point using ->.
+When BUT-LAST is passed the last expression is not threaded."
+ (interactive "P")
+ (clojure--thread-all "-> " but-last))
+
+;;;###autoload
+(defun clojure-thread-last-all (but-last)
+ "Fully thread the form at point using ->>.
+When BUT-LAST is passed the last expression is not threaded."
+ (interactive "P")
+ (clojure--thread-all "->> " but-last))
+
+;;; Cycling stuff
+
+(defcustom clojure-use-metadata-for-privacy nil
+ "If nil, `clojure-cycle-privacy' will use (defn- f []).
+If t, it will use (defn ^:private f [])."
+ :package-version '(clojure-mode . "5.5.0")
+ :safe #'booleanp
+ :type 'boolean)
+
+;;;###autoload
+(defun clojure-cycle-privacy ()
+ "Make public the current private def, or vice-versa.
+See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-privacy"
+ (interactive)
+ (save-excursion
+ (ignore-errors (forward-char 7))
+ (search-backward-regexp "(defn?\\(-\\| ^:private\\)?\\_>")
+ (if (match-string 1)
+ (replace-match "" nil nil nil 1)
+ (goto-char (match-end 0))
+ (insert (if (or clojure-use-metadata-for-privacy
+ (equal (match-string 0) "(def"))
+ " ^:private"
+ "-")))))
+
+(defun clojure--convert-collection (coll-open coll-close)
+ "Convert the collection at (point) by unwrapping it an wrapping it between COLL-OPEN and COLL-CLOSE."
+ (save-excursion
+ (while (and
+ (not (bobp))
+ (not (looking-at "(\\|{\\|\\[")))
+ (backward-char))
+ (when (or (eq ?\# (char-before))
+ (eq ?\' (char-before)))
+ (delete-char -1))
+ (when (and (bobp)
+ (not (memq (char-after) '(?\{ ?\( ?\[))))
+ (user-error "Beginning of file reached, collection is not found"))
+ (insert coll-open (substring (clojure-delete-and-extract-sexp) 1 -1) coll-close)))
+
+;;;###autoload
+(defun clojure-convert-collection-to-list ()
+ "Convert collection at (point) to list."
+ (interactive)
+ (clojure--convert-collection "(" ")"))
+
+;;;###autoload
+(defun clojure-convert-collection-to-quoted-list ()
+ "Convert collection at (point) to quoted list."
+ (interactive)
+ (clojure--convert-collection "'(" ")"))
+
+;;;###autoload
+(defun clojure-convert-collection-to-map ()
+ "Convert collection at (point) to map."
+ (interactive)
+ (clojure--convert-collection "{" "}"))
+
+;;;###autoload
+(defun clojure-convert-collection-to-vector ()
+ "Convert collection at (point) to vector."
+ (interactive)
+ (clojure--convert-collection "[" "]"))
+
+;;;###autoload
+(defun clojure-convert-collection-to-set ()
+ "Convert collection at (point) to set."
+ (interactive)
+ (clojure--convert-collection "#{" "}"))
+
+(defun clojure--goto-if ()
+ "Find the first surrounding if or if-not expression."
+ (when (in-string-p)
+ (while (or (not (looking-at "("))
+ (in-string-p))
+ (backward-char)))
+ (while (not (looking-at "\\((if \\)\\|\\((if-not \\)"))
+ (condition-case nil
+ (backward-up-list)
+ (scan-error (user-error "No if or if-not found")))))
+
+;;;###autoload
+(defun clojure-cycle-if ()
+ "Change a surrounding if to if-not, or vice-versa.
+
+See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-if"
+ (interactive)
+ (save-excursion
+ (clojure--goto-if)
+ (cond
+ ((looking-at "(if-not")
+ (forward-char 3)
+ (delete-char 4)
+ (forward-sexp 2)
+ (transpose-sexps 1))
+ ((looking-at "(if")
+ (forward-char 3)
+ (insert "-not")
+ (forward-sexp 2)
+ (transpose-sexps 1)))))
+
+;; TODO: Remove code duplication with `clojure--goto-if'.
+(defun clojure--goto-when ()
+ "Find the first surrounding when or when-not expression."
+ (when (in-string-p)
+ (while (or (not (looking-at "("))
+ (in-string-p))
+ (backward-char)))
+ (while (not (looking-at "\\((when \\)\\|\\((when-not \\)"))
+ (condition-case nil
+ (backward-up-list)
+ (scan-error (user-error "No when or when-not found")))))
+
+;;;###autoload
+(defun clojure-cycle-when ()
+ "Change a surrounding when to when-not, or vice-versa."
+ (interactive)
+ (save-excursion
+ (clojure--goto-when)
+ (cond
+ ((looking-at "(when-not")
+ (forward-char 9)
+ (delete-char -4))
+ ((looking-at "(when")
+ (forward-char 5)
+ (insert "-not")))))
+
+(defun clojure-cycle-not ()
+ "Add or remove a not form around the current form."
+ (interactive)
+ (save-excursion
+ (condition-case nil
+ (backward-up-list)
+ (scan-error (user-error "`clojure-cycle-not' must be invoked inside a list")))
+ (if (looking-back "(not ")
+ (progn
+ (delete-char -5)
+ (forward-sexp)
+ (delete-char 1))
+ (insert "(not ")
+ (forward-sexp)
+ (insert ")"))))
+
+;;; let related stuff
+
+(defvar clojure--let-regexp
+ "\(\\(when-let\\|if-let\\|let\\)\\(\\s-*\\|\\[\\)"
+ "Regexp matching let like expressions, i.e. let, when-let, if-let.
+
+The first match-group is the let expression, the second match-group is the whitespace or the opening square bracket if no whitespace between the let expression and the bracket.")
+
+(defun clojure--goto-let ()
+ "Go to the beginning of the nearest let form."
+ (when (in-string-p)
+ (while (or (not (looking-at "("))
+ (in-string-p))
+ (backward-char)))
+ (ignore-errors
+ (while (not (looking-at clojure--let-regexp))
+ (backward-up-list)))
+ (looking-at clojure--let-regexp))
+
+(defun clojure--inside-let-binding-p ()
+ (ignore-errors
+ (save-excursion
+ (let ((pos (point)))
+ (clojure--goto-let)
+ (re-search-forward "\\[")
+ (if (< pos (point))
+ nil
+ (forward-sexp)
+ (up-list)
+ (< pos (point)))))))
+
+(defun clojure--beginning-of-current-let-binding ()
+ "Move before the bound name of the current binding.
+Assume that point is in the binding form of a let."
+ (let ((current-point (point)))
+ (clojure--goto-let)
+ (search-forward "[")
+ (forward-char)
+ (while (> current-point (point))
+ (forward-sexp))
+ (backward-sexp 2)))
+
+(defun clojure--previous-line ()
+ "Keep the column position while go the previous line."
+ (let ((col (current-column)))
+ (forward-line -1)
+ (move-to-column col)))
+
+(defun clojure--prepare-to-insert-new-let-binding ()
+ "Move to right place in the let form to insert a new binding and indent."
+ (if (clojure--inside-let-binding-p)
+ (progn
+ (clojure--beginning-of-current-let-binding)
+ (newline-and-indent)
+ (clojure--previous-line)
+ (indent-for-tab-command))
+ (clojure--goto-let)
+ (search-forward "[")
+ (backward-up-list)
+ (forward-sexp)
+ (down-list -1)
+ (backward-char)
+ (if (looking-at "\\[\\s-*\\]")
+ (forward-char)
+ (forward-char)
+ (newline-and-indent))))
+
+(defun clojure--sexp-regexp (sexp)
+ (concat "\\([^[:word:]^-]\\)"
+ (mapconcat #'identity (mapcar 'regexp-quote (split-string sexp))
+ "[[:space:]\n\r]+")
+ "\\([^[:word:]^-]\\)"))
+
+(defun clojure--replace-sexp-with-binding (bound-name init-expr end)
+ (save-excursion
+ (while (re-search-forward (clojure--sexp-regexp init-expr) end t)
+ (replace-match (concat "\\1" bound-name "\\2")))))
+
+(defun clojure--replace-sexps-with-bindings (bindings end)
+ "Replace bindings with their respective bound names in the let form.
+BINDINGS is the list of bound names and init expressions, END denotes the end of the let expression."
+ (let ((bound-name (pop bindings))
+ (init-expr (pop bindings)))
+ (when bound-name
+ (clojure--replace-sexp-with-binding bound-name init-expr end)
+ (clojure--replace-sexps-with-bindings bindings end))))
+
+(defun clojure--replace-sexps-with-bindings-and-indent ()
+ (clojure--replace-sexps-with-bindings
+ (clojure--read-let-bindings)
+ (clojure--point-after 'clojure--goto-let 'forward-sexp))
+ (clojure-indent-region
+ (clojure--point-after 'clojure--goto-let)
+ (clojure--point-after 'clojure--goto-let 'forward-sexp)))
+
+(defun clojure--read-let-bindings ()
+ "Read the bound-name and init expression pairs in the binding form.
+Return a list: odd elements are bound names, even elements init expressions."
+ (clojure--goto-let)
+ (down-list 2)
+ (let* ((start (point))
+ (sexp-start start)
+ (end (save-excursion
+ (backward-char)
+ (forward-sexp)
+ (down-list -1)
+ (point)))
+ bindings)
+ (while (/= sexp-start end)
+ (forward-sexp)
+ (push
+ (string-trim (buffer-substring-no-properties sexp-start (point)))
+ bindings)
+ (skip-chars-forward "\r\n\t[:blank:]")
+ (setq sexp-start (point)))
+ (nreverse bindings)))
+
+(defun clojure--introduce-let-internal (name &optional n)
+ (if (numberp n)
+ (let ((init-expr-sexp (clojure-delete-and-extract-sexp)))
+ (insert name)
+ (ignore-errors (backward-up-list n))
+ (insert "(let" (clojure-delete-and-extract-sexp) ")")
+ (backward-sexp)
+ (down-list)
+ (forward-sexp)
+ (insert " [" name " " init-expr-sexp "]\n")
+ (clojure--replace-sexps-with-bindings-and-indent))
+ (insert "[ " (clojure-delete-and-extract-sexp) "]")
+ (backward-sexp)
+ (insert "(let " (clojure-delete-and-extract-sexp) ")")
+ (backward-sexp)
+ (down-list 2)
+ (insert name)
+ (forward-sexp)
+ (up-list)
+ (newline-and-indent)
+ (insert name)))
+
+(defun clojure--move-to-let-internal (name)
+ (if (not (save-excursion (clojure--goto-let)))
+ (clojure--introduce-let-internal name)
+ (let ((contents (clojure-delete-and-extract-sexp)))
+ (insert name)
+ (clojure--prepare-to-insert-new-let-binding)
+ (insert contents)
+ (backward-sexp)
+ (insert " ")
+ (backward-char)
+ (insert name)
+ (clojure--replace-sexps-with-bindings-and-indent))))
+
+(defun clojure--let-backward-slurp-sexp-internal ()
+ "Slurp the s-expression before the let form into the let form."
+ (clojure--goto-let)
+ (backward-sexp)
+ (let ((sexp (string-trim (clojure-delete-and-extract-sexp))))
+ (delete-blank-lines)
+ (down-list)
+ (forward-sexp 2)
+ (newline-and-indent)
+ (insert sexp)
+ (clojure--replace-sexps-with-bindings-and-indent)))
+
+;;;###autoload
+(defun clojure-let-backward-slurp-sexp (&optional n)
+ "Slurp the s-expression before the let form into the let form.
+With a numberic prefix argument slurp the previous N s-expression into the let form."
+ (interactive "p")
+ (unless n (setq n 1))
+ (dotimes (k n)
+ (save-excursion (clojure--let-backward-slurp-sexp-internal))))
+
+(defun clojure--let-forward-slurp-sexp-internal ()
+ "Slurp the next s-expression after the let form into the let form."
+ (clojure--goto-let)
+ (forward-sexp)
+ (let ((sexp (string-trim (clojure-delete-and-extract-sexp))))
+ (down-list -1)
+ (newline-and-indent)
+ (insert sexp)
+ (clojure--replace-sexps-with-bindings-and-indent)))
+
+;;;###autoload
+(defun clojure-let-forward-slurp-sexp (&optional n)
+ "Slurp the next s-expression after the let form into the let form.
+With a numeric prefix argument slurp the next N s-expressions into the let form."
+ (interactive "p")
+ (unless n (setq n 1))
+ (dotimes (k n)
+ (save-excursion (clojure--let-forward-slurp-sexp-internal))))
+
+;;;###autoload
+(defun clojure-introduce-let (&optional n)
+ "Create a let form, binding the form at point.
+With a numeric prefix argument the let is introduced N lists up."
+ (interactive "P")
+ (clojure--introduce-let-internal (read-from-minibuffer "Name of bound symbol: ") n))
+
+;;;###autoload
+(defun clojure-move-to-let ()
+ "Move the form at point to a binding in the nearest let."
+ (interactive)
+ (clojure--move-to-let-internal (read-from-minibuffer "Name of bound symbol: ")))
+
+\f
+;;; ClojureScript
+(defconst clojurescript-font-lock-keywords
+ (eval-when-compile
+ `(;; ClojureScript built-ins
+ (,(concat "(\\(?:\.*/\\)?"
+ (regexp-opt '("js-obj" "js-delete" "clj->js" "js->clj"))
+ "\\>")
+ 0 font-lock-builtin-face)))
+ "Additional font-locking for `clojurescrip-mode'.")
+
+;;;###autoload
+(define-derived-mode clojurescript-mode clojure-mode "ClojureScript"
+ "Major mode for editing ClojureScript code.
+
+\\{clojurescript-mode-map}"
+ (font-lock-add-keywords nil clojurescript-font-lock-keywords))
+
+;;;###autoload
+(define-derived-mode clojurec-mode clojure-mode "ClojureC"
+ "Major mode for editing ClojureC code.
+
+\\{clojurec-mode-map}")
+
+(defconst clojurex-font-lock-keywords
+ ;; cljx annotations (#+clj and #+cljs)
+ '(("#\\+cljs?\\>" 0 font-lock-preprocessor-face))
+ "Additional font-locking for `clojurex-mode'.")
+
+;;;###autoload
+(define-derived-mode clojurex-mode clojure-mode "ClojureX"
+ "Major mode for editing ClojureX code.
+
+\\{clojurex-mode-map}"
+ (font-lock-add-keywords nil clojurex-font-lock-keywords))
+
+;;;###autoload
+(progn
+ (add-to-list 'auto-mode-alist
+ '("\\.\\(clj\\|dtm\\|edn\\)\\'" . clojure-mode))
+ (add-to-list 'auto-mode-alist '("\\.cljc\\'" . clojurec-mode))
+ (add-to-list 'auto-mode-alist '("\\.cljx\\'" . clojurex-mode))
+ (add-to-list 'auto-mode-alist '("\\.cljs\\'" . clojurescript-mode))
+ ;; boot build scripts are Clojure source files
+ (add-to-list 'auto-mode-alist '("\\(?:build\\|profile\\)\\.boot\\'" . clojure-mode)))
+
+(provide 'clojure-mode)
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
+;;; clojure-mode.el ends here
--- /dev/null
+;;; clomacs-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
+\f
+;;;### (autoloads nil "clomacs" "clomacs.el" (22692 30292 0 0))
+;;; Generated autoloads from clomacs.el
+
+(autoload 'clomacs-def "clomacs" "\
+Wrap CL-ENTITY-NAME, evaluated on clojure side by EL-ENTITY-NAME.
+DOC - optional elisp function docstring (when nil it constructed from
+underlying clojure entity docstring if possible).
+TYPE possible values are listed in the CLOMACS-POSSIBLE-RETURN-TYPES,
+or it may be a custom function (:string by default).
+
+\(fn EL-ENTITY-NAME CL-ENTITY-NAME &key (DOC nil) (TYPE :string) LIB-NAME NAMESPACE)" nil t)
+
+(autoload 'clomacs-defun "clomacs" "\
+Wrap CL-FUNC-NAME, evaluated on clojure side by EL-FUNC-NAME.
+CALL-TYPE - call Clojure side :sync or :async.
+CALLBACK - callback function for :async CALL-TYPE case.
+DOC - optional elisp function docstring (when nil it constructed from
+underlying clojure entity docstring if possible).
+RETURN-TYPE possible values are listed in the CLOMACS-POSSIBLE-RETURN-TYPES,
+or it may be a custom function (:string by default).
+RETURN-VALUE may be :value or :stdout (:value by default).
+
+\(fn EL-FUNC-NAME CL-FUNC-NAME &key (CALL-TYPE :sync) (CALLBACK nil) (DOC nil) (RETURN-TYPE :string) (RETURN-VALUE :value) LIB-NAME NAMESPACE)" nil t)
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; clomacs-autoloads.el ends here
--- /dev/null
+;;; -*- no-byte-compile: t -*-
+(define-package "clomacs" "20170128.850" "Simplifies Emacs Lisp interaction with Clojure." '((emacs "24.3") (cider "0.11") (s "1.10.0")) :url "https://github.com/clojure-emacs/clomacs" :keywords '("clojure" "interaction"))
--- /dev/null
+;;; clomacs.el --- Simplifies Emacs Lisp interaction with Clojure. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2013-2017 Kostafey <kostafeyNOSPAMgmail.com>
+
+;; Author: Kostafey <kostafeyNOSPAMgmail.com>
+;; URL: https://github.com/clojure-emacs/clomacs
+;; Package-Version: 20170128.850
+;; Keywords: clojure, interaction
+;; Version: 0.0.2
+;; Package-Requires: ((emacs "24.3") (cider "0.11") (s "1.10.0"))
+
+;; 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:
+
+;; `clomacs-defun' - core Clojure to Elisp function wrapper.
+;;
+;; See README.md for detailed description.
+
+
+(require 'cl-lib)
+(require 'cider)
+(require 's)
+
+(defvar clomacs-verify-nrepl-on-call t)
+(defvar clomacs-autoload-nrepl-on-call t)
+
+(defun clomacs-search-connection (repl-buffer-project-name)
+ "Search nREPL connection buffer.
+E.g. if you want to find \"*cider-repl clomacs-20160419.258*\" you shold pass
+REPL-BUFFER-PROJECT-NAME \"clomacs\"."
+ (cl-reduce
+ (lambda (x y) (or x y))
+ (mapcar
+ (lambda (x)
+ (let ((this-repl
+ (s-chop-suffix
+ "*"
+ (cadr (split-string (buffer-name (car cider-connections)) " ")))))
+ (if (and
+ (>= (length this-repl)
+ (length repl-buffer-project-name))
+ (string= repl-buffer-project-name
+ (substring this-repl
+ 0
+ (length repl-buffer-project-name))))
+ x)))
+ cider-connections)))
+
+(defun clomacs-get-connection (&optional library)
+ "Return buffer with nREPL process related to LIBRARY.
+If LIBRARY is nil, attempts to use \"clomacs\", \"localhost\" or
+any current connection.
+If can't find any nREPL process return nil."
+ (if (> (length cider-connections) 0)
+ (if library
+ (clomacs-search-connection library)
+ (or (clomacs-search-connection "clomacs")
+ (clomacs-search-connection "localhost")
+ (cider-current-connection)))))
+
+(defun clomacs-get-session (connection)
+ "Return current session for this CONNECTION."
+ (assert connection)
+ (with-current-buffer
+ (set-buffer connection)
+ (cider-current-session)))
+
+(defun clomacs-launch-nrepl (library &optional sync)
+ (let* ((starting-msg (format
+ "Starting nREPL server for %s..."
+ (propertize (or library "current-buffer")
+ 'face 'font-lock-keyword-face)))
+ (lib-file (if library (find-library-name library)))
+ (is-opened (if lib-file (find-buffer-visiting lib-file)))
+ (lib-buff (or is-opened
+ (if lib-file
+ (find-file-noselect lib-file)))))
+ ;; simple run lein
+ (if lib-buff
+ (with-current-buffer lib-buff
+ (cider-jack-in))
+ (cider-jack-in))
+ (message starting-msg)
+ (if sync
+ (let ((old-cider-repl-pop cider-repl-pop-to-buffer-on-connect))
+ (setq cider-repl-pop-to-buffer-on-connect nil)
+ (while (not (clomacs-get-connection library))
+ (sleep-for 0.1))
+ (setq cider-repl-pop-to-buffer-on-connect old-cider-repl-pop)
+ (if (and library (not is-opened))
+ (kill-buffer lib-buff))))
+ (message "Started.")))
+
+(defun clomacs-return-stringp (raw-string)
+ (and
+ raw-string
+ (equal (substring raw-string 0 1) "\"")
+ (equal (substring raw-string
+ (1- (length raw-string)) (length raw-string)) "\"")))
+
+(defun clomacs-strip-string (raw-string)
+ (if (clomacs-return-stringp raw-string)
+ (substring raw-string 1 (1- (length raw-string)))
+ raw-string))
+
+(defun clomacs-format-result (raw-string return-type)
+ "Format Elisp representation of Clojure evaluation result."
+ (cl-assert return-type)
+ (if raw-string
+ (let ((return-string (clomacs-strip-string raw-string)))
+ (cond
+ ((functionp return-type) (funcall return-type raw-string))
+ ((eq return-type :string) return-string)
+ ((eq return-type :int) (string-to-number return-string))
+ ((eq return-type :number) (string-to-number return-string))
+ ((eq return-type :list) (read raw-string))
+ ((eq return-type :char) (string-to-char return-string))
+ ((eq return-type :vector) (string-to-vector return-string))))))
+
+(declare clomacs-format-arg)
+
+(defun clomacs-plist-p (object)
+ "Return t if OBJECT is a plist, otherwise, return nil."
+ (when (and (listp object)
+ (car object)
+ (listp (car object))
+ (not (listp (cdr (car object)))))
+ t))
+
+(defun clomacs-plist-to-map (lst)
+ "Build string representation of Clojure map from Elisp plist LST."
+ (let ((tail (car (last lst))))
+ (concat
+ "{"
+ (cl-reduce
+ (lambda (acc pair)
+ (concat acc
+ (clomacs-format-arg (car pair)) " "
+ (clomacs-format-arg (cdr pair))
+ (if (eq pair tail) "" " ")))
+ lst
+ :initial-value "")
+ "}")))
+
+(defun clomacs-format-arg (a)
+ "Format Clojure representation of Elisp argument."
+ (cond
+ ((numberp a) (number-to-string a))
+ ((stringp a) (clomacs-add-quotes a))
+ ((booleanp a) (if a "true" "false"))
+ ((clomacs-plist-p a) (clomacs-plist-to-map a))
+ ((and (listp a) (equal (car a) 'quote))
+ (concat "'" (clomacs-force-symbol-name
+ (cadr a))))
+ ((symbolp a) (clomacs-force-symbol-name a))
+ (t (replace-regexp-in-string
+ "\\\\." "." (format "'%S" a)))))
+
+(defvar clomacs-possible-return-types
+ (list :string
+ :int
+ :number
+ :list
+ :char
+ :vector))
+
+(defun clomacs-highlight-initialize ()
+ (font-lock-add-keywords
+ 'emacs-lisp-mode
+ '(("clomacs-defun\\b" . font-lock-keyword-face)
+ ("clomacs-def\\b" . font-lock-keyword-face))))
+
+(defun clomacs-force-symbol-name (some-symbol)
+ "Return lisp symbol SOME-SYMBOL as a string at all costs!"
+ (mapconcat 'char-to-string
+ (string-to-list (symbol-name some-symbol)) ""))
+
+(eval-after-load "clomacs"
+ (lambda ()
+ (clomacs-highlight-initialize)
+
+ ;; Should be last `clomacs-defun'
+ (clomacs-defun clomacs--doc
+ clojure.repl/doc
+ :return-value :stdout)
+
+ (defun clomacs-doc (x)
+ (if (clomacs-get-connection)
+ (clomacs--doc x)))))
+
+(defun clomacs-get-doc (doc cl-entity-name)
+ "Form the emacs-lisp side entity docstring.
+DOC - user-defined docsting.
+CL-ENTITY-NAME - clojure side entity name.
+CL-ENTITY-TYPE - \"value\" or \"function\""
+ (if doc doc
+ (concat "Wrapped clojure entity:"
+ (let ((cl-entity-doc (when (fboundp 'clomacs-doc)
+ (clomacs-doc cl-entity-name))))
+ (if cl-entity-doc (concat "\n" cl-entity-doc)
+ (clomacs-force-symbol-name cl-entity-name))))))
+
+(defun clomacs-ensure-nrepl-run (&optional lib-name)
+ "Ensure nrepl is running."
+ (when clomacs-verify-nrepl-on-call
+ (unless (clomacs-get-connection lib-name)
+ (if clomacs-autoload-nrepl-on-call
+ ;; Raise up the world - sync nrepl launch
+ (clomacs-launch-nrepl lib-name t)
+ (error
+ (concat "CIDER is not launched!"))))))
+
+(defun clomacs-get-result (result value type namespace)
+ "Parse result of clojure code evaluation from CIDER.
+Handle errors. Handle difference between CIDER versions."
+ (let ((val-new (cond
+ ((equal value :value) "value")
+ ((equal value :stdout) "out"))))
+ (if (or (plist-get result :stderr)
+ (nrepl-dict-get result "err"))
+ (error (or (plist-get result :stderr)
+ (nrepl-dict-get result "err")))
+ (clomacs-format-result
+ (let ((essence-result (or
+ (plist-get result value)
+ (nrepl-dict-get result val-new))))
+ (if (and namespace (equal value :value))
+ (substring essence-result 3)
+ essence-result))
+ type))))
+
+(defun clomacs-add-quotes (str)
+ (concat "\"" str "\""))
+
+(cl-defun clomacs-prepare-vars (cl-entity-name
+ &key
+ (doc nil)
+ (return-type :string)
+ namespace)
+ "Prepare intermediate variables for clomacs wrapper macros."
+ (cl-assert (and return-type
+ (or (functionp return-type)
+ (member return-type clomacs-possible-return-types)))
+ t
+ (format (concat "Wrong return-type %s! See C-h v "
+ "clomacs-possible-return-types")
+ (clomacs-force-symbol-name return-type)))
+ (let* ((doc (clomacs-get-doc doc cl-entity-name))
+ (cl-entity-name-str (clomacs-force-symbol-name cl-entity-name))
+ (namespace-str (clomacs-force-symbol-name namespace))
+ (ns-slash-pos (string-match "/" cl-entity-name-str))
+ (implicit-ns (if ns-slash-pos
+ (substring cl-entity-name-str 0 ns-slash-pos)))
+ (cl-entity-full-name (if (and namespace (not implicit-ns))
+ (concat namespace-str "/" cl-entity-name-str)
+ cl-entity-name-str)))
+ (list doc namespace-str cl-entity-full-name)))
+
+;;;###autoload
+(cl-defmacro clomacs-def (el-entity-name
+ cl-entity-name
+ &key
+ (doc nil)
+ (type :string)
+ lib-name
+ namespace)
+ "Wrap CL-ENTITY-NAME, evaluated on clojure side by EL-ENTITY-NAME.
+DOC - optional elisp function docstring (when nil it constructed from
+underlying clojure entity docstring if possible).
+TYPE possible values are listed in the CLOMACS-POSSIBLE-RETURN-TYPES,
+or it may be a custom function (:string by default)."
+ (cl-multiple-value-bind
+ (doc namespace-str cl-entity-full-name)
+ (clomacs-prepare-vars cl-entity-name
+ :doc doc
+ :namespace namespace)
+ `(defvar ,el-entity-name
+ (progn
+ (clomacs-ensure-nrepl-run ,lib-name)
+ (let* ((connection (clomacs-get-connection ,lib-name))
+ (result
+ (nrepl-sync-request:eval
+ (concat
+ (if ',namespace
+ (concat "(require '" ',namespace-str ") ") "")
+ ',cl-entity-full-name)
+ connection)))
+ (clomacs-get-result result :value ',type ',namespace)))
+ ,doc)))
+
+;;;###autoload
+(cl-defmacro clomacs-defun (el-func-name
+ cl-func-name
+ &key
+ (call-type :sync)
+ (callback nil)
+ (doc nil)
+ (return-type :string)
+ (return-value :value)
+ lib-name
+ namespace)
+ "Wrap CL-FUNC-NAME, evaluated on clojure side by EL-FUNC-NAME.
+CALL-TYPE - call Clojure side :sync or :async.
+CALLBACK - callback function for :async CALL-TYPE case.
+DOC - optional elisp function docstring (when nil it constructed from
+underlying clojure entity docstring if possible).
+RETURN-TYPE possible values are listed in the CLOMACS-POSSIBLE-RETURN-TYPES,
+or it may be a custom function (:string by default).
+RETURN-VALUE may be :value or :stdout (:value by default)."
+ (cl-multiple-value-bind
+ (doc namespace-str cl-entity-full-name)
+ (clomacs-prepare-vars cl-func-name
+ :doc doc
+ :namespace namespace)
+ `(defun ,el-func-name (&rest attributes)
+ ,doc
+ (clomacs-ensure-nrepl-run ,lib-name)
+ (let* ((attrs ""))
+ (dolist (a attributes)
+ (setq attrs (concat attrs " "
+ (clomacs-format-arg a))))
+ (let* ((connection (clomacs-get-connection ,lib-name))
+ (request (concat
+ (if ',namespace
+ (concat "(require '" ',namespace-str ") ") "")
+ "(" ',cl-entity-full-name attrs ")")))
+ (if (equal ,call-type :async)
+ (nrepl-request:eval
+ request
+ (lambda (result)
+ (if ,callback
+ (let ((el-result (clomacs-get-result
+ result
+ ,return-value ',return-type ',namespace)))
+ (if el-result
+ (,callback el-result)))))
+ connection)
+ (clomacs-get-result
+ (nrepl-sync-request:eval
+ request
+ connection)
+ ,return-value ',return-type ',namespace)))))))
+
+(defun clomacs-load-file (file-path)
+ "Sync and straightforward load clojure file."
+ (let* ((connection (cider-current-connection))
+ (session (clomacs-get-session connection)))
+ (nrepl-sync-request:eval
+ (with-temp-buffer
+ (insert-file-contents file-path)
+ (buffer-string))
+ connection
+ session)))
+
+(provide 'clomacs)
+
+;;; clomacs.el ends here
--- /dev/null
+{}
\ No newline at end of file
--- /dev/null
+;;; ejc-autocomplete.el -- SQL completitions at point (the part of ejc-sql).
+
+;;; Copyright © 2013-2016 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; 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, 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. */
+
+;;; Code:
+
+(require 'dash)
+(require 'auto-complete)
+(require 'ejc-lib)
+
+(defun ejc-get-prefix-word ()
+ "Return the word preceding dot before the typing."
+ (save-excursion
+ (let ((space-dist (or (save-excursion
+ (re-search-backward "[ \n\t\r]+" nil t))
+ 0))
+ (dot (search-backward "." nil t))
+ (space (re-search-backward "[ \n\t\r.]+" nil t)))
+ (if (and dot
+ space
+ (> dot space)
+ (<= space-dist space)) ; is a dot completition
+ (buffer-substring (1+ space) dot)
+ nil))))
+
+(defvar ejc-ansi-sql-words
+ '("select" "where" "and" "or" "from" "insert" "update" "delete" "join"
+ "order" "by" "distinct" "create" "alter" "drop"
+ "grant" "revoke" "deny" "commit" "rollback" "savepoint"))
+
+(defvar ejc-auxulary-sql-words
+ '("show" "errors" "desc" "count" "type" "table" "function" "procedure"
+ "begin" "end" "for" "return"))
+
+(defun ejc-get-ansi-sql-words ()
+ (append ejc-ansi-sql-words
+ ejc-auxulary-sql-words
+ (mapcar 'upcase ejc-ansi-sql-words)
+ (mapcar 'upcase ejc-auxulary-sql-words)))
+
+(defun ejc-not-nil-str (s)
+ (not (equal s "nil")))
+
+;;;###autoload
+(defun ejc-candidates ()
+ "Possible completions list according to already typed prefixes."
+ (let* ((prefix-1 (ejc-get-prefix-word))
+ (prefix-2 (save-excursion
+ (search-backward "." nil t)
+ (ejc-get-prefix-word)))
+ (result (ejc-get-stucture ejc-db prefix-1 prefix-2))
+ (pending (car result))
+ (candidates-cache (cdr result)))
+ (if (ejc-not-nil-str pending)
+ (message "Receiving database structure (%s)..." pending))
+ (if (and (not prefix-1) (not prefix-2))
+ (append candidates-cache (ejc-get-ansi-sql-words))
+ candidates-cache)))
+
+(defun ejc-return-point ()
+ "Return point position if point (cursor) is located next to dot char (.#)"
+ (let ((curr-char (buffer-substring
+ (save-excursion
+ (left-char 1)
+ (point))
+ (point))))
+ (if (equal curr-char ".")
+ (point)
+ nil)))
+
+(defvar ac-source-ejc-sql
+ '((candidates . ejc-candidates)
+ (requires . 1)
+ (cache . t)))
+
+(defvar ac-source-ejc-sql-point
+ '((candidates . ejc-candidates)
+ (prefix . ejc-return-point)
+ (requires . 0)
+ (cache . t)))
+
+;;;###autoload
+(defun ejc-ac-setup ()
+ "Add the completion sources to the front of `ac-sources'.
+This affects only the current buffer."
+ (interactive)
+ (add-to-list 'ac-sources 'ac-source-ejc-sql)
+ (add-to-list 'ac-sources 'ac-source-ejc-sql-point ))
+
+(provide 'ejc-autocomplete)
+
+;;; ejc-autocomplete.el ends here
--- /dev/null
+;;; ejc-format.el -- SQL formatting library (the part of ejc-sql).
+
+;;; Copyright © 2012, 2013 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; 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, 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. */
+
+;;; Code:
+
+(require 'cua-base)
+(require 'ejc-lib)
+(require 'subr-x)
+
+(defvar ejc-sql-separator "/"
+ "The char with purpose to separate the SQL statement both other.")
+
+(font-lock-add-keywords
+ 'sql-mode '(("/" 0 'font-lock-function-name-face t)))
+
+(defun ejc-get-sql-boundaries-at-point ()
+ "Returns list of the boundaries of the current SQL expression.
+The current SQL expression is the expression under the point.
+The boundaries are marked by `ejc-sql-separator's. If the top or
+bottom boundary is absent - it returns beginning or end of the
+buffer."
+ (save-excursion
+ (let* ((beg (progn
+ (if (search-backward ejc-sql-separator nil t nil)
+ (forward-char)
+ (beginning-of-buffer))
+ (point)))
+ (end (progn
+ (if (search-forward ejc-sql-separator nil t nil)
+ (backward-char)
+ (end-of-buffer))
+ (point))))
+ (list beg end))))
+
+(defmacro ejc--in-sql-boundaries (beg end &rest body)
+ "Inject `beg' and `end' local variables to the `body' scope.
+`beg' and `end' are the boundaries of the current sql expression."
+ `(let* ((boundaries (ejc-get-sql-boundaries-at-point))
+ (,beg (car boundaries))
+ (,end (car (cdr boundaries))))
+ ,@body))
+
+(defun ejc-mark-this-sql ()
+ "Select (mark) SQL around the point."
+ (interactive)
+ (ejc--in-sql-boundaries beg end
+ (when mark-active
+ (setq mark-active nil))
+ (goto-char beg)
+ (cua-set-mark)
+ (goto-char end)))
+
+(defun ejc-next-sql (&optional mark)
+ "Goto next SQL statement."
+ (interactive)
+ (ejc--in-sql-boundaries
+ beg end
+ (if (and mark (not mark-active))
+ (cua-set-mark))
+ (goto-char end)
+ (right-char 1)))
+
+(defun ejc-previous-sql (&optional mark)
+ "Goto previous SQL statement."
+ (interactive)
+ (ejc--in-sql-boundaries
+ beg end
+ (if (and mark (not mark-active))
+ (cua-set-mark))
+ (goto-char beg)
+ (left-char 1)))
+
+(defun ejc-apply-in-sql-boundaries (func)
+ (ejc--in-sql-boundaries beg end
+ (apply func (list beg end))))
+
+(defun ejc-get-sql-at-point ()
+ "Return SQL around the point."
+ (ejc--in-sql-boundaries beg end
+ (let ((sql (ejc-strip-text-properties (buffer-substring beg end))))
+ sql)))
+
+(defmacro ejc-ensure-sql-mode (&rest body)
+ `(if (not (equal major-mode 'sql-mode))
+ (error "SQL formatting is suitable in sql-mode only.")
+ (progn ,@body)))
+
+(defun ejc-format-sql (beg end)
+ (interactive "r")
+ (ejc-ensure-sql-mode
+ (save-excursion
+ (mapc (lambda (from-to)
+ (ejc-apply-in-sql-boundaries
+ (lambda (beg end)
+ (replace-regexp (car from-to) (cadr from-to) nil beg end))))
+ '(("\n" " ")
+ ("," ", ")
+ (" +" " ")
+ ("," ",\n ")
+ ("select" "select \n ")
+ (" from " "\nfrom \n ")
+ (" where " "\nwhere \n ")
+ (" and " "\n and ")
+ (" or " "\n or ")
+ (" order by " "\norder by \n")
+ (" inner join " "\ninner join ")
+ (" left join " "\nleft join ")
+ (" on " "\n on ")
+ (" group by " "\ngroup by "))))))
+
+(defun ejc-format-sql-at-point ()
+ (interactive)
+ (ejc--in-sql-boundaries
+ beg end
+ (ejc-format-sql beg end)))
+
+(defun ejc-pretty-print-sql-at-point ()
+ "Pretty-print SQL bounded by the `ejc-sql-separator' or/and buffer
+boundaries."
+ (interactive)
+ (ejc--in-sql-boundaries
+ beg end
+ (let ((result (ejc-pretty-print (buffer-substring beg end) :hibernate)))
+ (delete-region beg end)
+ (insert result))))
+
+(defun ejc-pretty-print-sql-region (beg end)
+ "Pretty-print SQL bounded by the selection area."
+ (interactive "r")
+ (let ((result (ejc-pretty-print (buffer-substring beg end) :hibernate)))
+ (delete-region beg end)
+ (insert result)))
+
+(defun ejc-insert-file-header ()
+ (interactive)
+ (insert (concat "-- -*- mode: sql; -*-\n"
+ "-- Local Variables:\n"
+ "-- eval: (ejc-sql-mode)\n"
+ "-- End:\n")))
+
+(defvar ejc-clear-sql-regexp
+ (concat "^\\s-*\\t*\""
+ "\\|\\\\n\"\s-*\\+$"
+ "\\|\\\\n\";$"))
+
+(defun ejc-strinp-sql-at-point ()
+ (interactive)
+ (ejc--in-sql-boundaries
+ beg end
+ (save-excursion
+ (replace-regexp ejc-clear-sql-regexp "" nil beg end)
+ (whitespace-cleanup-region beg end))))
+
+(defun ejc-longest-line-length (beg-line end-line)
+ (interactive)
+ (save-excursion
+ (let ((curr-line beg-line)
+ (max-length 0)
+ (new-length 0))
+ (while (<= curr-line end-line)
+ (goto-line curr-line)
+ (setq new-length (save-excursion
+ (end-of-line)
+ (current-column)))
+ (if (> new-length max-length)
+ (setq max-length new-length))
+ (setq curr-line (1+ curr-line)))
+ max-length)))
+
+(defun ejc-is-separator-string (pos)
+ (equal (string-trim (buffer-substring
+ pos
+ (save-excursion
+ (end-of-line)
+ (point))))
+ ejc-sql-separator))
+
+(defun ejc-dress-sql-at-point ()
+ (interactive)
+ (ejc-strinp-sql-at-point)
+ (save-excursion
+ (ejc--in-sql-boundaries
+ beg end
+ (let* ((beg-line (progn (goto-char beg)
+ (right-char)
+ (line-number-at-pos)))
+ (end-line (progn (goto-char end)
+ (if (ejc-is-separator-string end)
+ (left-char 1))
+ (line-number-at-pos)))
+ (length-line (ejc-longest-line-length beg-line end-line))
+ (curr-line beg-line))
+ (while (<= curr-line end-line)
+ (goto-line curr-line)
+ (beginning-of-line)
+ (insert-string "\"")
+ (end-of-line)
+ (dotimes (counter (+ 2 (- length-line (current-column))))
+ (insert-string " "))
+ (if (equal curr-line end-line)
+ (insert-string "\\n\";")
+ (insert-string "\\n\" +"))
+ (setq curr-line (1+ curr-line)))))))
+
+(defun ejc-flash-region (start end &optional timeout)
+ "Temporarily highlight region from START to END."
+ (let ((overlay (make-overlay start end)))
+ (overlay-put overlay 'face 'secondary-selection)
+ (run-with-timer (or timeout 0.2) nil 'delete-overlay overlay)))
+
+(defun ejc-flash-this-sql ()
+ "Select (mark) SQL around the point."
+ (interactive)
+ (ejc--in-sql-boundaries
+ beg end
+ (ejc-flash-region beg end)))
+
+(provide 'ejc-format)
+
+;;; ejc-format.el ends here
--- /dev/null
+;;; ejc-interaction.el -- ejc-sql interact with Clojure. -*- lexical-binding: t -*-
+
+;;; Copyright © 2013-2017 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; 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, 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. */
+
+;;; Code:
+
+(require 'ejc-lib)
+(require 'ejc-format)
+(require 'clomacs)
+
+(clomacs-defun ejc-sql-set-db
+ set-db
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.connect
+ :doc "Define ejc-sql.connect/db var.")
+
+(clomacs-defun ejc-jpa-connect
+ ejc-sql.jpa/connect-plain
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.jpa
+ :doc "Define ejc-sql.jpa/em var.")
+
+(clomacs-defun ejc-add-classpath
+ add-classpath
+ :lib-name "ejc-sql"
+ :namespace cemerick.pomegranate)
+
+(clomacs-defun ejc-require
+ clojure.core/require
+ :lib-name "ejc-sql")
+
+(clomacs-defun ejc-import
+ clojure.core/import
+ :lib-name "ejc-sql")
+
+(defun ejc-connect-to-db (conn-struct)
+ (ejc-require `'cemerick.pomegranate)
+ (cl-case (ejc-get-connection-type conn-struct)
+ ;;----------------------------------------------------------------------
+ ;; is JDBC/SQL
+ (:sql
+ (ejc-add-classpath (ejc-db-conn-classpath conn-struct))
+ (ejc-import (read (ejc-db-conn-classname conn-struct)))
+ (ejc-sql-set-db (ejc-connection-struct-to-plist conn-struct)))
+ ;;----------------------------------------------------------------------
+ ;; is JPA/JPQL
+ (:jpa
+ (ejc-jpa-connect (ejc-jpa-connection-name conn-struct)
+ (ejc-jpa-persistent-xml-url conn-struct)
+ (ejc-jpa-domain-objects-url conn-struct)
+ (ejc-jpa-jdbc-driver-url conn-struct))))
+ (setq-local ejc-connection-struct conn-struct))
+
+(defun ejc-get-sql-from-string (sql)
+ (let* ((sql (replace-regexp-in-string ejc-clear-sql-regexp "" sql))
+ (sql (replace-regexp-in-string "\"" "'" sql)))
+ sql))
+
+(clomacs-defun ejc--eval-sql-and-log
+ ejc-sql.connect/eval-sql-and-log
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.connect
+ :doc "Evaluate user's SQL scripts and write them to log file.")
+
+(clomacs-defun ejc--eval-sql-and-log-print
+ ejc-sql.connect/eval-sql-and-log-print
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.connect
+ :return-type :string
+ :return-value :stdout)
+
+(clomacs-defun ejc--eval-jpql
+ ejc-sql.jpa/eval-jpql-print
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.jpa
+ :return-type :string
+ :return-value :stdout)
+
+(defun ejc-eval-sql-and-log (db sql &optional call-type callback)
+ "Core function to evaluate SQL queries.
+Prepare SQL string, evaluate SQL script and write them to log file"
+ (if sql
+ (let* ((prepared-sql (ejc-get-sql-from-string sql))
+ (result (cl-case (ejc-get-connection-type ejc-connection-struct)
+ (:sql
+ (progn
+ (if (and (equal call-type :async) callback)
+ (let* ((buf (current-buffer))
+ (eval-sql-and-log-async
+ (clomacs-defun _
+ ejc-sql.connect/eval-sql-and-log-print
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.connect
+ :call-type :async
+ :callback (lambda (res)
+ (funcall callback res)
+ (with-current-buffer buf
+ (spinner-stop)))
+ :return-type :string
+ :return-value :stdout)))
+ (spinner-start 'rotating-line)
+ (funcall eval-sql-and-log-async db prepared-sql))
+ (ejc--eval-sql-and-log-print db prepared-sql))))
+ (:jpa (ejc--eval-jpql prepared-sql))
+ (nil "No database connection."))))
+ result)))
+
+(clomacs-defun ejc--eval-sql-get-column
+ ejc-sql.connect/eval-sql-internal-get-column
+ :lib-name "ejc-sql"
+ :return-type :list
+ :namespace ejc-sql.connect
+ :doc "Get `sql', return list.")
+
+(defalias 'ejc--eval-get-list 'ejc--eval-sql-get-column)
+
+(clomacs-defun ejc--get-table-meta
+ ejc-sql.connect/get-table-meta
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.connect)
+
+(clomacs-defun ejc-print
+ clojure.core/print
+ :lib-name "ejc-sql"
+ :return-type :string
+ :return-value :stdout)
+
+(defun ejc-get-table-meta (db table-name)
+ (ejc-print (ejc--get-table-meta db table-name)))
+
+(clomacs-defun ejc-get-log-file-path
+ print-log-file-path
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.output
+ :return-value :stdout)
+
+(clomacs-defun ejc-pretty-print
+ pretty-print
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.output
+ :return-value :stdout)
+
+(clomacs-defun ejc-set-rows-limit
+ set-rows-limit
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.output
+ :doc (concat "Set limit for number of records to output. "
+ "When nil no limit."))
+
+(clomacs-defun ejc-get-stucture
+ get-stucture
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :list)
+
+(clomacs-defun get-cached-tables-list
+ get-tables
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :list
+ :doc "Return cached tables list.
+ Requires `ejc-db' buffer local variable as parameter.")
+
+(clomacs-defun get-cached-colomns-list
+ get-colomns
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :list
+ :doc "Return cached tables list.
+ Requires `ejc-db' buffer local variable and table name as parameters.")
+
+(clomacs-defun ejc-invalidate-cache-inner
+ invalidate-cache
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :doc (concat "Clean your current connection cache "
+ "(database owners and tables list)."))
+
+(defun ejc-invalidate-cache ()
+ "Clean current connection cache (database owners and tables list)."
+ (interactive)
+ (ejc-invalidate-cache-inner ejc-connection-struct))
+
+(clomacs-defun ejc-get-cache
+ get-cache
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure)
+
+(clomacs-defun ejc-select-db-meta-script
+ select-db-meta-script
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure)
+
+(defun ejc-quit-connection ()
+ "Stop nREPL process, mark ejc-sql-mode buffers disconnected."
+ (interactive)
+ (when (y-or-n-p "Are you sure you want to close all jdbc connections?")
+ (cider--quit-connection (clomacs-get-connection "ejc-sql"))
+ ;; Update modeline of ejc-sql-mode buffers - mark as disconnected.
+ (let ((buffers (buffer-list)))
+ (while buffers
+ (with-current-buffer (car buffers)
+ (when (equal major-mode ejc-sql-mode)
+ (sql-highlight-product)))
+ (setq buffers (cdr buffers)))))
+ (unless (cider-connected-p)
+ (cider-close-ancillary-buffers)))
+
+(provide 'ejc-interaction)
+
+;;; ejc-interaction.el ends here
--- /dev/null
+;;; ejc-lib.el -- ejc-sql shared objects (the part of ejc-sql).
+
+;;; Copyright © 2013-2016 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; 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, 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. */
+
+;;; Code:
+
+(require 'dash)
+
+(defvar-local ejc-connection-name nil
+ "Buffer-local connection name created with `ejc-create-connection'.")
+
+(defvar-local ejc-connection-struct nil
+ "Buffer-local connection structure.")
+
+(defun ejc-string-endswith-p (s ending)
+ "Return non-nil if string S ends with ENDING."
+ (let ((elength (length ending)))
+ (string= (substring s (- 0 elength)) ending)))
+
+(defun ejc-get-connection-type (conn-struct)
+ "JDBC/SQL, JPA/JPQL or Hibernate/HQL connection type."
+ (cond
+ ((ejc-db-conn-p conn-struct) :sql)
+ ((ejc-jpa-p conn-struct) :jpa)
+ (t nil)))
+
+(cl-defstruct ejc-db-conn
+ "DB connection information structure"
+ ; path to jdbc jar file
+ (classpath "<path>/<filename>.jar")
+ ; the JDBC driver class
+ (classname "<com.povider.jdbc.DataBaseDriver>")
+ ; the kind of database, e.g:
+ ; informix-sqli, mysql, postgresql,
+ ; oracle, sqlserver, etc.
+ (subprotocol "<sql-kind>")
+ ; db connection path
+ ; locale, like ru_RU.1251
+ (database "<my-databse>")
+ (subname (concat
+ "://<db-host>:<db-port>:"
+ "<db-server>=<server-name>;"
+ "database=<db-name>;"
+ "DB_LOCALE=<locale>;"
+ "CLIENT_LOCALE=<locale>;"
+ ))
+ (user "<user-name>")
+ (password "<password>")
+ (connection-uri "jdbc:<povider>://[serverName[\instanceName][:portNumber]][;property=value[;property=value]]")
+ (separator ";"))
+
+(cl-defstruct ejc-jpa
+ "DB connection information structure for JPA"
+ (type :jpa)
+ (connection-name "<persistence-unit name=")
+ (persistent-xml-url "path to META-INF/persistence.xml")
+ (domain-objects-url "path to classes/")
+ (jdbc-driver-url "<path>/<filename>.jar"))
+
+(defun ejc-connection-struct-to-plist (conn-struct)
+ (-filter
+ (lambda (x) (cdr x))
+ (list
+ `(:classname . ,(ejc-db-conn-classname conn-struct))
+ `(:subprotocol . ,(ejc-db-conn-subprotocol conn-struct))
+ `(:subname . ,(ejc-db-conn-subname conn-struct))
+ `(:user . ,(ejc-db-conn-user conn-struct))
+ `(:password . ,(ejc-db-conn-password conn-struct))
+ `(:database . ,(ejc-db-conn-database conn-struct))
+ `(:separator . ,(ejc-db-conn-separator conn-struct))
+ `(:connection-uri . ,(ejc-db-conn-connection-uri conn-struct)))))
+
+(defun ejc-find-file-in-load-path (search-file-name &optional fail-on-error)
+ "Return the full path to `file-name'.
+`file-name' is searching in the emacs `load-path'."
+ (let ((result nil))
+ (dolist (path load-path)
+ (let ((search-file-path (expand-file-name search-file-name path)))
+ (if (file-exists-p search-file-path)
+ (setq result search-file-path))))
+ (if (and fail-on-error (not result))
+ (error (concat "Can't find file " search-file-name))
+ result)))
+
+(defun ejc-strip-text-properties (txt)
+ (set-text-properties 0 (length txt) nil txt)
+ txt)
+
+(provide 'ejc-lib)
+
+;;; ejc-lib.el ends here
--- /dev/null
+;;; ejc-result-mode.el
+
+;;; Copyright © 2017 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; 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, 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. */
+
+;;; Code:
+
+(defface ejc-result-table-borders-face '((t :inherit font-lock-comment-face))
+ "Face used to font-lock table borders."
+ :group 'ejc-sql-faces)
+
+(defconst ejc-result-font-lock-keywords
+ '(("|" . 'ejc-result-table-borders-face)
+ ("-" . 'ejc-result-table-borders-face)
+ ("+" . 'ejc-result-table-borders-face)))
+
+(defun ejc-result-mode ()
+ (interactive)
+ (kill-all-local-variables)
+ (setq truncate-lines t)
+ (setq major-mode 'ejc-result-mode
+ mode-name "SQL-Result")
+ (setq font-lock-defaults '(ejc-result-font-lock-keywords)))
+
+(provide 'ejc-result-mode)
+
+;;; ejc-result-mode.el ends here
--- /dev/null
+;;; ejc-sql-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
+\f
+;;;### (autoloads nil "ejc-autocomplete" "ejc-autocomplete.el" (22692
+;;;;;; 30293 0 0))
+;;; Generated autoloads from ejc-autocomplete.el
+
+(autoload 'ejc-candidates "ejc-autocomplete" "\
+Possible completions list according to already typed prefixes.
+
+\(fn)" nil nil)
+
+(autoload 'ejc-ac-setup "ejc-autocomplete" "\
+Add the completion sources to the front of `ac-sources'.
+This affects only the current buffer.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads nil "ejc-sql" "ejc-sql.el" (22692 30293 0 0))
+;;; Generated autoloads from ejc-sql.el
+
+(autoload 'ejc-sql-mode "ejc-sql" "\
+Toggle ejc-sql mode.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'ejc-create-menu "ejc-sql" "\
+
+
+\(fn)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads nil nil ("ejc-format.el" "ejc-interaction.el" "ejc-lib.el"
+;;;;;; "ejc-result-mode.el" "ejc-sql-pkg.el") (22692 30293 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; ejc-sql-autoloads.el ends here
--- /dev/null
+(define-package "ejc-sql" "20170215.321" "Emacs SQL client uses Clojure JDBC."
+ '((emacs "24.4")
+ (clomacs "0.0.2")
+ (cider "0.14")
+ (dash "2.12.1")
+ (auto-complete "1.5.1")
+ (spinner "1.7.1"))
+ :url "https://github.com/kostafey/ejc-sql" :keywords
+ '("sql" "jdbc"))
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; ejc-sql.el --- Emacs SQL client uses Clojure JDBC. -*- lexical-binding: t -*-
+
+;;; Copyright © 2012-2017 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;; Author: Kostafey <kostafeyNOSPAMgmail.com>
+;; URL: https://github.com/kostafey/ejc-sql
+;; Keywords: sql, jdbc
+;; Version: 0.0.1
+;; Package-Requires: ((emacs "24.4")(clomacs "0.0.2")(cider "0.14")(dash "2.12.1")(auto-complete "1.5.1")(spinner "1.7.1"))
+
+;; 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 2, 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:
+
+;; ejc-sql turns Emacs into simple SQL client, it uses JDBC connection to
+;; databases via clojure/java.jdbc lib.
+
+;; See README.md for detailed description.
+
+;;; Code:
+
+(require 'sql)
+(require 'dash)
+(require 'cl-lib)
+(require 'ejc-lib)
+(require 'ejc-format)
+(require 'ejc-interaction)
+(require 'ejc-result-mode)
+(require 'ejc-autocomplete)
+
+(defvar-local ejc-db nil
+ "JDBC connection info for current SQL buffer.")
+
+(defvar ejc-connections nil
+ "List of existing configured jdbc connections")
+
+(defvar ejc-results-buffer nil
+ "The results buffer.")
+
+(defvar ejc-results-buffer-name "*ejc-sql-output*"
+ "The results buffer name.")
+
+(defvar ejc-sql-editor-buffer-name "*ejc-sql-editor*"
+ "The buffer for conveniently edit ad-hoc SQL scripts.")
+
+(defvar ejc-show-results-buffer t
+ "When t show results in separate buffer, use minibuffer otherwise.")
+
+(defvar ejc-sql-mode-keymap (make-keymap) "ejc-sql-mode keymap.")
+(define-key ejc-sql-mode-keymap (kbd "C-c C-c") 'ejc-eval-user-sql-at-point)
+(define-key ejc-sql-mode-keymap (kbd "C-x S") 'ejc-eval-user-sql-region)
+(define-key ejc-sql-mode-keymap (kbd "C-x <up>") 'ejc-show-last-result)
+(define-key ejc-sql-mode-keymap (kbd "C-h t") 'ejc-describe-table)
+(define-key ejc-sql-mode-keymap (kbd "C-h T") 'ejc-describe-entity)
+(define-key ejc-sql-mode-keymap (kbd "C-c t") 'ejc-show-tables-list)
+(define-key ejc-sql-mode-keymap (kbd "C-c T") 'ejc-show-user-types-list)
+(define-key ejc-sql-mode-keymap (kbd "C-c s") 'ejc-strinp-sql-at-point)
+(define-key ejc-sql-mode-keymap (kbd "C-c S") 'ejc-dress-sql-at-point)
+(define-key ejc-sql-mode-keymap (kbd "C-c p") 'ejc-pretty-print-sql-at-point)
+(define-key ejc-sql-mode-keymap (kbd "C-S-s-<up>") '(lambda() (interactive) (ejc-previous-sql t)))
+(define-key ejc-sql-mode-keymap (kbd "C-S-s-<down>") '(lambda() (interactive) (ejc-next-sql t)))
+(define-key ejc-sql-mode-keymap (kbd "C-s-<up>") 'ejc-previous-sql)
+(define-key ejc-sql-mode-keymap (kbd "C-s-<down>") 'ejc-next-sql)
+
+(defvar ejc-sql-minor-mode-exit-hook nil
+ "*Functions to be called when `ejc-sql-mode' is exited.")
+
+(defvar ejc-sql-minor-mode-hook nil
+ "*Functions to be called when `ejc-sql-mode' is entered.")
+
+(defvar ejc-sql-mode nil)
+
+;;;###autoload
+(define-minor-mode ejc-sql-mode
+ "Toggle ejc-sql mode."
+ :lighter " ejc"
+ :keymap ejc-sql-mode-keymap
+ :group 'ejc
+ :global nil
+ ;; :after-hook (ejc-create-menu)
+ (if ejc-sql-mode
+ (progn
+ (ejc-ac-setup)
+ (ejc-create-menu)
+ (run-hooks 'ejc-sql-minor-mode-hook))
+ (progn
+ ;; (global-unset-key [menu-bar ejc-menu])
+ (run-hooks 'ejc-sql-minor-mode-exit-hook))))
+
+;;;###autoload
+(defun ejc-create-menu ()
+ (define-key-after
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu]
+ (cons "ejc-sql" (make-sparse-keymap "ejc-sql mode"))
+ 'tools )
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu ev]
+ '("Eval SQL" . ejc-eval-user-sql-at-point))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu fs]
+ '("Format SQL" . ejc-format-sql-at-point))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu ms]
+ '("Mark SQL" . ejc-mark-this-sql))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu tl]
+ '("Show tables list" . ejc-show-tables-list))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu cl]
+ '("Show constraints list" . ejc-show-constraints-list))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu pl]
+ '("Show procedures list" . ejc-show-procedures-list))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu ss]
+ '("Strip SQL" . ejc-strinp-sql-at-point))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu ds]
+ '("Dress SQL" . ejc-dress-sql-at-point))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu ol]
+ '("Open log" . ejc-open-log))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu sl]
+ '("Show last result" . ejc-show-last-result))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu qc]
+ '("Quit connection" . ejc-quit-connection)))
+
+(cl-defun ejc-create-connection (connection-name
+ &key
+ classpath
+ classname
+ subprotocol
+ subname
+ subname
+ user
+ password
+ database
+ connection-uri
+ separator)
+ "Add new connection configuration named CONNECTION-NAME
+to `ejc-connections' list or replace existing with the same CONNECTION-NAME."
+ (setq ejc-connections (-remove (lambda (x) (equal (car x) connection-name))
+ ejc-connections))
+ (setq ejc-connections (cons (cons
+ connection-name
+ (make-ejc-db-conn
+ :classpath (file-truename classpath)
+ :classname classname
+ :subprotocol subprotocol
+ :subname subname
+ :user user
+ :password password
+ :database database
+ :connection-uri connection-uri
+ :separator separator))
+ ejc-connections)))
+
+(defun ejc-find-connection (connection-name)
+ "Return pair with name CONNECTION-NAME and db connection structure from
+`ejc-connections'."
+ (-find (lambda (x) (equal (car x) connection-name))
+ ejc-connections))
+
+(defvar ejc-product-assoc
+ '((sqlserver . ms)))
+
+(defun ejc-configure-sql-buffer (product-name)
+ (sql-mode)
+ (sql-set-product (or (cdr (assoc product-name ejc-product-assoc))
+ (car (assoc product-name sql-product-alist))
+ "ansi"))
+ (auto-complete-mode t)
+ (auto-fill-mode t)
+ (ejc-sql-mode)
+ (ejc-sql-mode t))
+
+(defun ejc-connect (connection-name)
+ "Connect to selected db."
+ (interactive
+ (list
+ (ido-completing-read "DataBase connection name: "
+ (mapcar 'car ejc-connections))))
+ (let ((db (cdr (ejc-find-connection connection-name))))
+ (ejc-configure-sql-buffer (ejc-db-conn-subprotocol db))
+ (setq-local ejc-connection-name connection-name)
+ (setq-local ejc-db (ejc-connection-struct-to-plist db))
+ (message "Connection started...")
+ (ejc-connect-to-db db)
+ (setq mode-name (format "%s->[%s]" mode-name connection-name))
+ (message "Connected.")))
+
+(defun ejc-get-word-at-point (pos)
+ "Return SQL word around the point."
+ (interactive "d")
+ (let* ((char (char-after pos))
+ (str (char-to-string char)))
+ (save-excursion
+ (let* ((end (if (member str '(" " ")" "<" ">" "="))
+ (point)
+ (progn
+ (forward-sexp 1)
+ (point))))
+ (beg (progn
+ (forward-sexp -1)
+ (point)))
+ (sql-word (buffer-substring beg end)))
+ sql-word))))
+
+(defun ejc-get-prompt-symbol-under-point (msg)
+ (let ((sql-symbol (if mark-active
+ (buffer-substring (mark) (point))
+ (ejc-get-word-at-point (point))))
+ (enable-recursive-minibuffers t)
+ val)
+ (setq val (completing-read
+ (if sql-symbol
+ (format "%s (default %s): " msg sql-symbol)
+ (format "%s: " msg))
+ obarray))
+ (list (if (equal val "")
+ sql-symbol
+ val))))
+
+(defun ejc-check-connection ()
+ (unless ejc-db
+ (error "Run M-x ejc-connect first!")))
+
+(defun ejc-describe-table (table-name)
+ "Describe SQL table TABLE-NAME (default table name - word around the point)."
+ (interactive (ejc-get-prompt-symbol-under-point "Describe table"))
+ (ejc-check-connection)
+ (let* ((owner (car (split-string table-name "\\.")))
+ (table (cadr (split-string table-name "\\."))))
+ (when (not table)
+ (setq table owner)
+ (setq owner nil))
+ (ejc-show-last-result
+ (concat
+ (ejc-get-table-meta ejc-db table-name)
+ "\n"
+ (let ((sql (ejc-select-db-meta-script ejc-db :constraints
+ :owner owner
+ :table table)))
+ (if (ejc-not-nil-str sql)
+ (ejc-eval-sql-and-log ejc-db sql)
+ ""))))))
+
+(defun ejc-describe-entity (entity-name)
+ "Describe SQL entity ENTITY-NAME - function, procedure or type
+ (default entity name - word around the point)."
+ (interactive (ejc-get-prompt-symbol-under-point "Describe entity"))
+ (ejc-check-connection)
+ (ejc-show-last-result
+ (ejc-eval-sql-and-log ejc-db
+ (ejc-select-db-meta-script ejc-db :entity
+ :entity-name entity-name))))
+
+(defun ejc-eval-user-sql (sql &optional sync)
+ "Evaluate SQL by user: reload and show query results buffer, update log."
+ (message "Processing SQL query...")
+ (cl-labels ((msg-done () (if ejc-show-results-buffer
+ (message "Done SQL query."))))
+ (if sync
+ (progn
+ (ejc-show-last-result (ejc-eval-sql-and-log ejc-db sql))
+ (msg-done))
+ (ejc-eval-sql-and-log ejc-db sql
+ :async (lambda (res)
+ (ejc-show-last-result res)
+ (msg-done))))))
+
+(defun ejc-eval-user-sql-region (beg end)
+ "Evaluate SQL bounded by the selection area."
+ (interactive "r")
+ (ejc-check-connection)
+ (let ((sql (buffer-substring beg end)))
+ (ejc-eval-user-sql sql)))
+
+(cl-defun ejc-eval-user-sql-at-point (&optional sync)
+ "Evaluate SQL bounded by the `ejc-sql-separator' or/and buffer
+boundaries."
+ (interactive)
+ (ejc-check-connection)
+ (ejc-flash-this-sql)
+ (ejc-eval-user-sql (ejc-get-sql-at-point) sync))
+
+(defun ejc-show-tables-list (&optional owner)
+ "Output tables list."
+ (interactive)
+ (ejc-check-connection)
+ (ejc-eval-user-sql
+ (ejc-select-db-meta-script ejc-db :tables
+ :owner owner)))
+
+(defun ejc-show-user-types-list (&optional owner)
+ "Output user types list."
+ (interactive)
+ (ejc-check-connection)
+ (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :types
+ :owner owner)))
+
+(defun ejc-show-constraints-list (&optional owner table)
+ "Output constraints list."
+ (interactive)
+ (ejc-check-connection)
+ (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :constraints
+ :owner owner
+ :table table)))
+
+(defun ejc-show-procedures-list (&optional owner)
+ "Output procedures list."
+ (interactive)
+ (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :procedures
+ :owner owner)))
+
+;;-----------------------------------------------------------------------------
+;; results buffer
+;;
+(defun ejc-create-output-buffer ()
+ (set-buffer (get-buffer-create ejc-results-buffer-name))
+ (setq ejc-results-buffer (current-buffer))
+ (setq view-read-only t)
+ (ejc-result-mode)
+ ejc-results-buffer)
+
+(defun ejc-get-buffer-or-create (buffer-or-name create-buffer-fn)
+ "Return buffer passed in `buffer-or-name' parameter.
+If this buffer is not exists or it was killed - create buffer via
+`create-buffer-fn' function (this function must return buffer)."
+ (let ((buf (if (bufferp buffer-or-name)
+ buffer-or-name
+ (get-buffer buffer-or-name))))
+ (if (and buf (buffer-live-p buf))
+ buf
+ (apply create-buffer-fn nil))))
+
+(defun ejc-get-output-buffer ()
+ (if (and ejc-results-buffer (buffer-live-p ejc-results-buffer))
+ ejc-results-buffer
+ (ejc-create-output-buffer)))
+
+(defun ejc-toggle-show-results-buffer ()
+ (interactive)
+ (if ejc-show-results-buffer
+ (setq ejc-show-results-buffer nil)
+ (setq ejc-show-results-buffer t)))
+
+(defun ejc-show-last-result (&optional result)
+ "Popup buffer with last SQL execution result output."
+ (interactive)
+ (if ejc-show-results-buffer
+ (let ((output-buffer (ejc-get-output-buffer))
+ (old-split split-width-threshold))
+ (set-buffer output-buffer)
+ (when result
+ (read-only-mode -1)
+ (erase-buffer)
+ (insert result))
+ (read-only-mode 1)
+ (beginning-of-buffer)
+ (setq split-width-threshold nil)
+ (display-buffer output-buffer)
+ (setq split-width-threshold old-split))
+ (let ((result-lines (split-string result "\n")))
+ (message "%s"
+ (if (<= (length result-lines) 3)
+ (apply 'concat (cl-subseq result-lines 0 3))
+ (concat (apply 'concat (cl-subseq result-lines 0 3))
+ "... ("
+ (number-to-string (- (length result-lines) 3))
+ " more)"))))))
+;;
+;;-----------------------------------------------------------------------------
+
+;;-----------------------------------------------------------------------------
+;; editor buffer
+;;
+(defun ejc-create-sql-editor-buffer ()
+ "Create buffer dedicated to ad-hoc edit and SQL scripts."
+ (let ((sql-editor-buffer (get-buffer-create ejc-sql-editor-buffer-name)))
+ (save-excursion
+ (set-buffer sql-editor-buffer)
+ (ejc-configure-sql-buffer "ansi"))
+ sql-editor-buffer))
+
+(defun ejc-switch-to-sql-editor-buffer ()
+ "Switch to buffer dedicated to ad-hoc edit and SQL scripts.
+If the buffer is not exists - create it."
+ (interactive)
+ (switch-to-buffer
+ (ejc-get-buffer-or-create
+ ejc-sql-editor-buffer-name
+ 'ejc-create-sql-editor-buffer)))
+;;
+;;-----------------------------------------------------------------------------
+
+;;-----------------------------------------------------------------------------
+;; log buffer
+;;
+(defun ejc-open-log ()
+ (interactive)
+ (find-file-read-only (ejc-get-log-file-path))
+ (end-of-buffer))
+;;
+;;-----------------------------------------------------------------------------
+
+(provide 'ejc-sql)
+
+;;; ejc-sql.el ends here
--- /dev/null
+(defproject ejc-sql "0.0.1-SNAPSHOT"
+ :description "Interact with database via java/clojure libs to run SQL/JPQL scripts"
+ :url "https://github.com/kostafey/ejc-sql"
+ :license {:name "GPL 2.0+"
+ :url "http://www.gnu.org/licenses/old-licenses/gpl-2.0.html"}
+ :dependencies [[org.clojure/clojure "1.8.0"]
+ [org.clojure/clojure-contrib "1.2.0"]
+ [org.clojure/java.jdbc "0.5.8"]
+ [org.apache.openjpa/openjpa-all "2.2.2"]
+ [org.hibernate/hibernate-core "5.2.3.Final"]
+ [com.cemerick/pomegranate "0.3.0"]
+ [org.apache.commons/commons-lang3 "3.2.1"]])
--- /dev/null
+;;; connect.clj -- Core clojure functions for ejc-sql emacs extension.
+
+;;; Copyright © 2013-2016 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; 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, 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. */
+
+(ns ejc-sql.connect
+ (:use [clojure.java.io]
+ [ejc-sql.lib]
+ [ejc-sql.output])
+ (:require [clojure.java.jdbc :as j]
+ [clojure.java.jdbc.deprecated :as jd]
+ [clojure.contrib.java-utils])
+ (:import [java.sql Connection
+ DriverManager
+ PreparedStatement
+ ResultSet
+ SQLException]))
+
+(def db
+ "DataBase connection properties list from the last transaction.
+For debug purpose."
+ (atom nil))
+
+(defn set-db [ejc-db]
+ (reset! db ejc-db))
+
+(def dml-set
+ #{"SELECT"
+ "INSERT"
+ "UPDATE"
+ "DELETE"})
+
+(def ignore-set #{"(" "["})
+
+(defn determine-dml [sql]
+ "Determine if current SQL is Data Manipulation Language (DML) case."
+ (let [sql (.trim sql)
+ pos (loop [rest-sql sql
+ pos 0]
+ (let [symb (subs rest-sql 0 1)]
+ (if (ignore-set symb)
+ (recur (subs rest-sql 1) (inc pos))
+ pos)))]
+ (or
+ (dml-set (.toUpperCase (subs sql pos 6)))
+ (#{"SHOW"} (.toUpperCase (subs sql pos 4))))))
+
+(defn handle-special-cases [db sql]
+ (case (:subprotocol db)
+ "oracle" (case (clojure.string/upper-case sql)
+ "SHOW ERRORS" (str "SELECT line, position, sequence, text
+ FROM all_errors
+ WHERE type = 'FUNCTION'
+ AND name = 'FILTERDICT'
+ AND attribute != 'WARNING'
+ AND owner = '" (:user db) "'
+ ORDER BY line, position, sequence")
+ sql)
+ sql))
+
+(defn eval-sql-core
+ "The core SQL evaluation function."
+ [& {:keys [db sql]
+ :or {db @ejc-sql.connect/db}}]
+ (set-db db)
+ (let [statement-separator (or (:separator db) ";")]
+ (last
+ (for [sql-part (seq (.split (handle-special-cases db sql)
+ statement-separator))]
+ (try
+ (let [sql-query-word (determine-dml sql-part)]
+ (if (and sql-query-word (or (.equals sql-query-word "SELECT")
+ (.equals sql-query-word "SHOW")))
+ (list :result-set
+ (j/query db (list sql-part) {:as-arrays? false}))
+ (list :message
+ (str "Records affected: "
+ (first (j/execute! db (list sql-part)))))))
+ (catch SQLException e
+ (list :message
+ (str "Error: "(.getMessage e)))))))))
+
+(defn eval-user-sql [db sql]
+ (let [clear-sql (.trim sql)]
+ (ejc-sql.output/log-sql (str clear-sql "\n"))
+ (let [[result-type result] (eval-sql-core
+ :db db
+ :sql clear-sql)]
+ (if (= result-type :result-set)
+ (ejc-sql.output/print-table result)
+ result))))
+
+(defn eval-sql-and-log-print
+ "Write SQL to log file, evaluate it and print result."
+ [db sql]
+ (print (eval-user-sql db sql)))
+
+(defn eval-sql-internal-get-column [db sql]
+ (let [[result-type result] (eval-sql-core :db db
+ :sql sql)]
+ (if (= result-type :result-set)
+ (-> result rest flatten)
+ result)))
+
+(defn table-meta
+ [db table-name]
+ (set-db db)
+ (jd/with-connection db
+ (let
+ [connect (jd/connection)
+ statement (.createStatement connect)
+ execResult (try
+ (list
+ (.executeQuery
+ statement
+ (str "select * from " table-name " where 0 = 1")) true)
+ (catch SQLException e
+ (list (str "Error: " (.getMessage e)) false)))
+ result-data (first execResult)
+ success (last execResult)]
+ (if success
+ {:success true
+ :result
+ (let [resultSet result-data
+ rsMeta (.getMetaData resultSet)
+ colCount (.getColumnCount rsMeta)]
+ (loop [i 1
+ acc []]
+ (if (> i colCount)
+ acc
+ (recur (inc i)
+ (conj acc {:name (.getColumnLabel rsMeta i)
+ :type (.getColumnTypeName rsMeta i)})))))}
+ {:success false :result result-data}))))
+
+(defn get-table-meta
+ "Discribe table."
+ [db table-name]
+ (let [result-map (table-meta db table-name)
+ success (:success result-map)
+ result-data (:result result-map)
+ head (str "Table ``" table-name "`` description:\n")
+ head-length (dec (.length head))]
+ (if success
+ (str head
+ (ejc-sql.lib/simple-join head-length "-") "\n"
+ (ejc-sql.output/print-table result-data))
+ result-data)))
--- /dev/null
+(ns ejc-sql.jpa
+ (:require [cemerick.pomegranate :as pom])
+ (:use [clojure.java.io]
+ [ejc-sql.lib]
+ [ejc-sql.output])
+ (:import [javax.persistence Persistence
+ EntityManager
+ TypedQuery]
+ [org.apache.commons.lang3.builder
+ ReflectionToStringBuilder
+ ToStringStyle]))
+
+(def em)
+
+(defn connect [{:keys [connection-name
+ persistent-xml-url
+ domain-objects-url
+ jdbc-driver-url]}]
+ (pom/add-classpath persistent-xml-url)
+ (pom/add-classpath domain-objects-url)
+ (pom/add-classpath jdbc-driver-url)
+ (def em (-> (Persistence/createEntityManagerFactory connection-name)
+ (.createEntityManager))))
+
+(defn connect-plain [connection-name
+ persistent-xml-url
+ domain-objects-url
+ jdbc-driver-url]
+ (connect
+ {:connection-name connection-name
+ :persistent-xml-url persistent-xml-url
+ :domain-objects-url domain-objects-url
+ :jdbc-driver-url jdbc-driver-url}))
+
+(defn eval-jpql [jpql]
+ (-> em (.createQuery jpql) (.getResultList) (.toArray)))
+
+(defn row-to-str [row]
+ (if (not (array? row))
+ (ReflectionToStringBuilder/toString
+ row ToStringStyle/SHORT_PREFIX_STYLE)
+ (list (str row))))
+
+(defn eval-jpql-print [jpql]
+ (print
+ (format-output (map row-to-str (eval-jpql jpql))
+ :as-arrays? true, :add-headers? false)))
+
--- /dev/null
+;;; lib.clj -- Misc clojure functions for ejc-sql emacs extension.
+
+;;; Copyright © 2013 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; 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, 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. */
+
+(ns ejc-sql.lib
+ (:import (java.io File)))
+
+(def windows?
+ "The value is true if it runs under the os Windows."
+ (>= 0 (.indexOf (System/getProperty "os.name") "Windows")))
+
+(defn in?
+ "true if seq contains elm"
+ [seq elm]
+ (some #(= elm %) seq))
+
+(defn array? [x]
+ (-> x .getClass .isArray))
+
+(defn trim [s]
+ (if (instance? java.lang.String s)
+ (.trim s)
+ s))
+
+(defn filter-data [rs]
+ (map #(map trim %) rs))
+
+(defn get-rs-data [rs]
+ (map vals rs))
+
+(defn get-rs-headers [rs]
+ (for [[k _] (first rs)]
+ (subs (str k) 1)))
+
+(defn transpose [m]
+ (apply mapv vector m))
+
+(defn find-longest-list
+ "Returns the list of the longest lengths per column."
+ [lst]
+ (map #(apply max %) (transpose lst)))
+
+(defn simple-join [n s]
+ (clojure.string/join
+ (for [x (range 0 n)] s)))
+
+(defn str-length [s]
+ (.length (str s)))
+
+(defn get-rs-lengths [rs]
+ (map #(map str-length %) rs))
+
+(defn get-absolute-file-path [relative-file-path]
+ (-> (java.io.File. relative-file-path) .getAbsolutePath))
--- /dev/null
+;;; output.clj -- Output & formatting clojure functions for ejc-sql.
+
+;;; Copyright © 2013, 2016 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; 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, 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. */
+
+(ns ejc-sql.output
+ (:use clojure.java.io
+ ejc-sql.lib)
+ (:require clojure.contrib.java-utils)
+ (:import (java.io File)
+ (java.lang.reflect Method)
+ (java.util.Date)
+ (java.text.SimpleDateFormat)
+ (org.apache.openjpa.lib.jdbc SQLFormatter)
+ (org.hibernate.engine.jdbc.internal BasicFormatterImpl)))
+
+(defn get-log-dir []
+ (file (if windows?
+ (System/getenv "AppData")
+ "/var/log/")
+ "ejc-sql"))
+
+(defn get-log-file []
+ (file (get-log-dir)
+ (str (.format (new java.text.SimpleDateFormat
+ "yyyy-MM-dd")
+ (new java.util.Date)) ".log")))
+
+(defn print-log-file-path []
+ (print (.getAbsolutePath (get-log-file))))
+
+(defn log-sql [sql]
+ (let [log-file (get-log-file)
+ is-new-file (not (.exists log-file))]
+ (when is-new-file
+ (.mkdirs (File. (.getParent log-file)))
+ (.createNewFile log-file))
+ (with-open [wrtr (clojure.java.io/writer log-file :append true)]
+ (if is-new-file
+ (.write wrtr (str "-- -*- mode: sql; -*-\n"
+ "-- Local Variables:\n"
+ "-- eval: (ejc-sql-mode)\n"
+ "-- End:\n")))
+ (.write wrtr (str (simple-join 50 "-") " "
+ (.format (new java.text.SimpleDateFormat
+ "yyyy.MM.dd HH:mm:ss.S")
+ (new java.util.Date))
+ " " (simple-join 2 "-") "\n" sql "\n")))))
+
+(def rows-limit
+ "Limit number of records to output."
+ (atom 1000))
+
+(defn set-rows-limit [val]
+ "Set limit for number of records to output. When nil no limit."
+ (reset! rows-limit val))
+
+(defn print-table
+ "Prints a collection of maps in a textual table. Prints table headings
+ ks, and then a line of output for each row, corresponding to the keys
+ in ks. If ks are not specified, use the keys of the first item in rows."
+ ([ks rows]
+ (when (seq rows)
+ (let [row-limit @rows-limit
+ [rows msg] (if (and row-limit (> (count rows) row-limit))
+ [(take row-limit rows)
+ (format "Too many rows. Only %s from %s is shown.\n\n"
+ row-limit (count rows))]
+ [rows ""])
+ widths (map
+ (fn [k]
+ (apply max (count (name k)) (map #(count (str (get % k))) rows)))
+ ks)
+ headers (map name ks)
+ spacers (map #(apply str (repeat % "-")) widths)
+ ;; TODO: #(str "%" % "d") for numbers
+ fmts (map #(str "%-" % "s") widths)
+ fmt-row (fn [leader divider trailer row]
+ (str leader
+ (apply str (interpose divider
+ (for [[col fmt] (map vector (map #(get row %) ks) fmts)]
+ (format fmt (str col)))))
+ trailer))
+ result (new StringBuffer "")
+ ;; TODO: cahnge to #(println %) when async output ready
+ out #(.append result (str % "\n"))]
+ (out (fmt-row "" " | " "" (zipmap ks headers)))
+ (out (fmt-row "" "-+-" "" (zipmap ks spacers)))
+ (doseq [row rows]
+ (out (fmt-row "" " | " "" row)))
+ (str msg (.toString result)))))
+ ([rows] (print-table (keys (first rows)) rows)))
+
+(defn pretty-print [sql formatter]
+ (if (= formatter :jpa)
+ (print (.prettyPrint (SQLFormatter.) sql))
+ ;; :hibernate
+ (print (.format (BasicFormatterImpl.) sql))))
--- /dev/null
+;;; structure.clj -- Receive database stucture and keep it in cache.
+
+;;; Copyright © 2016-2017 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; 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, 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. */
+
+(ns ejc-sql.structure
+ (:use [ejc-sql.lib])
+ (:require
+ [clojure.java.jdbc :as j]
+ [ejc-sql.connect :as c]))
+
+(def cache (atom {}))
+
+(def queries
+ {
+ ;;--------
+ :oracle
+ ;;--------
+ {:entity (fn [& {:keys [entity-name]}]
+ (str " SELECT text \n"
+ " FROM all_source \n"
+ " WHERE name = '"entity-name"'"))
+ :types (fn [& _] "SELECT * FROM USER_TYPES")
+ :owners (fn [& _] (str " SELECT DISTINCT(owner) \n"
+ " FROM ALL_OBJECTS \n"
+ " ORDER BY owner \n"))
+ :tables (fn [& {:keys [owner]}]
+ (str " SELECT table_name, owner \n"
+ " FROM all_tables \n"
+ (if owner
+ (str " WHERE owner = '"owner"'"))
+ " ORDER BY table_name"))
+ :columns (fn [& {:keys [table]}]
+ (str " SELECT column_name \n"
+ " FROM ALL_TAB_COLUMNS \n"
+ " WHERE table_name = '"table"'"))
+ :constraints (fn [& {:keys [owner table]}]
+ (if table
+ (str " SELECT * FROM all_constraints \n"
+ " WHERE owner = "owner" \n"
+ " AND table_name = '"table"' \n")
+ "SELECT * FROM user_constraints"))
+ :procedures (fn [& {:keys [owner]}]
+ (str " SELECT object_name, procedure_name \n"
+ " FROM all_procedures \n"
+ (if owner
+ (str " WHERE owner = '" owner "'")
+ "")))
+ :objects (fn [& _]
+ (str "SELECT * FROM all_objects WHERE object_type IN "
+ "('FUNCTION','PROCEDURE','PACKAGE')"))}
+ ;;--------
+ :informix
+ ;;--------
+ {:owners nil
+ :tables (fn [& _]
+ (str " SELECT TRIM(t.tabname) as tablesList \n"
+ " FROM systables AS t \n"
+ " WHERE t.tabtype = 'T' \n"
+ " AND t.tabid >= 100 \n"
+ " ORDER BY t.tabname; \n"))
+ :columns (fn [& {:keys [table]}]
+ (str " SELECT TRIM(c.colname) AS column_name \n"
+ " FROM systables AS t, syscolumns AS c \n"
+ " WHERE t.tabid = c.tabid \n"
+ " AND t.tabtype = 'T' \n"
+ " AND t.tabid >= 100 \n"
+ " AND TRIM(t.tabname) = '" table "' \n"
+ " ORDER BY c.colno; \n"))}
+ ;;-------
+ :mysql
+ ;;-------
+ {:owners nil
+ :tables (fn [& {:keys [db-name]}]
+ (str " SELECT table_name FROM INFORMATION_SCHEMA.TABLES "
+ " WHERE table_schema = '" db-name "'"))
+ :columns (fn [& {:keys [table]}]
+ (str "SELECT column_name \n"
+ "FROM INFORMATION_SCHEMA.COLUMNS \n"
+ "WHERE table_name = '" table "' \n"))}
+ ;;--------
+ :h2
+ ;;--------
+ {:tables (fn [& _] (str "SELECT table_name \n"
+ "FROM INFORMATION_SCHEMA.TABLES \n"
+ "WHERE TABLE_SCHEMA='PUBLIC'"))
+ :columns (fn [& {:keys [table]}]
+ (str "SELECT column_name \n"
+ "FROM INFORMATION_SCHEMA.COLUMNS \n"
+ "WHERE table_name = '" table "' \n"))}
+ ;;-------
+ :sqlserver ; ms sql server
+ ;;-------
+ {:owners (fn [& _] (str " SELECT schema_owner \n"
+ " FROM information_schema.schemata \n"))
+ :tables (fn [& _]
+ "SELECT table_name FROM information_schema.tables")
+ :columns (fn [& {:keys [table]}]
+ (str "SELECT column_name \n"
+ "FROM information_schema.columns \n"
+ "WHERE table_name='" table "' "))
+ :constraints (fn [& {:keys [table]}]
+ (str "SELECT type_desc AS constraint_type, \n"
+ " name \n"
+ "FROM sys.objects \n"
+ "WHERE type_desc LIKE '%CONSTRAINT' \n"
+ " AND OBJECT_NAME(parent_object_id)='" table "'"))}})
+
+(defn autocomplete-available-for-db? [db-type]
+ (queries db-type))
+
+(defn get-db-name [db]
+ (let [{:keys [database subname connection-uri]} db]
+ (or database
+ (if subname
+ (let [separator (if (= (first (.split subname "/")) subname)
+ ":" "/")
+ raw-db-name (last (.split subname separator))
+ raw-db-name (first (.split raw-db-name "\\?"))
+ raw-db-name (first (.split raw-db-name ";"))]
+ raw-db-name)
+ ;; No subname - parse connection-uri
+ (let [props-list (.split connection-uri ";")
+ db-name-prop (first
+ (filter
+ (fn [prop]
+ (=
+ "databasename"
+ (.toLowerCase (first (.split prop "=")))))
+ props-list))]
+ (if db-name-prop
+ ;; "databaseName=my_db_name;"
+ (second (.split db-name-prop "="))
+ ;; "jdbc:jtds:sqlserver://localhost:1433/my_db_name;"
+ (last (.split (first props-list) "/"))))))))
+
+(defn get-user [db]
+ (let [{:keys [user connection-uri]} db]
+ (or user
+ (second (.split
+ (let [props-list (.split connection-uri ";")]
+ (first
+ (filter
+ (fn [prop]
+ (=
+ "user"
+ (.toLowerCase (first (.split prop "=")))))
+ props-list))) "=")))))
+
+(defn get-db-type [db]
+ (let [{:keys [subprotocol connection-uri]} db]
+ (keyword
+ (or subprotocol
+ (let [attrs (.split connection-uri ":")]
+ (if (= (second attrs) "jtds")
+ ;; jdbc:jtds:sqlserver://...
+ (nth attrs 2)
+ ;; jdbc:sqlserver://localhost\instance:1433;
+ (second attrs)))))))
+
+(defn select-db-meta-script [db meta-type &
+ {:keys [owner
+ table
+ entity-name]}]
+ "Return SQL request to obtain some database structure info."
+ (let [db-type (get-db-type db)
+ meta-type (if (keyword? meta-type) meta-type (keyword meta-type))
+ need-owners? (get-in queries [db-type :owners])
+ owner (or owner (if need-owners? (get-user db)))
+ sql-receiver (get-in queries [db-type meta-type])
+ sql (if sql-receiver
+ (sql-receiver :owner owner
+ :table table
+ :entity-name entity-name
+ :db-name (get-db-name db)))]
+ sql))
+
+(defn- get-single-row-result [db sql]
+ (if sql
+ (rest
+ (flatten
+ (j/query db (list sql) {:as-arrays? true})))))
+
+(defn- get-first-row-result [db sql]
+ (if sql
+ (rest
+ (map first
+ (j/query db (list sql) {:as-arrays? true})))))
+
+(defn- get? [obj & [force?]]
+ (if (and obj (or force? (realized? obj)))
+ @obj))
+
+(defn get-owners [db]
+ "Return owners list from cache if already received from DB,
+check if receiveing process is not running, then start it."
+ (let [db-type (get-db-type db)
+ need-owners? (get-in queries [db-type :owners])]
+ (if need-owners?
+ (do
+ (if (not (get-in @cache [db :owners]))
+ (swap! cache assoc-in [db :owners]
+ (future ((fn [db]
+ (let [sql (select-db-meta-script db :owners)]
+ (get-single-row-result db sql))) db))))
+ (get? (get-in @cache [db :owners]))))))
+
+(defn get-tables [db & [owner]]
+ "Return tables list for this owner from cache if already received from DB,
+check if receiveing process is not running, then start it."
+ (let [;; default owner
+ owner (:user db)]
+ (if (not (get-in @cache [db :tables (keyword owner)]))
+ (swap! cache assoc-in [db :tables (keyword owner)]
+ (future ((fn [db owner]
+ (let [sql (select-db-meta-script db :tables
+ :owner owner)]
+ (get-first-row-result db sql)))
+ db owner))))
+ (get? (get-in @cache [db :tables (keyword owner)]))))
+
+(defn get-colomns [db table force?]
+ "Return colomns list for this table from cache if already received from DB,
+check if receiveing process is not running, then start it."
+ (if (not (get-in @cache [db :colomns (keyword table)]))
+ (swap! cache assoc-in [db :colomns (keyword table)]
+ (future ((fn [db table]
+ (let [sql (select-db-meta-script db :columns
+ :table table)]
+ (get-single-row-result db sql)))
+ db table))))
+ (get? (get-in @cache [db :colomns (keyword table)]) force?))
+
+(defn get-stucture [db prefix-1 prefix-2]
+ "Return candidates autocomplete list from the database structure cache or
+async request to fill it, if not yet.
+Current completion environment near to point (cursor - #) could be:
+- `prefix-2`.`prefix-1`.#
+- `prefix-1`.#
+- something#
+The result list has the following structure:
+(pending item1 item2 ...)
+- If `pending` is some text (not nil) - the async request to get the structure
+ is running and `pending` describes whether it is owners, tables or both.
+- If `pending` is nil - no request is running, return result immediately."
+ (let [db-type (get-db-type db)]
+ (if (not (autocomplete-available-for-db? db-type))
+ ;; Do nothing
+ (list "nil")
+ ;; Try to create candidates autocomplete list
+ (let [need-owners? (get-in queries [db-type :owners])]
+ ;; Check against following cases:
+ ;; prefix-2.prefix-1.#
+ ;; prefix-1.#
+ ;; something#
+ (cond
+ ;; owner.table.#<colomns-list>
+ prefix-2 (let [table prefix-1
+ colomns-list (get-colomns db table true)]
+ (if colomns-list
+ (cons "nil" colomns-list)
+ ;; pending colomns...
+ (list "colomns")))
+ ;; [owner|table].#<tables-list|colomns-list>
+ prefix-1 (letfn [(get-columns []
+ (let [tables-list (get-tables db)]
+ (if tables-list
+ (if (in? tables-list prefix-1)
+ ;; table.#<colomns-list>
+ (let [table prefix-1
+ ;; force columns-cache obtaining...
+ columns-list (get-colomns db table true)]
+ ;; ok - columns
+ (cons "nil" columns-list))
+ ;; unknown.# case
+ ;; nothing to complete
+ (list "nil"))
+ ;; no tables yet
+ ;; pending tables...
+ (list "tables"))))]
+ (if need-owners?
+ (let [owners-list (get-owners db)]
+ (if owners-list
+ (if (in? owners-list prefix-1)
+ ;; owner.#<tables-list>
+ (let [owner prefix-1
+ tables-list (get-tables db)]
+ (if tables-list
+ ;; ok - tables
+ (cons "nil" tables-list)
+ ;; pending tables...
+ (list "tables")))
+ ;; not-owner.#<tables-list>
+ (get-columns))
+ ;; no owners yet
+ ;; pending owners...
+ (list "owners")))
+ ;; Do not assume owner.#<tables-list> for this database
+ ;; only table.#<colomns-list>
+ (get-columns)))
+ ;; #<owners-list&tables-list>
+ :else (let [owners-list (get-owners db)
+ tables-list (get-tables db)]
+ (cons (cond
+ (and (not owners-list)
+ (not tables-list)) "owners and tables"
+ (not owners-list) "owners"
+ (not tables-list) "tables"
+ :else "nil")
+ (distinct (concat owners-list tables-list)))))))))
+
+(defn get-cache []
+ "Output actual cache."
+ @cache)
+
+(defn invalidate-cache [db]
+ "Clean your current connection cache (database owners and tables list)."
+ (swap! cache assoc-in [db] nil))
+
--- /dev/null
+#Leiningen
+#Thu Feb 16 10:12:19 CET 2017
+version=0.0.1-SNAPSHOT
+groupId=ejc-sql
+artifactId=ejc-sql
--- /dev/null
+[{:dependencies {org.clojure/clojure {:vsn "1.8.0", :native-prefix nil}, org.codehaus.plexus/plexus-component-annotations {:vsn "1.5.5", :native-prefix nil}, org.apache.commons/commons-lang3 {:vsn "3.2.1", :native-prefix nil}, org.sonatype.aether/aether-util {:vsn "1.13.1", :native-prefix nil}, javax.el/el-api {:vsn "2.2", :native-prefix nil}, org.hibernate/hibernate-core {:vsn "5.2.3.Final", :native-prefix nil}, org.sonatyuice {:vsn "3.0.3", :native-prefix nil, :native? false}, org.sonatype.aether/aether-connector-file {:vsn "1.13.1", :native-prefix nil, :native? false}, org.hibernate.common/hibernate-commons-annotations {:vsn "5.0.1.Final", :native-prefix nil, :native? false}, org.apache.maven/maven-repository-metadata {:vsn "3.0.4", :native-prefix nil, :native? false}, commons-io {:vsn "2.0.1", :native-prefix nil, :native? false}, org.apache.openjpa/openjpa-all {:vsn "2.2.2", :native-prefix nil, :native? false}}}]
\ No newline at end of file
--- /dev/null
+ejc-sql turns Emacs into simple SQL client, it uses JDBC connection to
+databases via clojure/java.jdbc lib.
+
+See README.md for detailed description.
--- /dev/null
+This is the file .../info/dir, which contains the
+topmost node of the Info hierarchy, called (dir)Top.
+The first time you invoke Info you start off looking at this node.
+\1f
+File: dir, Node: Top This is the top of the INFO tree
+
+ This (the Directory node) gives a menu of major topics.
+ Typing "q" exits, "?" lists all Info commands, "d" returns here,
+ "h" gives a primer for first-timers,
+ "mEmacs<Return>" visits the Emacs manual, etc.
+
+ In Emacs, you can click mouse button 2 on a menu item or cross reference
+ to select it.
+
+* Menu:
+
+Emacs
+* Ghub: (ghub). Minuscule client library for the Github API.
--- /dev/null
+;;; ghub-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
+\f
+;;;### (autoloads nil "ghub" "ghub.el" (23082 53689 16798 734000))
+;;; Generated autoloads from ghub.el
+
+(autoload 'ghub-create-token "ghub" "\
+Create, store and return a new token.
+
+HOST is the Github instance, usually \"api.github.com\".
+USERNAME is the name of a user on that instance.
+PACKAGE is the package that will use the token.
+SCOPES are the scopes the token is given access to.
+
+\(fn HOST USERNAME PACKAGE SCOPES)" t nil)
+
+(autoload 'ghub-token-scopes "ghub" "\
+Return and echo the scopes of the specified token.
+This is intended for debugging purposes only. The user
+has to provide several values including their password.
+
+\(fn HOST USERNAME PACKAGE)" t nil)
+
+;;;***
+\f
+;;;### (autoloads nil nil ("ghub-pkg.el") (23082 53689 19979 831000))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; ghub-autoloads.el ends here
--- /dev/null
+(define-package "ghub" "20171207.1537" "minuscule client library for the Github API"
+ '((emacs "24.4")
+ (let-alist "1.0.5"))
+ :url "https://github.com/magit/ghub" :keywords
+ '("tools"))
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; ghub.el --- minuscule client library for the Github API -*- lexical-binding: t -*-
+
+;; Copyright (C) 2016-2017 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Homepage: https://github.com/magit/ghub
+;; Keywords: tools
+;; Package-Requires: ((emacs "24.4") (let-alist "1.0.5"))
+
+;; 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.
+
+;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt.
+
+;;; Commentary:
+
+;; Ghub is a library that provides basic support for using the Github API
+;; from Emacs packages. It abstracts access to API resources using only
+;; a handful of functions that are not resource-specific.
+
+;; It also handles the creation, storage and use of access tokens using a
+;; setup wizard, to make it easier for users to get started and to reduce
+;; the support burden imposed on package maintainers. It also comes with
+;; a comprehensive manual to address the cases when things don't just
+;; work as expected.
+
+;; Ghub is intentionally limited to only provide these two essential
+;; features — basic request functions and guided setup — to avoid being
+;; too opinionated, which would hinder wide adaption. It is assumed that
+;; wide adoption would make life easier for users and maintainers alike,
+;; because then all packages that talk to the Github API could be
+;; configured the same way.
+
+;;; Code:
+
+(require 'auth-source)
+(require 'cl-lib)
+(require 'json)
+(require 'let-alist)
+(require 'url)
+(require 'url-auth)
+
+(eval-when-compile (require 'subr-x))
+
+(defvar url-http-end-of-headers)
+(defvar url-http-response-status)
+
+;;; Settings
+
+(defconst ghub-default-host "api.github.com")
+
+(defvar ghub-github-token-scopes '(repo)
+ "The Github API scopes that your private tools need.
+
+The token that is created based on the value of this variable
+is used when `ghub-request' (or one of its wrappers) is called
+without providing a value for AUTH. Packages should always
+identify themselves using that argument, but when you use Ghub
+directly in private tools, then that is not necessary and the
+request is made on behalf of the `ghub' package itself, aka on
+behalf of some private tool.
+
+By default the only requested scope is `repo' because that is
+sufficient as well as required for most common uses. This and
+other scopes are documented at https://magit.vc/goto/2e586d36.
+
+If your private tools need other scopes, then you have to add
+them here *before* creating the token. Alternatively you can
+edit the scopes of an existing token using the web interface
+at https://github.com/settings/tokens.")
+
+(defvar ghub-override-system-name nil
+ "If non-nil, the string used to identify the local machine.
+If this is nil, then the value returned by `system-name' is
+used instead.")
+
+;;; Request
+;;;; API
+
+(defvar ghub-response-headers nil
+ "The headers returned in response to the last request.
+`ghub-request' returns the response body and stores the
+response header in this variable.")
+
+(defvar ghub-raw-response-body nil)
+
+(cl-defun ghub-head (resource &optional params
+ &key query payload headers
+ unpaginate noerror reader
+ username auth host)
+ "Make a `HEAD' request for RESOURCE, with optional query PARAMS.
+Like calling `ghub-request' (which see) with \"HEAD\" as METHOD."
+ (ghub-request "HEAD" resource params
+ :query query :payload payload :headers headers
+ :unpaginate unpaginate :noerror noerror :reader reader
+ :username username :auth auth :host host))
+
+(cl-defun ghub-get (resource &optional params
+ &key query payload headers
+ unpaginate noerror reader
+ username auth host)
+ "Make a `GET' request for RESOURCE, with optional query PARAMS.
+Like calling `ghub-request' (which see) with \"GET\" as METHOD."
+ (ghub-request "GET" resource params
+ :query query :payload payload :headers headers
+ :unpaginate unpaginate :noerror noerror :reader reader
+ :username username :auth auth :host host))
+
+(cl-defun ghub-put (resource &optional params
+ &key query payload headers
+ unpaginate noerror reader
+ username auth host)
+ "Make a `PUT' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"PUT\" as METHOD."
+ (ghub-request "PUT" resource params
+ :query query :payload payload :headers headers
+ :unpaginate unpaginate :noerror noerror :reader reader
+ :username username :auth auth :host host))
+
+(cl-defun ghub-post (resource &optional params
+ &key query payload headers
+ unpaginate noerror reader
+ username auth host)
+ "Make a `POST' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"POST\" as METHOD."
+ (ghub-request "POST" resource params
+ :query query :payload payload :headers headers
+ :unpaginate unpaginate :noerror noerror :reader reader
+ :username username :auth auth :host host))
+
+(cl-defun ghub-patch (resource &optional params
+ &key query payload headers
+ unpaginate noerror reader
+ username auth host)
+ "Make a `PATCH' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"PATCH\" as METHOD."
+ (ghub-request "PATCH" resource params
+ :query query :payload payload :headers headers
+ :unpaginate unpaginate :noerror noerror :reader reader
+ :username username :auth auth :host host))
+
+(cl-defun ghub-delete (resource &optional params
+ &key query payload headers
+ unpaginate noerror reader
+ username auth host)
+ "Make a `DELETE' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"DELETE\" as METHOD."
+ (ghub-request "DELETE" resource params
+ :query query :payload payload :headers headers
+ :unpaginate unpaginate :noerror noerror :reader reader
+ :username username :auth auth :host host))
+
+(define-error 'ghub-error "Ghub Error")
+(define-error 'ghub-http-error "HTTP Error" 'ghub-error)
+(define-error 'ghub-301 "Moved Permanently" 'ghub-http-error)
+(define-error 'ghub-400 "Bad Request" 'ghub-http-error)
+(define-error 'ghub-401 "Unauthorized" 'ghub-http-error)
+(define-error 'ghub-403 "Forbidden" 'ghub-http-error)
+(define-error 'ghub-404 "Not Found" 'ghub-http-error)
+(define-error 'ghub-422 "Unprocessable Entity" 'ghub-http-error)
+
+(cl-defun ghub-request (method resource &optional params
+ &key query payload headers
+ unpaginate noerror reader
+ username auth host)
+ "Make a request for RESOURCE and return the response body.
+
+Also place the response header in `ghub-response-headers'.
+
+METHOD is the http method, given as a string.
+RESOURCE is the resource to access, given as a string beginning
+ with a slash.
+
+PARAMS, QUERY, PAYLOAD and HEADERS are alists used to specify
+ data. The Github API documentation is vague on how data has
+ to be transmitted and for a particular resource usually just
+ talks about \"parameters\". Generally speaking when the METHOD
+ is \"HEAD\" or \"GET\", then they have to be transmitted as a
+ query, otherwise as a payload.
+Use PARAMS to automatically transmit like QUERY or PAYLOAD would
+ depending on METHOD.
+Use QUERY to explicitly transmit data as a query.
+Use PAYLOAD to explicitly transmit data as a payload.
+Use HEADERS for those rare resources that require that the data
+ is transmitted as headers instead of as a query or payload.
+ When that is the case, then the api documentation usually
+ mentions it explicitly.
+
+If UNPAGINATE is non-nil, then make multiple requests if necessary
+ to get all items at RESOURCE.
+If NOERROR is non-nil, then do not raise an error if the request
+ fails and return nil instead.
+If READER is non-nil, then it is used to read and return from the
+ response buffer. The default is `ghub--read-json-response'.
+ For the very few resources that do not return json, you might
+ want to use `ghub--read-raw-response'.
+
+If USERNAME is non-nil, then make a request on behalf of that
+ user. It is better to specify the user using the Git variable
+ `github.user' for \"api.github.com\", or `github.HOST.user' if
+ connecting to a Github Enterprise instance.
+
+Each package that uses `ghub' should use its own token. If AUTH
+ is nil, then the generic `ghub' token is used instead. This
+ is only acceptable for personal utilities. A packages that
+ is distributed to other users should always use this argument
+ to identify itself, using a symbol matching its name.
+
+ Package authors who find this inconvenient should write a
+ wrapper around this function and possibly for the method
+ specific functions also.
+
+ Some symbols have a special meaning. `none' means to make an
+ unauthorized request. `basic' means to make a password based
+ request. If the value is a string, then it is assumed to be
+ a valid token. `basic' and an explicit token string are only
+ intended for internal and debugging uses.
+
+ If AUTH is a package symbol, then the scopes are specified
+ using the variable `AUTH-github-token-scopes'. It is an error
+ if that is not specified. See `ghub-github-token-scopes' for
+ an example.
+
+If HOST is non-nil, then connect to that Github instance. This
+ defaults to \"api.github.com\". When a repository is connected
+ to a Github Enterprise instance, then it is better to specify
+ that using the Git variable `github.host' instead of using this
+ argument."
+ (unless (string-prefix-p "/" resource)
+ (setq resource (concat "/" resource)))
+ (unless host
+ (setq host (ghub--host)))
+ (cond
+ ((not params))
+ ((memq method '("GET" "HEAD"))
+ (when query
+ (error "PARAMS and QUERY are mutually exclusive for METHOD %S" method))
+ (setq query params))
+ (t
+ (when payload
+ (error "PARAMS and PAYLOAD are mutually exclusive for METHOD %S" method))
+ (setq payload params)))
+ (when (and payload (not (stringp payload)))
+ (setq payload (encode-coding-string (json-encode-list payload) 'utf-8)))
+ (let* ((qry (and query (concat "?" (ghub--url-encode-params query))))
+ (buf (let ((url-request-extra-headers
+ `(("Content-Type" . "application/json")
+ ,@(and (not (eq auth 'none))
+ (list (cons "Authorization"
+ (ghub--auth host auth username))))
+ ,@headers))
+ ;; Encode in case caller used (symbol-name 'GET). #35
+ (url-request-method (encode-coding-string method 'utf-8))
+ (url-request-data payload))
+ (url-retrieve-synchronously
+ (concat "https://" host resource qry)))))
+ (unwind-protect
+ (with-current-buffer buf
+ (set-buffer-multibyte t)
+ (let (link body)
+ (goto-char (point-min))
+ (let (headers)
+ (while (re-search-forward "^\\([^:]*\\): \\(.+\\)"
+ url-http-end-of-headers t)
+ (push (cons (match-string 1)
+ (match-string 2))
+ headers))
+ (and (setq link (cdr (assoc "Link" headers)))
+ (setq link (car (rassoc
+ (list "rel=\"next\"")
+ (mapcar (lambda (elt) (split-string elt "; "))
+ (split-string link ",")))))
+ (string-match "[?&]page=\\([^&>]+\\)" link)
+ (setq link (match-string 1 link)))
+ (setq ghub-response-headers (nreverse headers)))
+ (unless url-http-end-of-headers
+ (error "ghub: url-http-end-of-headers is nil when it shouldn't"))
+ (goto-char (1+ url-http-end-of-headers))
+ (setq body (funcall (or reader 'ghub--read-json-response)))
+ (unless (or noerror (= (/ url-http-response-status 100) 2))
+ (let ((data (list method resource qry payload body)))
+ (pcase url-http-response-status
+ (301 (signal 'ghub-301 data))
+ (400 (signal 'ghub-400 data))
+ (401 (signal 'ghub-401 data))
+ (403 (signal 'ghub-403 data))
+ (404 (signal 'ghub-404 data))
+ (422 (signal 'ghub-422 data))
+ (_ (signal 'ghub-http-error
+ (cons url-http-response-status data))))))
+ (if (and link unpaginate)
+ (nconc body
+ (ghub-request
+ method resource nil
+ :query (cons (cons 'page link)
+ (cl-delete 'page query :key #'car))
+ :payload payload
+ :headers headers
+ :unpaginate t :noerror noerror :reader reader
+ :username username :auth auth :host host))
+ body)))
+ (kill-buffer buf))))
+
+(defun ghub-wait (resource &optional username auth host duration)
+ "Busy-wait up to DURATION seconds for RESOURCE to become available.
+
+DURATION specifies how many seconds to wait at most. It defaults
+to 64 seconds. The first attempt is made immediately, the second
+after two seconds, and each subequent attemts are made after
+waiting as long as we already waited between all preceding
+attempts combined.
+
+See `ghub-request' for information about the other arguments."
+ (unless duration
+ (setq duration 64))
+ (with-local-quit
+ (let ((total 0))
+ (while (not (ignore-errors (ghub-get resource nil
+ :username username
+ :auth auth
+ :host host)))
+ (message "Waited (%3ss of %ss) for %s..." total duration resource)
+ (if (= total duration)
+ (signal 'ghub-error
+ (list (format "Github is taking too long to create %s"
+ resource)))
+ (if (> total 0)
+ (let ((wait (min total (- duration total))))
+ (sit-for wait)
+ (cl-incf total wait))
+ (sit-for (setq total 2))))))))
+
+;;;; Internal
+
+(defun ghub--read-json-response ()
+ (and (not (eobp))
+ (let ((json-object-type 'alist)
+ (json-array-type 'list)
+ (json-key-type 'symbol)
+ (json-false nil)
+ (json-null nil))
+ (json-read-from-string (ghub--read-raw-response)))))
+
+(defun ghub--read-raw-response ()
+ (and (not (eobp))
+ (setq ghub-raw-response-body
+ (decode-coding-string
+ (buffer-substring-no-properties (point) (point-max))
+ 'utf-8))))
+
+(defun ghub--url-encode-params (params)
+ (mapconcat (lambda (param)
+ (concat (url-hexify-string (symbol-name (car param))) "="
+ (url-hexify-string (cdr param))))
+ params "&"))
+
+;;; Authentication
+;;;; API
+
+;;;###autoload
+(defun ghub-create-token (host username package scopes)
+ "Create, store and return a new token.
+
+HOST is the Github instance, usually \"api.github.com\".
+USERNAME is the name of a user on that instance.
+PACKAGE is the package that will use the token.
+SCOPES are the scopes the token is given access to."
+ (interactive
+ (pcase-let ((`(,host ,username ,package)
+ (ghub--read-triplet)))
+ (list host username package
+ (split-string
+ (read-string
+ "Scopes (separated by commas): "
+ (mapconcat #'symbol-name
+ (symbol-value
+ (intern (format "%s-github-token-scopes" package)))
+ ","))
+ "," t "[\s\t]+"))))
+ (let ((user (ghub--ident username package)))
+ (cl-destructuring-bind (_save token)
+ (ghub--auth-source-get (list :save-function :secret)
+ :create t :host host :user user
+ :secret
+ (cdr (assq 'token
+ (ghub-post
+ "/authorizations"
+ `((scopes . ,scopes)
+ (note . ,(ghub--ident-github package)))
+ :username username :auth 'basic :host host))))
+ ;; If the Auth-Source cache contains the information that there
+ ;; is no value, then setting the value does not invalidate that
+ ;; now incorrect information.
+ (auth-source-forget (list :host host :user user))
+ token)))
+
+;;;###autoload
+(defun ghub-token-scopes (host username package)
+ "Return and echo the scopes of the specified token.
+This is intended for debugging purposes only. The user
+has to provide several values including their password."
+ (interactive (ghub--read-triplet))
+ (let ((scopes
+ (cdr (assq 'scopes (ghub--get-token-plist host username package)))))
+ (when (called-interactively-p 'any)
+ ;; Also show the input values to make it easy for package
+ ;; authors to verify that the user has done it correctly.
+ (message "Scopes for %s@%s: %S"
+ (ghub--ident username package)
+ host scopes))
+ scopes))
+
+;;;; Internal
+
+(defun ghub--auth (host auth &optional username)
+ (unless username
+ (setq username (ghub--username host)))
+ (if (eq auth 'basic)
+ (ghub--basic-auth host username)
+ (concat "token "
+ (encode-coding-string
+ (cl-typecase auth
+ (string auth)
+ (null (ghub--token host username 'ghub))
+ (symbol (ghub--token host username auth))
+ (t (signal 'wrong-type-argument
+ `((or stringp symbolp) ,auth))))
+ 'utf-8))))
+
+(defun ghub--basic-auth (host username)
+ (let ((url (url-generic-parse-url (concat "https://" host))))
+ (setf (url-user url) username)
+ (url-basic-auth url t)))
+
+(defun ghub--token (host username package &optional nocreate)
+ (let ((user (ghub--ident username package)))
+ (or (ghub--auth-source-get :secret :host host :user user)
+ (progn
+ ;; Auth-Source caches the information that there is no
+ ;; value, but in our case that is a situation that needs
+ ;; fixing so we want to keep trying by invalidating that
+ ;; information.
+ (auth-source-forget (list :host host :user user))
+ (and (not nocreate)
+ (ghub--confirm-create-token host username package))))))
+
+(defun ghub--host ()
+ (or (ignore-errors (car (process-lines "git" "config" "github.host")))
+ ghub-default-host))
+
+(defun ghub--username (host)
+ (let ((var (if (string-prefix-p "api.github.com" host)
+ "github.user"
+ (format "github.%s.user" host))))
+ (condition-case nil
+ (car (process-lines "git" "config" var))
+ (error
+ (let ((user (read-string
+ (format "Git variable `%s' is unset. Set to: " var))))
+ (or (and user (progn (call-process "git" nil nil nil
+ "config" "--global" var user)
+ user))
+ (user-error "Abort")))))))
+
+(defun ghub--ident (username package)
+ (format "%s^%s" username package))
+
+(defun ghub--ident-github (package)
+ (format "Emacs package %s @ %s"
+ package
+ (or ghub-override-system-name (system-name))))
+
+(defun ghub--package-scopes (package)
+ (symbol-value (intern (format "%s-github-token-scopes" package))))
+
+(defun ghub--confirm-create-token (host username package)
+ (let* ((ident (ghub--ident-github package))
+ (scopes (ghub--package-scopes package))
+ (max-mini-window-height 40))
+ (if (yes-or-no-p
+ (format
+ "Such a Github API token is not available:
+
+ Host: %s
+ User: %s
+ Package: %s
+
+ Scopes requested in `%s-github-token-scopes':\n%s
+ Store locally according to `auth-sources':\n %S
+ Store on Github as:\n %S
+
+WARNING: If you have enabled two-factor authentication then
+ you have to abort and create the token manually.
+
+If in doubt, then abort and view the documentation first.
+
+Otherwise confirm and then provide your Github username and
+password at the next two prompts. Depending on the backend
+you might have to provide a passphrase and confirm that you
+really want to save the token.
+
+Create and store such a token? "
+ host username package package
+ (mapconcat (lambda (scope) (format " %s" scope)) scopes "\n")
+ auth-sources ident))
+ (progn
+ (when (ghub--get-token-id host username package)
+ (if (yes-or-no-p
+ (format
+ "A token named %S\nalready exists on Github. Replace it?"
+ ident))
+ (ghub--delete-token host username package)
+ (user-error "Abort")))
+ (ghub-create-token host username package scopes))
+ (user-error "Abort"))))
+
+(defun ghub--get-token-id (host username package)
+ (let ((ident (ghub--ident-github package)))
+ (cl-some (lambda (x)
+ (let-alist x
+ (and (equal .app.name ident) .id)))
+ (ghub-get "/authorizations" nil
+ :unpaginate t
+ :username username :auth 'basic :host host))))
+
+(defun ghub--get-token-plist (host username package)
+ (ghub-get (format "/authorizations/%s"
+ (ghub--get-token-id host username package))
+ nil :username username :auth 'basic :host host))
+
+(defun ghub--delete-token (host username package)
+ (ghub-delete (format "/authorizations/%s"
+ (ghub--get-token-id host username package))
+ nil :username username :auth 'basic :host host))
+
+(defun ghub--read-triplet ()
+ (let ((host (read-string "Host: " (ghub--host))))
+ (list host
+ (read-string "Username: " (ghub--username host))
+ (intern (read-string "Package: " "ghub")))))
+
+(defun ghub--auth-source-get (key:s &rest spec)
+ (declare (indent 1))
+ (let ((plist (car (apply #'auth-source-search :max 1 spec))))
+ (cl-flet ((value (k) (let ((v (plist-get plist k)))
+ (if (functionp v) (funcall v) v))))
+ (if (listp key:s)
+ (mapcar #'value key:s)
+ (value key:s)))))
+
+(advice-add 'auth-source-netrc-parse-next-interesting :around
+ 'auth-source-netrc-parse-next-interesting@save-match-data)
+(defun auth-source-netrc-parse-next-interesting@save-match-data (fn)
+ "Save match-data for the benefit of caller `auth-source-netrc-parse-one'.
+Without wrapping this function in `save-match-data' the caller
+won't see the secret from a line that is followed by a commented
+line."
+ (save-match-data (funcall fn)))
+
+;;; ghub.el ends soon
+(provide 'ghub)
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
+;;; ghub.el ends here
--- /dev/null
+This is ghub.info, produced by makeinfo version 5.2 from ghub.texi.
+
+ Copyright (C) 2017 Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+ You can redistribute this document 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 document 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.
+INFO-DIR-SECTION Emacs
+START-INFO-DIR-ENTRY
+* Ghub: (ghub). Minuscule client library for the Github API.
+END-INFO-DIR-ENTRY
+
+\1f
+File: ghub.info, Node: Top, Next: Introduction, Up: (dir)
+
+Ghub User and Developer Manual
+******************************
+
+Ghub is a library that provides basic support for using the Github API
+from Emacs packages. It abstracts access to API resources using only a
+handful of functions that are not resource-specific.
+
+ It also handles the creation, storage and use of access tokens using
+a setup wizard, to make it easier for users to get started and to reduce
+the support burden imposed on package maintainers. It also comes with a
+comprehensive manual to address the cases when things don’t just work as
+expected.
+
+ Ghub is intentionally limited to only provide these two essential
+features — basic request functions and guided setup — to avoid being too
+opinionated, which would hinder wide adaption. It is assumed that wide
+adoption would make life easier for users and maintainers alike, because
+then all packages that talk to the Github API could be configured the
+same way.
+
+ This manual is for Ghub version 1.3.0 (v1.3.0-22-g45cd8c8+1).
+
+ Copyright (C) 2017 Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+ You can redistribute this document 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 document 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.
+
+* Menu:
+
+* Introduction::
+* Limitations::
+* Getting Started::
+* Using Ghub in Personal Scripts::
+* Using Ghub in a Package::
+* API::
+
+— The Detailed Node Listing —
+
+Getting Started
+
+* Setting the Username::
+* Interactively Creating and Storing a Token::
+* Manually Creating and Storing a Token::
+* How Ghub uses Auth-Source::
+
+API
+
+* Making Requests::
+* Authentication::
+* Configuration Variables::
+
+
+\1f
+File: ghub.info, Node: Introduction, Next: Limitations, Prev: Top, Up: Top
+
+1 Introduction
+**************
+
+Ghub is a library that provides basic support for using the Github API
+from Emacs packages. It abstracts access to API resources using only a
+handful of functions that are not resource-specific.
+
+ It also handles the creation, storage and use of access tokens using
+a setup wizard, to make it easier for users to get started and to reduce
+the support burden imposed on package maintainers. It also comes with a
+comprehensive manual to address the cases when things don’t just work as
+expected.
+
+ Ghub is intentionally limited to only provide these two essential
+features — basic request functions and guided setup — to avoid being too
+opinionated, which would hinder wide adaption.
+
+ Fancier interfaces can implemented on top of Ghub, and one such
+wrapper — named simply Ghub+ — has already been implemented. The
+benefit of basing various opinionated interfaces on top of a single
+library that provides only the core functionality is that choosing the
+programming interface does no longer also dictate how access tokens are
+handled. Users can then use multiple packages that access the Github
+API without having to learn the various incompatible ways packages
+expects the appropriate token to be made available to them.
+
+ Ghub uses the built-in ‘auth-source’ library to store access tokens.
+That library is very flexible and supports multiple backends, which
+means that it is up to the user how secrets are stored. They can, among
+other things, choose between storing secrets in plain text for ease of
+use, or encrypted for better security.
+
+ Previously (as in until this library is widely adapted) it was up to
+package authors to decide if things should be easy or secure. (Note
+that ‘auth-source’ defaults to "easy" — you have been warned.)
+
+ Ghub expects package authors to use a dedicated access token instead
+of sharing a single token between all packages that rely on it. That
+means that users cannot configure Ghub once and later start using a new
+package without any additional setup. But Ghub helps with that.
+
+ When the user invokes some command defined in some package and that
+ultimately results in ‘ghub-request’ being called and the appropriate
+token is not available yet, then the user is guided through the process
+of creating and storing a new token, and at the end of that process the
+request is carried out as if the token had been available to begin with.
+
+\1f
+File: ghub.info, Node: Limitations, Next: Getting Started, Prev: Introduction, Up: Top
+
+2 Limitations
+*************
+
+As mentioned, Ghub restricts itself to provide core functionality and
+leaves it to other libraries to do opinionated things on top of that.
+But currently there also are some limitations that concern the core
+parts. Obviously these limitations have to be lifted to maximize
+adaption and so they will.
+
+ These secondary features already exist (just mentioning them, so you
+don’t assume that they don’t):
+
+ • Support for Github Enterprise instances.
+
+ • Support for token scope validation.
+
+ These features will likely never be implemented in Ghub:
+
+ • Functions for particular resources.
+
+ • Using something other than json-like alists to handle what the
+ Github API calls "parameters".
+
+ • Retrieving an existing token. Github does not support it so we
+ cannot do it. If you lose your local copy of a token, then you
+ have to replace it with a new one.
+
+ These features are not supported yet:
+
+ • Asynchronous requests are not supported yet.
+
+ • The Github GraphQL API is not supported yet.
+
+ • If a request fails due to a missing scope, then that isn’t handled
+ by ‘ghub-request’ yet. For now package authors just have to hope
+ that users don’t mess with scopes or handle such errors themselves.
+
+ Likewise, other errors too should be handled by Ghub.
+
+ • Packages cannot request additional scopes.
+
+ Once a token has been created a package cannot request new scopes
+ that it previously did not need. I am not quite sure yet whether
+ Ghub should support that. An alternative would be to let packages
+ at least invalidate their own tokens.
+
+ • Other Git forges (Gitlab, Bitbucket…) are not supported.
+
+ Support for other forges will likely be implemented using *other*
+ libraries that are very similar to this library. Whether common
+ code will be factored out into a library to be used by all these
+ libraries or whether some code duplication is to be preferred, has
+ not been decided yet.
+
+\1f
+File: ghub.info, Node: Getting Started, Next: Using Ghub in Personal Scripts, Prev: Limitations, Up: Top
+
+3 Getting Started
+*****************
+
+If you would like to use a package that uses this library, then just do
+so. If the necessary information isn’t available when it attempts to
+make a request, then you will be asked to provide it.
+
+* Menu:
+
+* Setting the Username::
+* Interactively Creating and Storing a Token::
+* Manually Creating and Storing a Token::
+* How Ghub uses Auth-Source::
+
+\1f
+File: ghub.info, Node: Setting the Username, Next: Interactively Creating and Storing a Token, Up: Getting Started
+
+3.1 Setting the Username
+========================
+
+If you haven’t set the Git variable ‘github.user’ yet when making a
+request, then you will be asked:
+
+ Git variable `github.user' is unset. Set to:
+
+ You are expected to provide your Github username here. The provided
+value will be saved globally (using ‘git config --global github.user
+USERNAME’).
+
+ If you need to identify as another user in a particular repository,
+then you have to set that variable locally, *before* making a request:
+
+ cd /path/to/repo
+ git config github.user USERNAME
+
+ For Github Enterprise instances you have to specify where the API can
+be accessed *before* you try to access it and a different variable has
+to be used to set the username. For example if the API is available at
+‘https://example.com/api/v3’, then you should do this:
+
+ # Do this once
+ git config --global github.example.com/api/v3.user EMPLOYEE
+
+ # Do this for every corporate repository
+ cd /path/to/repo
+ git config github.host example.com/api/v3
+
+ If you do not set ‘github.example.com/api/v3.user’, then you will be
+asked to provide the value when trying to make a request, but you do
+have to manually set ‘github.host’, or Ghub assumes that you are trying
+to access ‘api.github.com’.
+
+\1f
+File: ghub.info, Node: Interactively Creating and Storing a Token, Next: Manually Creating and Storing a Token, Prev: Setting the Username, Up: Getting Started
+
+3.2 Interactively Creating and Storing a Token
+==============================================
+
+Ghub uses a different token for every package as well as for every
+machine from which you access the Github API (and obviously also for
+every Github instance and user). This allows packages to only request
+the scopes that they actually need and also gives users the opportunity
+to refuse access to certain scopes if they expect to not use the
+features that need them.
+
+ Usually you don’t have to worry about creating and storing a token
+yourself and can just make a request. Note however that you don’t have
+to use the setup wizard described below. Alternatively you can perform
+the setup manually as described in the next section.
+
+ Unfortunately the wizard does not work (yet?) if you have enabled
+two-factor authentication, in which case the token has to be created and
+stored manually.
+
+ If you make a request and the required token is not available yet,
+then the setup wizard will first ask you something like this:
+
+ Such a Github API token is not available:
+
+ Host: api.github.com
+ User: USERNAME
+ Package: PACKAGE
+
+ Scopes requested in `PACKAGE-github-token-scopes':
+ repo
+ Store locally according to `auth-sources':
+ ("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")
+ Store on Github as:
+ "Emacs package FOO @ LOCAL-MACHINE"
+
+ WARNING: If you have enabled two-factor authentication
+ then you have to create the token manually.
+
+ If in doubt, then abort and view the documentation first.
+
+ Create and store such a token? (yes or no)
+
+ If you don’t have any doubts, then answer "yes". Lets address some
+of the doubts that you might have:
+
+ • Unfortunately Ghub cannot know whether you have enabled two-factor
+ authentication without making a request using basic (password)
+ authentication, which it cannot do if you have enabled two-factor
+ authentication. It also cannot determine whether you have enabled
+ two-factor authentication depending on whether a request fails or
+ not because there are other reasons why a request might fail.
+
+ So this warning is always displayed and you are expected to know
+ whether you have enabled two-factor authentication or not. If you
+ have, then you must abort and see *note Manually Creating and
+ Storing a Token::.
+
+ • ‘Host’ usually is "api.github.com" and that’s usually what you
+ want. If you are trying to access a Github Enterprise instance,
+ then it should be something else and you have to set the value
+ manually as described in the next section.
+
+ • ‘User’ should be your Github.com (or Github Enterprise instance)
+ username. If it is something else, then you made a mistake at the
+ first prompt or during the step describe in the previous section
+ and have to refer to that in order to fix this issue.
+
+ • ‘Package’ should be the name of the package you are using to access
+ the Github API.
+
+ If it is ‘ghub’, then the package author disregarded that
+ convention and you should probably report a bug in the issue
+ tracker of that package.
+
+ Or you yourself are using ‘ghub-request’ or one of its wrappers
+ directly, in which case this is expected and perfectly fine. In
+ that case you might however want to abort and change the value of
+ the variable ‘ghub-github-token-scopes’ before triggering the
+ wizard again.
+
+ • Each PACKAGE has to specify the tokens that it needs using a
+ variable named ‘PACKAGE-github-token-scopes’. The doc-string of
+ that variable should document why the various scopes are needed.
+
+ The meaning of the various scopes are documented at
+ <https://magit.vc/goto/f63aeb0a>.
+
+ • The value of ‘auth-sources’ is shown. The default value causes
+ secrets to be stored in plain text. Because this might be
+ unexpected, Ghub additionally displays a warning when appropriate.
+
+ WARNING: ... unencrypted ... TODO implement ...
+
+ Whether that is something that needs fixing, is up to you. If your
+ answer is yes, then you should abort and see *note How Ghub uses
+ Auth-Source:: for instructions on how to save the token more
+ securely.
+
+ • When creating a token it is necessary to provide a token
+ description. Ghub used descriptions that have the form "Emacs
+ package PACKAGE @ LOCAL-MACHINE".
+
+ Github uses the token description to identify the token, not merely
+ as something useful to humans. Token descriptions therefore have
+ to be unique and in rare cases you get an additional prompt, asking
+ you something like:
+
+ A token named "Emacs package FOO @ LOCAL-MACHINE"
+ already exists on Github. Replace it?
+
+ You might see this message when you have lost the old token and
+ want to replace it with a new one, in which case you should
+ obviously just proceed.
+
+ Or two of your computers have the same hostname, which is bad
+ practice because it gains you nothing but leads to issues such as
+ this. Or you are dual-booting on this machine and use the same
+ hostname in all operating systems, which is a somewhat reasonable
+ thing to do.
+
+ In either case you will have to use something other than the value
+ returned by ‘system-name’ to identify the current machine or
+ operating system. Or you can continue to identify different things
+ using the same identifier, in which case you have to manually
+ distribute the token.
+
+ The former is recommended and also easier to do, using the variable
+ ‘ghub-override-system-name’. See *note Configuration Variables::
+ for details.
+
+\1f
+File: ghub.info, Node: Manually Creating and Storing a Token, Next: How Ghub uses Auth-Source, Prev: Interactively Creating and Storing a Token, Up: Getting Started
+
+3.3 Manually Creating and Storing a Token
+=========================================
+
+If you have enabled two-factor authentication, then you have to create
+and store access tokens yourself. You might also prefers to always do
+it manually to have more control than when relying on the setup wizard.
+
+ If you cannot or don’t want to use the wizard then you have to (1)
+figure out what scopes a package wants, (2) create such a token using
+the web interface and (3) store the token where Ghub expects to find it.
+
+ A package named PACKAGE has to specify the scopes that it wants in
+the variable named ‘PACKAGE-ghub-token-scopes’. The doc-string of such
+variables should document what the various scopes are needed for.
+
+ To create or edit a token go to <https://github.com/settings/tokens>.
+
+ Finally store the token in a place where Ghub looks for it as
+describe in *note How Ghub uses Auth-Source::.
+
+\1f
+File: ghub.info, Node: How Ghub uses Auth-Source, Prev: Manually Creating and Storing a Token, Up: Getting Started
+
+3.4 How Ghub uses Auth-Source
+=============================
+
+Please see *note (auth)Top:: for all the gory details about Auth-Source.
+Some Ghub-specific information and important notes follow.
+
+ The variable ‘auth-sources’ controls how and where Auth-Source stores
+new secrets and where it looks for known secrets. The default value is
+‘("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")’, which means that it
+looks in all of these files in order to find secrets and that it stores
+new secrets in ‘~/.authinfo’ because that is the first element of the
+list. It doesn’t matter which files already do or don’t exist when
+storing a new secret, the first file is always used.
+
+ Secrets are stored in ‘~/.authinfo’ in plain text. If you don’t want
+that (good choice), then you have to customize ‘auth-sources’ e.g. by
+flipping the positions of the first two elements.
+
+ Auth-Source also supports storing secrets in various key-chains,
+refer to its documentation for more information.
+
+ Some Auth-Source backends only support storing three values per
+entry, the "machine", the "login" and the "password". Because Ghub uses
+separate tokens for each package, it has to squeeze four values into
+those three slots, and it does that by using "USERNAME^PACKAGE" as the
+"login".
+
+ An entry in one of the three mentioned files would then look like
+this:
+
+ machine api.github.com login tarsius^ghub password 012345abcdef...
+
+\1f
+File: ghub.info, Node: Using Ghub in Personal Scripts, Next: Using Ghub in a Package, Prev: Getting Started, Up: Top
+
+4 Using Ghub in Personal Scripts
+********************************
+
+You can use ‘ghub-request’ and its wrapper functions in your personal
+scripts of course. Unlike when you use Ghub from a package that you
+distribute for others to use, you don’t have to specify a package in
+personal scripts.
+
+ ;; This is perfectly acceptable in personal scripts ...
+ (ghub-get "/user")
+
+ ;; ... and actually equal to
+ (ghub-get "/user" nil :auth 'ghub)
+
+ ;; In packages you have to specify the package using AUTH.
+ (ghub-get "/user" nil :auth 'foobar)
+
+ When you do not specify the AUTH argument, then a request is made on
+behalf of the ‘ghub’ package itself. Like for any package that uses
+Ghub, ‘ghub’ has to declare what scopes it needs, using, in this case,
+the variable ‘ghub-github-token-scopes’.
+
+ The default value of that variable is ‘(repo)’ and you might want to
+add additional scopes. You can later add additional scopes to an
+existing token, using the web interface at
+<https://github.com/settings/tokens>.
+
+ If you do that, then you might want to also set the variable
+accordingly, but note that Ghub only consults that when *creating* a new
+token. If you want to know a token’s effective scopes use the command
+‘ghub-token-scopes’, described in the next section.
+
+\1f
+File: ghub.info, Node: Using Ghub in a Package, Next: API, Prev: Using Ghub in Personal Scripts, Up: Top
+
+5 Using Ghub in a Package
+*************************
+
+Every package should use its own token. This allows you as the author
+of some package to only request access to API scopes that are actually
+needed, which in turn might make it easier for users to trust your
+package not to do unwanted things.
+
+ The scopes used by PACKAGE have to be defined using the variable
+‘PACKAGE-github-token-scopes’, and you have to tell ‘ghub-request’ on
+behalf of what package a request is being made by passing the symbol
+PACKAGE as the value of its AUTH argument.
+
+ (ghub-request "GET" "/user" nil :auth 'PACKAGE)
+
+ -- Variable: PACKAGE-github-token-scopes
+
+ This variable defines the token scopes requested by the package
+ named PACKAGE. The doc-string should explain what the various
+ scopes are needed for to prevent users from giving PACKAGE fewer
+ permissions than it absolutely needs and also to give them greater
+ confidence that PACKAGE is only requesting the permissions that it
+ actually need.
+
+ The value of this variable does not necessarily correspond to the
+ scopes that the respective token actually gives access to. There
+ is nothing that prevents users from changing the value *after*
+ creating the token or from editing the token’s scopes later on.
+
+ So it is pointless to check the value of this variable before
+ making a request. You also should not query the API to reliably
+ determine the supported tokens before making a query. Doing the
+ latter would mean that every request becomes two requests and that
+ the first request would have to be done using the user’s password
+ instead of a token.
+
+ -- Command: ghub-token-scopes
+
+ Because we cannot be certain that the user hasn’t messed up the
+ scopes, Ghub provides this command to make it easy to debug such
+ issues without having to rely on users being thoughtful enough to
+ correctly determine the used scopes manually.
+
+ Just tell users to run ‘M-x ghub-token-scopes’ and to provide the
+ correct values for the HOST, USERNAME and PACKAGE when prompted,
+ and to then post the output.
+
+ It is to be expected that users will occasionally mess that up so
+ this command does not only output the scopes but also the user
+ input so that you can have greater confidence in the validity of
+ the user’s answer.
+
+ Scopes for USERNAME^PACKAGE@HOST: (SCOPE...)
+
+\1f
+File: ghub.info, Node: API, Prev: Using Ghub in a Package, Up: Top
+
+6 API
+*****
+
+This section describes the Ghub API. In other words it describes the
+public functions and variables provided by the Ghub library and not the
+Github API that can be accessed by using those functions. The latter is
+documented at <https://developer.github.com/v3>.
+
+* Menu:
+
+* Making Requests::
+* Authentication::
+* Configuration Variables::
+
+\1f
+File: ghub.info, Node: Making Requests, Next: Authentication, Up: API
+
+6.1 Making Requests
+===================
+
+ -- Function: ghub-request method resource &optional params &key query
+ payload headers unpaginate noerror reader username auth host
+
+ This function make a request for RESOURCE using METHOD. PARAMS,
+ QUERY, PAYLOAD and/or HEADERS are alists holding additional request
+ data. The response body is returned and the response header in
+ stored in the variable ‘ghub-response-headers’.
+
+ • METHOD is the http method, given as a string.
+
+ • RESOURCE is the resource to access, given as a string
+ beginning with a slash.
+
+ • PARAMS, QUERY, PAYLOAD and HEADERS are alists and are used to
+ specify request data. All these arguments are alists that
+ resemble the Json expected and returned by the Github API. The
+ keys are symbols and the values are stored in the ‘cdr’ (not
+ the ‘cadr’) and can be strings, integers and lists of strings
+ and integers.
+
+ The Github API documentation is vague on how data has to be
+ transmitted and for a particular resource usually just talks
+ about "parameters". Generally speaking when the METHOD is
+ "HEAD" or "GET", then they have to be transmitted as a query,
+ otherwise as a payload.
+
+ • Use PARAMS to automatically transmit like QUERY or
+ PAYLOAD would depending on METHOD.
+
+ • Use QUERY to explicitly transmit data as a query.
+
+ • Use PAYLOAD to explicitly transmit data as a payload.
+
+ • Use HEADERS for those rare resources that require that
+ the data is transmitted as headers instead of as a query
+ or payload. When that is the case, then the Github API
+ documentation usually mentions it explicitly.
+
+ • If UNPAGINATE is non-nil, then this function makes multiple
+ requests if necessary to get all items at RESOURCE.
+
+ • If NOERROR is non-nil, then no error is raised if the request
+ fails and ‘nil’ is returned instead.
+
+ • If READER is non-nil, then it is used to read and return from
+ the response buffer. The default is
+ ‘ghub--read-json-response’. For the very few resources that
+ do not return json, you might want to use
+ ‘ghub--read-raw-response’.
+
+ • If USERNAME is non-nil, then the request is made on behalf of
+ that user. It is better to specify the user using the Git
+ variable ‘github.user’ for "api.github.com", or
+ ‘github.HOST.user’ if connecting to a Github Enterprise
+ instance.
+
+ • Each package that uses Ghub should use its own token. If AUTH
+ is nil, then the generic ‘ghub’ token is used instead. This
+ is only acceptable for personal utilities. A packages that is
+ distributed to other users should always use this argument to
+ identify itself, using a symbol matching its name.
+
+ Package authors who find this inconvenient should write a
+ wrapper around this function and possibly for the method
+ specific functions also.
+
+ Some symbols have a special meaning. ‘none’ means to make an
+ unauthorized request. ‘basic’ means to make a password based
+ request. If the value is a string, then it is assumed to be a
+ valid token. ‘basic’ and an explicit token string are only
+ intended for internal and debugging uses.
+
+ If AUTH is a package symbol, then the scopes are specified
+ using the variable ‘AUTH-github-token-scopes’. It is an error
+ if that is not specified. See ‘ghub-github-token-scopes’ for
+ an example.
+
+ • If HOST is non-nil, then connect to that Github instance.
+ This defaults to "api.github.com". When a repository is
+ connected to a Github Enterprise instance, then it is better
+ to specify that using the Git variable ‘github.host’ instead
+ of using this argument.
+
+ -- Variable: ghub-response-headers
+
+ A select few Github API resources respond by transmitting data in
+ the response header instead of in the response body. Because there
+ are so few of these inconsistencies ‘ghub-request’ always returns
+ the response body.
+
+ To access the response header use this variable after
+ ‘ghub-request’ has returned.
+
+ -- Variable: ghub-override-system-name
+
+ If non-nil, the value of this variable is used to override the
+ value returned by ‘system-name’ for the purpose of identifying the
+ local machine, which is necessary because Ghub uses separate tokens
+ for each machine. Also see *note Configuration Variables::.
+
+ -- Variable: ghub-github-token-scopes
+ -- Variable: PACKAGE-github-token-scopes
+
+ Such a variable define the token scopes requested by the respective
+ package PACKAGE given by the first word in the variable name.
+ ‘ghub’ itself is treated like any other package. Also see *note
+ Using Ghub in a Package::.
+
+ -- Function: ghub-head resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host
+ -- Function: ghub-get resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host
+
+ These functions are simple wrappers around ‘ghub-request’. Their
+ signature is identical to that of the latter, except that they do
+ not have an argument named METHOD. The http method is instead given
+ by the second word in the function name.
+
+ As described in the documentation for ‘ghub-request’, it depends on
+ the used method whether the value of the PARAMS argument is used as
+ the query or the payload. For the "HEAD" and "GET" methods it is
+ used as the query.
+
+ -- Function: ghub-put resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host
+ -- Function: ghub-post resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host
+ -- Function: ghub-patch resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host
+ -- Function: ghub-delete resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host
+
+ These functions are simple wrappers around ‘ghub-request’. Their
+ signature is identical to that of the latter, except that they do
+ not have an argument named METHOD. The http method is instead given
+ by the second word in the function name.
+
+ As described in the documentation for ‘ghub-request’, it depends on
+ the used method whether the value of the PARAMS argument is used as
+ the query or the payload. For the "PUT", "POST", "PATCH" and
+ "DELETE" methods it is used as the payload.
+
+ -- Function: ghub-wait resource &optional username auth host duration
+
+ Some API requests result in an immediate successful response even
+ when the requested action has not actually been carried out yet.
+ An example is the request for the creation of a new repository,
+ which doesn’t cause the repository to immediately become available.
+ The Github API documentation usually mention this when describing
+ an affected resource.
+
+ If you want to do something with some resource right after creating
+ after making a request for its creation, then you might have to
+ wait for it to actually be created. This function can be used to
+ do so. It repeatedly tries to access the resource until it becomes
+ available or until the timeout exceeds. In the latter case it
+ signals ‘ghub-error’.
+
+ RESOURCE specifies the resource that this function waits for.
+
+ DURATION specifies for how many seconds to wait at most, defaulting
+ to 64 seconds. Emacs will block during that time, but the user can
+ abort using ‘C-g’.
+
+ The first attempt is made immediately and often that will actually
+ succeed. If not, then another attempt is made after two seconds,
+ and each subsequent attempt is made after waiting as long as we
+ already waited between all preceding attempts combined.
+
+ See ‘ghub-request’’s documentation above for information about the
+ other arguments.
+
+\1f
+File: ghub.info, Node: Authentication, Next: Configuration Variables, Prev: Making Requests, Up: API
+
+6.2 Authentication
+==================
+
+ -- Command: ghub-create-token
+
+ This command creates a new token using the values it reads from the
+ user and then stores it according to variable ‘auth-sources’. It
+ can also be called non-interactively, but you shouldn’t do that
+ yourself.
+
+ This is useful if you want fully setup things before attempting to
+ make the initial request, if you want to provide fewer than the
+ requested scopes or customize ‘auth-sources’ first, or if something
+ has gone wrong when using the wizard that is used when making a
+ request without doing this first. (Note that instead of using this
+ command you can also just repeat the initial request after making
+ the desired adjustments — that is easier.)
+
+ This command reads, in that order, the HOST (Github instance), the
+ USERNAME, the PACKAGE and the SCOPES in the minibuffer, providing
+ reasonable default choices. SCOPES defaults to the scopes that
+ PACKAGE requests using the variable ‘PACKAGE-github-token-scopes’.
+
+ -- Command: ghub-token-scopes
+
+ Users are free to give a token access to fewer scopes than what the
+ respective package requested. That can of course lead to issues
+ and package maintainers have to be able to quickly determine if
+ such a (mis-)configuration is the root cause when users report
+ issues.
+
+ This command reads the required values in the minibuffer and then
+ shows a message containing these values along with the scopes of
+ the respective token. It also returns the scopes (only) when
+ called non-interactively. Also see *note Using Ghub in a
+ Package::.
+
+\1f
+File: ghub.info, Node: Configuration Variables, Prev: Authentication, Up: API
+
+6.3 Configuration Variables
+===========================
+
+The username and, unless you only use Github.com itself, the Github
+Enterprise instance have to be configured using Git variables. In rare
+cases it might also be necessary to specify the identity of the local
+machine, which is done using a lisp variable.
+
+ -- Variable: github.user
+
+ The Github.com username. This should be set globally and if you
+ have multiple Github.com user accounts, then you should set this
+ locally only for those repositories that you want to access using
+ the secondary identity.
+
+ -- Variable: github.HOST.user
+
+ This variable serves the same purpose as ‘github.user’ but for the
+ Github Enterprise instance identified by HOST.
+
+ The reason why separate variables are used is that this makes it
+ possible to set the both values globally instead of having to set
+ one of the values locally in each and every repository that is
+ connected to the Github Enterprise instance, not Github.com.
+
+ -- Variable: github.host
+
+ This variable should only be set locally for a repository and
+ specifies the Github Enterprise edition that that repository is
+ connected to. You should not set this globally because then each
+ and every repository becomes connected to the specified Github
+ Enterprise instance, including those that should actually be
+ connected to Github.com.
+
+ When this is undefined, then "api.github.com" is used (define in
+ the constant ‘ghub-default-host-host’, which you should never
+ attempt to change.)
+
+ -- Variable: ghub-override-system-name
+
+ Ghub uses a different token for each quadruple ‘(USERNAME PACKAGE
+ HOST LOCAL-MACHINE)‘. Theoretically it could reuse tokens to some
+ extend but that would be more difficult to implement, less
+ flexible, and less secure (though slightly more convenient).
+
+ A token is identified on the respective Github instance (Github.com
+ or a Github Enterprise instance) using the pair ‘(PACKAGE .
+ LOCAL-MACHINE)‘, or more precisely the string "Emacs package
+ PACKAGE @ LOCAL-MACHINE". USERNAME and HOST do not have to be
+ encoded because the token is stored for USERNAME on HOST and cannot
+ be used by another user and/or on another instance.
+
+ There is one potential problem though; for any given ‘(PACKAGE .
+ LOCAL-MACHINE)‘ there can only be one token identified by "Emacs
+ package PACKAGE @ LOCAL-MACHINE", Github does not allow multiple
+ tokens with the same description because it uses the description as
+ the identifier. (It could use some hash instead, but alas it does
+ not.)
+
+ If you have multiple machines and some of them have the same name,
+ then you should probably change that as this is not how thing ought
+ to be. However if you dual-boot, then it might make sense to give
+ that machine the same name regardless of what operating system you
+ have booted into.
+
+ You could use the same token on both operating systems, but setting
+ that up might be somewhat difficult because it is not possible to
+ download an existing token from Github. You could of course
+ locally copy the token, but that is inconvenient and would make it
+ harder to only revoke the token used on your infected Windows
+ installation without also revoking it for your totally safe *BSD
+ installation.
+
+ Alternatively you can set this variable to a unique value, that
+ will then be used to identify the local machine instead of the
+ value returned by ‘system-name’.
+
+
+\1f
+Tag Table:
+Node: Top\7f757
+Node: Introduction\7f2786
+Node: Limitations\7f5322
+Node: Getting Started\7f7463
+Node: Setting the Username\7f7965
+Node: Interactively Creating and Storing a Token\7f9390
+Node: Manually Creating and Storing a Token\7f15345
+Node: How Ghub uses Auth-Source\7f16433
+Node: Using Ghub in Personal Scripts\7f18003
+Node: Using Ghub in a Package\7f19452
+Node: API\7f22017
+Node: Making Requests\7f22444
+Node: Authentication\7f31001
+Node: Configuration Variables\7f32800
+\1f
+End Tag Table
+
+\1f
+Local Variables:
+coding: utf-8
+End:
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-autoscaling-describe-launch-configurations
-# key: aws-autoscaling-describe-launch-configurations
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} autoscaling describe-launch-configurations --query 'reverse(sort_by(LaunchConfigurations &CreatedTime)[*].[LaunchConfigurationName, CreatedTime])' --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-autoscaling-update-auto-scaling-group-min-max
-# key: aws-autoscaling-update-auto-scaling-group-min-max
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} autoscaling update-auto-scaling-group --auto-scaling-group-name ${4:`(yank)`} --min-size $5 --max-size $6 $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-cloudformation-change-ls
-# key: cloud-change-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} cloudformation list-change-sets --stack-name ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-cloudformation-create-change-set
-# key: cloud-createchange
-# expand-env: ((yas/indent-line 'auto) (yas/wrap-around-region 't))
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} \
-${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} \
-cloudformation create-change-set \
-${4:--capabilities CAPABILITY_NAMED_IAM} \
---stack-name '$5' \
---change-set-name '$6' \
---description '$7' \
---parameters ${8:file://} \
-${9:--change-set-type=${10:$$(yas-choose-value '("CREATE" "UPDATE"))}}$0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-cloudformation-describe-change-set
-# key: cloud-descchange
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} cloudformation describe-change-set --stack-name ${4:`(yank)`} --change-set-name $5 --output ${6:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-cloudformation-describe-stack
-# key: cloud-desc
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} cloudformation describe-stacks --stack-name ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-cloudformation-describe-stack-events
-# key: cloud-events-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} cloudformation describe-stack-events --stack-name ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-cloudformation-ls
-# key: cloud-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} cloudformation list-stacks --stack-status-filter ${4:$$(yas-choose-value '(
-"CREATE_COMPLETE"
-"CREATE_IN_PROGRESS"
-"CREATE_FAILED"
-"ROLLBACK_IN_PROGRESS"
-"ROLLBACK_FAILED"
-"ROLLBACK_COMPLETE"
-"DELETE_IN_PROGRESS"
-"DELETE_FAILED"
-"DELETE_COMPLETE"
-"UPDATE_IN_PROGRESS"
-"UPDATE_COMPLETE_CLEANUP_IN_PROGRESS"
-"UPDATE_COMPLETE"
-"UPDATE_ROLLBACK_IN_PROGRESS"
-"UPDATE_ROLLBACK_FAILED"
-"UPDATE_ROLLBACK_COMPLETE_CLEANUP_IN_PROGRESS"
-"UPDATE_ROLLBACK_COMPLETE"
-"REVIEW_IN_PROGRESS"
-))} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-cloudformation-validate-template
-# key: cloud-val-temp
-# --
-aws --profile=test --region=us-east-1 cloudformation validate-template --template-body file://${1:`(yank)`} --output ${2:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-cloudtrail-lookup-events
-# key: cloudtrail-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} cloudtrail lookup-events --max-items ${4:100} --lookup-attributes AttributeKey=${5:$$(yas-choose-value '("ResourceType,AttributeValue=AWS::EC2::Instance" "ResourceName,AttributeValue="))}$6 --output ${7:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-delete-snapshot (yank)
-# key: snap-del
-# --
-# aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} ec2 delete-snapshot --snapshot-id ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-delete-volume (yank)
-# key: ebs-del
-# --
-# aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} ec2 delete-volume --volume-id ${4:`(yank)`} $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-describe-instance-attribute (yank)
-# key: ec2-attribute
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} ec2 describe-instance-attribute --instance-id ${4:`(yank)`} --attribute ${5:$$(yas-choose-value '("instanceType" "kernel" "ramdisk" "userData" "disableApiTermination" "instanceInitiatedShutdownBehavior" "rootDeviceName" "blockDeviceMapping" "productCodes" "sourceDestCheck" "groupSet" "ebsOptimized" "sriovNetSupport"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-describe-instance-status (yank)
-# key: aws-ec2-describe-instance-status
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} ec2 describe-instance-status --instance-ids ${4:`(yank)`} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-describe-userdata (yank)
-# key: ec2-userdata
-# --
-(base64-decode-string (shell-command-to-string "aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} ec2 describe-instance-attribute --instance-id ${4:`(yank)`} --attribute userData --query 'UserData.Value' --output text"))$0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-get-console-output (yank)
-# key: ec2-console
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} ec2 get-console-output --output text --instance-id ${4:`(yank)`} >#<buffer *$4-console-output*> $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-get-dns-names
-# key: aws-ec2-get-dns-names
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} ec2 describe-instances --filters "Name=tag:Name,Values=$4" --query "Reservations[].Instances[?State.Name=='running'].[InstanceId, PublicDnsName]" --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-get-instance-details (yank)
-# key: ec2-det
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} ec2 describe-instances --instance-ids ${4:`(yank)`} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-get-instance-volumes
-# key: ec2-vol
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} ec2 describe-instances --query "Reservations[].Instances[].[join(\`,\`,Tags[?Key==\`Name\`].Value),join(' ', BlockDeviceMappings[].Ebs.VolumeId)]" --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-get-securitygroup-details (yank)
-# key: aws-ec2-get-securitygroup-details
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} ec2 describe-security-groups --group-ids ${4:`(yank)`} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-get-securitygroup-references (yank)
-# key: aws-ec2-get-securitygroup-references
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} ec2 describe-security-group-references --group-id ${4:`(yank)`} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-get-securitygroups
-# key: aws-ec2-get-securitygroups
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} ec2 describe-security-groups --query "sort_by(SecurityGroups, &GroupName)[*].[GroupName, GroupId, Description]" --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-get-snapshot-details (yank)
-# key: snap-det
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} ec2 describe-snapshots --snapshot-id ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-get-volumes
-# key: ebs-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} ec2 describe-volumes --query 'Volumes[].[VolumeId,State,SnapshotId,join(\`,\`,Tags[?Key==\`Name\`].Value)]' --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-get-volumes-unused
-# key: ebs-ls-avail
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} ec2 describe-volumes --query 'Volumes[].[VolumeId,Size,VolumeType,CreateTime,State,SnapshotId]' --filters Name=status,Values=available --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-instance-running
-# key: aws-ec2-instance-running
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} ec2 describe-instances --instance-ids $4 --query "Reservations[].Instances[].[InstanceId, State.Name]" --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-list-subnets
-# key: sub-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} ec2 describe-subnets --query "sort_by(sort_by(Subnets[].{VpcId:VpcId, SubnetId:SubnetId, State:State, AvailabilityZone:AvailabilityZone, CidrBlock:CidrBlock, AvailableIpAddressCount:AvailableIpAddressCount Tags:to_string(Tags[].[Key, Value])}, &SubnetId), &VpcId)" --output ${4:$$(yas-choose-value '("table" "text" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-list-vpcs
-# key: vpc-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} ec2 describe-vpcs --query "sort_by(Vpcs[].{VpcId:VpcId, State:State, AvailabilityZone:AvailabilityZone, CidrBlock:CidrBlock, AvailableIpAddressCount:AvailableIpAddressCount Tags:to_string(Tags[].[Key, Value])}, &VpcId)" --output ${4:$$(yas-choose-value '("table" "text" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-start-stop-instance (yank)
-# key: ec2-start
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} ec2 ${4:$$(yas-choose-value '("start-instances" "stop-instances" "reboot-instances"))} --instance-ids ${5:`(yank)`} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-ec2-volume-details (yank)
-# key: ebs-det
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} ec2 describe-volumes --volume-ids ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-elb-describe-instance-health (yank)
-# key: aws-elb-describe-instance-health
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} elb describe-instance-health --load-balancer-name ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-elb-describe-load-balancer (yank)
-# key: aws-elb-describe-load-balancer
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} elb describe-load-balancers --load-balancer-name ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-elb-describe-load-balancer-attributes (yank)
-# key: aws-elb-describe-load-balancer-attributes
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} elb describe-load-balancer-attributes --load-balancer-name ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-elb-get-list
-# key: elb-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} elb describe-load-balancers --query "reverse(sort_by(LoadBalancerDescriptions, &CreatedTime)[].[LoadBalancerName, CreatedTime])" --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-elb-search
-# key: aws-elb-search
-# --
-for REGION in `(insert-string (mapconcat 'identity bba-aws-regions " "))`; do
- for BALANCER in \`aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} --region=\${REGION} elb describe-load-balancers --query "reverse(sort_by(LoadBalancerDescriptions, &CreatedTime)[].[LoadBalancerName])" --output text\`; do
- aws --profile=$1 --region=\${REGION} elb describe-load-balancers --load-balancer-name \${BALANCER} --output text | awk "{print \\"\${REGION}:\${BALANCER}:\\"\\\$0}"
- done
-done $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-emr-describe-cluster (yank)
-# key: aws-emr-describe-cluster
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} --region=${2:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)} emr describe-cluster --cluster-id ${3: `(yank)`} --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-emr-list-clusters
-# key: emr-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} --region=${2:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)} emr list-clusters --active --query 'Clusters[*].{ID: Id, NAME: Name}' --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-logs-get-groups
-# key: logs-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} logs describe-log-groups --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-logs-set-retention
-# key: logs-set-ret
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)}} logs put-retention-policy --log-group-name ${4:`(yank)`} --retention-in-days ${5:$$(yas-choose-value '( "60" "1" "3" "5" "7" "14" "30" "90" "120" "150" "180" "365" "400" "545" "731" "1827" "3653"))} $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-rds-describe-db-instance-details (yank)
-# key: aws-rds-describe-db-instance-details
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} rds describe-db-instances --db-instance-identifier ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-rds-describe-db-instances
-# key: rds-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} rds describe-db-instances --query "DBInstances[*].[DBInstanceIdentifier,DbiResourceId, Endpoint.Address]" --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-rds-describe-db-parameter-groups
-# key: aws-rds-describe-db-parameter-groups
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} rds describe-db-parameter-groups --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-rds-describe-parameters (yank)
-# key: aws-rds-describe-parameters
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} rds describe-db-parameters --db-parameter-group-name ${4:`(yank)`} --query "Parameters[*][ParameterName, ParameterValue]" --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-region-loop
-# key: aws-region-loop
-# --
-for REGION in `(insert-string (mapconcat 'identity bba-aws-regions " "))`; do
-$0
-done
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-regions
-# key: awsreg
-# --
---region=${1:$$(yas-choose-value "\$\{REGION\}" bba-aws-regions)} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-route53-list-hosted-zones
-# key: r53-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} route53 list-hosted-zones --query 'HostedZones[].[Id, Name]' --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-route53-list-resource-record-sets (yank)
-# key: aws-route53-list-resource-record-sets
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} route53 list-resource-record-sets --hosted-zone-id ${2:`(yank)`} --query \"ResourceRecordSets[?contains(Name, '$3')]\" --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-sns-ls
-# key: sns-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} sns list-topics --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-support-describe
-# key: support-desc
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} support describe-communications --case-id ${4:`(yank)`} --output ${5:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-support-ls
-# key: support-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} support describe-cases --no-include-communications --query "reverse(sort_by(cases, &timeCreated)[].[subject, timeCreated, displayId])" --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: aws-support-ls
-# key: support-ls
-# --
-aws --profile=${1:$$(yas-choose-value bba-aws-profiles)} ${2:--region=${3:$$(yas-choose-value bba-aws-regions)}} support describe-cases --no-include-communications --query "reverse(sort_by(cases, &timeCreated)[].[subject, timeCreated, displayId])" --output ${4:$$(yas-choose-value '("text" "table" "json"))} $0
\ No newline at end of file
projects / emacsconfig.git / commitdiff