Update elpa packages
This commit is contained in:
Marcus Kammer
parent
f5daf46dc6
commit
d915e27d60
239 changed files with 96311 additions and 0 deletions
24
elpa/berrys-theme-20191106.1423/berrys-theme-autoloads.el
Normal file
24
elpa/berrys-theme-20191106.1423/berrys-theme-autoloads.el
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
;;; berrys-theme-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "berrys-theme" "berrys-theme.el" (0 0 0 0))
|
||||
;;; Generated autoloads from berrys-theme.el
|
||||
|
||||
(when (and (boundp 'custom-theme-load-path) load-file-name) (add-to-list 'custom-theme-load-path (file-name-as-directory (file-name-directory load-file-name))))
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "berrys-theme" '("berrys")))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; berrys-theme-autoloads.el ends here
|
||||
2
elpa/berrys-theme-20191106.1423/berrys-theme-pkg.el
Normal file
2
elpa/berrys-theme-20191106.1423/berrys-theme-pkg.el
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "berrys-theme" "20191106.1423" "A light, clean and elegant theme" '((emacs "24.1")) :commit "1fcc22758abf33b42826750ed0774ee0f6601d2b" :authors '(("Slava Buzin" . "v8v.buzin@gmail.com")) :maintainer '("Slava Buzin" . "v8v.buzin@gmail.com") :url "https://github.com/vbuzin/berrys-theme")
|
||||
399
elpa/berrys-theme-20191106.1423/berrys-theme.el
Normal file
399
elpa/berrys-theme-20191106.1423/berrys-theme.el
Normal file
|
|
@ -0,0 +1,399 @@
|
|||
;;; berrys-theme.el --- A light, clean and elegant theme -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright © 2019-present Slava Buzin
|
||||
|
||||
;; Title: Berrys Theme
|
||||
;; Project: berrys-theme
|
||||
;; Version: 0.1.0
|
||||
;; Package-Version: 20191106.1423
|
||||
;; URL: https://github.com/vbuzin/berrys-theme
|
||||
;; Author: Slava Buzin <v8v.buzin@gmail.com>
|
||||
;; Package-Requires: ((emacs "24.1"))
|
||||
;; License: MIT
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Berrys is a 9 colorspace theme build to run in GUI mode
|
||||
;; with support for some third-party syntax- and UI packages.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(deftheme berrys "A light, clean and elegant theme")
|
||||
|
||||
;;;; Colors
|
||||
(let* ((class '((class color) (min-colors 89)))
|
||||
(berrys00 nil)
|
||||
|
||||
(berrys01 "#FAFAFA")
|
||||
(berrys02 "#2C302E")
|
||||
(berrys03 "#646881")
|
||||
(berrys04 "#E2E3E8")
|
||||
|
||||
(berrys05 "#1098F7")
|
||||
(berrys06 "#B2EAFF")
|
||||
|
||||
(berrys07 nil)
|
||||
|
||||
(berrys08 "#00AC00")
|
||||
|
||||
(berrys09 "#D89800")
|
||||
|
||||
(berrys10 "#B80C09")
|
||||
|
||||
(berrys-cursor berrys05)
|
||||
(berrys-comment berrys03)
|
||||
(berrys-string berrys03)
|
||||
|
||||
(berrys-warning berrys09)
|
||||
(berrys-error berrys10))
|
||||
|
||||
(custom-theme-set-faces
|
||||
'berrys
|
||||
|
||||
;;; Core
|
||||
;; =============================================================================
|
||||
;; => Base
|
||||
`(bold ((,class (:weight bold))))
|
||||
`(bold-italic ((,class (:weight bold :slant italic))))
|
||||
`(default ((,class (:foreground ,berrys02 :background ,berrys01))))
|
||||
`(error ((,class (:foreground ,berrys-error))))
|
||||
`(fixed-pitch-serif ((,class (:family unspecified))))
|
||||
`(font-lock-builtin-face ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(font-lock-comment-face ((,class (:foreground ,berrys-comment :slant italic))))
|
||||
`(font-lock-comment-delimiter-face ((,class (:foreground ,berrys-comment :slant italic))))
|
||||
`(font-lock-constant-face ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(font-lock-doc-face ((,class (:inherit (font-lock-comment-face)))))
|
||||
`(font-lock-function-name-face ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(font-lock-keyword-face ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(font-lock-string-face ((,class (:foreground ,berrys-string))))
|
||||
`(font-lock-type-face ((,class (:foreground ,berrys02 :slant italic))))
|
||||
`(font-lock-variable-name-face ((,class (:foreground ,berrys02))))
|
||||
`(font-lock-warning-face ((,class (:inherit warning))))
|
||||
`(shadow ((,class (:foreground ,berrys03))))
|
||||
`(warning ((,class (:foreground ,berrys-warning))))
|
||||
|
||||
;; => Core UI
|
||||
`(cursor ((,class (:background ,berrys-cursor :inverse-video t))))
|
||||
`(custom-button ((,class (:background ,berrys05 :foreground ,berrys01))))
|
||||
`(custom-variable-tag ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(custom-visibility ((,class (:inherit link))))
|
||||
`(diff-added ((,class (:foreground ,berrys08))))
|
||||
`(diff-context ((,class (:foreground ,berrys-string))))
|
||||
`(diff-file-header ((,class (:inherit diff-header))))
|
||||
`(diff-header ((,class (:foreground ,berrys03))))
|
||||
`(diff-hunk-header ((,class (:inherit diff-header))))
|
||||
`(diff-indicator-added ((,class (:foreground ,berrys08))))
|
||||
`(diff-refine-added ((,class (:foreground ,berrys08))))
|
||||
`(diff-refine-changed ((,class (:foreground ,berrys09))))
|
||||
`(diff-refine-removed ((,class (:foreground ,berrys10))))
|
||||
`(diff-removed ((,class (:foreground ,berrys10))))
|
||||
`(dired-directory ((,class :foreground ,berrys02 :weight bold)))
|
||||
`(header-line ((,class :foreground ,berrys02 :weight bold)))
|
||||
`(highlight ((,class (:background ,berrys04))))
|
||||
`(hl-line ((,class (:background ,berrys04))))
|
||||
`(info-node ((,class (:foreground ,berrys05 :weight bold))))
|
||||
`(info-menu-header ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(info-menu-star ((,class (:foreground ,berrys05))))
|
||||
`(info-title-4 ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(isearch ((,class (:foreground ,berrys05 :weight bold))))
|
||||
`(isearch-fail ((,class (:foreground ,berrys01 :background ,berrys-error))))
|
||||
`(lazy-highlight ((,class (:inherit isearch))))
|
||||
`(link ((,class (:underline t))))
|
||||
`(link-visited ((,class (:underline t))))
|
||||
`(match ((,class (:inherit isearch))))
|
||||
|
||||
`(message-cited-text ((,class (:inherit font-lock-comment-face))))
|
||||
`(message-header-cc ((,class (:foreground ,berrys-string))))
|
||||
`(message-header-name ((,class (:foreground ,berrys-string))))
|
||||
`(message-header-newsgroups ((,class (:foreground ,berrys-string :slant italic :weight bold))))
|
||||
`(message-header-other ((,class (:foreground ,berrys-string))))
|
||||
`(message-header-subject ((,class (:foreground ,berrys-string))))
|
||||
`(message-header-to ((,class (:foreground ,berrys-string))))
|
||||
`(message-header-xheader ((,class (:foreground ,berrys-string))))
|
||||
`(message-mml ((,class (:foreground ,berrys-string))))
|
||||
`(message-separator ((,class (:inherit font-lock-comment-face))))
|
||||
|
||||
`(minibuffer-prompt ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(mode-line ((,class (:foreground ,berrys02 :background ,berrys04))))
|
||||
`(mode-line-buffer-id ((,class (:weight bold))))
|
||||
`(mode-line-highlight ((,class (:inherit highlight))))
|
||||
`(mode-line-inactive ((,class (:foreground ,berrys02 :background ,berrys01 :box (:color ,berrys04)))))
|
||||
`(outline-1 ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(outline-2 ((,class (:inherit outline-1))))
|
||||
`(outline-3 ((,class (:inherit outline-1))))
|
||||
`(outline-4 ((,class (:inherit outline-1))))
|
||||
`(outline-5 ((,class (:inherit outline-1))))
|
||||
`(outline-6 ((,class (:inherit outline-1))))
|
||||
`(outline-7 ((,class (:inherit outline-1))))
|
||||
`(outline-8 ((,class (:inherit outline-1))))
|
||||
`(region ((,class (:background ,berrys06))))
|
||||
`(secondary-selection ((,class (:background ,berrys04 :foreground ,berrys02))))
|
||||
`(show-paren-match ((,class (:weight bold))))
|
||||
`(show-paren-mismatch ((,class (:foreground ,berrys-error :weight bold))))
|
||||
`(success ((,class (:foreground ,berrys08))))
|
||||
`(whitespace-big-indent ((,class (:foreground ,berrys01 :background ,berrys10))))
|
||||
`(whitespace-line ((,class (:background ,berrys01))))
|
||||
`(whitespace-trailing ((,class (:foreground ,berrys01 :background ,berrys10))))
|
||||
|
||||
;;; Packages
|
||||
;; =============================================================================
|
||||
;; => Ace jump
|
||||
`(ace-jump-face-foreground ((,class (:foreground ,berrys05 :weight bold))))
|
||||
|
||||
;; => Anzu
|
||||
`(anzu-match-1 ((,class (:foreground ,berrys05 :weight bold :box (:color ,berrys05)))))
|
||||
`(anzu-match-2 ((,class (:foreground ,berrys01 :background ,berrys05 :weight bold :box (:color ,berrys05)))))
|
||||
`(anzu-match-3 ((,class (:foreground ,berrys01 :background ,berrys03 :weight bold :box (:color ,berrys03)))))
|
||||
`(anzu-mode-line ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(anzu-mode-line-no-match ((,class (:foreground ,berrys10 :weight bold))))
|
||||
`(anzu-replace-to ((,class (:foreground ,berrys-string :weight bold))))
|
||||
|
||||
;; => Company
|
||||
`(company-echo-common ((,class (:foreground ,berrys01 :background ,berrys10))))
|
||||
`(company-scrollbar-bg ((,class (:foreground ,berrys04 :background ,berrys04))))
|
||||
`(company-scrollbar-fg ((,class (:foreground ,berrys02 :background ,berrys02))))
|
||||
`(company-template-field ((,class (:inherit region))))
|
||||
`(company-tooltip ((,class (:foreground ,berrys02 :background ,berrys04))))
|
||||
`(company-tooltip-annotation ((,class (:foreground ,berrys-string))))
|
||||
`(company-tooltip-common ((,class (:inherit company-tooltip))))
|
||||
`(company-tooltip-common-selection ((,class (:inherit company-tooltip-selection))))
|
||||
`(company-tooltip-mouse ((,class (:inherit highlight))))
|
||||
`(company-tooltip-search ((,class (:inherit isearch))))
|
||||
`(company-tooltip-search-selection ((,class (:inherit company-tooltip-search))))
|
||||
`(company-tooltip-selection ((,class (:background ,berrys06))))
|
||||
|
||||
;; => bm
|
||||
`(bm-face ((,class (:foreground ,berrys05 :background ,berrys01))))
|
||||
`(bm-fringe-face ((,class (:inherit bm-face))))
|
||||
`(bm-persistent-face ((,class (:foreground ,berrys01 :background ,berrys05))))
|
||||
`(bm-fringe-persistent-face ((,class (:inherit bm-persistent-face))))
|
||||
|
||||
;; => Flx
|
||||
`(flx-highlight-face ((,class (:foreground ,berrys05 :weight bold))))
|
||||
|
||||
;; => Flycheck
|
||||
`(flycheck-error ((,class (:underline (:style wave :color ,berrys-error)))))
|
||||
`(flycheck-fringe-error ((,class (:foreground ,berrys-error :weight bold))))
|
||||
`(flycheck-fringe-info ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(flycheck-fringe-warning ((,class (:foreground ,berrys-warning :weight bold))))
|
||||
`(flycheck-info ((,class (:underline (:style wave :color ,berrys05)))))
|
||||
`(flycheck-warning ((,class (:underline (:style wave :color ,berrys-warning)))))
|
||||
|
||||
;; => Gnus
|
||||
`(gnus-header-content ((,class (:foreground ,berrys-string :italic t))))
|
||||
`(gnus-header-from ((,class (:foreground ,berrys-string))))
|
||||
`(gnus-header-name ((,class (:foreground ,berrys-string :weight bold))))
|
||||
`(gnus-header-subject ((,class (:foreground ,berrys-string))))
|
||||
|
||||
;; => Haskell-mode
|
||||
`(haskell-error-face ((,class (:underline (:style wave :color ,berrys-error)))))
|
||||
`(haskell-hole-face ((,class (:underline (:style wave :color ,berrys05)))))
|
||||
`(haskell-warning-face ((,class (:underline (:style wave :color ,berrys-warning)))))
|
||||
|
||||
;; => Helm
|
||||
`(helm-M-x-key ((,class (:foreground ,berrys03 :underline t))))
|
||||
`(helm-buffer-directory ((,class (:inherit helm-buffer-file))))
|
||||
`(helm-buffer-not-saved ((,class (:foreground ,berrys03 :slant italic))))
|
||||
`(helm-buffer-process ((,class (:foreground ,berrys03))))
|
||||
`(helm-candidate-number ((,class (:weight bold))))
|
||||
`(helm-candidate-number-suspended ((,class (:foreground ,berrys03 :weight bold))))
|
||||
`(helm-ff-directory ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(helm-ff-dirs ((,class (:inherit helm-ff-file))))
|
||||
`(helm-ff-dotted-directory ((,class (:inherit helm-ff-directory))))
|
||||
`(helm-ff-dotted-symlink-directory ((,class (:inherit helm-ff-dotted-directory))))
|
||||
`(helm-ff-file ((,class (:foreground ,berrys02))))
|
||||
`(helm-ff-executable ((,class (:foreground ,berrys08))))
|
||||
`(helm-ff-invalid-symlink ((,class (:foreground ,berrys01 :background ,berrys10))))
|
||||
`(helm-ff-pipe ((,class (:foreground ,berrys09 :background ,berrys02))))
|
||||
`(helm-ff-prefix ((,class (:foreground ,berrys02 :background ,berrys06))))
|
||||
`(helm-ff-socket ((,class (:foreground ,berrys10 :box (:color ,berrys10)))))
|
||||
`(helm-grep-file ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(helm-grep-finish ((,class (:foreground ,berrys08 :weight bold))))
|
||||
`(helm-grep-lineno ((,class (:foreground ,berrys03))))
|
||||
`(helm-grep-match ((,class (:inherit isearch))))
|
||||
`(helm-header ((,class (:inherit helm-source-header :background ,berrys01))))
|
||||
`(helm-header-line-left-margin ((,class (:foreground ,berrys01 :background ,berrys09))))
|
||||
`(helm-helper ((,class (:foreground ,berrys02))))
|
||||
`(helm-history-deleted ((,class (:foreground ,berrys01 :background ,berrys10))))
|
||||
`(helm-history-remote ((,class (:foreground ,berrys10))))
|
||||
`(helm-lisp-completion-info ((,class (:foreground ,berrys04 :weight bold))))
|
||||
`(helm-lisp-show-completion ((,class (:inherit isearch))))
|
||||
`(helm-locate-finish ((,class (:foreground ,berrys08))))
|
||||
`(helm-match ((,class (:foreground ,berrys05 :weight bold))))
|
||||
`(helm-match-item ((,class (:inherit isearch))))
|
||||
`(helm-moccur-buffer ((,class (:foreground ,berrys02))))
|
||||
`(helm-mode-prefix ((,class (:foreground ,berrys01 :background ,berrys06))))
|
||||
`(helm-resume-need-update ((,class (:foreground ,berrys01 :background ,berrys10))))
|
||||
`(helm-selection ((,class (:inherit highlight))))
|
||||
`(helm-selection-line ((,class (:inherit highlight))))
|
||||
`(helm-source-header ((,class (:foreground ,berrys02 :weight bold :height 1.3))))
|
||||
`(helm-separator ((,class (:foreground ,berrys02))))
|
||||
`(helm-visible-mark ((,class (:background ,berrys06))))
|
||||
`(helm-yas-key ((,class (:inherit helm-M-x-key))))
|
||||
|
||||
;; => Ido
|
||||
`(ido-indicator ((,class (:foreground ,berrys01 :background ,berrys10))))
|
||||
`(ido-only-match ((,class (:foreground ,berrys05 :weight bold))))
|
||||
`(ido-subdir ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(ido-virtual ((,class (:foreground ,berrys-string :weight bold))))
|
||||
|
||||
;; => Indent guide
|
||||
`(indent-guide-face ((,class (:foreground ,berrys-comment))))
|
||||
|
||||
;; => Ivy
|
||||
`(ivy-confirm-face ((,class (:foreground ,berrys08 :weight bold))))
|
||||
`(ivy-current-match ((,class (:inherit hl-line))))
|
||||
`(ivy-cursor ((,class (:foreground ,berrys01 :background ,berrys02))))
|
||||
`(ivy-match-required-face ((,class (:foreground ,berrys10 :weight bold))))
|
||||
`(ivy-remote ((,class (:foreground ,berrys02 :underline t))))
|
||||
`(ivy-minibuffer-match-face-2 ((,class (:foreground ,berrys05 :weight bold))))
|
||||
`(ivy-minibuffer-match-face-3 ((,class (:inherit ivy-minibuffer-match-face-2 :underline t))))
|
||||
`(ivy-minibuffer-match-face-4 ((,class (:inherit ivy-minibuffer-match-face-2 :box (:color ,berrys05)))))
|
||||
|
||||
;; => Markdown
|
||||
`(markdown-code-face ((,class (:family unspecified))))
|
||||
`(markdown-header-face ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(markdown-header-face-1 ((,class (:inherit markdown-header-face :height 1.4))))
|
||||
`(markdown-header-face-2 ((,class (:inherit markdown-header-face :height 1.3))))
|
||||
`(markdown-header-face-3 ((,class (:inherit markdown-header-face :height 1.2))))
|
||||
`(markdown-header-face-4 ((,class (:inherit markdown-header-face :height 1.1))))
|
||||
`(markdown-inline-code-face ((,class (:inherit markdown-code-face))))
|
||||
`(markdown-italic-face ((,class (:inherit italic))))
|
||||
|
||||
;; => Magit
|
||||
`(magit-bisect-bad ((,class (:foreground ,berrys-error))))
|
||||
`(magit-bisect-good ((,class (:foreground ,berrys08))))
|
||||
`(magit-bisect-skip ((,class (:foreground ,berrys09))))
|
||||
`(magit-blame-highlight ((,class (:foreground ,berrys03 :background ,berrys04))))
|
||||
`(magit-branch-local ((,class (:foreground ,berrys05))))
|
||||
`(magit-branch-remote ((,class (:foreground ,berrys08))))
|
||||
`(magit-reflog-checkout ((,class (:foreground ,berrys05))))
|
||||
`(magit-diff-base ((,class (:foreground ,berrys09))))
|
||||
`(magit-diff-base-highlight ((,class (:inherit magit-diff-base))))
|
||||
`(magit-diff-context ((,class (:foreground ,berrys-string))))
|
||||
`(magit-diff-context-highlight ((,class (:inherit magit-diff-context))))
|
||||
`(magit-diff-added ((,class (:foreground ,berrys08))))
|
||||
`(magit-diff-added-highlight ((,class (:inherit magit-diff-added))))
|
||||
`(magit-diff-file-heading ((,class (:foreground ,berrys-string))))
|
||||
`(magit-diff-file-heading-selection ((,class (:inherit magit-diff-file-heading))))
|
||||
`(magit-diff-hunk-heading ((,class (:foreground ,berrys03))))
|
||||
`(magit-diff-hunk-heading-highlight ((,class (:inherit magit-diff-hunk-heading))))
|
||||
`(magit-diff-hunk-heading-selection ((,class (:inherit magit-diff-hunk-heading))))
|
||||
`(magit-diff-lines-boundary((,class (:inherit unspecified))))
|
||||
`(magit-diff-lines-heading ((,class (:inherit unspecified))))
|
||||
`(magit-diff-our-highlight ((,class (:inherit magit-diff-removed))))
|
||||
`(magit-diff-removed ((,class (:foreground ,berrys10))))
|
||||
`(magit-diff-removed-highlight ((,class (:inherit magit-diff-removed))))
|
||||
`(magit-diffstat-added ((,class (:foreground ,berrys08))))
|
||||
`(magit-diffstat-removed ((,class (:foreground ,berrys10))))
|
||||
`(magit-diff-their-highlight ((,class (:inherit magit-diff-added))))
|
||||
`(magit-diff-whitespace-warning ((,class (:foreground ,berrys01 :background ,berrys10))))
|
||||
`(magit-log-author ((,class (:foreground ,berrys02))))
|
||||
`(magit-log-date ((,class (:foreground ,berrys-comment))))
|
||||
`(magit-log-graph ((,class (:foreground ,berrys-comment))))
|
||||
`(magit-hash ((,class (:foreground ,berrys-comment))))
|
||||
`(magit-header-line ((,class (:foreground ,berrys-string))))
|
||||
`(magit-header-line-log-select ((,class (:foreground ,berrys02))))
|
||||
`(magit-process-ok ((,class (:foreground ,berrys08))))
|
||||
`(magit-reflog-cherry-pick ((,class (:foreground ,berrys08))))
|
||||
`(magit-reflog-commit ((,class (:foreground ,berrys08))))
|
||||
`(magit-reflog-merge ((,class (:foreground ,berrys08))))
|
||||
`(magit-reflog-reset ((,class (:foreground ,berrys10))))
|
||||
`(magit-refname ((,class (:foreground ,berrys-comment))))
|
||||
`(magit-section-heading ((,class (:foreground ,berrys02))))
|
||||
`(magit-section-heading-selection ((,class (:inherit magit-section-heading))))
|
||||
`(magit-section-highlight ((,class (:inherit unspecified))))
|
||||
`(magit-section-secondary-heading ((,class (:foreground ,berrys02))))
|
||||
`(magit-signature-bad ((,class (:foreground ,berrys-error))))
|
||||
`(magit-signature-error ((,class (:foreground ,berrys-error))))
|
||||
`(magit-signature-expired ((,class (:foreground ,berrys-warning))))
|
||||
`(magit-signature-expired-key ((,class (:inherit magit-signature-expired))))
|
||||
`(magit-signature-good ((,class (:foreground ,berrys08))))
|
||||
`(magit-signature-revoked ((,class (:foreground ,berrys10))))
|
||||
`(magit-signature-untrusted ((,class (:foreground ,berrys10))))
|
||||
`(magit-tag ((,class (:foreground ,berrys05))))
|
||||
|
||||
;; => Mu4e
|
||||
`(mu4e-attach-number-face ((,class (:foreground ,berrys05))))
|
||||
`(mu4e-contact-face ((,class (:foreground ,berrys-string :slant italic))))
|
||||
`(mu4e-context-face ((,class (:foreground ,berrys-string))))
|
||||
`(mu4e-flagged-face ((,class (:foreground ,berrys09))))
|
||||
`(mu4e-header-face ((,class (:foreground ,berrys02))))
|
||||
`(mu4e-header-highlight-face ((,class (:inherit highlight))))
|
||||
`(mu4e-header-key-face ((,class (:foreground ,berrys-string :weight bold))))
|
||||
`(mu4e-header-marks-face ((,class (:foreground ,berrys05 :weight bold))))
|
||||
`(mu4e-header-value-face ((,class (:foreground ,berrys-string :slant italic))))
|
||||
`(mu4e-highlight-face ((,class (:foreground ,berrys05))))
|
||||
`(mu4e-special-header-value-face ((,class (:foreground ,berrys-string :slant italic))))
|
||||
`(mu4e-region-code ((,class (:box (:color ,berrys05)))))
|
||||
`(mu4e-replied-face ((,class :slant italic)))
|
||||
`(mu4e-url-number-face ((,class (:foreground ,berrys05))))
|
||||
|
||||
;; => Org mode
|
||||
`(org-agenda-date ((,class (:foreground ,berrys02))))
|
||||
`(org-agenda-diary ((,class (:foreground ,berrys-string :slant italic))))
|
||||
`(org-agenda-dimmed-todo-face ((,class (:foreground ,berrys-comment :slant italic))))
|
||||
`(org-agenda-done ((,class (:foreground ,berrys-string :slant italic :strike-through t))))
|
||||
`(org-agenda-restriction-lock ((,class (:background ,berrys04))))
|
||||
`(org-agenda-structure ((,class (:foreground ,berrys05 :weight bold :height 1.3))))
|
||||
`(org-block ((,class (:inherit berrys02))))
|
||||
`(org-clock-overlay ((,class (:inherit secondary-selection))))
|
||||
`(org-column ((,class (:foreground ,berrys-string :slant normal))))
|
||||
`(org-column-title ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(org-date ((,class (:foreground ,berrys02 :slant italic))))
|
||||
`(org-date-selected ((,class (:foreground ,berrys05 :weight bold))))
|
||||
`(org-document-info ((,class (:foreground ,berrys03))))
|
||||
`(org-document-title ((,class (:foreground ,berrys03 :weight bold))))
|
||||
`(org-done ((,class(:inherit org-level-1 :foreground ,berrys08))))
|
||||
`(org-ellipsis ((,class (:inherit unspecified))))
|
||||
`(org-footnote ((,class (:foreground ,berrys02 :underline t))))
|
||||
`(org-formula ((,class (:foreground ,berrys-string))))
|
||||
`(org-headline-done ((,class (:inherit org-level-1 :strike-through t))))
|
||||
`(org-latex-and-related ((,class (:foreground ,berrys-string))))
|
||||
`(org-level-1 ((,class (:foreground ,berrys02 :weight bold))))
|
||||
`(org-level-2 ((,class (:inherit org-level-1))))
|
||||
`(org-level-3 ((,class (:inherit org-level-1))))
|
||||
`(org-level-4 ((,class (:inherit org-level-1))))
|
||||
`(org-level-5 ((,class (:inherit org-level-1))))
|
||||
`(org-level-6 ((,class (:inherit org-level-1))))
|
||||
`(org-level-7 ((,class (:inherit org-level-1))))
|
||||
`(org-level-8 ((,class (:inherit org-level-1))))
|
||||
`(org-link ((,class (:inherit unspecified :underline t))))
|
||||
`(org-mode-line-clock ((,class (:inherit mode-line))))
|
||||
`(org-mode-line-clock-overrun ((,class (:foreground ,berrys09))))
|
||||
`(org-priority ((,class(:inherit org-level-1 :foreground ,berrys05))))
|
||||
`(org-scheduled ((,class (:foreground ,berrys02 :slant italic))))
|
||||
`(org-scheduled-previously ((,class (:foreground ,berrys10 :slant italic))))
|
||||
`(org-scheduled-today ((,class (:inherit org-scheduled))))
|
||||
`(org-sexp-date ((,class (:foreground ,berrys-string :slant italic))))
|
||||
`(org-special-keyword ((,class (:foreground ,berrys-string))))
|
||||
`(org-table ((,class (:foreground ,berrys02))))
|
||||
`(org-tag ((,class(:inherit org-level-1 :foreground ,berrys05))))
|
||||
`(org-time-grid ((,class (:foreground ,berrys-string :slant italic))))
|
||||
`(org-todo ((,class (:inherit org-level-1 :foreground ,berrys05))))
|
||||
`(org-upcoming-deadline ((,class (:foreground ,berrys09 :slant italic))))
|
||||
`(org-warning ((,class (:foreground ,berrys09 :slant italic))))
|
||||
`(org-verbatim ((,class (:inherit default))))
|
||||
|
||||
;; Org Pomodoro
|
||||
`(org-pomodoro-mode-line ((,class (:foreground ,berrys05 :weight bold))))
|
||||
`(org-pomodoro-mode-line-break ((,class (:foreground ,berrys08 :weight bold))))
|
||||
`(org-pomodoro-mode-line-overtime ((,class (:foreground ,berrys-error :weight bold))))
|
||||
|
||||
;; => Which key
|
||||
`(which-key-key-face ((,class (:foreground ,berrys05 :weight bold))))))
|
||||
|
||||
;;;###autoload
|
||||
(when (and (boundp 'custom-theme-load-path) load-file-name)
|
||||
(add-to-list 'custom-theme-load-path
|
||||
(file-name-as-directory (file-name-directory load-file-name))))
|
||||
|
||||
(provide-theme 'berrys)
|
||||
(provide 'berrys-theme)
|
||||
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; indent-tabs-mode: nil
|
||||
;; End:
|
||||
|
||||
;;; berrys-theme.el ends here
|
||||
22
elpa/dash-20191109.1327/dash-autoloads.el
Normal file
22
elpa/dash-20191109.1327/dash-autoloads.el
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
;;; dash-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "dash" "dash.el" (0 0 0 0))
|
||||
;;; Generated autoloads from dash.el
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dash" '("dash-" "-keep" "-butlast" "-non" "-only-some" "-zip" "-e" "->" "-a" "-gr" "-when-let" "-d" "-l" "-s" "-p" "-r" "-m" "-i" "-f" "-u" "-value-to-list" "-t" "--" "-c" "!cons" "!cdr")))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; dash-autoloads.el ends here
|
||||
2
elpa/dash-20191109.1327/dash-pkg.el
Normal file
2
elpa/dash-20191109.1327/dash-pkg.el
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "dash" "20191109.1327" "A modern list library for Emacs" 'nil :commit "e85ed7aa93ef0959b630607bca17af90c74b34be" :keywords '("lists") :authors '(("Magnar Sveen" . "magnars@gmail.com")) :maintainer '("Magnar Sveen" . "magnars@gmail.com"))
|
||||
3050
elpa/dash-20191109.1327/dash.el
Normal file
3050
elpa/dash-20191109.1327/dash.el
Normal file
File diff suppressed because it is too large
Load diff
BIN
elpa/dash-20191109.1327/dash.elc
Normal file
BIN
elpa/dash-20191109.1327/dash.elc
Normal file
Binary file not shown.
|
|
@ -0,0 +1,23 @@
|
|||
;;; dash-functional-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "dash-functional" "dash-functional.el" (0 0
|
||||
;;;;;; 0 0))
|
||||
;;; Generated autoloads from dash-functional.el
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dash-functional" '("-rpartial" "-juxt" "-not" "-o" "-a" "-iteratefn" "-c" "-f" "-p")))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; dash-functional-autoloads.el ends here
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "dash-functional" "20191109.1327" "Collection of useful combinators for Emacs Lisp" '((dash "2.0.0") (emacs "24")) :commit "e85ed7aa93ef0959b630607bca17af90c74b34be" :keywords '("lisp" "functions" "combinators"))
|
||||
219
elpa/dash-functional-20191109.1327/dash-functional.el
Normal file
219
elpa/dash-functional-20191109.1327/dash-functional.el
Normal file
|
|
@ -0,0 +1,219 @@
|
|||
;;; dash-functional.el --- Collection of useful combinators for Emacs Lisp -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
|
||||
|
||||
;; Authors: Matus Goljer <matus.goljer@gmail.com>
|
||||
;; Magnar Sveen <magnars@gmail.com>
|
||||
;; Version: 1.2.0
|
||||
;; Package-Version: 20191109.1327
|
||||
;; Package-Requires: ((dash "2.0.0") (emacs "24"))
|
||||
;; Keywords: lisp functions combinators
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Collection of useful combinators for Emacs Lisp
|
||||
;;
|
||||
;; See documentation on https://github.com/magnars/dash.el#functions
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dash)
|
||||
|
||||
(defun -partial (fn &rest args)
|
||||
"Takes a function FN and fewer than the normal arguments to FN,
|
||||
and returns a fn that takes a variable number of additional ARGS.
|
||||
When called, the returned function calls FN with ARGS first and
|
||||
then additional args."
|
||||
(apply 'apply-partially fn args))
|
||||
|
||||
(defun -rpartial (fn &rest args)
|
||||
"Takes a function FN and fewer than the normal arguments to FN,
|
||||
and returns a fn that takes a variable number of additional ARGS.
|
||||
When called, the returned function calls FN with the additional
|
||||
args first and then ARGS."
|
||||
(lambda (&rest args-before) (apply fn (append args-before args))))
|
||||
|
||||
(defun -juxt (&rest fns)
|
||||
"Takes a list of functions and returns a fn that is the
|
||||
juxtaposition of those fns. The returned fn takes a variable
|
||||
number of args, and returns a list containing the result of
|
||||
applying each fn to the args (left-to-right)."
|
||||
(lambda (&rest args) (mapcar (lambda (x) (apply x args)) fns)))
|
||||
|
||||
(defun -compose (&rest fns)
|
||||
"Takes a list of functions and returns a fn that is the
|
||||
composition of those fns. The returned fn takes a variable
|
||||
number of arguments, and returns the result of applying
|
||||
each fn to the result of applying the previous fn to
|
||||
the arguments (right-to-left)."
|
||||
(lambda (&rest args)
|
||||
(car (-reduce-r-from (lambda (fn xs) (list (apply fn xs)))
|
||||
args fns))))
|
||||
|
||||
(defun -applify (fn)
|
||||
"Changes an n-arity function FN to a 1-arity function that
|
||||
expects a list with n items as arguments"
|
||||
(apply-partially 'apply fn))
|
||||
|
||||
(defun -on (operator transformer)
|
||||
"Return a function of two arguments that first applies
|
||||
TRANSFORMER to each of them and then applies OPERATOR on the
|
||||
results (in the same order).
|
||||
|
||||
In types: (b -> b -> c) -> (a -> b) -> a -> a -> c"
|
||||
(lambda (x y) (funcall operator (funcall transformer x) (funcall transformer y))))
|
||||
|
||||
(defun -flip (func)
|
||||
"Swap the order of arguments for binary function FUNC.
|
||||
|
||||
In types: (a -> b -> c) -> b -> a -> c"
|
||||
(lambda (x y) (funcall func y x)))
|
||||
|
||||
(defun -const (c)
|
||||
"Return a function that returns C ignoring any additional arguments.
|
||||
|
||||
In types: a -> b -> a"
|
||||
(lambda (&rest _) c))
|
||||
|
||||
(defmacro -cut (&rest params)
|
||||
"Take n-ary function and n arguments and specialize some of them.
|
||||
Arguments denoted by <> will be left unspecialized.
|
||||
|
||||
See SRFI-26 for detailed description."
|
||||
(let* ((i 0)
|
||||
(args (mapcar (lambda (_) (setq i (1+ i)) (make-symbol (format "D%d" i)))
|
||||
(-filter (-partial 'eq '<>) params))))
|
||||
`(lambda ,args
|
||||
,(let ((body (--map (if (eq it '<>) (pop args) it) params)))
|
||||
(if (eq (car params) '<>)
|
||||
(cons 'funcall body)
|
||||
body)))))
|
||||
|
||||
(defun -not (pred)
|
||||
"Take a unary predicate PRED and return a unary predicate
|
||||
that returns t if PRED returns nil and nil if PRED returns
|
||||
non-nil."
|
||||
(lambda (x) (not (funcall pred x))))
|
||||
|
||||
(defun -orfn (&rest preds)
|
||||
"Take list of unary predicates PREDS and return a unary
|
||||
predicate with argument x that returns non-nil if at least one of
|
||||
the PREDS returns non-nil on x.
|
||||
|
||||
In types: [a -> Bool] -> a -> Bool"
|
||||
(lambda (x) (-any? (-cut funcall <> x) preds)))
|
||||
|
||||
(defun -andfn (&rest preds)
|
||||
"Take list of unary predicates PREDS and return a unary
|
||||
predicate with argument x that returns non-nil if all of the
|
||||
PREDS returns non-nil on x.
|
||||
|
||||
In types: [a -> Bool] -> a -> Bool"
|
||||
(lambda (x) (-all? (-cut funcall <> x) preds)))
|
||||
|
||||
(defun -iteratefn (fn n)
|
||||
"Return a function FN composed N times with itself.
|
||||
|
||||
FN is a unary function. If you need to use a function of higher
|
||||
arity, use `-applify' first to turn it into a unary function.
|
||||
|
||||
With n = 0, this acts as identity function.
|
||||
|
||||
In types: (a -> a) -> Int -> a -> a.
|
||||
|
||||
This function satisfies the following law:
|
||||
|
||||
(funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))."
|
||||
(lambda (x) (--dotimes n (setq x (funcall fn x))) x))
|
||||
|
||||
(defun -counter (&optional beg end inc)
|
||||
"Return a closure that counts from BEG to END, with increment INC.
|
||||
|
||||
The closure will return the next value in the counting sequence
|
||||
each time it is called, and nil after END is reached. BEG
|
||||
defaults to 0, INC defaults to 1, and if END is nil, the counter
|
||||
will increment indefinitely.
|
||||
|
||||
The closure accepts any number of arguments, which are discarded."
|
||||
(let ((inc (or inc 1))
|
||||
(n (or beg 0)))
|
||||
(lambda (&rest _)
|
||||
(when (or (not end) (< n end))
|
||||
(prog1 n
|
||||
(setq n (+ n inc)))))))
|
||||
|
||||
(defvar -fixfn-max-iterations 1000
|
||||
"The default maximum number of iterations performed by `-fixfn'
|
||||
unless otherwise specified.")
|
||||
|
||||
(defun -fixfn (fn &optional equal-test halt-test)
|
||||
"Return a function that computes the (least) fixpoint of FN.
|
||||
|
||||
FN must be a unary function. The returned lambda takes a single
|
||||
argument, X, the initial value for the fixpoint iteration. The
|
||||
iteration halts when either of the following conditions is satisfied:
|
||||
|
||||
1. Iteration converges to the fixpoint, with equality being
|
||||
tested using EQUAL-TEST. If EQUAL-TEST is not specified,
|
||||
`equal' is used. For functions over the floating point
|
||||
numbers, it may be necessary to provide an appropriate
|
||||
appoximate comparison test.
|
||||
|
||||
2. HALT-TEST returns a non-nil value. HALT-TEST defaults to a
|
||||
simple counter that returns t after `-fixfn-max-iterations',
|
||||
to guard against infinite iteration. Otherwise, HALT-TEST
|
||||
must be a function that accepts a single argument, the
|
||||
current value of X, and returns non-nil as long as iteration
|
||||
should continue. In this way, a more sophisticated
|
||||
convergence test may be supplied by the caller.
|
||||
|
||||
The return value of the lambda is either the fixpoint or, if
|
||||
iteration halted before converging, a cons with car `halted' and
|
||||
cdr the final output from HALT-TEST.
|
||||
|
||||
In types: (a -> a) -> a -> a."
|
||||
(let ((eqfn (or equal-test 'equal))
|
||||
(haltfn (or halt-test
|
||||
(-not
|
||||
(-counter 0 -fixfn-max-iterations)))))
|
||||
(lambda (x)
|
||||
(let ((re (funcall fn x))
|
||||
(halt? (funcall haltfn x)))
|
||||
(while (and (not halt?) (not (funcall eqfn x re)))
|
||||
(setq x re
|
||||
re (funcall fn re)
|
||||
halt? (funcall haltfn re)))
|
||||
(if halt? (cons 'halted halt?)
|
||||
re)))))
|
||||
|
||||
(defun -prodfn (&rest fns)
|
||||
"Take a list of n functions and return a function that takes a
|
||||
list of length n, applying i-th function to i-th element of the
|
||||
input list. Returns a list of length n.
|
||||
|
||||
In types (for n=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d)
|
||||
|
||||
This function satisfies the following laws:
|
||||
|
||||
(-compose (-prodfn f g ...) (-prodfn f\\=' g\\=' ...)) = (-prodfn (-compose f f\\=') (-compose g g\\=') ...)
|
||||
(-prodfn f g ...) = (-juxt (-compose f (-partial \\='nth 0)) (-compose g (-partial \\='nth 1)) ...)
|
||||
(-compose (-prodfn f g ...) (-juxt f\\=' g\\=' ...)) = (-juxt (-compose f f\\=') (-compose g g\\=') ...)
|
||||
(-compose (-partial \\='nth n) (-prod f1 f2 ...)) = (-compose fn (-partial \\='nth n))"
|
||||
(lambda (x) (-zip-with 'funcall fns x)))
|
||||
|
||||
(provide 'dash-functional)
|
||||
|
||||
;;; dash-functional.el ends here
|
||||
BIN
elpa/dash-functional-20191109.1327/dash-functional.elc
Normal file
BIN
elpa/dash-functional-20191109.1327/dash-functional.elc
Normal file
Binary file not shown.
22
elpa/f-20191110.1357/f-autoloads.el
Normal file
22
elpa/f-20191110.1357/f-autoloads.el
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
;;; f-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "f" "f.el" (0 0 0 0))
|
||||
;;; Generated autoloads from f.el
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "f" '("f-")))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; f-autoloads.el ends here
|
||||
2
elpa/f-20191110.1357/f-pkg.el
Normal file
2
elpa/f-20191110.1357/f-pkg.el
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "f" "20191110.1357" "Modern API for working with files and directories" '((s "1.7.0") (dash "2.2.0")) :commit "1814209e2ff43cf2e6d38c4cd476218915f550fb" :keywords '("files" "directories") :authors '(("Johan Andersson" . "johan.rejeep@gmail.com")) :maintainer '("Johan Andersson" . "johan.rejeep@gmail.com") :url "http://github.com/rejeep/f.el")
|
||||
624
elpa/f-20191110.1357/f.el
Normal file
624
elpa/f-20191110.1357/f.el
Normal file
|
|
@ -0,0 +1,624 @@
|
|||
;;; f.el --- Modern API for working with files and directories -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2013 Johan Andersson
|
||||
|
||||
;; Author: Johan Andersson <johan.rejeep@gmail.com>
|
||||
;; Maintainer: Johan Andersson <johan.rejeep@gmail.com>
|
||||
;; Version: 0.20.0
|
||||
;; Package-Version: 20191110.1357
|
||||
;; Keywords: files, directories
|
||||
;; URL: http://github.com/rejeep/f.el
|
||||
;; Package-Requires: ((s "1.7.0") (dash "2.2.0"))
|
||||
|
||||
;; This file is NOT part of GNU Emacs.
|
||||
|
||||
;;; 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, 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:
|
||||
|
||||
|
||||
|
||||
(require 's)
|
||||
(require 'dash)
|
||||
|
||||
(put 'f-guard-error 'error-conditions '(error f-guard-error))
|
||||
(put 'f-guard-error 'error-message "Destructive operation outside sandbox")
|
||||
|
||||
(defvar f--guard-paths nil
|
||||
"List of allowed paths to modify when guarded.
|
||||
|
||||
Do not modify this variable.")
|
||||
|
||||
(defmacro f--destructive (path &rest body)
|
||||
"If PATH is allowed to be modified, yield BODY.
|
||||
|
||||
If PATH is not allowed to be modified, throw error."
|
||||
(declare (indent 1))
|
||||
`(if f--guard-paths
|
||||
(if (--any? (or (f-same? it ,path)
|
||||
(f-ancestor-of? it ,path)) f--guard-paths)
|
||||
(progn ,@body)
|
||||
(signal 'f-guard-error (list ,path f--guard-paths)))
|
||||
,@body))
|
||||
|
||||
|
||||
;;;; Paths
|
||||
|
||||
(defun f-join (&rest args)
|
||||
"Join ARGS to a single path."
|
||||
(let (path (relative (f-relative? (car args))))
|
||||
(-map
|
||||
(lambda (arg)
|
||||
(setq path (f-expand arg path)))
|
||||
args)
|
||||
(if relative (f-relative path) path)))
|
||||
|
||||
(defun f-split (path)
|
||||
"Split PATH and return list containing parts."
|
||||
(let ((parts (s-split (f-path-separator) path 'omit-nulls)))
|
||||
(if (f-absolute? path)
|
||||
(push (f-path-separator) parts)
|
||||
parts)))
|
||||
|
||||
(defun f-expand (path &optional dir)
|
||||
"Expand PATH relative to DIR (or `default-directory').
|
||||
PATH and DIR can be either a directory names or directory file
|
||||
names. Return a directory name if PATH is a directory name, and
|
||||
a directory file name otherwise. File name handlers are
|
||||
ignored."
|
||||
(let (file-name-handler-alist)
|
||||
(expand-file-name path dir)))
|
||||
|
||||
(defun f-filename (path)
|
||||
"Return the name of PATH."
|
||||
(file-name-nondirectory (directory-file-name path)))
|
||||
|
||||
(defalias 'f-parent 'f-dirname)
|
||||
(defun f-dirname (path)
|
||||
"Return the parent directory to PATH."
|
||||
(let ((parent (file-name-directory
|
||||
(directory-file-name (f-expand path default-directory)))))
|
||||
(unless (f-same? path parent)
|
||||
(if (f-relative? path)
|
||||
(f-relative parent)
|
||||
(directory-file-name parent)))))
|
||||
|
||||
(defun f-common-parent (paths)
|
||||
"Return the deepest common parent directory of PATHS."
|
||||
(cond
|
||||
((not paths) nil)
|
||||
((not (cdr paths)) (f-parent (car paths)))
|
||||
(:otherwise
|
||||
(let* ((paths (-map 'f-split paths))
|
||||
(common (caar paths))
|
||||
(re nil))
|
||||
(while (and (not (null (car paths))) (--all? (equal (car it) common) paths))
|
||||
(setq paths (-map 'cdr paths))
|
||||
(push common re)
|
||||
(setq common (caar paths)))
|
||||
(cond
|
||||
((null re) "")
|
||||
((and (= (length re) 1) (f-root? (car re)))
|
||||
(f-root))
|
||||
(:otherwise
|
||||
(concat (apply 'f-join (nreverse re)) "/")))))))
|
||||
|
||||
(defun f-ext (path)
|
||||
"Return the file extension of PATH.
|
||||
|
||||
The extension, in a file name, is the part that follows the last
|
||||
'.', excluding version numbers and backup suffixes."
|
||||
(file-name-extension path))
|
||||
|
||||
(defun f-no-ext (path)
|
||||
"Return everything but the file extension of PATH."
|
||||
(file-name-sans-extension path))
|
||||
|
||||
(defun f-swap-ext (path ext)
|
||||
"Return PATH but with EXT as the new extension.
|
||||
EXT must not be nil or empty."
|
||||
(if (s-blank? ext)
|
||||
(error "Extension cannot be empty or nil")
|
||||
(concat (f-no-ext path) "." ext)))
|
||||
|
||||
(defun f-base (path)
|
||||
"Return the name of PATH, excluding the extension of file."
|
||||
(f-no-ext (f-filename path)))
|
||||
|
||||
(defun f-relative (path &optional dir)
|
||||
"Return PATH relative to DIR."
|
||||
(file-relative-name path dir))
|
||||
|
||||
(defalias 'f-abbrev 'f-short)
|
||||
(defun f-short (path)
|
||||
"Return abbrev of PATH. See `abbreviate-file-name'."
|
||||
(abbreviate-file-name path))
|
||||
|
||||
(defun f-long (path)
|
||||
"Return long version of PATH."
|
||||
(f-expand path))
|
||||
|
||||
(defun f-canonical (path)
|
||||
"Return the canonical name of PATH."
|
||||
(file-truename path))
|
||||
|
||||
(defun f-slash (path)
|
||||
"Append slash to PATH unless one already.
|
||||
|
||||
Some functions, such as `call-process' requires there to be an
|
||||
ending slash."
|
||||
(if (f-dir? path)
|
||||
(file-name-as-directory path)
|
||||
path))
|
||||
|
||||
(defun f-full (path)
|
||||
"Return absolute path to PATH, with ending slash."
|
||||
(f-slash (f-long path)))
|
||||
|
||||
(defun f--uniquify (paths)
|
||||
"Helper for `f-uniquify' and `f-uniquify-alist'."
|
||||
(let* ((files-length (length paths))
|
||||
(uniq-filenames (--map (cons it (f-filename it)) paths))
|
||||
(uniq-filenames-next (-group-by 'cdr uniq-filenames)))
|
||||
(while (/= files-length (length uniq-filenames-next))
|
||||
(setq uniq-filenames-next
|
||||
(-group-by 'cdr
|
||||
(--mapcat
|
||||
(let ((conf-files (cdr it)))
|
||||
(if (> (length conf-files) 1)
|
||||
(--map (cons (car it) (concat (f-filename (s-chop-suffix (cdr it) (car it))) (f-path-separator) (cdr it))) conf-files)
|
||||
conf-files))
|
||||
uniq-filenames-next))))
|
||||
uniq-filenames-next))
|
||||
|
||||
(defun f-uniquify (files)
|
||||
"Return unique suffixes of FILES.
|
||||
|
||||
This function expects no duplicate paths."
|
||||
(-map 'car (f--uniquify files)))
|
||||
|
||||
(defun f-uniquify-alist (files)
|
||||
"Return alist mapping FILES to unique suffixes of FILES.
|
||||
|
||||
This function expects no duplicate paths."
|
||||
(-map 'cadr (f--uniquify files)))
|
||||
|
||||
|
||||
;;;; I/O
|
||||
|
||||
(defun f-read-bytes (path)
|
||||
"Read binary data from PATH.
|
||||
|
||||
Return the binary data as unibyte string."
|
||||
(with-temp-buffer
|
||||
(set-buffer-multibyte nil)
|
||||
(setq buffer-file-coding-system 'binary)
|
||||
(insert-file-contents-literally path)
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
|
||||
(defalias 'f-read 'f-read-text)
|
||||
(defun f-read-text (path &optional coding)
|
||||
"Read text with PATH, using CODING.
|
||||
|
||||
CODING defaults to `utf-8'.
|
||||
|
||||
Return the decoded text as multibyte string."
|
||||
(decode-coding-string (f-read-bytes path) (or coding 'utf-8)))
|
||||
|
||||
(defalias 'f-write 'f-write-text)
|
||||
(defun f-write-text (text coding path)
|
||||
"Write TEXT with CODING to PATH.
|
||||
|
||||
TEXT is a multibyte string. CODING is a coding system to encode
|
||||
TEXT with. PATH is a file name to write to."
|
||||
(f-write-bytes (encode-coding-string text coding) path))
|
||||
|
||||
(defun f-unibyte-string-p (s)
|
||||
"Determine whether S is a unibyte string."
|
||||
(not (multibyte-string-p s)))
|
||||
|
||||
(defun f-write-bytes (data path)
|
||||
"Write binary DATA to PATH.
|
||||
|
||||
DATA is a unibyte string. PATH is a file name to write to."
|
||||
(f--write-bytes data path nil))
|
||||
|
||||
(defalias 'f-append 'f-append-text)
|
||||
(defun f-append-text (text coding path)
|
||||
"Append TEXT with CODING to PATH.
|
||||
|
||||
If PATH does not exist, it is created."
|
||||
(f-append-bytes (encode-coding-string text coding) path))
|
||||
|
||||
(defun f-append-bytes (data path)
|
||||
"Append binary DATA to PATH.
|
||||
|
||||
If PATH does not exist, it is created."
|
||||
(f--write-bytes data path :append))
|
||||
|
||||
(defun f--write-bytes (data filename append)
|
||||
"Write binary DATA to FILENAME.
|
||||
If APPEND is non-nil, append the DATA to the existing contents."
|
||||
(f--destructive filename
|
||||
(unless (f-unibyte-string-p data)
|
||||
(signal 'wrong-type-argument (list 'f-unibyte-string-p data)))
|
||||
(let ((coding-system-for-write 'binary)
|
||||
(write-region-annotate-functions nil)
|
||||
(write-region-post-annotation-function nil))
|
||||
(write-region data nil filename append :silent)
|
||||
nil)))
|
||||
|
||||
|
||||
;;;; Destructive
|
||||
|
||||
(defun f-mkdir (&rest dirs)
|
||||
"Create directories DIRS."
|
||||
(let (path)
|
||||
(-each
|
||||
dirs
|
||||
(lambda (dir)
|
||||
(setq path (f-expand dir path))
|
||||
(unless (f-directory? path)
|
||||
(f--destructive path (make-directory path)))))))
|
||||
|
||||
(defun f-delete (path &optional force)
|
||||
"Delete PATH, which can be file or directory.
|
||||
|
||||
If FORCE is t, a directory will be deleted recursively."
|
||||
(f--destructive path
|
||||
(if (or (f-file? path) (f-symlink? path))
|
||||
(delete-file path)
|
||||
(delete-directory path force))))
|
||||
|
||||
(defun f-symlink (source path)
|
||||
"Create a symlink to SOURCE from PATH."
|
||||
(f--destructive path (make-symbolic-link source path)))
|
||||
|
||||
(defun f-move (from to)
|
||||
"Move or rename FROM to TO.
|
||||
If TO is a directory name, move FROM into TO."
|
||||
(f--destructive to (rename-file from to t)))
|
||||
|
||||
(defun f-copy (from to)
|
||||
"Copy file or directory FROM to TO.
|
||||
If FROM names a directory and TO is a directory name, copy FROM
|
||||
into TO as a subdirectory."
|
||||
(f--destructive to
|
||||
(if (f-file? from)
|
||||
(copy-file from to)
|
||||
;; The behavior of `copy-directory' differs between Emacs 23 and
|
||||
;; 24 in that in Emacs 23, the contents of `from' is copied to
|
||||
;; `to', while in Emacs 24 the directory `from' is copied to
|
||||
;; `to'. We want the Emacs 24 behavior.
|
||||
(if (> emacs-major-version 23)
|
||||
(copy-directory from to)
|
||||
(if (f-dir? to)
|
||||
(progn
|
||||
(apply 'f-mkdir (f-split to))
|
||||
(let ((new-to (f-expand (f-filename from) to)))
|
||||
(copy-directory from new-to)))
|
||||
(copy-directory from to))))))
|
||||
|
||||
(defun f-copy-contents (from to)
|
||||
"Copy contents in directory FROM, to directory TO."
|
||||
(unless (f-exists? to)
|
||||
(error "Cannot copy contents to non existing directory %s" to))
|
||||
(unless (f-dir? from)
|
||||
(error "Cannot copy contents as %s is a file" from))
|
||||
(--each (f-entries from)
|
||||
(f-copy it (file-name-as-directory to))))
|
||||
|
||||
(defun f-touch (path)
|
||||
"Update PATH last modification date or create if it does not exist."
|
||||
(f--destructive path
|
||||
(if (f-file? path)
|
||||
(set-file-times path)
|
||||
(f-write-bytes "" path))))
|
||||
|
||||
|
||||
;;;; Predicates
|
||||
|
||||
(defun f-exists? (path)
|
||||
"Return t if PATH exists, false otherwise."
|
||||
(file-exists-p path))
|
||||
|
||||
(defalias 'f-exists-p 'f-exists?)
|
||||
|
||||
(defalias 'f-dir? 'f-directory?)
|
||||
(defalias 'f-dir-p 'f-dir?)
|
||||
|
||||
(defun f-directory? (path)
|
||||
"Return t if PATH is directory, false otherwise."
|
||||
(file-directory-p path))
|
||||
|
||||
(defalias 'f-directory-p 'f-directory?)
|
||||
|
||||
(defun f-file? (path)
|
||||
"Return t if PATH is file, false otherwise."
|
||||
(file-regular-p path))
|
||||
|
||||
(defalias 'f-file-p 'f-file?)
|
||||
|
||||
(defun f-symlink? (path)
|
||||
"Return t if PATH is symlink, false otherwise."
|
||||
(not (not (file-symlink-p path))))
|
||||
|
||||
(defalias 'f-symlink-p 'f-symlink?)
|
||||
|
||||
(defun f-readable? (path)
|
||||
"Return t if PATH is readable, false otherwise."
|
||||
(file-readable-p path))
|
||||
|
||||
(defalias 'f-readable-p 'f-readable?)
|
||||
|
||||
(defun f-writable? (path)
|
||||
"Return t if PATH is writable, false otherwise."
|
||||
(file-writable-p path))
|
||||
|
||||
(defalias 'f-writable-p 'f-writable?)
|
||||
|
||||
(defun f-executable? (path)
|
||||
"Return t if PATH is executable, false otherwise."
|
||||
(file-executable-p path))
|
||||
|
||||
(defalias 'f-executable-p 'f-executable?)
|
||||
|
||||
(defun f-absolute? (path)
|
||||
"Return t if PATH is absolute, false otherwise."
|
||||
(file-name-absolute-p path))
|
||||
|
||||
(defalias 'f-absolute-p 'f-absolute?)
|
||||
|
||||
(defun f-relative? (path)
|
||||
"Return t if PATH is relative, false otherwise."
|
||||
(not (f-absolute? path)))
|
||||
|
||||
(defalias 'f-relative-p 'f-relative?)
|
||||
|
||||
(defun f-root? (path)
|
||||
"Return t if PATH is root directory, false otherwise."
|
||||
(not (f-parent path)))
|
||||
|
||||
(defalias 'f-root-p 'f-root?)
|
||||
|
||||
(defun f-ext? (path &optional ext)
|
||||
"Return t if extension of PATH is EXT, false otherwise.
|
||||
|
||||
If EXT is nil or omitted, return t if PATH has any extension,
|
||||
false otherwise.
|
||||
|
||||
The extension, in a file name, is the part that follows the last
|
||||
'.', excluding version numbers and backup suffixes."
|
||||
(if ext
|
||||
(string= (f-ext path) ext)
|
||||
(not (eq (f-ext path) nil))))
|
||||
|
||||
(defalias 'f-ext-p 'f-ext?)
|
||||
|
||||
(defalias 'f-equal? 'f-same?)
|
||||
(defalias 'f-equal-p 'f-equal?)
|
||||
|
||||
(defun f-same? (path-a path-b)
|
||||
"Return t if PATH-A and PATH-B are references to same file."
|
||||
(when (and (f-exists? path-a)
|
||||
(f-exists? path-b))
|
||||
(equal
|
||||
(f-canonical (directory-file-name (f-expand path-a)))
|
||||
(f-canonical (directory-file-name (f-expand path-b))))))
|
||||
|
||||
(defalias 'f-same-p 'f-same?)
|
||||
|
||||
(defun f-parent-of? (path-a path-b)
|
||||
"Return t if PATH-A is parent of PATH-B."
|
||||
(--when-let (f-parent path-b)
|
||||
(f-same? path-a it)))
|
||||
|
||||
(defalias 'f-parent-of-p 'f-parent-of?)
|
||||
|
||||
(defun f-child-of? (path-a path-b)
|
||||
"Return t if PATH-A is child of PATH-B."
|
||||
(--when-let (f-parent path-a)
|
||||
(f-same? it path-b)))
|
||||
|
||||
(defalias 'f-child-of-p 'f-child-of?)
|
||||
|
||||
(defun f-ancestor-of? (path-a path-b)
|
||||
"Return t if PATH-A is ancestor of PATH-B."
|
||||
(unless (f-same? path-a path-b)
|
||||
(s-starts-with? (f-full path-a)
|
||||
(f-full path-b))))
|
||||
|
||||
(defalias 'f-ancestor-of-p 'f-ancestor-of?)
|
||||
|
||||
(defun f-descendant-of? (path-a path-b)
|
||||
"Return t if PATH-A is desendant of PATH-B."
|
||||
(unless (f-same? path-a path-b)
|
||||
(s-starts-with? (f-full path-b)
|
||||
(f-full path-a))))
|
||||
|
||||
(defalias 'f-descendant-of-p 'f-descendant-of?)
|
||||
|
||||
(defun f-hidden? (path)
|
||||
"Return t if PATH is hidden, nil otherwise."
|
||||
(unless (f-exists? path)
|
||||
(error "Path does not exist: %s" path))
|
||||
(string= (substring path 0 1) "."))
|
||||
|
||||
(defalias 'f-hidden-p 'f-hidden?)
|
||||
|
||||
(defun f-empty? (path)
|
||||
"If PATH is a file, return t if the file in PATH is empty, nil otherwise.
|
||||
If PATH is directory, return t if directory has no files, nil otherwise."
|
||||
(if (f-directory? path)
|
||||
(equal (f-files path nil t) nil)
|
||||
(= (f-size path) 0)))
|
||||
|
||||
(defalias 'f-empty-p 'f-empty?)
|
||||
|
||||
|
||||
;;;; Stats
|
||||
|
||||
(defun f-size (path)
|
||||
"Return size of PATH.
|
||||
|
||||
If PATH is a file, return size of that file. If PATH is
|
||||
directory, return sum of all files in PATH."
|
||||
(if (f-directory? path)
|
||||
(-sum (-map 'f-size (f-files path nil t)))
|
||||
(nth 7 (file-attributes path))))
|
||||
|
||||
(defun f-depth (path)
|
||||
"Return the depth of PATH.
|
||||
|
||||
At first, PATH is expanded with `f-expand'. Then the full path is used to
|
||||
detect the depth.
|
||||
'/' will be zero depth, '/usr' will be one depth. And so on."
|
||||
(- (length (f-split (f-expand path))) 1))
|
||||
|
||||
|
||||
;;;; Misc
|
||||
|
||||
(defun f-this-file ()
|
||||
"Return path to this file."
|
||||
(cond
|
||||
(load-in-progress load-file-name)
|
||||
((and (boundp 'byte-compile-current-file) byte-compile-current-file)
|
||||
byte-compile-current-file)
|
||||
(:else (buffer-file-name))))
|
||||
|
||||
(defvar f--path-separator nil
|
||||
"A variable to cache result of `f-path-separator'.")
|
||||
|
||||
(defun f-path-separator ()
|
||||
"Return path separator."
|
||||
(or f--path-separator
|
||||
(setq f--path-separator (substring (f-join "x" "y") 1 2))))
|
||||
|
||||
(defun f-glob (pattern &optional path)
|
||||
"Find PATTERN in PATH."
|
||||
(file-expand-wildcards
|
||||
(f-join (or path default-directory) pattern)))
|
||||
|
||||
(defun f--collect-entries (path recursive)
|
||||
(let (result
|
||||
(entries
|
||||
(-reject
|
||||
(lambda (file)
|
||||
(or
|
||||
(equal (f-filename file) ".")
|
||||
(equal (f-filename file) "..")))
|
||||
(directory-files path t))))
|
||||
(cond (recursive
|
||||
(-map
|
||||
(lambda (entry)
|
||||
(if (f-file? entry)
|
||||
(setq result (cons entry result))
|
||||
(when (f-directory? entry)
|
||||
(setq result (cons entry result))
|
||||
(setq result (append result (f--collect-entries entry recursive))))))
|
||||
entries))
|
||||
(t (setq result entries)))
|
||||
result))
|
||||
|
||||
(defmacro f--entries (path body &optional recursive)
|
||||
"Anaphoric version of `f-entries'."
|
||||
`(f-entries
|
||||
,path
|
||||
(lambda (path)
|
||||
(let ((it path))
|
||||
,body))
|
||||
,recursive))
|
||||
|
||||
(defun f-entries (path &optional fn recursive)
|
||||
"Find all files and directories in PATH.
|
||||
|
||||
FN - called for each found file and directory. If FN returns a thruthy
|
||||
value, file or directory will be included.
|
||||
RECURSIVE - Search for files and directories recursive."
|
||||
(let ((entries (f--collect-entries path recursive)))
|
||||
(if fn (-select fn entries) entries)))
|
||||
|
||||
(defmacro f--directories (path body &optional recursive)
|
||||
"Anaphoric version of `f-directories'."
|
||||
`(f-directories
|
||||
,path
|
||||
(lambda (path)
|
||||
(let ((it path))
|
||||
,body))
|
||||
,recursive))
|
||||
|
||||
(defun f-directories (path &optional fn recursive)
|
||||
"Find all directories in PATH. See `f-entries'."
|
||||
(let ((directories (-select 'f-directory? (f--collect-entries path recursive))))
|
||||
(if fn (-select fn directories) directories)))
|
||||
|
||||
(defmacro f--files (path body &optional recursive)
|
||||
"Anaphoric version of `f-files'."
|
||||
`(f-files
|
||||
,path
|
||||
(lambda (path)
|
||||
(let ((it path))
|
||||
,body))
|
||||
,recursive))
|
||||
|
||||
(defun f-files (path &optional fn recursive)
|
||||
"Find all files in PATH. See `f-entries'."
|
||||
(let ((files (-select 'f-file? (f--collect-entries path recursive))))
|
||||
(if fn (-select fn files) files)))
|
||||
|
||||
(defmacro f--traverse-upwards (body &optional path)
|
||||
"Anaphoric version of `f-traverse-upwards'."
|
||||
`(f-traverse-upwards
|
||||
(lambda (dir)
|
||||
(let ((it dir))
|
||||
,body))
|
||||
,path))
|
||||
|
||||
(defun f-traverse-upwards (fn &optional path)
|
||||
"Traverse up as long as FN return nil, starting at PATH.
|
||||
|
||||
If FN returns a non-nil value, the path sent as argument to FN is
|
||||
returned. If no function callback return a non-nil value, nil is
|
||||
returned."
|
||||
(unless path
|
||||
(setq path default-directory))
|
||||
(when (f-relative? path)
|
||||
(setq path (f-expand path)))
|
||||
(if (funcall fn path)
|
||||
path
|
||||
(unless (f-root? path)
|
||||
(f-traverse-upwards fn (f-parent path)))))
|
||||
|
||||
(defun f-root ()
|
||||
"Return absolute root."
|
||||
(f-traverse-upwards 'f-root?))
|
||||
|
||||
(defmacro f-with-sandbox (path-or-paths &rest body)
|
||||
"Only allow PATH-OR-PATHS and descendants to be modified in BODY."
|
||||
(declare (indent 1))
|
||||
`(let ((paths (if (listp ,path-or-paths)
|
||||
,path-or-paths
|
||||
(list ,path-or-paths))))
|
||||
(unwind-protect
|
||||
(let ((f--guard-paths paths))
|
||||
,@body)
|
||||
(setq f--guard-paths nil))))
|
||||
|
||||
(provide 'f)
|
||||
|
||||
;;; f.el ends here
|
||||
BIN
elpa/f-20191110.1357/f.elc
Normal file
BIN
elpa/f-20191110.1357/f.elc
Normal file
Binary file not shown.
22
elpa/gherkin-mode-20171224.1353/gherkin-mode-autoloads.el
Normal file
22
elpa/gherkin-mode-20171224.1353/gherkin-mode-autoloads.el
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
;;; gherkin-mode-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "gherkin-mode" "gherkin-mode.el" (0 0 0 0))
|
||||
;;; Generated autoloads from gherkin-mode.el
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gherkin-mode" '("gherkin-")))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; gherkin-mode-autoloads.el ends here
|
||||
2
elpa/gherkin-mode-20171224.1353/gherkin-mode-pkg.el
Normal file
2
elpa/gherkin-mode-20171224.1353/gherkin-mode-pkg.el
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "gherkin-mode" "20171224.1353" "An emacs major mode for editing gherkin files." 'nil :commit "0313492e7da152f0aa73ddf96c0287ded8f51253" :keywords '("languages") :authors '(("Craig Andera")) :maintainer '("Craig Andera"))
|
||||
64
elpa/gherkin-mode-20171224.1353/gherkin-mode.el
Normal file
64
elpa/gherkin-mode-20171224.1353/gherkin-mode.el
Normal file
|
|
@ -0,0 +1,64 @@
|
|||
;;; gherkin-mode.el --- An emacs major mode for editing gherkin files.
|
||||
|
||||
;; Copyright (C) 2017 Craig Andera
|
||||
|
||||
;; Author: Craig Andera
|
||||
;; Keywords: languages
|
||||
;; Package-Version: 20171224.1353
|
||||
;; Version: 0.0.1
|
||||
|
||||
;; Licensed under the Apache License, Version 2.0 (the "License");
|
||||
;; you may not use this file except in compliance with the License.
|
||||
;; You may obtain a copy of the License at
|
||||
;;
|
||||
;; http://www.apache.org/licenses/LICENSE-2.0
|
||||
;;
|
||||
;; Unless required by applicable law or agreed to in writing, software
|
||||
;; distributed under the License is distributed on an "AS IS" BASIS,
|
||||
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
;; See the License for the specific language governing permissions and
|
||||
;; limitations under the License.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; A mode for editing gherkin files.
|
||||
;;
|
||||
;; For more about gherkin, see https://github.com/alandipert/gherkin.
|
||||
|
||||
;;; Code:
|
||||
|
||||
;; TODO: Oh so many things
|
||||
|
||||
(defconst gherkin-keywords-re
|
||||
(regexp-opt
|
||||
'("&" "nil" "t"
|
||||
"quote" "fn" "if" "set!" "def" "do" "recur"
|
||||
"eq?" "nil?" "car" "cdr" "cons" "list" "eval"
|
||||
"apply" "read" "+" "-" "/" "mod" "<" ">"
|
||||
"cons?" "symbol?" "number?" "string?" "fn?"
|
||||
"gensym" "random" "exit" "println" "sh" "sh!"
|
||||
"load-file" "gc" "error" "type" "str")
|
||||
'words))
|
||||
|
||||
(defconst gherkin-keywords
|
||||
`(("<.*>" . font-lock-constant-face)
|
||||
("#.*$" . font-lock-comment-face)
|
||||
,gherkin-keywords-re
|
||||
("\\?\\w+" . font-lock-variable-name-face)
|
||||
("\"[^\"]*\"" . font-lock-string-face)
|
||||
("'[^']*'" . font-lock-string-face)))
|
||||
|
||||
(define-derived-mode gherkin-mode lisp-mode
|
||||
"GK"
|
||||
:group 'gherkin-mode
|
||||
;; Comments
|
||||
(make-local-variable 'comment-start)
|
||||
(setq comment-start "# ")
|
||||
;; Font-lock support
|
||||
(setq font-lock-defaults '(gherkin-keywords))
|
||||
;; Key maps
|
||||
;;(define-key gherkin-mode-map (kbd "C-c C-x") 'whatever)
|
||||
)
|
||||
|
||||
(provide 'gherkin-mode)
|
||||
;;; gherkin-mode.el ends here
|
||||
BIN
elpa/gherkin-mode-20171224.1353/gherkin-mode.elc
Normal file
BIN
elpa/gherkin-mode-20171224.1353/gherkin-mode.elc
Normal file
Binary file not shown.
67
elpa/macrostep-20161120.2106/macrostep-autoloads.el
Normal file
67
elpa/macrostep-20161120.2106/macrostep-autoloads.el
Normal file
|
|
@ -0,0 +1,67 @@
|
|||
;;; macrostep-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "macrostep" "macrostep.el" (0 0 0 0))
|
||||
;;; Generated autoloads from macrostep.el
|
||||
|
||||
(autoload 'macrostep-mode "macrostep" "\
|
||||
Minor mode for inline expansion of macros in Emacs Lisp source buffers.
|
||||
|
||||
\\<macrostep-keymap>Progressively expand macro forms with \\[macrostep-expand], collapse them with \\[macrostep-collapse],
|
||||
and move back and forth with \\[macrostep-next-macro] and \\[macrostep-prev-macro].
|
||||
Use \\[macrostep-collapse-all] or collapse all visible expansions to
|
||||
quit and return to normal editing.
|
||||
|
||||
\\{macrostep-keymap}
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(autoload 'macrostep-expand "macrostep" "\
|
||||
Expand the macro form following point by one step.
|
||||
|
||||
Enters `macrostep-mode' if it is not already active, making the
|
||||
buffer temporarily read-only. If macrostep-mode is active and the
|
||||
form following point is not a macro form, search forward in the
|
||||
buffer and expand the next macro form found, if any.
|
||||
|
||||
With a prefix argument, the expansion is displayed in a separate
|
||||
buffer instead of inline in the current buffer. Setting
|
||||
`macrostep-expand-in-separate-buffer' to non-nil swaps these two
|
||||
behaviors.
|
||||
|
||||
\(fn &optional TOGGLE-SEPARATE-BUFFER)" t nil)
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "macrostep" '("macrostep-")))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "macrostep-c" "macrostep-c.el" (0 0 0 0))
|
||||
;;; Generated autoloads from macrostep-c.el
|
||||
|
||||
(autoload 'macrostep-c-mode-hook "macrostep-c" "\
|
||||
|
||||
|
||||
\(fn)" nil nil)
|
||||
|
||||
(add-hook 'c-mode-hook #'macrostep-c-mode-hook)
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "macrostep-c" '("macrostep-c-")))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("macrostep-pkg.el") (0 0 0 0))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; macrostep-autoloads.el ends here
|
||||
187
elpa/macrostep-20161120.2106/macrostep-c.el
Normal file
187
elpa/macrostep-20161120.2106/macrostep-c.el
Normal file
|
|
@ -0,0 +1,187 @@
|
|||
;;; macrostep-c.el --- macrostep interface to C preprocessor
|
||||
|
||||
;; Copyright (C) 2015 Jon Oddie <j.j.oddie@gmail.com>
|
||||
|
||||
;; Author: Jon Oddie <j.j.oddie@gmail.com>
|
||||
;; Maintainer: Jon Oddie <j.j.oddie@gmail.com>
|
||||
;; Created: 27 November 2015
|
||||
;; Updated: 27 November 2015
|
||||
;; Version: 0.9
|
||||
;; Keywords: c, languages, macro, debugging
|
||||
;; Url: https://github.com/joddie/macrostep
|
||||
|
||||
;; 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:
|
||||
|
||||
;; A thin wrapper around Emacs's built-in `cmacexp' library to provide
|
||||
;; basic support for expanding C macros using the `macrostep' user
|
||||
;; interface. To use, position point on a macro use in a C buffer and
|
||||
;; type `M-x macrostep-expand'. The variables `c-macro-preprocessor'
|
||||
;; and especially `c-macro-cppflags' may need to be set correctly for
|
||||
;; accurate expansion.
|
||||
|
||||
;; This is fairly basic compared to the Emacs Lisp `macrostep'. In
|
||||
;; particular, there is no step-by-step expansion, since C macros are
|
||||
;; expanded in a single "cpp" pass, and no pretty-printing.
|
||||
|
||||
;; To hide the buffer containing "cpp" warnings (not recommended), you
|
||||
;; could do something like:
|
||||
;;
|
||||
;; (push `(,(regexp-quote macrostep-c-warning-buffer)
|
||||
;; (display-buffer-no-window))
|
||||
;; display-buffer-alist)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'macrostep)
|
||||
(require 'cmacexp)
|
||||
(require 'cl-lib)
|
||||
|
||||
(eval-and-compile
|
||||
(if (require 'subr-x nil t)
|
||||
(defalias 'macrostep-c-string-trim 'string-trim)
|
||||
(defun macrostep-c-string-trim (string)
|
||||
(when (string-match "\\`[ \t\n\r]+" string)
|
||||
(setq string (replace-match "" t t string)))
|
||||
(when (string-match "[ \t\n\r]+\\'" string)
|
||||
(setq string (replace-match "" t t string)))
|
||||
string)))
|
||||
|
||||
(put 'macrostep-c-non-macro 'error-conditions
|
||||
'(macrostep-c-non-macro error))
|
||||
(put 'macrostep-c-non-macro 'error-message
|
||||
"Text around point is not a macro call.")
|
||||
|
||||
(put 'macrostep-c-expansion-failed 'error-conditions
|
||||
'(macrostep-c-expansion-failed error))
|
||||
(put 'macrostep-c-expansion-failed 'error-message
|
||||
"Macro-expansion failed.")
|
||||
|
||||
(defvar macrostep-c-warning-buffer "*Macroexpansion Warnings*")
|
||||
|
||||
;;;###autoload
|
||||
(defun macrostep-c-mode-hook ()
|
||||
(setq macrostep-sexp-bounds-function
|
||||
#'macrostep-c-sexp-bounds)
|
||||
(setq macrostep-sexp-at-point-function
|
||||
#'macrostep-c-sexp-at-point)
|
||||
(setq macrostep-environment-at-point-function
|
||||
#'ignore)
|
||||
(setq macrostep-expand-1-function
|
||||
#'macrostep-c-expand-1)
|
||||
(setq macrostep-print-function
|
||||
#'macrostep-c-print-function)
|
||||
(add-hook 'macrostep-mode-off-hook
|
||||
#'macrostep-c-mode-off nil t))
|
||||
|
||||
(defun macrostep-c-mode-off (&rest ignore)
|
||||
(when (derived-mode-p 'c-mode)
|
||||
(let ((warning-window
|
||||
(get-buffer-window macrostep-c-warning-buffer)))
|
||||
(when warning-window
|
||||
(quit-window nil warning-window)))))
|
||||
|
||||
;;;###autoload
|
||||
(add-hook 'c-mode-hook #'macrostep-c-mode-hook)
|
||||
|
||||
(defun macrostep-c-sexp-bounds ()
|
||||
(save-excursion
|
||||
(cl-loop
|
||||
(let ((region (macrostep-c-sexp-bounds-1)))
|
||||
(cond
|
||||
((null region)
|
||||
(signal 'macrostep-c-non-macro nil))
|
||||
((macrostep-c-expandable-p region)
|
||||
(cl-return region))
|
||||
(t
|
||||
(condition-case nil
|
||||
(progn
|
||||
(backward-up-list)
|
||||
(skip-syntax-backward "-"))
|
||||
(scan-error
|
||||
(signal 'macrostep-c-non-macro nil)))))))))
|
||||
|
||||
(defun macrostep-c-sexp-bounds-1 ()
|
||||
(let ((region (bounds-of-thing-at-point 'symbol)))
|
||||
(when region
|
||||
(cl-destructuring-bind (symbol-start . symbol-end) region
|
||||
(save-excursion
|
||||
(goto-char symbol-end)
|
||||
(if (looking-at "[[:space:]]*(")
|
||||
(cons symbol-start (scan-sexps symbol-end 1))
|
||||
region))))))
|
||||
|
||||
(defun macrostep-c-expandable-p (region)
|
||||
(cl-destructuring-bind (start . end) region
|
||||
(condition-case nil
|
||||
(cl-destructuring-bind (expansion warnings)
|
||||
(macrostep-c-expand-region start end)
|
||||
(declare (ignore warnings))
|
||||
(and (cl-plusp (length expansion))
|
||||
(not (string= expansion (buffer-substring start end)))))
|
||||
(macrostep-c-expansion-failed nil))))
|
||||
|
||||
(defun macrostep-c-sexp-at-point (start end)
|
||||
(cons start end))
|
||||
|
||||
(defun macrostep-c-expand-1 (region _ignore)
|
||||
(cl-destructuring-bind (start . end) region
|
||||
(cl-destructuring-bind (expansion warnings)
|
||||
(macrostep-c-expand-region start end)
|
||||
(when (cl-plusp (length warnings))
|
||||
(with-current-buffer
|
||||
(get-buffer-create macrostep-c-warning-buffer)
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(insert warnings)
|
||||
(goto-char (point-min)))
|
||||
(special-mode)
|
||||
(display-buffer (current-buffer)
|
||||
'(display-buffer-pop-up-window
|
||||
(inhibit-same-window . t)
|
||||
(allow-no-window . t)))))
|
||||
expansion)))
|
||||
|
||||
(defun macrostep-c-expand-region (start end)
|
||||
(let ((expansion
|
||||
(condition-case nil
|
||||
(c-macro-expansion start end
|
||||
(concat c-macro-preprocessor " "
|
||||
c-macro-cppflags))
|
||||
(search-failed
|
||||
(signal 'macrostep-c-expansion-failed nil)))))
|
||||
(with-temp-buffer
|
||||
(save-excursion
|
||||
(insert expansion))
|
||||
(when (looking-at (regexp-quote "/*"))
|
||||
(search-forward "*/"))
|
||||
(let ((warnings (buffer-substring (point-min) (point)))
|
||||
(expansion (buffer-substring (point) (point-max))))
|
||||
(mapcar #'macrostep-c-string-trim (list expansion warnings))))))
|
||||
|
||||
(defun macrostep-c-print-function (expansion &rest _ignore)
|
||||
(with-temp-buffer
|
||||
(insert expansion)
|
||||
(let ((exit-code
|
||||
(shell-command-on-region (point-min) (point-max) "indent" nil t)))
|
||||
(when (zerop exit-code)
|
||||
(setq expansion (macrostep-c-string-trim (buffer-string))))))
|
||||
(insert expansion))
|
||||
|
||||
(provide 'macrostep-c)
|
||||
|
||||
;;; macrostep-c.el ends here
|
||||
BIN
elpa/macrostep-20161120.2106/macrostep-c.elc
Normal file
BIN
elpa/macrostep-20161120.2106/macrostep-c.elc
Normal file
Binary file not shown.
12
elpa/macrostep-20161120.2106/macrostep-pkg.el
Normal file
12
elpa/macrostep-20161120.2106/macrostep-pkg.el
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
(define-package "macrostep" "20161120.2106" "interactive macro expander"
|
||||
'((cl-lib "0.5"))
|
||||
:keywords
|
||||
'("lisp" "languages" "macro" "debugging")
|
||||
:authors
|
||||
'(("joddie" . "j.j.oddie@gmail.com"))
|
||||
:maintainer
|
||||
'("joddie" . "j.j.oddie@gmail.com")
|
||||
:url "https://github.com/joddie/macrostep")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
1129
elpa/macrostep-20161120.2106/macrostep.el
Normal file
1129
elpa/macrostep-20161120.2106/macrostep.el
Normal file
File diff suppressed because it is too large
Load diff
BIN
elpa/macrostep-20161120.2106/macrostep.elc
Normal file
BIN
elpa/macrostep-20161120.2106/macrostep.elc
Normal file
Binary file not shown.
24
elpa/nord-theme-20190616.1757/nord-theme-autoloads.el
Normal file
24
elpa/nord-theme-20190616.1757/nord-theme-autoloads.el
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
;;; nord-theme-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "nord-theme" "nord-theme.el" (0 0 0 0))
|
||||
;;; Generated autoloads from nord-theme.el
|
||||
|
||||
(when (and (boundp 'custom-theme-load-path) load-file-name) (add-to-list 'custom-theme-load-path (file-name-as-directory (file-name-directory load-file-name))))
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nord-theme" '("nord")))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; nord-theme-autoloads.el ends here
|
||||
2
elpa/nord-theme-20190616.1757/nord-theme-pkg.el
Normal file
2
elpa/nord-theme-20190616.1757/nord-theme-pkg.el
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "nord-theme" "20190616.1757" "An arctic, north-bluish clean and elegant theme" '((emacs "24")) :commit "52756cdc909b29691eef228897b3de561cd99f43" :authors '(("Arctic Ice Studio" . "development@arcticicestudio.com")) :maintainer '("Arctic Ice Studio" . "development@arcticicestudio.com") :url "https://github.com/arcticicestudio/nord-emacs")
|
||||
699
elpa/nord-theme-20190616.1757/nord-theme.el
Normal file
699
elpa/nord-theme-20190616.1757/nord-theme.el
Normal file
|
|
@ -0,0 +1,699 @@
|
|||
;;; nord-theme.el --- An arctic, north-bluish clean and elegant theme
|
||||
|
||||
;; Copyright (C) 2016-present Arctic Ice Studio <development@arcticicestudio.com> (https://www.arcticicestudio.com)
|
||||
;; Copyright (C) 2016-present Sven Greb <development@svengreb.de> (https://www.svengreb.de)
|
||||
|
||||
;; Title: Nord Theme
|
||||
;; Project: nord-emacs
|
||||
;; Version: 0.4.0
|
||||
;; Package-Version: 20190616.1757
|
||||
;; URL: https://github.com/arcticicestudio/nord-emacs
|
||||
;; Author: Arctic Ice Studio <development@arcticicestudio.com>
|
||||
;; Package-Requires: ((emacs "24"))
|
||||
;; License: MIT
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Nord is a 16 colorspace theme build to run in GUI- and terminal
|
||||
;; mode with support for many third-party syntax- and UI packages.
|
||||
|
||||
;;; References:
|
||||
;; Awesome Emacs
|
||||
;; https://github.com/emacs-tw/awesome-emacs
|
||||
;; GNU ELPA
|
||||
;; https://elpa.gnu.org
|
||||
;; GNU Emacs
|
||||
;; https://www.gnu.org/software/emacs/manual/html_node/emacs/Custom-Themes.html
|
||||
;; https://www.gnu.org/software/emacs/manual/html_node/emacs/Creating-Custom-Themes.html
|
||||
;; https://www.gnu.org/software/emacs/manual/html_node/emacs/Faces.html
|
||||
;; https://www.gnu.org/software/emacs/manual/html_node/emacs/Standard-Faces.html
|
||||
;; https://www.gnu.org/software/emacs/manual/html_node/emacs/Face-Customization.html
|
||||
;; https://www.gnu.org/software/emacs/manual/html_node/elisp/Face-Attributes.html
|
||||
;; https://www.gnu.org/software/emacs/manual/html_node/elisp/Faces-for-Font-Lock.html
|
||||
;; https://www.gnu.org/software/emacs/manual/html_node/elisp/Display-Feature-Testing.html
|
||||
;; marmalade repo
|
||||
;; https://marmalade-repo.org
|
||||
;; MELPA
|
||||
;; https://melpa.org
|
||||
;; https://stable.melpa.org
|
||||
|
||||
;;; Code:
|
||||
|
||||
(unless (>= emacs-major-version 24)
|
||||
(error "Nord theme requires Emacs 24 or later!"))
|
||||
|
||||
(deftheme nord "An arctic, north-bluish clean and elegant theme")
|
||||
|
||||
(defgroup nord nil
|
||||
"Nord theme customizations.
|
||||
The theme has to be reloaded after changing anything in this group."
|
||||
:group 'faces)
|
||||
|
||||
(defcustom nord-comment-brightness 10
|
||||
"Allows to define a custom comment color brightness with percentage adjustments from 0% - 20%.
|
||||
As of version 0.4.0, this variable is obsolete/deprecated and has no effect anymore and will be removed in version 1.0.0!
|
||||
The comment color brightness has been increased by 10% by default.
|
||||
Please see https://github.com/arcticicestudio/nord-emacs/issues/73 for more details."
|
||||
:type 'integer
|
||||
:group 'nord)
|
||||
|
||||
(make-obsolete-variable
|
||||
'nord-comment-brightness
|
||||
"The custom color brightness feature has been deprecated and will be removed in version 1.0.0!
|
||||
The comment color brightness has been increased by 10% by default.
|
||||
Please see https://github.com/arcticicestudio/nord-emacs/issues/73 for more details."
|
||||
"0.4.0")
|
||||
|
||||
(defcustom nord-region-highlight nil
|
||||
"Allows to set a region highlight style based on the Nord components.
|
||||
Valid styles are
|
||||
- 'snowstorm' - Uses 'nord0' as foreground- and 'nord4' as background color
|
||||
- 'frost' - Uses 'nord0' as foreground- and 'nord8' as background color"
|
||||
:type 'string
|
||||
:group 'nord)
|
||||
|
||||
(defcustom nord-uniform-mode-lines nil
|
||||
"Enables uniform activate- and inactive mode lines using 'nord3' as background."
|
||||
:type 'boolean
|
||||
:group 'nord)
|
||||
|
||||
(setq nord-theme--brightened-comments '("#4c566a" "#4e586d" "#505b70" "#525d73" "#556076" "#576279" "#59647c" "#5b677f" "#5d6982" "#5f6c85" "#616e88" "#63718b" "#66738e" "#687591" "#6a7894" "#6d7a96" "#6f7d98" "#72809a" "#75829c" "#78859e" "#7b88a1"))
|
||||
|
||||
(defun nord-theme--brightened-comment-color (percent)
|
||||
"Returns the brightened comment color for the given percent.
|
||||
The value must be greater or equal to 0 and less or equal to 20, otherwise the default 'nord3' color is used.
|
||||
As of version 0.4.0, this function is obsolete/deprecated and has no effect anymore and will be removed in version 1.0.0!
|
||||
The comment color brightness has been increased by 10% by default.
|
||||
Please see https://github.com/arcticicestudio/nord-emacs/issues/73 for more details."
|
||||
(nth 10 nord-theme--brightened-comments))
|
||||
|
||||
(make-obsolete
|
||||
'nord-theme--brightened-comment-color
|
||||
"The custom color brightness feature has been deprecated and will be removed in version 1.0.0!\
|
||||
The comment color brightness has been increased by 10% by default.\
|
||||
Please see https://github.com/arcticicestudio/nord-emacs/issues/73 for more details."
|
||||
"0.4.0")
|
||||
|
||||
;;;; Color Constants
|
||||
(let ((class '((class color) (min-colors 89)))
|
||||
(nord0 (if (display-graphic-p) "#2E3440" nil))
|
||||
(nord1 (if (display-graphic-p) "#3B4252" "black"))
|
||||
(nord2 (if (display-graphic-p) "#434C5E" "#434C5E"))
|
||||
(nord3 (if (display-graphic-p) "#4C566A" "brightblack"))
|
||||
(nord4 (if (display-graphic-p) "#D8DEE9" "#D8DEE9"))
|
||||
(nord5 (if (display-graphic-p) "#E5E9F0" "white"))
|
||||
(nord6 (if (display-graphic-p) "#ECEFF4" "brightwhite"))
|
||||
(nord7 (if (display-graphic-p) "#8FBCBB" "cyan"))
|
||||
(nord8 (if (display-graphic-p) "#88C0D0" "brightcyan"))
|
||||
(nord9 (if (display-graphic-p) "#81A1C1" "blue"))
|
||||
(nord10 (if (display-graphic-p) "#5E81AC" "brightblue"))
|
||||
(nord11 (if (display-graphic-p) "#BF616A" "red"))
|
||||
(nord12 (if (display-graphic-p) "#D08770" "brightyellow"))
|
||||
(nord13 (if (display-graphic-p) "#EBCB8B" "yellow"))
|
||||
(nord14 (if (display-graphic-p) "#A3BE8C" "green"))
|
||||
(nord15 (if (display-graphic-p) "#B48EAD" "magenta"))
|
||||
(nord-annotation (if (display-graphic-p) "#D08770" "brightyellow"))
|
||||
(nord-attribute (if (display-graphic-p) "#8FBCBB" "cyan"))
|
||||
(nord-class (if (display-graphic-p) "#8FBCBB" "cyan"))
|
||||
(nord-comment (if (display-graphic-p) (nord-theme--brightened-comment-color nord-comment-brightness) "brightblack"))
|
||||
(nord-escape (if (display-graphic-p) "#D08770" "brightyellow"))
|
||||
(nord-method (if (display-graphic-p) "#88C0D0" "brightcyan"))
|
||||
(nord-keyword (if (display-graphic-p) "#81A1C1" "blue"))
|
||||
(nord-numeric (if (display-graphic-p) "#B48EAD" "magenta"))
|
||||
(nord-operator (if (display-graphic-p) "#81A1C1" "blue"))
|
||||
(nord-preprocessor (if (display-graphic-p) "#5E81AC" "brightblue"))
|
||||
(nord-punctuation (if (display-graphic-p) "#D8DEE9" "#D8DEE9"))
|
||||
(nord-regexp (if (display-graphic-p) "#EBCB8B" "yellow"))
|
||||
(nord-string (if (display-graphic-p) "#A3BE8C" "green"))
|
||||
(nord-tag (if (display-graphic-p) "#81A1C1" "blue"))
|
||||
(nord-variable (if (display-graphic-p) "#D8DEE9" "#D8DEE9"))
|
||||
(nord-region-highlight-foreground (if (or
|
||||
(string= nord-region-highlight "frost")
|
||||
(string= nord-region-highlight "snowstorm")) "#2E3440" nil))
|
||||
(nord-region-highlight-background (if
|
||||
(string= nord-region-highlight "frost") "#88C0D0"
|
||||
(if (string= nord-region-highlight "snowstorm") "#D8DEE9" "#434C5E")))
|
||||
(nord-uniform-mode-lines-background (if nord-uniform-mode-lines "#4C566A" "#3B4252")))
|
||||
|
||||
;;;; +------------+
|
||||
;;;; + Core Faces +
|
||||
;;;; +------------+
|
||||
(custom-theme-set-faces
|
||||
'nord
|
||||
;; +--- Base ---+
|
||||
`(bold ((,class (:weight bold))))
|
||||
`(bold-italic ((,class (:weight bold :slant italic))))
|
||||
`(default ((,class (:foreground ,nord4 :background ,nord0))))
|
||||
`(error ((,class (:foreground ,nord11 :weight bold))))
|
||||
`(escape-glyph ((,class (:foreground ,nord12))))
|
||||
`(font-lock-builtin-face ((,class (:foreground ,nord9))))
|
||||
`(font-lock-comment-face ((,class (:foreground ,nord-comment))))
|
||||
`(font-lock-comment-delimiter-face ((,class (:foreground ,nord-comment))))
|
||||
`(font-lock-constant-face ((,class (:foreground ,nord9))))
|
||||
`(font-lock-doc-face ((,class (:foreground ,nord-comment))))
|
||||
`(font-lock-function-name-face ((,class (:foreground ,nord8))))
|
||||
`(font-lock-keyword-face ((,class (:foreground ,nord9))))
|
||||
`(font-lock-negation-char-face ((,class (:foreground ,nord9))))
|
||||
`(font-lock-preprocessor-face ((,class (:foreground ,nord10 :weight bold))))
|
||||
`(font-lock-reference-face ((,class (:foreground ,nord9))))
|
||||
`(font-lock-regexp-grouping-backslash ((,class (:foreground ,nord13))))
|
||||
`(font-lock-regexp-grouping-construct ((,class (:foreground ,nord13))))
|
||||
`(font-lock-string-face ((,class (:foreground ,nord14))))
|
||||
`(font-lock-type-face ((,class (:foreground ,nord7))))
|
||||
`(font-lock-variable-name-face ((,class (:foreground ,nord4))))
|
||||
`(font-lock-warning-face ((,class (:foreground ,nord13))))
|
||||
`(italic ((,class (:slant italic))))
|
||||
`(shadow ((,class (:foreground ,nord3))))
|
||||
`(underline ((,class (:underline t))))
|
||||
`(warning ((,class (:foreground ,nord13 :weight bold))))
|
||||
|
||||
;; +--- Syntax ---+
|
||||
;; > C
|
||||
`(c-annotation-face ((,class (:foreground ,nord-annotation))))
|
||||
|
||||
;; > diff
|
||||
`(diff-added ((,class (:foreground ,nord14))))
|
||||
`(diff-changed ((,class (:foreground ,nord13))))
|
||||
`(diff-context ((,class (:inherit default))))
|
||||
`(diff-file-header ((,class (:foreground ,nord8))))
|
||||
`(diff-function ((,class (:foreground ,nord7))))
|
||||
`(diff-header ((,class (:foreground ,nord9 :weight bold))))
|
||||
`(diff-hunk-header ((,class (:foreground ,nord9 :background ,nord0))))
|
||||
`(diff-indicator-added ((,class (:foreground ,nord14))))
|
||||
`(diff-indicator-changed ((,class (:foreground ,nord13))))
|
||||
`(diff-indicator-removed ((,class (:foreground ,nord11))))
|
||||
`(diff-nonexistent ((,class (:foreground ,nord11))))
|
||||
`(diff-refine-added ((,class (:foreground ,nord14))))
|
||||
`(diff-refine-changed ((,class (:foreground ,nord13))))
|
||||
`(diff-refine-removed ((,class (:foreground ,nord11))))
|
||||
`(diff-removed ((,class (:foreground ,nord11))))
|
||||
|
||||
;; +--- UI ---+
|
||||
`(border ((,class (:foreground ,nord4))))
|
||||
`(buffer-menu-buffer ((,class (:foreground ,nord4 :weight bold))))
|
||||
`(button ((,class (:background ,nord0 :foreground ,nord8 :box (:line-width 2 :color ,nord4 :style sunken-button)))))
|
||||
`(completions-annotations ((,class (:foreground ,nord9))))
|
||||
`(completions-common-part ((,class (:foreground ,nord8 :weight bold))))
|
||||
`(completions-first-difference ((,class (:foreground ,nord11))))
|
||||
`(custom-button ((,class (:background ,nord0 :foreground ,nord8 :box (:line-width 2 :color ,nord4 :style sunken-button)))))
|
||||
`(custom-button-mouse ((,class (:background ,nord4 :foreground ,nord0 :box (:line-width 2 :color ,nord4 :style sunken-button)))))
|
||||
`(custom-button-pressed ((,class (:background ,nord6 :foreground ,nord0 :box (:line-width 2 :color ,nord4 :style sunken-button)))))
|
||||
`(custom-button-pressed-unraised ((,class (:background ,nord4 :foreground ,nord0 :box (:line-width 2 :color ,nord4 :style sunken-button)))))
|
||||
`(custom-button-unraised ((,class (:background ,nord0 :foreground ,nord8 :box (:line-width 2 :color ,nord4 :style sunken-button)))))
|
||||
`(custom-changed ((,class (:foreground ,nord13))))
|
||||
`(custom-comment ((,class (:foreground ,nord-comment))))
|
||||
`(custom-comment-tag ((,class (:foreground ,nord7))))
|
||||
`(custom-documentation ((,class (:foreground ,nord4))))
|
||||
`(custom-group-tag ((,class (:foreground ,nord8 :weight bold))))
|
||||
`(custom-group-tag-1 ((,class (:foreground ,nord8 :weight bold))))
|
||||
`(custom-invalid ((,class (:foreground ,nord11))))
|
||||
`(custom-modified ((,class (:foreground ,nord13))))
|
||||
`(custom-rogue ((,class (:foreground ,nord12 :background ,nord2))))
|
||||
`(custom-saved ((,class (:foreground ,nord14))))
|
||||
`(custom-set ((,class (:foreground ,nord8))))
|
||||
`(custom-state ((,class (:foreground ,nord14))))
|
||||
`(custom-themed ((,class (:foreground ,nord8 :background ,nord2))))
|
||||
`(cursor ((,class (:background ,nord4))))
|
||||
`(fringe ((,class (:foreground ,nord4 :background ,nord0))))
|
||||
`(file-name-shadow ((,class (:inherit shadow))))
|
||||
`(header-line ((,class (:foreground ,nord4 :background ,nord2))))
|
||||
`(help-argument-name ((,class (:foreground ,nord8))))
|
||||
`(highlight ((,class (:foreground ,nord8 :background ,nord2))))
|
||||
`(hl-line ((,class (:background ,nord1))))
|
||||
`(info-menu-star ((,class (:foreground ,nord9))))
|
||||
`(isearch ((,class (:foreground ,nord0 :background ,nord8))))
|
||||
`(isearch-fail ((,class (:foreground ,nord11))))
|
||||
`(link ((,class (:underline t))))
|
||||
`(link-visited ((,class (:underline t))))
|
||||
`(linum ((,class (:foreground ,nord3 :background ,nord0))))
|
||||
`(linum-relative-current-face ((,class (:foreground ,nord3 :background ,nord0))))
|
||||
`(match ((,class (:inherit isearch))))
|
||||
`(message-cited-text ((,class (:foreground ,nord4))))
|
||||
`(message-header-cc ((,class (:foreground ,nord9))))
|
||||
`(message-header-name ((,class (:foreground ,nord7))))
|
||||
`(message-header-newsgroup ((,class (:foreground ,nord14))))
|
||||
`(message-header-other ((,class (:foreground ,nord4))))
|
||||
`(message-header-subject ((,class (:foreground ,nord8))))
|
||||
`(message-header-to ((,class (:foreground ,nord9))))
|
||||
`(message-header-xheader ((,class (:foreground ,nord13))))
|
||||
`(message-mml ((,class (:foreground ,nord10))))
|
||||
`(message-separator ((,class (:inherit shadow))))
|
||||
`(minibuffer-prompt ((,class (:foreground ,nord8 :weight bold))))
|
||||
`(mm-command-output ((,class (:foreground ,nord8))))
|
||||
`(mode-line ((,class (:foreground ,nord8 :background ,nord3))))
|
||||
`(mode-line-buffer-id ((,class (:weight bold))))
|
||||
`(mode-line-highlight ((,class (:inherit highlight))))
|
||||
`(mode-line-inactive ((,class (:foreground ,nord4 :background ,nord-uniform-mode-lines-background))))
|
||||
`(next-error ((,class (:inherit error))))
|
||||
`(nobreak-space ((,class (:foreground ,nord3))))
|
||||
`(outline-1 ((,class (:foreground ,nord8 :weight bold))))
|
||||
`(outline-2 ((,class (:inherit outline-1))))
|
||||
`(outline-3 ((,class (:inherit outline-1))))
|
||||
`(outline-4 ((,class (:inherit outline-1))))
|
||||
`(outline-5 ((,class (:inherit outline-1))))
|
||||
`(outline-6 ((,class (:inherit outline-1))))
|
||||
`(outline-7 ((,class (:inherit outline-1))))
|
||||
`(outline-8 ((,class (:inherit outline-1))))
|
||||
`(package-description ((,class (:foreground ,nord4))))
|
||||
`(package-help-section-name ((,class (:foreground ,nord8 :weight bold))))
|
||||
`(package-name ((,class (:foreground ,nord8))))
|
||||
`(package-status-available ((,class (:foreground ,nord7))))
|
||||
`(package-status-avail-obso ((,class (:foreground ,nord7 :slant italic))))
|
||||
`(package-status-built-in ((,class (:foreground ,nord9))))
|
||||
`(package-status-dependency ((,class (:foreground ,nord8 :slant italic))))
|
||||
`(package-status-disabled ((,class (:foreground ,nord3))))
|
||||
`(package-status-external ((,class (:foreground ,nord12 :slant italic))))
|
||||
`(package-status-held ((,class (:foreground ,nord4 :weight bold))))
|
||||
`(package-status-new ((,class (:foreground ,nord14))))
|
||||
`(package-status-incompat ((,class (:foreground ,nord11))))
|
||||
`(package-status-installed ((,class (:foreground ,nord7 :weight bold))))
|
||||
`(package-status-unsigned ((,class (:underline ,nord13))))
|
||||
`(query-replace ((,class (:foreground ,nord8 :background ,nord2))))
|
||||
`(region ((,class (:foreground ,nord-region-highlight-foreground :background ,nord-region-highlight-background))))
|
||||
`(scroll-bar ((,class (:background ,nord3))))
|
||||
`(secondary-selection ((,class (:background ,nord2))))
|
||||
`(show-paren-match-face ((,class (:foreground ,nord0 :background ,nord8))))
|
||||
`(show-paren-mismatch-face ((,class (:background ,nord11))))
|
||||
`(success ((,class (:foreground ,nord14))))
|
||||
`(term ((,class (:foreground ,nord4 :background ,nord0))))
|
||||
`(term-color-black ((,class (:foreground ,nord1 :background ,nord1))))
|
||||
`(term-color-white ((,class (:foreground ,nord5 :background ,nord5))))
|
||||
`(term-color-cyan ((,class (:foreground ,nord7 :background ,nord7))))
|
||||
`(term-color-blue ((,class (:foreground ,nord8 :background ,nord8))))
|
||||
`(term-color-red ((,class (:foreground ,nord11 :background ,nord11))))
|
||||
`(term-color-yellow ((,class (:foreground ,nord13 :background ,nord13))))
|
||||
`(term-color-green ((,class (:foreground ,nord14 :background ,nord14))))
|
||||
`(term-color-magenta ((,class (:foreground ,nord15 :background ,nord15))))
|
||||
`(tool-bar ((,class (:foreground ,nord4 :background ,nord3))))
|
||||
`(tooltip ((,class (:foreground ,nord0 :background ,nord4))))
|
||||
`(trailing-whitespace ((,class (:foreground ,nord3))))
|
||||
`(tty-menu-disabled-face ((,class (:foreground ,nord1))))
|
||||
`(tty-menu-enabled-face ((,class (:background ,nord2 foreground ,nord4))))
|
||||
`(tty-menu-selected-face ((,class (:foreground ,nord8 :underline t))))
|
||||
`(undo-tree-visualizer-current-face ((,class (:foreground ,nord8))))
|
||||
`(undo-tree-visualizer-default-face ((,class (:foreground ,nord4))))
|
||||
`(undo-tree-visualizer-unmodified-face ((,class (:foreground ,nord4))))
|
||||
`(undo-tree-visualizer-register-face ((,class (:foreground ,nord9))))
|
||||
`(vc-conflict-state ((,class (:foreground ,nord12))))
|
||||
`(vc-edited-state ((,class (:foreground ,nord13))))
|
||||
`(vc-locally-added-state ((,class (:underline ,nord14))))
|
||||
`(vc-locked-state ((,class (:foreground ,nord10))))
|
||||
`(vc-missing-state ((,class (:foreground ,nord11))))
|
||||
`(vc-needs-update-state ((,class (:foreground ,nord12))))
|
||||
`(vc-removed-state ((,class (:foreground ,nord11))))
|
||||
`(vc-state-base ((,class (:foreground ,nord4))))
|
||||
`(vc-up-to-date-state ((,class (:foreground ,nord8))))
|
||||
`(vertical-border ((,class (:foreground ,nord2))))
|
||||
`(which-func ((,class (:foreground ,nord8))))
|
||||
`(whitespace-big-indent ((,class (:foreground ,nord3 :background ,nord0))))
|
||||
`(whitespace-empty ((,class (:foreground ,nord3 :background ,nord0))))
|
||||
`(whitespace-hspace ((,class (:foreground ,nord3 :background ,nord0))))
|
||||
`(whitespace-indentation ((,class (:foreground ,nord3 :background ,nord0))))
|
||||
`(whitespace-line ((,class (:background ,nord0))))
|
||||
`(whitespace-newline ((,class (:foreground ,nord3 :background ,nord0))))
|
||||
`(whitespace-space ((,class (:foreground ,nord3 :background ,nord0))))
|
||||
`(whitespace-space-after-tab ((,class (:foreground ,nord3 :background ,nord0))))
|
||||
`(whitespace-space-before-tab ((,class (:foreground ,nord3 :background ,nord0))))
|
||||
`(whitespace-tab ((,class (:foreground ,nord3 :background ,nord0))))
|
||||
`(whitespace-trailing ((,class (:inherit trailing-whitespace))))
|
||||
`(widget-button-pressed ((,class (:foreground ,nord9 :background ,nord1))))
|
||||
`(widget-documentation ((,class (:foreground ,nord4))))
|
||||
`(widget-field ((,class (:background ,nord2 :foreground ,nord4))))
|
||||
`(widget-single-line-field ((,class (:background ,nord2 :foreground ,nord4))))
|
||||
`(window-divider ((,class (:background ,nord3))))
|
||||
`(window-divider-first-pixel ((,class (:background ,nord3))))
|
||||
`(window-divider-last-pixel ((,class (:background ,nord3))))
|
||||
|
||||
;;;; +-----------------+
|
||||
;;;; + Package Support +
|
||||
;;;; +-----------------+
|
||||
;; +--- Syntax ---+
|
||||
;; > Auctex
|
||||
`(font-latex-bold-face ((,class (:inherit bold))))
|
||||
`(font-latex-italic-face ((,class (:inherit italic))))
|
||||
`(font-latex-math-face ((,class (:foreground ,nord8))))
|
||||
`(font-latex-sectioning-0-face ((,class (:foreground ,nord8 :weight bold))))
|
||||
`(font-latex-sectioning-1-face ((,class (:inherit font-latex-sectioning-0-face))))
|
||||
`(font-latex-sectioning-2-face ((,class (:inherit font-latex-sectioning-0-face))))
|
||||
`(font-latex-sectioning-3-face ((,class (:inherit font-latex-sectioning-0-face))))
|
||||
`(font-latex-sectioning-4-face ((,class (:inherit font-latex-sectioning-0-face))))
|
||||
`(font-latex-sectioning-5-face ((,class (:inherit font-latex-sectioning-0-face))))
|
||||
`(font-latex-script-char-face ((,class (:inherit font-lock-warning-face))))
|
||||
`(font-latex-string-face ((,class (:inherit font-lock-string-face))))
|
||||
`(font-latex-warning-face ((,class (:inherit font-lock-warning-face))))
|
||||
|
||||
;; > Elixir
|
||||
`(elixir-attribute-face ((,class (:foreground ,nord-annotation))))
|
||||
`(elixir-atom-face ((,class (:foreground ,nord4 :weight bold))))
|
||||
|
||||
;; > Enhanced Ruby
|
||||
`(enh-ruby-heredoc-delimiter-face ((,class (:foreground ,nord14))))
|
||||
`(enh-ruby-op-face ((,class (:foreground ,nord9))))
|
||||
`(enh-ruby-regexp-delimiter-face ((,class (:foreground ,nord13))))
|
||||
`(enh-ruby-regexp-face ((,class (:foreground ,nord13))))
|
||||
`(enh-ruby-string-delimiter-face ((,class (:foreground ,nord14))))
|
||||
`(erm-syn-errline ((,class (:foreground ,nord11 :underline t))))
|
||||
`(erm-syn-warnline ((,class (:foreground ,nord13 :underline t))))
|
||||
|
||||
;; > Java Development Environment for Emacs
|
||||
`(jdee-db-active-breakpoint-face ((,class (:background ,nord2 :weight bold))))
|
||||
`(jdee-bug-breakpoint-cursor ((,class (:background ,nord2))))
|
||||
`(jdee-db-requested-breakpoint-face ((,class (:foreground ,nord13 :background ,nord2 :weight bold))))
|
||||
`(jdee-db-spec-breakpoint-face ((,class (:foreground ,nord14 :background ,nord2 :weight bold))))
|
||||
`(jdee-font-lock-api-face ((,class (:foreground ,nord4))))
|
||||
`(jdee-font-lock-code-face ((,class (:slant italic))))
|
||||
`(jdee-font-lock-constant-face ((,class (:foreground ,nord-keyword))))
|
||||
`(jdee-font-lock-constructor-face ((,class (:foreground ,nord-method))))
|
||||
`(jdee-font-lock-doc-tag-face ((,class (:foreground ,nord7))))
|
||||
`(jdee-font-lock-link-face ((,class (:underline t))))
|
||||
`(jdee-font-lock-modifier-face ((,class (:foreground ,nord-keyword))))
|
||||
`(jdee-font-lock-number-face ((,class (:foreground ,nord-numeric))))
|
||||
`(jdee-font-lock-operator-fac ((,class (:foreground ,nord-operator))))
|
||||
`(jdee-font-lock-package-face ((,class (:foreground ,nord-class))))
|
||||
`(jdee-font-lock-pre-face ((,class (:foreground ,nord-comment :slant italic))))
|
||||
`(jdee-font-lock-private-face ((,class (:foreground ,nord-keyword))))
|
||||
`(jdee-font-lock-public-face ((,class (:foreground ,nord-keyword))))
|
||||
`(jdee-font-lock-variable-face ((,class (:foreground ,nord-variable))))
|
||||
|
||||
;; > JavaScript 2
|
||||
`(js2-function-call ((,class (:foreground ,nord8))))
|
||||
`(js2-private-function-call ((,class (:foreground ,nord8))))
|
||||
`(js2-jsdoc-html-tag-delimiter ((,class (:foreground ,nord6))))
|
||||
`(js2-jsdoc-html-tag-name ((,class (:foreground ,nord9))))
|
||||
`(js2-external-variable ((,class (:foreground ,nord4))))
|
||||
`(js2-function-param ((,class (:foreground ,nord4))))
|
||||
`(js2-jsdoc-value ((,class (:foreground ,nord-comment))))
|
||||
`(js2-jsdoc-tag ((,class (:foreground ,nord7))))
|
||||
`(js2-jsdoc-type ((,class (:foreground ,nord7))))
|
||||
`(js2-private-member ((,class (:foreground ,nord4))))
|
||||
`(js2-object-property ((,class (:foreground ,nord4))))
|
||||
`(js2-error ((,class (:foreground ,nord11))))
|
||||
`(js2-warning ((,class (:foreground ,nord13))))
|
||||
`(js2-instance-member ((,class (:foreground ,nord4))))
|
||||
|
||||
;; > JavaScript 3
|
||||
`(js3-error-face ((,class (:foreground ,nord11))))
|
||||
`(js3-external-variable-face ((,class (:foreground ,nord4))))
|
||||
`(js3-function-param-face ((,class (:foreground ,nord4))))
|
||||
`(js3-instance-member-face ((,class (:foreground ,nord4))))
|
||||
`(js3-jsdoc-html-tag-delimiter-face ((,class (:foreground ,nord6))))
|
||||
`(js3-jsdoc-html-tag-name-face ((,class (:foreground ,nord9))))
|
||||
`(js3-jsdoc-tag-face ((,class (:foreground ,nord9))))
|
||||
`(js3-jsdoc-type-face ((,class (:foreground ,nord7))))
|
||||
`(js3-jsdoc-value-face ((,class (:foreground ,nord4))))
|
||||
`(js3-magic-paren-face ((,class (:inherit show-paren-match-face))))
|
||||
`(js3-private-function-call-face ((,class (:foreground ,nord8))))
|
||||
`(js3-private-member-face ((,class (:foreground ,nord4))))
|
||||
`(js3-warning-face ((,class (:foreground ,nord13))))
|
||||
|
||||
;; > Markdown
|
||||
`(markdown-blockquote-face ((,class (:foreground ,nord-comment))))
|
||||
`(markdown-bold-face ((,class (:inherit bold))))
|
||||
`(markdown-header-face-1 ((,class (:foreground ,nord8))))
|
||||
`(markdown-header-face-2 ((,class (:foreground ,nord8))))
|
||||
`(markdown-header-face-3 ((,class (:foreground ,nord8))))
|
||||
`(markdown-header-face-4 ((,class (:foreground ,nord8))))
|
||||
`(markdown-header-face-5 ((,class (:foreground ,nord8))))
|
||||
`(markdown-header-face-6 ((,class (:foreground ,nord8))))
|
||||
`(markdown-inline-code-face ((,class (:foreground ,nord7))))
|
||||
`(markdown-italic-face ((,class (:inherit italic))))
|
||||
`(markdown-link-face ((,class (:foreground ,nord8))))
|
||||
`(markdown-markup-face ((,class (:foreground ,nord9))))
|
||||
`(markdown-reference-face ((,class (:inherit markdown-link-face))))
|
||||
`(markdown-url-face ((,class (:foreground ,nord4 :underline t))))
|
||||
|
||||
;; > Rainbow Delimeters
|
||||
`(rainbow-delimiters-depth-1-face ((,class :foreground ,nord7)))
|
||||
`(rainbow-delimiters-depth-2-face ((,class :foreground ,nord8)))
|
||||
`(rainbow-delimiters-depth-3-face ((,class :foreground ,nord9)))
|
||||
`(rainbow-delimiters-depth-4-face ((,class :foreground ,nord10)))
|
||||
`(rainbow-delimiters-depth-5-face ((,class :foreground ,nord12)))
|
||||
`(rainbow-delimiters-depth-6-face ((,class :foreground ,nord13)))
|
||||
`(rainbow-delimiters-depth-7-face ((,class :foreground ,nord14)))
|
||||
`(rainbow-delimiters-depth-8-face ((,class :foreground ,nord15)))
|
||||
`(rainbow-delimiters-unmatched-face ((,class :foreground ,nord11)))
|
||||
|
||||
;; > Web Mode
|
||||
`(web-mode-attr-tag-custom-face ((,class (:foreground ,nord-attribute))))
|
||||
`(web-mode-builtin-face ((,class (:foreground ,nord-keyword))))
|
||||
`(web-mode-comment-face ((,class (:foreground ,nord-comment))))
|
||||
`(web-mode-comment-keyword-face ((,class (:foreground ,nord-comment))))
|
||||
`(web-mode-constant-face ((,class (:foreground ,nord-variable))))
|
||||
`(web-mode-css-at-rule-face ((,class (:foreground ,nord-annotation))))
|
||||
`(web-mode-css-function-face ((,class (:foreground ,nord-method))))
|
||||
`(web-mode-css-property-name-face ((,class (:foreground ,nord-keyword))))
|
||||
`(web-mode-css-pseudo-class-face ((,class (:foreground ,nord-class))))
|
||||
`(web-mode-css-selector-face ((,class (:foreground ,nord-keyword))))
|
||||
`(web-mode-css-string-face ((,class (:foreground ,nord-string))))
|
||||
`(web-mode-doctype-face ((,class (:foreground ,nord-preprocessor))))
|
||||
`(web-mode-function-call-face ((,class (:foreground ,nord-method))))
|
||||
`(web-mode-function-name-face ((,class (:foreground ,nord-method))))
|
||||
`(web-mode-html-attr-name-face ((,class (:foreground ,nord-attribute))))
|
||||
`(web-mode-html-attr-equal-face ((,class (:foreground ,nord-punctuation))))
|
||||
`(web-mode-html-attr-value-face ((,class (:foreground ,nord-string))))
|
||||
`(web-mode-html-entity-face ((,class (:foreground ,nord-keyword))))
|
||||
`(web-mode-html-tag-bracket-face ((,class (:foreground ,nord-punctuation))))
|
||||
`(web-mode-html-tag-custom-face ((,class (:foreground ,nord-tag))))
|
||||
`(web-mode-html-tag-face ((,class (:foreground ,nord-tag))))
|
||||
`(web-mode-html-tag-namespaced-face ((,class (:foreground ,nord-keyword))))
|
||||
`(web-mode-json-key-face ((,class (:foreground ,nord-class))))
|
||||
`(web-mode-json-string-face ((,class (:foreground ,nord-string))))
|
||||
`(web-mode-keyword-face ((,class (:foreground ,nord-keyword))))
|
||||
`(web-mode-preprocessor-face ((,class (:foreground ,nord-preprocessor))))
|
||||
`(web-mode-string-face ((,class (:foreground ,nord-string))))
|
||||
`(web-mode-symbol-face ((,class (:foreground ,nord-variable))))
|
||||
`(web-mode-type-face ((,class (:foreground ,nord-class))))
|
||||
`(web-mode-warning-face ((,class (:inherit ,font-lock-warning-face))))
|
||||
`(web-mode-variable-name-face ((,class (:foreground ,nord-variable))))
|
||||
|
||||
;; +--- UI ---+
|
||||
;; > Anzu
|
||||
`(anzu-mode-line ((,class (:foreground, nord8))))
|
||||
`(anzu-mode-line-no-match ((,class (:foreground, nord11))))
|
||||
|
||||
;; > Avy
|
||||
`(avy-lead-face ((,class (:background ,nord11 :foreground ,nord5))))
|
||||
`(avy-lead-face-0 ((,class (:background ,nord10 :foreground ,nord5))))
|
||||
`(avy-lead-face-1 ((,class (:background ,nord3 :foreground ,nord5))))
|
||||
`(avy-lead-face-2 ((,class (:background ,nord15 :foreground ,nord5))))
|
||||
|
||||
;; > Company
|
||||
`(company-echo-common ((,class (:foreground ,nord0 :background ,nord4))))
|
||||
`(company-preview ((,class (:foreground ,nord4 :background ,nord10))))
|
||||
`(company-preview-common ((,class (:foreground ,nord0 :background ,nord8))))
|
||||
`(company-preview-search ((,class (:foreground ,nord0 :background ,nord8))))
|
||||
`(company-scrollbar-bg ((,class (:foreground ,nord1 :background ,nord1))))
|
||||
`(company-scrollbar-fg ((,class (:foreground ,nord2 :background ,nord2))))
|
||||
`(company-template-field ((,class (:foreground ,nord0 :background ,nord7))))
|
||||
`(company-tooltip ((,class (:foreground ,nord4 :background ,nord2))))
|
||||
`(company-tooltip-annotation ((,class (:foreground ,nord12))))
|
||||
`(company-tooltip-annotation-selection ((,class (:foreground ,nord12 :weight bold))))
|
||||
`(company-tooltip-common ((,class (:foreground ,nord8))))
|
||||
`(company-tooltip-common-selection ((,class (:foreground ,nord8 :background ,nord3))))
|
||||
`(company-tooltip-mouse ((,class (:inherit highlight))))
|
||||
`(company-tooltip-selection ((,class (:background ,nord3 :weight bold))))
|
||||
|
||||
;; > diff-hl
|
||||
`(diff-hl-change ((,class (:background ,nord13))))
|
||||
`(diff-hl-insert ((,class (:background ,nord14))))
|
||||
`(diff-hl-delete ((,class (:background ,nord11))))
|
||||
|
||||
;; > Evil
|
||||
`(evil-ex-info ((,class (:foreground ,nord8))))
|
||||
`(evil-ex-substitute-replacement ((,class (:foreground ,nord9))))
|
||||
`(evil-ex-substitute-matches ((,class (:inherit isearch))))
|
||||
|
||||
;; > Flycheck
|
||||
`(flycheck-error ((,class (:underline (:style wave :color ,nord11)))))
|
||||
`(flycheck-fringe-error ((,class (:foreground ,nord11 :weight bold))))
|
||||
`(flycheck-fringe-info ((,class (:foreground ,nord8 :weight bold))))
|
||||
`(flycheck-fringe-warning ((,class (:foreground ,nord13 :weight bold))))
|
||||
`(flycheck-info ((,class (:underline (:style wave :color ,nord8)))))
|
||||
`(flycheck-warning ((,class (:underline (:style wave :color ,nord13)))))
|
||||
|
||||
;; > Git Gutter
|
||||
`(git-gutter:modified ((,class (:foreground ,nord13))))
|
||||
`(git-gutter:added ((,class (:foreground ,nord14))))
|
||||
`(git-gutter:deleted ((,class (:foreground ,nord11))))
|
||||
|
||||
;; > Git Gutter Plus
|
||||
`(git-gutter+-modified ((,class (:foreground ,nord13))))
|
||||
`(git-gutter+-added ((,class (:foreground ,nord14))))
|
||||
`(git-gutter+-deleted ((,class (:foreground ,nord11))))
|
||||
|
||||
;; > Helm
|
||||
`(helm-bookmark-addressbook ((,class (:foreground ,nord7))))
|
||||
`(helm-bookmark-directory ((,class (:foreground ,nord9))))
|
||||
`(helm-bookmark-file ((,class (:foreground ,nord8))))
|
||||
`(helm-bookmark-gnus ((,class (:foreground ,nord10))))
|
||||
`(helm-bookmark-info ((,class (:foreground ,nord14))))
|
||||
`(helm-bookmark-man ((,class (:foreground ,nord4))))
|
||||
`(helm-bookmark-w3m ((,class (:foreground ,nord9))))
|
||||
`(helm-buffer-directory ((,class (:foreground ,nord9))))
|
||||
`(helm-buffer-file ((,class (:foreground ,nord8))))
|
||||
`(helm-buffer-not-saved ((,class (:foreground ,nord13))))
|
||||
`(helm-buffer-process ((,class (:foreground ,nord10))))
|
||||
`(helm-candidate-number ((,class (:foreground ,nord4 :weight bold))))
|
||||
`(helm-candidate-number-suspended ((,class (:foreground ,nord4))))
|
||||
`(helm-ff-directory ((,class (:foreground ,nord9 :weight bold))))
|
||||
`(helm-ff-dirs ((,class (:foreground ,nord9))))
|
||||
`(helm-ff-dotted-director ((,class (:foreground ,nord9 :underline t))))
|
||||
`(helm-ff-dotted-symlink-director ((,class (:foreground ,nord7 :weight bold))))
|
||||
`(helm-ff-executable ((,class (:foreground ,nord8))))
|
||||
`(helm-ff-file ((,class (:foreground ,nord4))))
|
||||
`(helm-ff-invalid-symlink ((,class (:foreground ,nord11 :weight bold))))
|
||||
`(helm-ff-prefix ((,class (:foreground ,nord0 :background ,nord9))))
|
||||
`(helm-ff-symlink ((,class (:foreground ,nord7))))
|
||||
`(helm-grep-cmd-line ((,class (:foreground ,nord4 :background ,nord0))))
|
||||
`(helm-grep-file ((,class (:foreground ,nord8))))
|
||||
`(helm-grep-finish ((,class (:foreground ,nord5))))
|
||||
`(helm-grep-lineno ((,class (:foreground ,nord4))))
|
||||
`(helm-grep-match ((,class (:inherit isearch))))
|
||||
`(helm-grep-running ((,class (:foreground ,nord8))))
|
||||
`(helm-header ((,class (:foreground ,nord9 :background ,nord2))))
|
||||
`(helm-header-line-left-margin ((,class (:foreground ,nord9 :background ,nord2))))
|
||||
`(helm-history-deleted ((,class (:foreground ,nord11))))
|
||||
`(helm-history-remote ((,class (:foreground ,nord4))))
|
||||
`(helm-lisp-completion-info ((,class (:foreground ,nord4 :weight bold))))
|
||||
`(helm-lisp-show-completion ((,class (:inherit isearch))))
|
||||
`(helm-locate-finish ((,class (:foreground ,nord14))))
|
||||
`(helm-match ((,class (:foreground ,nord8))))
|
||||
`(helm-match-item ((,class (:inherit isearch))))
|
||||
`(helm-moccur-buffer ((,class (:foreground ,nord8))))
|
||||
`(helm-resume-need-update ((,class (:foreground ,nord0 :background ,nord13))))
|
||||
`(helm-selection ((,class (:inherit highlight))))
|
||||
`(helm-selection-line ((,class (:background ,nord2))))
|
||||
`(helm-source-header ((,class (:height 1.44 :foreground ,nord8 :background ,nord2))))
|
||||
`(helm-swoop-line-number-face ((,class (:foreground ,nord4 :background ,nord0))))
|
||||
`(helm-swoop-target-word-face ((,class (:foreground ,nord0 :background ,nord7))))
|
||||
`(helm-swoop-target-line-face ((,class (:background ,nord13 :foreground ,nord3))))
|
||||
`(helm-swoop-target-line-block-face ((,class (:background ,nord13 :foreground ,nord3))))
|
||||
`(helm-separator ((,class (:background ,nord2))))
|
||||
`(helm-visible-mark ((,class (:background ,nord2))))
|
||||
|
||||
;; > Magit
|
||||
`(magit-branch ((,class (:foreground ,nord7 :weight bold))))
|
||||
`(magit-diff-context-highlight ((,class (:background ,nord2))))
|
||||
`(magit-diff-file-header ((,class (:foreground ,nord8 :box (:color ,nord8)))))
|
||||
`(magit-diffstat-added ((,class (:foreground ,nord14))))
|
||||
`(magit-diffstat-removed ((,class (:foreground ,nord11))))
|
||||
`(magit-hash ((,class (:foreground ,nord8))))
|
||||
`(magit-hunk-heading ((,class (:foreground ,nord9))))
|
||||
`(magit-hunk-heading-highlight ((,class (:foreground ,nord9 :background ,nord2))))
|
||||
`(magit-item-highlight ((,class (:foreground ,nord8 :background ,nord2))))
|
||||
`(magit-log-author ((,class (:foreground ,nord7))))
|
||||
`(magit-process-ng ((,class (:foreground ,nord13 :weight bold))))
|
||||
`(magit-process-ok ((,class (:foreground ,nord14 :weight bold))))
|
||||
`(magit-section-heading ((,class (:foreground ,nord7 :weight bold))))
|
||||
`(magit-section-highlight ((,class (:background ,nord2))))
|
||||
|
||||
;; > MU4E
|
||||
`(mu4e-header-marks-face ((,class (:foreground ,nord9))))
|
||||
`(mu4e-title-face ((,class (:foreground ,nord8))))
|
||||
`(mu4e-header-key-face ((,class (:foreground ,nord8))))
|
||||
`(mu4e-highlight-face ((,class (:highlight))))
|
||||
`(mu4e-flagged-face ((,class (:foreground ,nord13))))
|
||||
`(mu4e-unread-face ((,class (:foreground ,nord13 :weight bold))))
|
||||
`(mu4e-link-face ((,class (:underline t))))
|
||||
|
||||
;; > Powerline
|
||||
`(powerline-active1 ((,class (:foreground ,nord4 :background ,nord1))))
|
||||
`(powerline-active2 ((,class (:foreground ,nord4 :background ,nord3))))
|
||||
`(powerline-inactive1 ((,class (:background ,nord2))))
|
||||
`(powerline-inactive2 ((,class (:background ,nord2))))
|
||||
|
||||
;; > Powerline Evil
|
||||
`(powerline-evil-base-face ((,class (:foreground ,nord4))))
|
||||
`(powerline-evil-normal-face ((,class (:background ,nord8))))
|
||||
`(powerline-evil-insert-face ((,class (:foreground ,nord0 :background ,nord4))))
|
||||
`(powerline-evil-visual-face ((,class (:foreground ,nord0 :background ,nord7))))
|
||||
`(powerline-evil-replace-face ((,class (:foreground ,nord0 :background ,nord9))))
|
||||
|
||||
;; > NeoTree
|
||||
`(neo-banner-face ((,class (:foreground ,nord10))))
|
||||
`(neo-dir-link-face ((,class (:foreground ,nord9))))
|
||||
`(neo-expand-btn-face ((,class (:foreground ,nord6 :bold t))))
|
||||
`(neo-file-link-face ((,class (:foreground ,nord4))))
|
||||
`(neo-root-dir-face ((,class (:foreground ,nord7 :weight bold))))
|
||||
`(neo-vc-added-face ((,class (:foreground ,nord14))))
|
||||
`(neo-vc-conflict-face ((,class (:foreground ,nord11))))
|
||||
`(neo-vc-default-face ((,class (:foreground ,nord4))))
|
||||
`(neo-vc-edited-face ((,class (:foreground ,nord13))))
|
||||
`(neo-vc-ignored-face ((,class (:foreground ,nord3))))
|
||||
`(neo-vc-missing-face ((,class (:foreground ,nord12))))
|
||||
`(neo-vc-needs-merge-face ((,class (:background ,nord12 :foreground ,nord4))))
|
||||
`(neo-vc-needs-update-face ((,class (:background ,nord10 :foreground ,nord4))))
|
||||
`(neo-vc-removed-face ((,class (:foreground ,nord11 :strike-through nil))))
|
||||
`(neo-vc-up-to-date-face ((,class (:foreground ,nord4))))
|
||||
`(neo-vc-user-face ((,class (:foreground ,nord4))))
|
||||
|
||||
;; > Org
|
||||
`(org-level-1 ((,class (:foreground ,nord8 :weight bold))))
|
||||
`(org-level-2 ((,class (:inherit org-level-1))))
|
||||
`(org-level-3 ((,class (:inherit org-level-1))))
|
||||
`(org-level-4 ((,class (:inherit org-level-1))))
|
||||
`(org-level-5 ((,class (:inherit org-level-1))))
|
||||
`(org-level-6 ((,class (:inherit org-level-1))))
|
||||
`(org-level-7 ((,class (:inherit org-level-1))))
|
||||
`(org-level-8 ((,class (:inherit org-level-1))))
|
||||
`(org-agenda-structure ((,class (:foreground ,nord9))))
|
||||
`(org-agenda-date ((,class (:foreground ,nord8 :underline nil))))
|
||||
`(org-agenda-done ((,class (:foreground ,nord14))))
|
||||
`(org-agenda-dimmed-todo-face ((,class (:background ,nord13))))
|
||||
`(org-block ((,class (:foreground ,nord4))))
|
||||
`(org-block-background ((,class (:background ,nord0))))
|
||||
`(org-block-begin-line ((,class (:foreground ,nord7))))
|
||||
`(org-block-end-line ((,class (:foreground ,nord7))))
|
||||
`(org-checkbox ((,class (:foreground ,nord9))))
|
||||
`(org-checkbox-statistics-done ((,class (:foreground ,nord14))))
|
||||
`(org-checkbox-statistics-todo ((,class (:foreground ,nord13))))
|
||||
`(org-code ((,class (:foreground ,nord7))))
|
||||
`(org-column ((,class (:background ,nord2))))
|
||||
`(org-column-title ((,class (:inherit org-column :weight bold :underline t))))
|
||||
`(org-date ((,class (:foreground ,nord8))))
|
||||
`(org-document-info ((,class (:foreground ,nord4))))
|
||||
`(org-document-info-keyword ((,class (:foreground ,nord3 :weight bold))))
|
||||
`(org-document-title ((,class (:foreground ,nord8 :weight bold))))
|
||||
`(org-done ((,class (:foreground ,nord14 :weight bold))))
|
||||
`(org-ellipsis ((,class (:foreground ,nord3))))
|
||||
`(org-footnote ((,class (:foreground ,nord8))))
|
||||
`(org-formula ((,class (:foreground ,nord9))))
|
||||
`(org-hide ((,class (:foreground ,nord0 :background ,nord0))))
|
||||
`(org-link ((,class (:underline t))))
|
||||
`(org-scheduled ((,class (:foreground ,nord14))))
|
||||
`(org-scheduled-previously ((,class (:foreground ,nord13))))
|
||||
`(org-scheduled-today ((,class (:foreground ,nord8))))
|
||||
`(org-special-keyword ((,class (:foreground ,nord9))))
|
||||
`(org-table ((,class (:foreground ,nord9))))
|
||||
`(org-todo ((,class (:foreground ,nord13 :weight bold))))
|
||||
`(org-upcoming-deadline ((,class (:foreground ,nord12))))
|
||||
`(org-warning ((,class (:foreground ,nord13 :weight bold))))
|
||||
`(font-latex-bold-face ((,class (:inherit bold))))
|
||||
`(font-latex-italic-face ((,class (:slant italic))))
|
||||
`(font-latex-string-face ((,class (:foreground ,nord14))))
|
||||
`(font-latex-match-reference-keywords ((,class (:foreground ,nord9))))
|
||||
`(font-latex-match-variable-keywords ((,class (:foreground ,nord4))))
|
||||
`(ido-only-match ((,class (:foreground ,nord8))))
|
||||
`(org-sexp-date ((,class (:foreground ,nord7))))
|
||||
`(ido-first-match ((,class (:foreground ,nord8 :weight bold))))
|
||||
`(ido-subdir ((,class (:foreground ,nord9))))
|
||||
`(org-quote ((,class (:inherit org-block :slant italic))))
|
||||
`(org-verse ((,class (:inherit org-block :slant italic))))
|
||||
`(org-agenda-date-weekend ((,class (:foreground ,nord9))))
|
||||
`(org-agenda-date-today ((,class (:foreground ,nord8 :weight bold))))
|
||||
`(org-agenda-done ((,class (:foreground ,nord14))))
|
||||
`(org-verbatim ((,class (:foreground ,nord7))))))
|
||||
|
||||
;;;###autoload
|
||||
(when (and (boundp 'custom-theme-load-path) load-file-name)
|
||||
(add-to-list 'custom-theme-load-path
|
||||
(file-name-as-directory (file-name-directory load-file-name))))
|
||||
|
||||
(provide-theme 'nord)
|
||||
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; indent-tabs-mode: nil
|
||||
;; End:
|
||||
|
||||
;;; nord-theme.el ends here
|
||||
33
elpa/ob-http-20180707.1448/ob-http-autoloads.el
Normal file
33
elpa/ob-http-20180707.1448/ob-http-autoloads.el
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
;;; ob-http-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "ob-http" "ob-http.el" (0 0 0 0))
|
||||
;;; Generated autoloads from ob-http.el
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-http" '("org-babel-" "ob-http")))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "ob-http-mode" "ob-http-mode.el" (0 0 0 0))
|
||||
;;; Generated autoloads from ob-http-mode.el
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-http-mode" '("ob-http-mode")))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("ob-http-pkg.el") (0 0 0 0))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; ob-http-autoloads.el ends here
|
||||
66
elpa/ob-http-20180707.1448/ob-http-mode.el
Normal file
66
elpa/ob-http-20180707.1448/ob-http-mode.el
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
;;; ob-http-mode.el --- syntax highlight for ob-http
|
||||
|
||||
;; Copyright (C) 2015 Feng Zhou
|
||||
|
||||
;; 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/>.
|
||||
|
||||
(require 's)
|
||||
|
||||
(setq ob-http-mode-keywords
|
||||
(let* ((ob-http-methods
|
||||
'(GET POST PUT PATCH DELETE OPTIONS HEAD TRACE CONNECT))
|
||||
(ob-http-headers
|
||||
'(Accept Accept-Charset Accept-Encoding Accept-Language
|
||||
Accept-Datetime Authorization Cache-Control
|
||||
Connection Cookie Content-Length Content-MD5
|
||||
Content-Type Date Expect From Host If-Match
|
||||
If-Modified-Since If-None-Match If-Range
|
||||
If-Unmodified-Since Max-Forwards Origin Pragma
|
||||
Proxy-Authorization Range Referer TE User-Agent
|
||||
Upgrade Via Warning))
|
||||
(ob-http-methods-regexp
|
||||
(rx-to-string
|
||||
`(seq
|
||||
bol
|
||||
(? (1+ space))
|
||||
(group-n 1 (or ,@(mapcar 'symbol-name ob-http-methods)))
|
||||
space
|
||||
(group-n 2 (1+ any))
|
||||
eol)))
|
||||
(ob-http-headers-regexp
|
||||
(rx-to-string
|
||||
`(seq
|
||||
bol
|
||||
(? (1+ space))
|
||||
(group-n 1 (or ,@(mapcar 'symbol-name ob-http-headers)))
|
||||
": "
|
||||
(group-n 2 (1+ any))
|
||||
eol)))
|
||||
(ob-http-custom-headers-regexp
|
||||
"\\(^X-[^ :]+\\): \\(.*\\)$")
|
||||
(ob-http-variable-regexp
|
||||
"\\([^ ?&=\n]+\\)=\\([^&\n]*\\)")
|
||||
(ob-http-misc-regexp
|
||||
"\\(&\\|=\\|?\\|{\\|}\\|\\[\\|\\]\\|\\,\\|:\\)"))
|
||||
`((,ob-http-headers-regexp (1 font-lock-variable-name-face) (2 font-lock-string-face))
|
||||
(,ob-http-custom-headers-regexp (1 font-lock-variable-name-face) (2 font-lock-string-face))
|
||||
(,ob-http-variable-regexp (1 font-lock-variable-name-face) (2 font-lock-string-face))
|
||||
(,ob-http-methods-regexp (1 font-lock-constant-face) (2 font-lock-function-name-face))
|
||||
(,ob-http-misc-regexp (1 font-lock-comment-face)))))
|
||||
|
||||
(define-derived-mode ob-http-mode fundamental-mode "ob http"
|
||||
(set (make-local-variable 'font-lock-defaults) '(ob-http-mode-keywords)))
|
||||
|
||||
(provide 'ob-http-mode)
|
||||
;;; ob-http-mode.el ends here
|
||||
BIN
elpa/ob-http-20180707.1448/ob-http-mode.elc
Normal file
BIN
elpa/ob-http-20180707.1448/ob-http-mode.elc
Normal file
Binary file not shown.
11
elpa/ob-http-20180707.1448/ob-http-pkg.el
Normal file
11
elpa/ob-http-20180707.1448/ob-http-pkg.el
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
(define-package "ob-http" "20180707.1448" "http request in org-mode babel"
|
||||
'((s "1.9.0")
|
||||
(cl-lib "0.5"))
|
||||
:authors
|
||||
'(("ZHOU Feng" . "zf.pascal@gmail.com"))
|
||||
:maintainer
|
||||
'("ZHOU Feng" . "zf.pascal@gmail.com")
|
||||
:url "http://github.com/zweifisch/ob-http")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
287
elpa/ob-http-20180707.1448/ob-http.el
Normal file
287
elpa/ob-http-20180707.1448/ob-http.el
Normal file
|
|
@ -0,0 +1,287 @@
|
|||
;;; ob-http.el --- http request in org-mode babel
|
||||
|
||||
;; Copyright (C) 2015 Feng Zhou
|
||||
|
||||
;; Author: ZHOU Feng <zf.pascal@gmail.com>
|
||||
;; URL: http://github.com/zweifisch/ob-http
|
||||
;; Version: 0.0.1
|
||||
;; Package-Requires: ((s "1.9.0") (cl-lib "0.5"))
|
||||
|
||||
;; 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:
|
||||
;;
|
||||
;; http request in org-mode babel
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
(require 's)
|
||||
(require 'subr-x)
|
||||
(require 'json)
|
||||
(require 'ob-http-mode)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defconst org-babel-header-args:http
|
||||
'((pretty . :any)
|
||||
(proxy . :any)
|
||||
(noproxy . :any)
|
||||
(curl . :any)
|
||||
(cookie . :any)
|
||||
(schema . :any)
|
||||
(host . :any)
|
||||
(port . :any)
|
||||
(user . :any)
|
||||
(username . :any) ;; deprecated, use user instead
|
||||
(password . :any) ;; deprecated
|
||||
(follow-redirect . :any)
|
||||
(path-prefix . :any)
|
||||
(resolve . :any)
|
||||
(max-time . :any))
|
||||
"http header arguments")
|
||||
|
||||
(defgroup ob-http nil
|
||||
"org-mode blocks for http request"
|
||||
:group 'org)
|
||||
|
||||
(defcustom ob-http:max-time 10
|
||||
"maximum time in seconds that you allow the whole operation to take"
|
||||
:group 'ob-http
|
||||
:type 'integer)
|
||||
|
||||
(defcustom ob-http:remove-cr nil
|
||||
"remove carriage return from header"
|
||||
:group 'ob-http
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom ob-http:curl-custom-arguments nil
|
||||
"List of custom headers that shall be added to each curl request"
|
||||
:group 'ob-http
|
||||
:type '(repeat (string :format "%v")))
|
||||
|
||||
(cl-defstruct ob-http-request method url headers body)
|
||||
(cl-defstruct ob-http-response headers body headers-map)
|
||||
|
||||
(defun ob-http-parse-request (input)
|
||||
(let* ((headers-body (ob-http-split-header-body input))
|
||||
(headers (s-split-up-to "\\(\r\n\\|[\n\r]\\)" (car headers-body) 1))
|
||||
(method-url (split-string (car headers) " ")))
|
||||
(make-ob-http-request
|
||||
:method (car method-url)
|
||||
:url (cadr method-url)
|
||||
:headers (if (cadr headers) (s-lines (cadr headers)))
|
||||
:body (cadr headers-body))))
|
||||
|
||||
(defun ob-http-parse-response (response)
|
||||
(let* ((headers-body (ob-http-split-header-body response))
|
||||
(headers-map (mapcar 'ob-http-parse-header (s-lines (car headers-body)))))
|
||||
(make-ob-http-response
|
||||
:headers (car headers-body)
|
||||
:body (cadr headers-body)
|
||||
:headers-map headers-map)))
|
||||
|
||||
(defun ob-http-split-header-body (input)
|
||||
(let ((splited (s-split-up-to "\\(\r\n\\|[\n\r]\\)[ \t]*\\1" input 1)))
|
||||
(if (and (string-match "^HTTP/\\(1.[0-1]\\|2\\) \\(30\\|100\\)" (car splited))
|
||||
(string-match "^HTTP/\\(1.[0-1]\\|2\\)" (cadr splited)))
|
||||
(ob-http-split-header-body (cadr splited))
|
||||
splited)))
|
||||
|
||||
(defun ob-http-parse-header (line)
|
||||
(let ((key-value (s-split-up-to ": " line 1)))
|
||||
`(,(s-downcase (car key-value)) . ,(cadr key-value))))
|
||||
|
||||
(defun ob-http-parse-content-type (content-type)
|
||||
(when content-type
|
||||
(cond
|
||||
((string-match "json" content-type) 'json)
|
||||
((string-match "html" content-type) 'html)
|
||||
((string-match "xml" content-type) 'xml))))
|
||||
|
||||
(defun ob-http-shell-command-to-string (command input)
|
||||
(with-temp-buffer
|
||||
(insert input)
|
||||
(shell-command-on-region (point-min) (point-max) command nil 't)
|
||||
(buffer-string)))
|
||||
|
||||
(defun ob-http-pretty-json (str)
|
||||
(if (executable-find "jq")
|
||||
(ob-http-shell-command-to-string "jq -r ." str)
|
||||
(with-temp-buffer
|
||||
(insert str)
|
||||
(json-pretty-print-buffer)
|
||||
(buffer-string))))
|
||||
|
||||
(defun ob-http-pretty-xml (str)
|
||||
(cond
|
||||
((executable-find "xml_pp") (ob-http-shell-command-to-string "xml_pp" str))
|
||||
((executable-find "xmlstarlet") (ob-http-shell-command-to-string "xmlstarlet fo" str))
|
||||
(t str)))
|
||||
|
||||
(defun ob-http-pretty-html (str)
|
||||
(cond
|
||||
((executable-find "elinks") (ob-http-shell-command-to-string "elinks -dump" str))
|
||||
((executable-find "tidy") (ob-http-shell-command-to-string "tidy -i -raw -q 2> /dev/null" str))
|
||||
((executable-find "pup") (ob-http-shell-command-to-string "pup -p" str))
|
||||
(t str)))
|
||||
|
||||
(defun ob-http-pretty (body content-type)
|
||||
(if (string= "" body)
|
||||
body
|
||||
(cl-case (ob-http-parse-content-type content-type)
|
||||
(json (ob-http-pretty-json body))
|
||||
(xml (ob-http-pretty-xml body))
|
||||
(html (ob-http-pretty-html body))
|
||||
(otherwise body))))
|
||||
|
||||
(defun ob-http-pretty-response (response content-type)
|
||||
(setf (ob-http-response-body response)
|
||||
(ob-http-pretty (ob-http-response-body response)
|
||||
(if (member content-type '("yes" nil))
|
||||
(ob-http-get-response-header response "content-type")
|
||||
content-type))))
|
||||
|
||||
(defun ob-http-select (response path)
|
||||
(let ((content-type (ob-http-parse-content-type
|
||||
(ob-http-get-response-header response "content-type")))
|
||||
(body (ob-http-response-body response)))
|
||||
(cond
|
||||
((and (eq 'json content-type) (executable-find "jq"))
|
||||
(ob-http-shell-command-to-string (format "jq -r \"%s\"" path) body))
|
||||
((and (eq 'html content-type) (executable-find "pup"))
|
||||
(ob-http-shell-command-to-string (format "pup -p \"%s\"" path) body))
|
||||
((and (eq 'xml content-type) (executable-find "xmlstarlet"))
|
||||
(ob-http-shell-command-to-string (format "xmlstarlet sel -t -c '%s' | xmlstarlet fo -o" path) body))
|
||||
(t body))))
|
||||
|
||||
(defun org-babel-expand-body:http (body params)
|
||||
(s-format body 'ob-http-aget
|
||||
(mapcar (lambda (x) (when (eq (car x) :var) (cdr x))) params)))
|
||||
|
||||
(defun ob-http-get-response-header (response header)
|
||||
(cdr (assoc (s-downcase header) (ob-http-response-headers-map response))))
|
||||
|
||||
(defun ob-http-remove-carriage-return (response)
|
||||
(setf (ob-http-response-headers response)
|
||||
(s-join "\n" (s-lines (ob-http-response-headers response))))
|
||||
response)
|
||||
|
||||
(defun ob-http-flatten (l)
|
||||
(cond
|
||||
((null l) nil)
|
||||
((atom l) (list l))
|
||||
(t
|
||||
(append (ob-http-flatten (car l)) (ob-http-flatten (cdr l))))))
|
||||
|
||||
(defun ob-http-aget (key alist)
|
||||
(assoc-default (intern key) alist))
|
||||
|
||||
(defun ob-http-construct-url (path params)
|
||||
(if (s-starts-with? "/" path)
|
||||
(s-concat
|
||||
(format "%s://" (or (assoc-default :schema params) "http"))
|
||||
(assoc-default :host params)
|
||||
(when (assoc :port params)
|
||||
(format ":%s" (assoc-default :port params)))
|
||||
(assoc-default :path-prefix params)
|
||||
path)
|
||||
path))
|
||||
|
||||
(defun ob-http-file (response filename)
|
||||
(let ((body (ob-http-response-body response)))
|
||||
(with-temp-file filename
|
||||
(insert body))))
|
||||
|
||||
(defun org-babel-execute:http (body params)
|
||||
(let* ((request (ob-http-parse-request (org-babel-expand-body:http body params)))
|
||||
(proxy (cdr (assoc :proxy params)))
|
||||
(noproxy (assoc :noproxy params))
|
||||
(follow-redirect (and (assoc :follow-redirect params) (not (string= "no" (cdr (assoc :follow-redirect params))))))
|
||||
(pretty (assoc :pretty params))
|
||||
(prettify (and pretty (not (string= (cdr pretty) "no"))))
|
||||
(file (assoc :file params))
|
||||
(get-header (cdr (assoc :get-header params)))
|
||||
(cookie-jar (cdr (assoc :cookie-jar params)))
|
||||
(cookie (cdr (assoc :cookie params)))
|
||||
(curl (cdr (assoc :curl params)))
|
||||
(select (cdr (assoc :select params)))
|
||||
(resolve (cdr (assoc :resolve params)))
|
||||
(request-body (ob-http-request-body request))
|
||||
(error-output (org-babel-temp-file "curl-error"))
|
||||
(args (append ob-http:curl-custom-arguments (list "-i"
|
||||
(when (and proxy (not noproxy)) `("-x" ,proxy))
|
||||
(when noproxy '("--noproxy" "*"))
|
||||
(let ((method (ob-http-request-method request)))
|
||||
(if (string= "HEAD" method) "-I" `("-X" ,method)))
|
||||
(when follow-redirect "-L")
|
||||
(when (and (assoc :username params) (assoc :password params))
|
||||
`("--user" ,(s-format "${:username}:${:password}" 'ob-http-aget params)))
|
||||
(when (assoc :user params) `("--user" ,(cdr (assoc :user params))))
|
||||
(mapcar (lambda (x) `("-H" ,x)) (ob-http-request-headers request))
|
||||
(when (s-present? request-body)
|
||||
(let ((tmp (org-babel-temp-file "http-")))
|
||||
(with-temp-file tmp (insert request-body))
|
||||
`("-d" ,(format "@%s" tmp))))
|
||||
(when cookie-jar `("--cookie-jar" ,cookie-jar))
|
||||
(when cookie `("--cookie" ,cookie))
|
||||
(when resolve (mapcar (lambda (x) `("--resolve" ,x)) (split-string resolve ",")))
|
||||
(when curl (split-string-and-unquote curl))
|
||||
"--max-time"
|
||||
(int-to-string (or (cdr (assoc :max-time params))
|
||||
ob-http:max-time))
|
||||
"--globoff"
|
||||
(ob-http-construct-url (ob-http-request-url request) params)))))
|
||||
(with-current-buffer (get-buffer-create "*curl commands history*")
|
||||
(goto-char (point-max))
|
||||
(insert "curl "
|
||||
(string-join (mapcar 'shell-quote-argument (ob-http-flatten args)) " ")
|
||||
"\n"))
|
||||
(with-current-buffer (get-buffer-create "*curl output*")
|
||||
(erase-buffer)
|
||||
(if (= 0 (apply 'call-process "curl" nil `(t ,error-output) nil (ob-http-flatten args)))
|
||||
(let ((response (ob-http-parse-response (buffer-string))))
|
||||
(when prettify (ob-http-pretty-response response (cdr pretty)))
|
||||
(when ob-http:remove-cr (ob-http-remove-carriage-return response))
|
||||
(cond (get-header (ob-http-get-response-header response get-header))
|
||||
(select (ob-http-select response select))
|
||||
(prettify (ob-http-response-body response))
|
||||
(file (ob-http-file response (cdr file)))
|
||||
(t (s-join "\n\n" (list (ob-http-response-headers response) (ob-http-response-body response))))))
|
||||
(with-output-to-temp-buffer "*curl error*"
|
||||
(princ (with-temp-buffer
|
||||
(insert-file-contents-literally error-output)
|
||||
(s-join "\n" (s-lines (buffer-string)))))
|
||||
"")))))
|
||||
|
||||
(defun ob-http-export-expand-variables (&optional backend)
|
||||
"Scan current buffer for all HTTP source code blocks and expand variables.
|
||||
|
||||
Add this function to `org-export-before-processing-hook' to
|
||||
enable variable expansion before source block is exported."
|
||||
(let ((case-fold-search t) elt replacement)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (search-forward-regexp "^[ \t]*#\\+begin_src[ \t]+http" nil 'noerror)
|
||||
(setq elt (org-element-at-point))
|
||||
(when (eq 'src-block (car elt))
|
||||
(setq replacement (org-babel-expand-src-block))
|
||||
(goto-char (org-element-property :begin elt))
|
||||
(delete-region (org-element-property :begin elt) (org-element-property :end elt))
|
||||
(insert (org-element-interpret-data (org-element-put-property elt :value replacement))))))))
|
||||
|
||||
(eval-after-load "org"
|
||||
'(add-to-list 'org-src-lang-modes '("http" . "ob-http")))
|
||||
|
||||
(provide 'ob-http)
|
||||
;;; ob-http.el ends here
|
||||
BIN
elpa/ob-http-20180707.1448/ob-http.elc
Normal file
BIN
elpa/ob-http-20180707.1448/ob-http.elc
Normal file
Binary file not shown.
87
elpa/ob-ipython-20180224.953/client.py
Normal file
87
elpa/ob-ipython-20180224.953/client.py
Normal file
|
|
@ -0,0 +1,87 @@
|
|||
import jupyter_client as client
|
||||
import threading
|
||||
import json
|
||||
import sys
|
||||
import argparse
|
||||
|
||||
find_connection_file = client.find_connection_file
|
||||
|
||||
semaphore = threading.Semaphore(value=0)
|
||||
interested_lock = threading.Lock()
|
||||
interested = []
|
||||
|
||||
def msg_router(io, shell):
|
||||
while True:
|
||||
msg = io()
|
||||
msg['channel'] = 'io'
|
||||
msgid = msg['parent_header'].get('msg_id', None)
|
||||
with interested_lock:
|
||||
if msgid not in interested:
|
||||
continue
|
||||
print(json.dumps(msg, default=str))
|
||||
if (msg.get('msg_type', '') == 'status' and
|
||||
msg['content']['execution_state'] == 'idle'):
|
||||
break
|
||||
|
||||
while True:
|
||||
msg = shell()
|
||||
msg['channel'] = 'shell'
|
||||
msgid = msg['parent_header'].get('msg_id', None)
|
||||
with interested_lock:
|
||||
if msgid not in interested:
|
||||
continue
|
||||
print(json.dumps(msg, default=str))
|
||||
if msg.get('msg_type', '') in ['execute_reply',
|
||||
'inspect_reply',
|
||||
'complete_reply']:
|
||||
semaphore.release()
|
||||
|
||||
def create_client(name):
|
||||
if name.endswith('.json'):
|
||||
cf = find_connection_file(name)
|
||||
else:
|
||||
cf = find_connection_file('emacs-' + name)
|
||||
c = client.BlockingKernelClient(connection_file=cf)
|
||||
c.load_connection_file()
|
||||
c.start_channels()
|
||||
io, shell = c.get_iopub_msg, c.get_shell_msg
|
||||
t = threading.Thread(target=msg_router, args=(io, shell))
|
||||
t.setDaemon(True)
|
||||
t.start()
|
||||
return c
|
||||
|
||||
parser = argparse.ArgumentParser()
|
||||
parser.add_argument('--conn-file')
|
||||
parser.add_argument('--execute', action='store_true')
|
||||
parser.add_argument('--inspect', action='store_true')
|
||||
parser.add_argument('--complete', action='store_true')
|
||||
args = parser.parse_args()
|
||||
|
||||
c = create_client(args.conn_file)
|
||||
|
||||
with interested_lock:
|
||||
if args.execute:
|
||||
msgid = c.execute(sys.stdin.read(), allow_stdin=False)
|
||||
interested.append(msgid)
|
||||
|
||||
elif args.inspect:
|
||||
req = json.loads(sys.stdin.read())
|
||||
code = req['code']
|
||||
msgid = c.inspect(code,
|
||||
cursor_pos=req.get('pos', len(code)),
|
||||
detail_level=req.get('detail', 0))
|
||||
interested.append(msgid)
|
||||
|
||||
elif args.complete:
|
||||
req = json.loads(sys.stdin.read())
|
||||
code = req['code']
|
||||
pos = req.get('pos', len(code))
|
||||
# causes things to hang as kernel doesn't come back with a
|
||||
# complete_reply
|
||||
if code[pos-1] in ['\n', '\r']:
|
||||
sys.exit(0)
|
||||
msgid = c.complete(code,
|
||||
cursor_pos=pos)
|
||||
interested.append(msgid)
|
||||
|
||||
semaphore.acquire()
|
||||
26
elpa/ob-ipython-20180224.953/ob-ipython-autoloads.el
Normal file
26
elpa/ob-ipython-20180224.953/ob-ipython-autoloads.el
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
;;; ob-ipython-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "ob-ipython" "ob-ipython.el" (0 0 0 0))
|
||||
;;; Generated autoloads from ob-ipython.el
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ipython" '("ipython--async-" "ob-ipython-" "org-babel-" "company-ob-ipython")))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("ob-ipython-pkg.el") (0 0 0 0))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; ob-ipython-autoloads.el ends here
|
||||
16
elpa/ob-ipython-20180224.953/ob-ipython-pkg.el
Normal file
16
elpa/ob-ipython-20180224.953/ob-ipython-pkg.el
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
(define-package "ob-ipython" "20180224.953" "org-babel functions for IPython evaluation"
|
||||
'((s "1.9.0")
|
||||
(dash "2.10.0")
|
||||
(dash-functional "1.2.0")
|
||||
(f "0.17.2")
|
||||
(emacs "24"))
|
||||
:keywords
|
||||
'("literate programming" "reproducible research")
|
||||
:authors
|
||||
'(("Greg Sexton" . "gregsexton@gmail.com"))
|
||||
:maintainer
|
||||
'("Greg Sexton" . "gregsexton@gmail.com")
|
||||
:url "http://www.gregsexton.org")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
734
elpa/ob-ipython-20180224.953/ob-ipython.el
Normal file
734
elpa/ob-ipython-20180224.953/ob-ipython.el
Normal file
|
|
@ -0,0 +1,734 @@
|
|||
;;; ob-ipython.el --- org-babel functions for IPython evaluation
|
||||
|
||||
;; Author: Greg Sexton <gregsexton@gmail.com>
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: http://www.gregsexton.org
|
||||
;; Package-Requires: ((s "1.9.0") (dash "2.10.0") (dash-functional "1.2.0") (f "0.17.2") (emacs "24"))
|
||||
|
||||
;; The MIT License (MIT)
|
||||
|
||||
;; Copyright (c) 2015 Greg Sexton
|
||||
|
||||
;; Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
;; of this software and associated documentation files (the "Software"), to deal
|
||||
;; in the Software without restriction, including without limitation the rights
|
||||
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
;; copies of the Software, and to permit persons to whom the Software is
|
||||
;; furnished to do so, subject to the following conditions:
|
||||
|
||||
;; The above copyright notice and this permission notice shall be included in
|
||||
;; all copies or substantial portions of the Software.
|
||||
|
||||
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
|
||||
;; THE SOFTWARE.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating Python source code using IPython.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ob)
|
||||
(require 'ob-python)
|
||||
(require 'dash)
|
||||
(require 'dash-functional)
|
||||
(require 's)
|
||||
(require 'f)
|
||||
(require 'json)
|
||||
(require 'python)
|
||||
(require 'cl)
|
||||
|
||||
;; variables
|
||||
|
||||
(defcustom ob-ipython-kernel-extra-args '()
|
||||
"List of extra args to pass when creating a kernel."
|
||||
:group 'ob-ipython)
|
||||
|
||||
(defcustom ob-ipython-client-path
|
||||
(f-expand "./client.py"
|
||||
(or (-when-let (f load-file-name) (f-dirname f)) default-directory))
|
||||
"Path to the client script."
|
||||
:group 'ob-ipython)
|
||||
|
||||
(defcustom ob-ipython-command
|
||||
"jupyter"
|
||||
"Command to launch ipython. Usually ipython or jupyter."
|
||||
:group 'ob-ipython)
|
||||
|
||||
(defcustom ob-ipython-resources-dir "./obipy-resources/"
|
||||
"Directory where resources (e.g images) are stored so that they
|
||||
can be displayed.")
|
||||
|
||||
;; utils
|
||||
|
||||
(defun ob-ipython--write-string-to-file (file string)
|
||||
(if string
|
||||
(with-temp-buffer
|
||||
(let ((require-final-newline nil))
|
||||
(insert string)
|
||||
(write-file file)))
|
||||
(error "No output was produced to write to a file.")))
|
||||
|
||||
(defun ob-ipython--write-base64-string (file b64-string)
|
||||
(if b64-string
|
||||
(with-temp-buffer
|
||||
(let ((buffer-file-coding-system 'binary)
|
||||
(require-final-newline nil))
|
||||
(insert b64-string)
|
||||
(base64-decode-region (point-min) (point-max))
|
||||
(write-file file)))
|
||||
(error "No output was produced to write to a file.")))
|
||||
|
||||
(defun ob-ipython--create-traceback-buffer (traceback)
|
||||
(let ((buf (get-buffer-create "*ob-ipython-traceback*")))
|
||||
(with-current-buffer buf
|
||||
(special-mode)
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(-each traceback
|
||||
(lambda (line) (insert (format "%s\n" line))))
|
||||
(ansi-color-apply-on-region (point-min) (point-max))))
|
||||
(pop-to-buffer buf)))
|
||||
|
||||
(defun ob-ipython--create-inspect-buffer (doc)
|
||||
(let ((buf (get-buffer-create "*ob-ipython-inspect*")))
|
||||
(with-current-buffer buf
|
||||
(special-mode)
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(insert doc)
|
||||
(ansi-color-apply-on-region (point-min) (point-max))
|
||||
(whitespace-cleanup)
|
||||
(goto-char (point-min))))
|
||||
(pop-to-buffer buf)))
|
||||
|
||||
(defun ob-ipython--clear-output-buffer ()
|
||||
(let ((buf (get-buffer-create "*ob-ipython-out*")))
|
||||
(with-current-buffer buf
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)))))
|
||||
|
||||
(defun ob-ipython--output (output append-p)
|
||||
(when (not (s-blank? output))
|
||||
(let ((buf (get-buffer-create "*ob-ipython-out*")))
|
||||
(with-current-buffer buf
|
||||
(special-mode)
|
||||
(let ((inhibit-read-only t))
|
||||
(unless append-p (erase-buffer))
|
||||
(when (s-blank? (buffer-string)) (pop-to-buffer buf))
|
||||
(let ((p (point)))
|
||||
(if (= p (point-max)) ;allow tailing
|
||||
(progn (insert output)
|
||||
(-when-let (w (get-buffer-window buf 'visible))
|
||||
(set-window-point w (point-max))))
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(insert output)))
|
||||
(ansi-color-apply-on-region p (point-max))
|
||||
;; this adds some support for control chars
|
||||
(comint-carriage-motion p (point-max)))
|
||||
(unless append-p (goto-char (point-min))))))))
|
||||
|
||||
(defun ob-ipython--dump-error (err-msg)
|
||||
(with-current-buffer (get-buffer-create "*ob-ipython-debug*")
|
||||
(special-mode)
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(insert err-msg)
|
||||
(goto-char (point-min))))
|
||||
(error "There was a fatal error trying to process the request. See *ob-ipython-debug*"))
|
||||
|
||||
(defun ob-ipython--generate-file-name (suffix)
|
||||
(s-concat (make-temp-name ob-ipython-resources-dir) suffix))
|
||||
|
||||
;; process management
|
||||
|
||||
(defun ob-ipython--kernel-file (name)
|
||||
(if (s-ends-with-p ".json" name)
|
||||
name
|
||||
(format "emacs-%s.json" name)))
|
||||
|
||||
(defun ob-ipython--kernel-repl-cmd (name)
|
||||
(list ob-ipython-command "console" "--simple-prompt" "--existing"
|
||||
(ob-ipython--kernel-file name)))
|
||||
|
||||
;;; TODO: could setup a default sentinel that outputs error on process
|
||||
;;; early termination
|
||||
(defun ob-ipython--create-process (name cmd)
|
||||
(let ((buf (get-buffer-create (format "*ob-ipython-%s*" name))))
|
||||
(with-current-buffer buf (erase-buffer))
|
||||
(apply 'start-process name buf (car cmd) (cdr cmd))))
|
||||
|
||||
(defun ob-ipython--get-python ()
|
||||
(locate-file (if (eq system-type 'windows-nt)
|
||||
"python.exe"
|
||||
(or python-shell-interpreter "python"))
|
||||
exec-path))
|
||||
|
||||
(defun ob-ipython--create-kernel (name &optional kernel)
|
||||
(when (and (not (ignore-errors (process-live-p (get-process (format "kernel-%s" name)))))
|
||||
(not (s-ends-with-p ".json" name)))
|
||||
(ob-ipython--create-process
|
||||
(format "kernel-%s" name)
|
||||
(append
|
||||
(list ob-ipython-command "console" "--simple-prompt")
|
||||
(list "-f" (ob-ipython--kernel-file name))
|
||||
(if kernel (list "--kernel" kernel) '())
|
||||
;;should be last in the list of args
|
||||
ob-ipython-kernel-extra-args))
|
||||
(sleep-for 1)))
|
||||
|
||||
(defun ob-ipython--get-kernel-processes ()
|
||||
(let ((procs (-filter (lambda (p)
|
||||
(s-starts-with? "kernel-" (process-name p)))
|
||||
(process-list))))
|
||||
(-zip (-map (-compose (-partial 's-replace "kernel-" "")
|
||||
'process-name)
|
||||
procs)
|
||||
procs)))
|
||||
|
||||
(defun ob-ipython--create-repl (name)
|
||||
(let ((python-shell-completion-native-enable nil)
|
||||
(cmd (s-join " " (ob-ipython--kernel-repl-cmd name))))
|
||||
(if (string= "default" name)
|
||||
(progn
|
||||
(run-python cmd nil nil)
|
||||
(format "*%s*" python-shell-buffer-name))
|
||||
(let ((process-name (format "Python:%s" name)))
|
||||
(get-buffer-process
|
||||
(python-shell-make-comint cmd process-name nil))
|
||||
(format "*%s*" process-name)))))
|
||||
|
||||
;; kernel management
|
||||
|
||||
(defun ob-ipython--choose-kernel ()
|
||||
(let ((procs (ob-ipython--get-kernel-processes)))
|
||||
(-> (ido-completing-read "kernel? " (-map 'car procs) nil t)
|
||||
(assoc procs)
|
||||
cdr
|
||||
list)))
|
||||
|
||||
;;; TODO: make this work on windows
|
||||
;;; NOTE: interrupting remote kernel not currently possible, cf https://github.com/jupyter/jupyter_console/issues/150
|
||||
(defun ob-ipython-interrupt-kernel (proc)
|
||||
"Interrupt a running kernel. Useful for terminating infinite
|
||||
loops etc. If things get really desparate try `ob-ipython-kill-kernel'."
|
||||
(interactive (ob-ipython--choose-kernel))
|
||||
(when proc
|
||||
;; send SIGINT to "python -m ipykernel_launcher", a child of proc
|
||||
(let ((proc-name (process-name proc)))
|
||||
(accept-process-output
|
||||
;; get the child pid with pgrep -P
|
||||
;; NOTE assumes proc has only 1 child (seems to be true always)
|
||||
(make-process
|
||||
:name (concat proc-name "-child")
|
||||
:command (list "pgrep" "-P" (number-to-string
|
||||
(process-id proc)))
|
||||
;; send SIGINT to child-proc
|
||||
:filter
|
||||
(lambda (proc child-proc-id)
|
||||
(make-process
|
||||
:name (concat "interrupt-" proc-name)
|
||||
:command (list "kill" "-2"
|
||||
(string-trim child-proc-id)))))))))
|
||||
|
||||
(defun ob-ipython-kill-kernel (proc)
|
||||
"Kill a kernel process. If you then re-evaluate a source block
|
||||
a new kernel will be started."
|
||||
(interactive (ob-ipython--choose-kernel))
|
||||
(when proc
|
||||
(delete-process proc)
|
||||
(message (format "Killed %s" (process-name proc)))))
|
||||
|
||||
;; evaluation
|
||||
|
||||
(defvar ob-ipython--async-queue nil)
|
||||
|
||||
(defun ob-ipython--enqueue (q x)
|
||||
(set q (append (symbol-value q) (list x))))
|
||||
|
||||
(defun ob-ipython--dequeue (q)
|
||||
(let ((ret (car (symbol-value q))))
|
||||
(set q (cdr (symbol-value q)))
|
||||
ret))
|
||||
|
||||
(defun ob-ipython--collect-json ()
|
||||
;; this function assumes that we're in a buffer with the json lines
|
||||
(let ((json-array-type 'list))
|
||||
(let (acc)
|
||||
(while (not (= (point) (point-max)))
|
||||
(setq acc (cons (json-read) acc))
|
||||
(forward-line))
|
||||
(nreverse acc))))
|
||||
|
||||
(defun ob-ipython--running-p ()
|
||||
(get-process "execute"))
|
||||
|
||||
(defun ob-ipython--run-async (code name callback args)
|
||||
(let ((proc (ob-ipython--create-process
|
||||
"execute"
|
||||
(list (ob-ipython--get-python)
|
||||
"--" ob-ipython-client-path "--conn-file" name "--execute"))))
|
||||
;; TODO: maybe add a way of disabling streaming output?
|
||||
;; TODO: cleanup and break out - we parse twice, can we parse once?
|
||||
(set-process-filter
|
||||
proc
|
||||
(lexical-let ((parse-pos 0))
|
||||
(lambda (proc output)
|
||||
;; not guaranteed to be given lines - we need to handle buffering
|
||||
(with-current-buffer (process-buffer proc)
|
||||
(goto-char (point-max))
|
||||
(insert output)
|
||||
(let ((json-array-type 'list))
|
||||
(goto-char parse-pos)
|
||||
(while (not (= (point) (point-max)))
|
||||
(condition-case nil
|
||||
(progn (-> (json-read)
|
||||
list
|
||||
ob-ipython--extract-output
|
||||
(ob-ipython--output t))
|
||||
(forward-line)
|
||||
(setq parse-pos (point)))
|
||||
(error (goto-char (point-max))))))))))
|
||||
(set-process-sentinel
|
||||
proc
|
||||
(lexical-let ((callback callback)
|
||||
(args args))
|
||||
(lambda (proc state)
|
||||
(when (not (process-live-p proc))
|
||||
(with-current-buffer (process-buffer proc)
|
||||
(goto-char (point-min))
|
||||
(apply callback (-> (ob-ipython--collect-json)
|
||||
ob-ipython--eval
|
||||
(cons args))))
|
||||
(ob-ipython--maybe-run-async)))))
|
||||
(process-send-string proc code)
|
||||
(process-send-string proc "\n")
|
||||
(process-send-eof proc)))
|
||||
|
||||
(defun ob-ipython--maybe-run-async ()
|
||||
(when (not (ob-ipython--running-p))
|
||||
(when-let (val (ob-ipython--dequeue 'ob-ipython--async-queue))
|
||||
(cl-destructuring-bind (code name callback args) val
|
||||
(ob-ipython--run-async code name callback args)))))
|
||||
|
||||
(defun ob-ipython--execute-request-async (code name callback args)
|
||||
(ob-ipython--enqueue 'ob-ipython--async-queue (list code name callback args))
|
||||
(ob-ipython--maybe-run-async))
|
||||
|
||||
(defun ob-ipython--execute-request (code name)
|
||||
(with-temp-buffer
|
||||
(let ((ret (apply 'call-process-region code nil
|
||||
(ob-ipython--get-python) nil t nil
|
||||
(list "--" ob-ipython-client-path "--conn-file" name "--execute"))))
|
||||
(if (> ret 0)
|
||||
(ob-ipython--dump-error (buffer-string))
|
||||
(goto-char (point-min))
|
||||
(ob-ipython--collect-json)))))
|
||||
|
||||
(defun ob-ipython--extract-output (msgs)
|
||||
(->> msgs
|
||||
(-filter (lambda (msg) (string= "stream" (cdr (assoc 'msg_type msg)))))
|
||||
(-filter (lambda (msg) (-contains? '("stdout" "stderr")
|
||||
(->> msg (assoc 'content)
|
||||
(assoc 'name)
|
||||
cdr))))
|
||||
(-map (lambda (msg) (->> msg (assoc 'content) (assoc 'text) cdr)))
|
||||
(-reduce 's-concat)))
|
||||
|
||||
(defun ob-ipython--extract-result (msgs)
|
||||
`((:value . ,(->> msgs
|
||||
(-filter (lambda (msg)
|
||||
(s-equals? "execute_result"
|
||||
(cdr (assoc 'msg_type msg)))))
|
||||
(-mapcat (lambda (msg)
|
||||
(->> msg (assoc 'content) (assoc 'data) cdr)))))
|
||||
(:display . ,(->> msgs
|
||||
(-filter (lambda (msg)
|
||||
(s-equals? "display_data"
|
||||
(cdr (assoc 'msg_type msg)))))
|
||||
(-mapcat (lambda (msg)
|
||||
(->> msg (assoc 'content) (assoc 'data) cdr)))))))
|
||||
|
||||
(defun ob-ipython--extract-error (msgs)
|
||||
(let ((error-content
|
||||
(->> msgs
|
||||
(-filter (lambda (msg) (-contains? '("execute_reply" "inspect_reply")
|
||||
(cdr (assoc 'msg_type msg)))))
|
||||
car
|
||||
(assoc 'content)
|
||||
cdr)))
|
||||
;; TODO: this doesn't belong in this abstraction
|
||||
(ob-ipython--create-traceback-buffer (cdr (assoc 'traceback error-content)))
|
||||
(format "%s: %s" (cdr (assoc 'ename error-content)) (cdr (assoc 'evalue error-content)))))
|
||||
|
||||
(defun ob-ipython--extract-status (msgs)
|
||||
(->> msgs
|
||||
(-filter (lambda (msg) (-contains? '("execute_reply" "inspect_reply" "complete_reply")
|
||||
(cdr (assoc 'msg_type msg)))))
|
||||
car
|
||||
(assoc 'content)
|
||||
(assoc 'status)
|
||||
cdr))
|
||||
|
||||
(defun ob-ipython--extract-execution-count (msgs)
|
||||
(->> msgs
|
||||
(-filter (lambda (msg) (-contains? '("execute_reply")
|
||||
(cdr (assoc 'msg_type msg)))))
|
||||
car
|
||||
(assoc 'content)
|
||||
(assoc 'execution_count)
|
||||
cdr))
|
||||
|
||||
(defun ob-ipython--eval (service-response)
|
||||
(let ((status (ob-ipython--extract-status service-response)))
|
||||
(cond ((string= "ok" status) `((:result . ,(ob-ipython--extract-result service-response))
|
||||
(:output . ,(ob-ipython--extract-output service-response))
|
||||
(:exec-count . ,(ob-ipython--extract-execution-count service-response))))
|
||||
((string= "abort" status) (error "Kernel execution aborted."))
|
||||
((string= "error" status) (error (ob-ipython--extract-error service-response))))))
|
||||
|
||||
;; inspection
|
||||
|
||||
(defun ob-ipython--inspect-request (code &optional pos detail)
|
||||
(let ((input (json-encode `((code . ,code)
|
||||
(pos . ,(or pos (length code)))
|
||||
(detail . ,(or detail 0)))))
|
||||
(args (list "--" ob-ipython-client-path
|
||||
"--conn-file"
|
||||
(ob-ipython--get-session-from-edit-buffer (current-buffer))
|
||||
"--inspect")))
|
||||
(with-temp-buffer
|
||||
(let ((ret (apply 'call-process-region input nil
|
||||
(ob-ipython--get-python) nil t nil
|
||||
args)))
|
||||
(if (> ret 0)
|
||||
(ob-ipython--dump-error (buffer-string))
|
||||
(goto-char (point-min))
|
||||
(ob-ipython--collect-json))))))
|
||||
|
||||
(defun ob-ipython--inspect (code pos)
|
||||
"Given a piece of code and a point position, return inspection results."
|
||||
(let* ((resp (ob-ipython--inspect-request code pos 0))
|
||||
(status (ob-ipython--extract-status resp)))
|
||||
(if (string= "ok" status)
|
||||
(->> resp
|
||||
(-filter (lambda (msg)
|
||||
(-contains? '("execute_result" "display_data" "inspect_reply")
|
||||
(cdr (assoc 'msg_type msg)))))
|
||||
(-mapcat (lambda (msg)
|
||||
(->> msg
|
||||
(assoc 'content)
|
||||
(assoc 'data)
|
||||
cdr))))
|
||||
(error (ob-ipython--extract-error resp)))))
|
||||
|
||||
(defun ob-ipython-inspect (buffer pos)
|
||||
"Ask a kernel for documentation on the thing at POS in BUFFER."
|
||||
(interactive (list (current-buffer) (point)))
|
||||
(let ((code (with-current-buffer buffer
|
||||
(buffer-substring-no-properties (point-min) (point-max)))))
|
||||
(-if-let (result (->> (ob-ipython--inspect code pos)
|
||||
(assoc 'text/plain)
|
||||
cdr))
|
||||
(ob-ipython--create-inspect-buffer result)
|
||||
(message "No documentation was found."))))
|
||||
|
||||
;; completion
|
||||
|
||||
(defun ob-ipython--complete-request (code &optional pos)
|
||||
(let ((input (json-encode `((code . ,code)
|
||||
(pos . ,(or pos (length code))))))
|
||||
(args (list "--" ob-ipython-client-path "--conn-file"
|
||||
(ob-ipython--get-session-from-edit-buffer (current-buffer))
|
||||
"--complete")))
|
||||
(with-temp-buffer
|
||||
(let ((ret (apply 'call-process-region input nil
|
||||
(ob-ipython--get-python) nil t nil
|
||||
args)))
|
||||
(if (> ret 0)
|
||||
(ob-ipython--dump-error (buffer-string))
|
||||
(goto-char (point-min))
|
||||
(ob-ipython--collect-json))))))
|
||||
|
||||
(defun ob-ipython-completions (buffer pos)
|
||||
"Ask a kernel for completions on the thing at POS in BUFFER."
|
||||
(let* ((code (with-current-buffer buffer
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
(resp (ob-ipython--complete-request code pos))
|
||||
(status (ob-ipython--extract-status resp)))
|
||||
(if (not (string= "ok" status))
|
||||
'()
|
||||
(->> resp
|
||||
(-filter (lambda (msg)
|
||||
(-contains? '("complete_reply")
|
||||
(cdr (assoc 'msg_type msg)))))
|
||||
(-mapcat (lambda (msg)
|
||||
(->> msg
|
||||
(assoc 'content)
|
||||
cdr)))))))
|
||||
|
||||
(defun ob-ipython--company-doc-buffer (doc)
|
||||
"Make company-suggested doc-buffer with ansi-color support."
|
||||
(let ((buf (company-doc-buffer doc)))
|
||||
(with-current-buffer buf
|
||||
(ansi-color-apply-on-region (point-min) (point-max)))
|
||||
buf))
|
||||
|
||||
(defun company-ob-ipython (command &optional arg &rest ignored)
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-ob-ipython))
|
||||
(prefix (and ob-ipython-mode
|
||||
(let ((res (ob-ipython-completions (current-buffer) (1- (point)))))
|
||||
(substring-no-properties (buffer-string)
|
||||
(cdr (assoc 'cursor_start res))
|
||||
(cdr (assoc 'cursor_end res))))))
|
||||
(candidates (cons :async (lambda (cb)
|
||||
(let ((res (ob-ipython-completions
|
||||
(current-buffer) (1- (point)))))
|
||||
(funcall cb (cdr (assoc 'matches res)))))))
|
||||
(sorted t)
|
||||
(doc-buffer (ob-ipython--company-doc-buffer
|
||||
(cdr (assoc 'text/plain (ob-ipython--inspect arg (length arg))))))))
|
||||
|
||||
;; mode
|
||||
|
||||
(define-minor-mode ob-ipython-mode
|
||||
""
|
||||
nil
|
||||
" ipy"
|
||||
'())
|
||||
|
||||
;; babel framework
|
||||
|
||||
(add-to-list 'org-src-lang-modes '("ipython" . python))
|
||||
(add-hook 'org-mode-hook 'ob-ipython-auto-configure-kernels)
|
||||
|
||||
(defvar ob-ipython-configured-kernels nil)
|
||||
|
||||
(defun ob-ipython--get-kernels ()
|
||||
"Return a list of available jupyter kernels and their corresponding languages.
|
||||
The elements of the list have the form (\"kernel\" \"language\")."
|
||||
(and ob-ipython-command
|
||||
(let ((kernelspecs (cdar (json-read-from-string
|
||||
(shell-command-to-string
|
||||
(s-concat ob-ipython-command " kernelspec list --json"))))))
|
||||
(-map (lambda (spec)
|
||||
(cons (symbol-name (car spec))
|
||||
(->> (cdr spec)
|
||||
(assoc 'spec)
|
||||
cdr
|
||||
(assoc 'language)
|
||||
cdr)))
|
||||
kernelspecs))))
|
||||
|
||||
(defun ob-ipython--configure-kernel (kernel-lang)
|
||||
"Configure org mode to use specified kernel."
|
||||
(let* ((kernel (car kernel-lang))
|
||||
(language (cdr kernel-lang))
|
||||
(jupyter-lang (concat "jupyter-" language))
|
||||
(mode (intern (or (cdr (assoc language org-src-lang-modes))
|
||||
(replace-regexp-in-string "[0-9]*" "" language))))
|
||||
(header-args (intern (concat "org-babel-default-header-args:" jupyter-lang))))
|
||||
(add-to-list 'org-src-lang-modes `(,jupyter-lang . ,mode))
|
||||
;; Only set defaults if the corresponding variable is nil or does not
|
||||
;; exist yet.
|
||||
(unless (and (boundp header-args) (symbol-value header-args))
|
||||
(set (intern (concat "org-babel-default-header-args:" jupyter-lang))
|
||||
`((:session . ,language)
|
||||
(:kernel . ,kernel))))
|
||||
(defalias (intern (concat "org-babel-execute:" jupyter-lang))
|
||||
'org-babel-execute:ipython)
|
||||
(defalias (intern (concat "org-babel-" jupyter-lang "-initiate-session"))
|
||||
'org-babel-ipython-initiate-session)
|
||||
kernel-lang))
|
||||
|
||||
(defun ob-ipython-auto-configure-kernels (&optional replace)
|
||||
"Auto-configure kernels for use with org-babel based on the
|
||||
available kernelspecs of the current jupyter installation. If
|
||||
REPLACE is non-nil, force configuring the kernels even if they
|
||||
have previously been configured."
|
||||
(interactive (list t))
|
||||
(when (or replace (not ob-ipython-configured-kernels))
|
||||
(setq ob-ipython-configured-kernels
|
||||
(-map 'ob-ipython--configure-kernel (ob-ipython--get-kernels)))))
|
||||
|
||||
(defvar org-babel-default-header-args:ipython '())
|
||||
|
||||
(defun org-babel-edit-prep:ipython (info)
|
||||
;; TODO: based on kernel, should change the major mode
|
||||
(ob-ipython--create-kernel (->> info (nth 2) (assoc :session) cdr
|
||||
ob-ipython--normalize-session)
|
||||
(->> info (nth 2) (assoc :kernel) cdr))
|
||||
(ob-ipython-mode +1))
|
||||
|
||||
(defun ob-ipython--normalize-session (session)
|
||||
(if (string= "default" session)
|
||||
(error "default is reserved for when no name is provided. Please use a different session name.")
|
||||
(or session "default")))
|
||||
|
||||
(defun ob-ipython--get-session-from-edit-buffer (buffer)
|
||||
(with-current-buffer buffer
|
||||
(->> org-src--babel-info
|
||||
(nth 2)
|
||||
(assoc :session)
|
||||
cdr
|
||||
ob-ipython--normalize-session)))
|
||||
|
||||
(defun org-babel-execute:ipython (body params)
|
||||
"Execute a block of IPython code with Babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(ob-ipython--clear-output-buffer)
|
||||
(if (cdr (assoc :async params))
|
||||
(ob-ipython--execute-async body params)
|
||||
(ob-ipython--execute-sync body params)))
|
||||
|
||||
(defun ob-ipython--execute-async (body params)
|
||||
(let* ((file (cdr (assoc :ipyfile params)))
|
||||
(session (cdr (assoc :session params)))
|
||||
(result-type (cdr (assoc :result-type params)))
|
||||
(sentinel (ipython--async-gen-sentinel)))
|
||||
(ob-ipython--create-kernel (ob-ipython--normalize-session session)
|
||||
(cdr (assoc :kernel params)))
|
||||
(ob-ipython--execute-request-async
|
||||
(org-babel-expand-body:generic (encode-coding-string body 'utf-8)
|
||||
params (org-babel-variable-assignments:python params))
|
||||
(ob-ipython--normalize-session session)
|
||||
(lambda (ret sentinel buffer file result-type)
|
||||
(let ((replacement (ob-ipython--process-response ret file result-type)))
|
||||
(ipython--async-replace-sentinel sentinel buffer replacement)))
|
||||
(list sentinel (current-buffer) file result-type))
|
||||
(format "%s - %s" (length ob-ipython--async-queue) sentinel)))
|
||||
|
||||
(defun ob-ipython--execute-sync (body params)
|
||||
(let* ((file (cdr (assoc :ipyfile params)))
|
||||
(session (cdr (assoc :session params)))
|
||||
(result-type (cdr (assoc :result-type params))))
|
||||
(ob-ipython--create-kernel (ob-ipython--normalize-session session)
|
||||
(cdr (assoc :kernel params)))
|
||||
(-when-let (ret (ob-ipython--eval
|
||||
(ob-ipython--execute-request
|
||||
(org-babel-expand-body:generic (encode-coding-string body 'utf-8)
|
||||
params (org-babel-variable-assignments:python params))
|
||||
(ob-ipython--normalize-session session))))
|
||||
(ob-ipython--process-response ret file result-type))))
|
||||
|
||||
(defun ob-ipython--process-response (ret file result-type)
|
||||
(let ((result (cdr (assoc :result ret)))
|
||||
(output (cdr (assoc :output ret))))
|
||||
(if (eq result-type 'output)
|
||||
output
|
||||
(ob-ipython--output output nil)
|
||||
(s-concat
|
||||
(format "# Out[%d]:\n" (cdr (assoc :exec-count ret)))
|
||||
(s-join "\n" (->> (-map (-partial 'ob-ipython--render file)
|
||||
(list (cdr (assoc :value result))
|
||||
(cdr (assoc :display result))))
|
||||
(remove-if-not nil)))))))
|
||||
|
||||
(defun ob-ipython--render (file-or-nil values)
|
||||
(let ((org (lambda (value) value))
|
||||
(png (lambda (value)
|
||||
(let ((file (or file-or-nil (ob-ipython--generate-file-name ".png"))))
|
||||
(ob-ipython--write-base64-string file value)
|
||||
(format "[[file:%s]]" file))))
|
||||
(svg (lambda (value)
|
||||
(let ((file (or file-or-nil (ob-ipython--generate-file-name ".svg"))))
|
||||
(ob-ipython--write-string-to-file file value)
|
||||
(format "[[file:%s]]" file))))
|
||||
(html (lambda (value)
|
||||
;; ((eq (car value) 'text/html)
|
||||
;; (let ((pandoc (executable-find "pandoc")))
|
||||
;; (and pandoc (with-temp-buffer
|
||||
;; (insert value)
|
||||
;; (shell-command-on-region
|
||||
;; (point-min) (point-max)
|
||||
;; (format "%s -f html -t org" pandoc) t t)
|
||||
;; (s-trim (buffer-string))))))
|
||||
))
|
||||
(txt (lambda (value)
|
||||
(let ((lines (s-lines value)))
|
||||
(if (cdr lines)
|
||||
(->> lines
|
||||
(-map 's-trim)
|
||||
(s-join "\n ")
|
||||
(s-concat " ")
|
||||
(format "#+BEGIN_EXAMPLE\n%s\n#+END_EXAMPLE"))
|
||||
(s-concat ": " (car lines)))))))
|
||||
(or (-when-let (val (cdr (assoc 'text/org values))) (funcall org val))
|
||||
(-when-let (val (cdr (assoc 'image/png values))) (funcall png val))
|
||||
(-when-let (val (cdr (assoc 'image/svg+xml values))) (funcall svg val))
|
||||
(-when-let (val (cdr (assoc 'text/plain values))) (funcall txt val)))))
|
||||
|
||||
(defun org-babel-prep-session:ipython (session params)
|
||||
"Prepare SESSION according to the header arguments in PARAMS.
|
||||
VARS contains resolved variable references"
|
||||
;; c-u c-c c-v c-z
|
||||
(error "Currently unsupported."))
|
||||
|
||||
(defun org-babel-load-session:ipython (session body params)
|
||||
"Load BODY into SESSION."
|
||||
;; c-c c-v c-l
|
||||
(error "Currently unsupported."))
|
||||
|
||||
(defun org-babel-ipython-initiate-session (&optional session params)
|
||||
"Create a session named SESSION according to PARAMS."
|
||||
(if (string= session "none")
|
||||
(error "ob-ipython currently only supports evaluation using a session.
|
||||
Make sure your src block has a :session param.")
|
||||
(when (not (s-ends-with-p ".json" session))
|
||||
(ob-ipython--create-kernel (ob-ipython--normalize-session session)
|
||||
(cdr (assoc :kernel params))))
|
||||
(ob-ipython--create-repl (ob-ipython--normalize-session session))))
|
||||
|
||||
;; async
|
||||
|
||||
(defun ipython--async-gen-sentinel ()
|
||||
;; lifted directly from org-id. thanks.
|
||||
(let ((rnd (md5 (format "%s%s%s%s%s%s%s"
|
||||
(random)
|
||||
(current-time)
|
||||
(user-uid)
|
||||
(emacs-pid)
|
||||
(user-full-name)
|
||||
user-mail-address
|
||||
(recent-keys)))))
|
||||
(format "%s-%s-4%s-%s%s-%s"
|
||||
(substring rnd 0 8)
|
||||
(substring rnd 8 12)
|
||||
(substring rnd 13 16)
|
||||
(format "%x"
|
||||
(logior
|
||||
#b10000000
|
||||
(logand
|
||||
#b10111111
|
||||
(string-to-number
|
||||
(substring rnd 16 18) 16))))
|
||||
(substring rnd 18 20)
|
||||
(substring rnd 20 32))))
|
||||
|
||||
(defun ipython--async-replace-sentinel (sentinel buffer replacement)
|
||||
(save-window-excursion
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(with-current-buffer buffer
|
||||
(goto-char (point-min))
|
||||
(re-search-forward sentinel)
|
||||
(re-search-backward "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)")
|
||||
(org-babel-remove-result)
|
||||
(org-babel-insert-result
|
||||
replacement
|
||||
(cdr (assoc :result-params (nth 2 (org-babel-get-src-block-info)))))
|
||||
(org-redisplay-inline-images))))))
|
||||
|
||||
;; lib
|
||||
|
||||
(provide 'ob-ipython)
|
||||
|
||||
;;; ob-ipython.el ends here
|
||||
BIN
elpa/ob-ipython-20180224.953/ob-ipython.elc
Normal file
BIN
elpa/ob-ipython-20180224.953/ob-ipython.elc
Normal file
Binary file not shown.
43
elpa/ox-nikola-20151114.1116/ox-nikola-autoloads.el
Normal file
43
elpa/ox-nikola-20151114.1116/ox-nikola-autoloads.el
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
;;; ox-nikola-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "ox-nikola" "ox-nikola.el" (0 0 0 0))
|
||||
;;; Generated autoloads from ox-nikola.el
|
||||
|
||||
(autoload 'org-nikola-export-as-rst "ox-nikola" "\
|
||||
Export current buffer to a reStructuredText buffer.
|
||||
|
||||
\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
|
||||
|
||||
(autoload 'org-nikola-export-to-rst "ox-nikola" "\
|
||||
Export current buffer to a reStructuredText file
|
||||
|
||||
\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
|
||||
|
||||
(autoload 'org-nikola-publish-to-rst "ox-nikola" "\
|
||||
Publish an org file to reStructuredText.
|
||||
|
||||
FILENAME is the filename of the Org file to be published. PLIST
|
||||
is the property list for the given project. PUB-DIR is the
|
||||
publishing directory.
|
||||
|
||||
Return output file name.
|
||||
|
||||
\(fn PLIST FILENAME PUB-DIR)" nil nil)
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-nikola" '("org-nikola-")))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; ox-nikola-autoloads.el ends here
|
||||
2
elpa/ox-nikola-20151114.1116/ox-nikola-pkg.el
Normal file
2
elpa/ox-nikola-20151114.1116/ox-nikola-pkg.el
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "ox-nikola" "20151114.1116" "Export Nikola articles using org-mode." '((emacs "24.4") (org "8.2.4") (ox-rst "0.2")) :commit "5bcbc1a38f6619f62294194f13ca0cd4ca14dd48" :keywords '("org" "nikola") :authors '(("IGARASHI Masanao" . "syoux2@gmail.com")) :maintainer '("IGARASHI Masanao" . "syoux2@gmail.com") :url "https://github.com/masayuko/ox-nikola")
|
||||
282
elpa/ox-nikola-20151114.1116/ox-nikola.el
Normal file
282
elpa/ox-nikola-20151114.1116/ox-nikola.el
Normal file
|
|
@ -0,0 +1,282 @@
|
|||
;;; ox-nikola.el --- Export Nikola articles using org-mode.
|
||||
|
||||
;; Copyright (C) 2014,2015 IGARASHI Masanao
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program; if not, write to the Free Software
|
||||
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
;; Author: IGARASHI Masanao <syoux2@gmail.com>
|
||||
;; Keywords: org, nikola
|
||||
;; Package-Version: 20151114.1116
|
||||
;; Version: 0.1
|
||||
;; URL: https://github.com/masayuko/ox-nikola
|
||||
;; Package-Requires: ((emacs "24.4") (org "8.2.4") (ox-rst "0.2"))
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;; Dependencies
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(require 'ox)
|
||||
(require 'ox-publish)
|
||||
(require 'ox-rst)
|
||||
|
||||
|
||||
;;; User Configurable Variables
|
||||
|
||||
(defgroup org-export-nikola nil
|
||||
"Options for exporting Org mode files to Nikola reStructuredText."
|
||||
:tag "Org Nikola"
|
||||
:group 'org-export)
|
||||
|
||||
(defcustom org-nikola-nikola-template ""
|
||||
"Default template in a Nikola article."
|
||||
:group 'org-export-nikola
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-nikola-type "text"
|
||||
"Default type in a Nikola article."
|
||||
:group 'org-export-nikola
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-nikola-password ""
|
||||
"Default password in a Nikola article."
|
||||
:group 'org-export-nikola
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-nikola-section ""
|
||||
"Default section in a Nikola article."
|
||||
:group 'org-export-nikola
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-nikola-category ""
|
||||
"Default category in a Nikola article."
|
||||
:group 'org-export-nikola
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-nikola-annotations ""
|
||||
"Default annotations metadata field in a Nikola article. True or other"
|
||||
:group 'org-export-nikola
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-nikola-noannotations ""
|
||||
"Default noannotations metadata field in a Nikola article. True or other"
|
||||
:group 'org-export-nikola
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-nikola-nocomments ""
|
||||
"Default nocomments metadata field in a Nikola article. True or other"
|
||||
:group 'org-export-nikola
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-nikola-hidetitle ""
|
||||
"Default hidetitle metadata field in a Nikola article. True or other"
|
||||
:group 'org-export-nikola
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-nikola-previewimage ""
|
||||
"Default previewimage in a Nikola article."
|
||||
:group 'org-export-nikola
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-nikola-enclosure ""
|
||||
"Default enclosure in a Nikola article."
|
||||
:group 'org-export-nikola
|
||||
:type 'string)
|
||||
|
||||
;;; Define Back-End
|
||||
|
||||
(org-export-define-derived-backend 'nikola 'rst
|
||||
:menu-entry
|
||||
'(?n "Export to reStructuredText for Nikola"
|
||||
((?R "As reStructuredText buffer" org-nikola-export-as-rst)
|
||||
(?r "As reStructuredText file" org-nikola-export-to-rst)))
|
||||
:translate-alist
|
||||
'((template . org-nikola-template))
|
||||
:options-alist
|
||||
'((:description "DESCRIPTION" nil nil newline)
|
||||
(:keywords "KEYWORDS" nil nil space)
|
||||
(:nikola-slug "NIKOLA_SLUG" nil "")
|
||||
(:nikola-link "NIKOLA_LINK" nil "")
|
||||
(:nikola-type "NIKOLA_TYPE" nil org-nikola-type)
|
||||
(:nikola-password "NIKOLA_PASSWORD" nil org-nikola-password)
|
||||
(:nikola-template "NIKOLA_TEMPLATE" nil org-nikola-nikola-template)
|
||||
(:nikola-section "NIKOLA_SECTION" nil org-nikola-section)
|
||||
(:nikola-updated "NIKOLA_UPDATED" nil "")
|
||||
(:nikola-category "NIKOLA_CATEGORY" nil org-nikola-category)
|
||||
(:nikola-annotations "NIKOLA_ANNOTATIONS" nil org-nikola-annotations)
|
||||
(:nikola-annotations "NIKOLA_NOANNOTATIONS" nil org-nikola-noannotations)
|
||||
(:nikola-nocomments "NIKOLA_NOCOMMENTS" nil org-nikola-nocomments)
|
||||
(:nikola-hidetitle "NIKOLA_HIDETITLE" nil org-nikola-hidetitle)
|
||||
(:nikola-previewimage "NIKOLA_PREVIEWIMAGE" nil org-nikola-previewimage)
|
||||
(:nikola-enclosure "NIKOLA_ENCLOSURE" nil org-nikola-enclosure)))
|
||||
|
||||
|
||||
;;; Template
|
||||
|
||||
(defun org-nikola-template (contents info)
|
||||
"Return complete document string after reStructuredText conversion.
|
||||
CONTENTS is the transcoded contents string. INFO is a plist
|
||||
holding export options."
|
||||
(concat
|
||||
(org-nikola--front-matter info)
|
||||
"\n"
|
||||
contents))
|
||||
|
||||
(defun org-nikola--get-option (info property-name &optional default)
|
||||
(let ((property (org-export-data (plist-get info property-name) info)))
|
||||
(if (string= "" property) default property)))
|
||||
|
||||
(defun org-nikola--get-true-option (info property-name)
|
||||
(let ((property (org-export-data (plist-get info property-name) info)))
|
||||
(if (or (string= (downcase property) "true")
|
||||
(string= (downcase property) "t"))
|
||||
"True" "")))
|
||||
|
||||
(defun org-nikola--front-matter (info)
|
||||
(let* ((title
|
||||
(org-nikola--get-option info :title ""))
|
||||
(author
|
||||
(org-nikola--get-option info :author ""))
|
||||
(email
|
||||
(org-nikola--get-option info :email ""))
|
||||
(date
|
||||
(org-nikola--get-option info :date ""))
|
||||
(title
|
||||
(if (string= title "")
|
||||
(cond
|
||||
((and (org-string-nw-p date) (org-string-nw-p author))
|
||||
(concat
|
||||
author
|
||||
" "
|
||||
date
|
||||
(when (org-string-nw-p email) (concat " " email))))
|
||||
((and (org-string-nw-p date) (org-string-nw-p email))
|
||||
(concat
|
||||
email
|
||||
" "
|
||||
date))
|
||||
((org-string-nw-p date)
|
||||
date)
|
||||
((and (org-string-nw-p author) (org-string-nw-p email))
|
||||
(concat author " " email))
|
||||
((org-string-nw-p author) author)
|
||||
((org-string-nw-p email) email)) title))
|
||||
(slug
|
||||
(org-nikola--get-option info :nikola-slug title))
|
||||
(keywords
|
||||
(org-nikola--get-option info :keywords ""))
|
||||
(link
|
||||
(org-nikola--get-option info :nikola-link ""))
|
||||
(description
|
||||
(org-nikola--get-option info :description ""))
|
||||
(type
|
||||
(org-nikola--get-option info :nikola-type ""))
|
||||
(password
|
||||
(org-nikola--get-option info :nikola-password ""))
|
||||
(template
|
||||
(org-nikola--get-option info :nikola-template ""))
|
||||
(section
|
||||
(org-nikola--get-option info :nikola-section ""))
|
||||
(updated
|
||||
(org-nikola--get-option info :nikola-updated ""))
|
||||
(category
|
||||
(org-nikola--get-option info :nikola-category ""))
|
||||
(annotations
|
||||
(org-nikola--get-true-option info :nikola-annotations))
|
||||
(noannotations
|
||||
(org-nikola--get-true-option info :nikola-noannotations))
|
||||
(nocomments
|
||||
(org-nikola--get-true-option info :nikola-nocomments))
|
||||
(hidetitle
|
||||
(org-nikola--get-true-option info :nikola-hidetitle))
|
||||
(previewimage
|
||||
(org-nikola--get-option info :nikola-previewimage ""))
|
||||
(enclosure
|
||||
(org-nikola--get-option info :nikola-enclosure "")))
|
||||
(concat
|
||||
".. title: " title
|
||||
"\n.. slug: " (replace-regexp-in-string "[ ]+" "-"
|
||||
(replace-regexp-in-string
|
||||
"[\s-]+" "-" slug))
|
||||
"\n.. date: " date
|
||||
(cond ((not (string= "" updated)) (concat "\n.. updated: " updated)))
|
||||
"\n.. tags: " keywords
|
||||
"\n.. link: " link
|
||||
"\n.. description: " description
|
||||
(cond ((not (string= "" type)) (concat "\n.. type: " type)))
|
||||
(cond ((and (not (string= "" author)) (plist-get info :with-author))
|
||||
(concat "\n.. author: " author)))
|
||||
(cond ((and (not (string= "" email)) (plist-get info :with-email))
|
||||
(format " <%s>" email)))
|
||||
(cond ((not (string= "" password)) (concat "\n.. password: " password)))
|
||||
(cond ((not (string= "" template)) (concat "\n.. template: " template)))
|
||||
(cond ((not (string= "" section)) (concat "\n.. section: " section)))
|
||||
(cond ((not (string= "" category)) (concat "\n.. category: " category)))
|
||||
(cond ((not (string= "" annotations))
|
||||
(concat "\n.. annotations: " annotations)))
|
||||
(cond ((not (string= "" noannotations))
|
||||
(concat "\n.. noannotations: " noannotations)))
|
||||
(cond ((not (string= "" nocomments))
|
||||
(concat "\n.. nocomments: " nocomments)))
|
||||
(cond ((not (string= "" hidetitle))
|
||||
(concat "\n.. hidetitle: " hidetitle)))
|
||||
(cond ((not (string= "" previewimage))
|
||||
(concat "\n.. previewimage: " previewimage)))
|
||||
(cond ((not (string= "" enclosure))
|
||||
(concat "\n.. enclosure: " enclosure)))
|
||||
"\n")))
|
||||
|
||||
|
||||
;;; End-User functions
|
||||
|
||||
;;;###autoload
|
||||
(defun org-nikola-export-as-rst
|
||||
(&optional async subtreep visible-only body-only ext-plist)
|
||||
"Export current buffer to a reStructuredText buffer."
|
||||
(interactive)
|
||||
(org-export-to-buffer 'nikola "*Org nikola RST Export*"
|
||||
async subtreep visible-only body-only ext-plist
|
||||
(lambda () (rst-mode))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun org-nikola-export-to-rst
|
||||
(&optional async subtreep visible-only body-only ext-plist)
|
||||
"Export current buffer to a reStructuredText file"
|
||||
(interactive)
|
||||
(let ((outfile (org-export-output-file-name ".rst" subtreep)))
|
||||
(org-export-to-file 'nikola outfile
|
||||
async subtreep visible-only body-only ext-plist)))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun org-nikola-publish-to-rst (plist filename pub-dir)
|
||||
"Publish an org file to reStructuredText.
|
||||
|
||||
FILENAME is the filename of the Org file to be published. PLIST
|
||||
is the property list for the given project. PUB-DIR is the
|
||||
publishing directory.
|
||||
|
||||
Return output file name."
|
||||
(org-publish-org-to 'nikola filename ".rst" plist pub-dir))
|
||||
|
||||
|
||||
;;; provide
|
||||
|
||||
(provide 'ox-nikola)
|
||||
|
||||
;;; ox-nikola.el ends here
|
||||
BIN
elpa/ox-nikola-20151114.1116/ox-nikola.elc
Normal file
BIN
elpa/ox-nikola-20151114.1116/ox-nikola.elc
Normal file
Binary file not shown.
90
elpa/ox-rst-20191013.551/ox-rst-autoloads.el
Normal file
90
elpa/ox-rst-20191013.551/ox-rst-autoloads.el
Normal file
|
|
@ -0,0 +1,90 @@
|
|||
;;; ox-rst-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "ox-rst" "ox-rst.el" (0 0 0 0))
|
||||
;;; Generated autoloads from ox-rst.el
|
||||
|
||||
(autoload 'org-rst-export-as-rst "ox-rst" "\
|
||||
Export current buffer to a reStructuredText buffer.
|
||||
|
||||
If narrowing is active in the current buffer, only export its
|
||||
narrowed part.
|
||||
|
||||
If a region is active, export that region.
|
||||
|
||||
A non-nil optional argument ASYNC means the process should happen
|
||||
asynchronously. The resulting buffer should be accessible
|
||||
through the `org-export-stack' interface.
|
||||
|
||||
When optional argument SUBTREEP is non-nil, export the sub-tree
|
||||
at point, extracting information from the headline properties
|
||||
first.
|
||||
|
||||
When optional argument VISIBLE-ONLY is non-nil, don't export
|
||||
contents of hidden elements.
|
||||
|
||||
Export is done in a buffer named \"*Org RST Export*\", which will
|
||||
be displayed when `org-export-show-temporary-export-buffer' is
|
||||
non-nil.
|
||||
|
||||
\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
|
||||
|
||||
(autoload 'org-rst-convert-region-to-rst "ox-rst" "\
|
||||
Assume the current region has Org syntax, and convert it to
|
||||
reStructuredText.
|
||||
This can be used in any buffer. For example, you can write an
|
||||
itemized list in Org syntax in a Markdown buffer and use this command
|
||||
to convert it.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'org-rst-export-to-rst "ox-rst" "\
|
||||
Export current buffer to a reStructuredText file.
|
||||
|
||||
If narrowing is active in the current buffer, only export its
|
||||
narrowed part.
|
||||
|
||||
If a region is active, export that region.
|
||||
|
||||
A non-nil optional argument ASYNC means the process should happen
|
||||
asynchronously. The resulting file should be accessible through
|
||||
the `org-export-stack' interface.
|
||||
|
||||
When optional argument SUBTREEP is non-nil, export the sub-tree
|
||||
at point, extracting information from the headline properties
|
||||
first.
|
||||
|
||||
When optional argument VISIBLE-ONLY is non-nil, don't export
|
||||
contents of hidden elements.
|
||||
|
||||
Return output file's name.
|
||||
|
||||
\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
|
||||
|
||||
(autoload 'org-rst-publish-to-rst "ox-rst" "\
|
||||
Publish an org file to reStructuredText.
|
||||
|
||||
FILENAME is the filename of the Org file to be published. PLIST
|
||||
is the property list for the given project. PUB-DIR is the
|
||||
publishing directory.
|
||||
|
||||
Return output file name.
|
||||
|
||||
\(fn PLIST FILENAME PUB-DIR)" nil nil)
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-rst" '("org-rst-" "my-org-export-inline-image-p")))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; ox-rst-autoloads.el ends here
|
||||
2
elpa/ox-rst-20191013.551/ox-rst-pkg.el
Normal file
2
elpa/ox-rst-20191013.551/ox-rst-pkg.el
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "ox-rst" "20191013.551" "Export reStructuredText using org-mode." '((emacs "25.1") (org "8.3")) :commit "9158bfd18096c559e0a225ae62ab683f1c98a547" :keywords '("org" "rst" "rest" "restructuredtext") :authors '(("Masanao Igarashi" . "syoux2@gmail.com")) :maintainer '("Masanao Igarashi" . "syoux2@gmail.com") :url "https://github.com/msnoigrs/ox-rst")
|
||||
1743
elpa/ox-rst-20191013.551/ox-rst.el
Normal file
1743
elpa/ox-rst-20191013.551/ox-rst.el
Normal file
File diff suppressed because it is too large
Load diff
BIN
elpa/ox-rst-20191013.551/ox-rst.elc
Normal file
BIN
elpa/ox-rst-20191013.551/ox-rst.elc
Normal file
Binary file not shown.
53
elpa/powershell-20190421.2038/powershell-autoloads.el
Normal file
53
elpa/powershell-20190421.2038/powershell-autoloads.el
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
;;; powershell-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "powershell" "powershell.el" (0 0 0 0))
|
||||
;;; Generated autoloads from powershell.el
|
||||
|
||||
(add-to-list 'auto-mode-alist '("\\.ps[dm]?1\\'" . powershell-mode))
|
||||
|
||||
(autoload 'powershell-mode "powershell" "\
|
||||
Major mode for editing PowerShell scripts.
|
||||
|
||||
\\{powershell-mode-map}
|
||||
Entry to this mode calls the value of `powershell-mode-hook' if
|
||||
that value is non-nil.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'powershell "powershell" "\
|
||||
Run an inferior PowerShell.
|
||||
If BUFFER is non-nil, use it to hold the powershell
|
||||
process. Defaults to *PowerShell*.
|
||||
|
||||
Interactively, a prefix arg means to prompt for BUFFER.
|
||||
|
||||
If BUFFER exists but the shell process is not running, it makes a
|
||||
new shell.
|
||||
|
||||
If BUFFER exists and the shell process is running, just switch to
|
||||
BUFFER.
|
||||
|
||||
If PROMPT-STRING is non-nil, sets the prompt to the given value.
|
||||
|
||||
See the help for `shell' for more details. (Type
|
||||
\\[describe-mode] in the shell buffer for a list of commands.)
|
||||
|
||||
\(fn &optional BUFFER PROMPT-STRING)" t nil)
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "powershell" '("powershell-" "explicit-powershell.exe-args")))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; powershell-autoloads.el ends here
|
||||
2
elpa/powershell-20190421.2038/powershell-pkg.el
Normal file
2
elpa/powershell-20190421.2038/powershell-pkg.el
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "powershell" "20190421.2038" "Mode for editing PowerShell scripts" '((emacs "24")) :commit "87826777bd3ebd53740be99b4546bfc11ccc625d" :keywords '("powershell" "languages") :authors '(("Frédéric Perrin <frederic (dot) perrin (arobas) resel (dot) fr>")) :maintainer '("Frédéric Perrin <frederic (dot) perrin (arobas) resel (dot) fr>") :url "http://github.com/jschaf/powershell.el")
|
||||
1386
elpa/powershell-20190421.2038/powershell.el
Normal file
1386
elpa/powershell-20190421.2038/powershell.el
Normal file
File diff suppressed because it is too large
Load diff
BIN
elpa/powershell-20190421.2038/powershell.elc
Normal file
BIN
elpa/powershell-20190421.2038/powershell.elc
Normal file
Binary file not shown.
664
elpa/python-docstring-20190716.921/docstring_wrap.py
Normal file
664
elpa/python-docstring-20190716.921/docstring_wrap.py
Normal file
|
|
@ -0,0 +1,664 @@
|
|||
# Copyright (C) 2012
|
||||
# See LICENSE.txt for details.
|
||||
|
||||
"""
|
||||
General Python docstring wrapper
|
||||
================================
|
||||
|
||||
Utility for wrapping docstrings in Python; specifically, docstrings in
|
||||
U{Epytext <http://epydoc.sourceforge.net/manual-epytext.html>} or Sphinx
|
||||
ReStructureText format.
|
||||
|
||||
The wrapping herein generally adheres to all the conventions set forth by the
|
||||
Twisted project U{http://twistedmatrix.com/}, but should be generally accurate
|
||||
for most Python projects.
|
||||
"""
|
||||
|
||||
from __future__ import unicode_literals
|
||||
|
||||
import argparse
|
||||
import sys
|
||||
import re
|
||||
|
||||
from io import StringIO
|
||||
from uuid import uuid4
|
||||
|
||||
|
||||
__all__ = [
|
||||
"wrapPythonDocstring"
|
||||
]
|
||||
|
||||
|
||||
if sys.version_info[0] <= 2:
|
||||
makeID = lambda: unicode(uuid4())
|
||||
fromStdin = lambda s: s.decode("utf-8")
|
||||
toStdout = lambda s: s.encode("utf-8")
|
||||
PY2 = True
|
||||
else:
|
||||
makeID = lambda: str(uuid4())
|
||||
fromStdin = lambda s: s
|
||||
toStdout = lambda s: s
|
||||
PY2 = False
|
||||
|
||||
|
||||
|
||||
def isUnderline(expr):
|
||||
return bool(re.match("[=]+$", expr) or re.match("[-]+$", expr))
|
||||
|
||||
|
||||
|
||||
def startslist(x):
|
||||
return (x == '-' or (x.endswith(".") and (x[:-1].isdigit()
|
||||
or x[:-1] == '#')))
|
||||
|
||||
|
||||
|
||||
def isAcronym(word):
|
||||
"""
|
||||
Is the given word an acronym (separated by periods, so it doesn't end a
|
||||
sentence)? cf. lots of interesting acronyms, e.g. this is one. solve for
|
||||
x. a.b.c. is also one. You might also want to give an example
|
||||
parenthetically (e.g. this one).
|
||||
"""
|
||||
word = word.strip("(")
|
||||
return ((len(word) > 2 and word[1::2] == '.' * int(len(word) / 2)) or
|
||||
word in ["cf.", "viz."])
|
||||
|
||||
|
||||
|
||||
def isSentenceEnd(prevWord):
|
||||
"""
|
||||
Is the given word the end of a sentence?
|
||||
"""
|
||||
if not prevWord:
|
||||
return False
|
||||
# Exclamation points and question marks generally end sentences.
|
||||
if prevWord[-1] in "?!":
|
||||
return True
|
||||
# Now, if it's not a period, it's probably not the end of a sentence.
|
||||
if prevWord[-1] != ".":
|
||||
return False
|
||||
if isAcronym(prevWord):
|
||||
return False
|
||||
return True
|
||||
|
||||
|
||||
|
||||
def beginsField(line):
|
||||
"""
|
||||
Does the given (stripped) line begin an epytext or ReST field?
|
||||
"""
|
||||
if line.startswith("@"):
|
||||
return True
|
||||
sphinxwords = """
|
||||
param params return type rtype summary var ivar cvar raises raise except
|
||||
exception
|
||||
""".split()
|
||||
for word in sphinxwords:
|
||||
if line.startswith(":" + word):
|
||||
return True
|
||||
return False
|
||||
|
||||
|
||||
|
||||
class RegularParagraph(object):
|
||||
otherIndent = ""
|
||||
|
||||
def __init__(self, pointTracker, fixedIndent="", hangIndent="",
|
||||
followIndent="", originalIndent=0):
|
||||
self.words = []
|
||||
self.fixedIndent = fixedIndent
|
||||
self.hangIndent = hangIndent
|
||||
self.followIndent = followIndent
|
||||
self.more = None
|
||||
self.prev = None
|
||||
self.pointTracker = pointTracker
|
||||
# originalIndent is the width of the indentation of the line this
|
||||
# paragraph originally came from in the input text.
|
||||
self.originalIndent = originalIndent
|
||||
self._unwrappedLines = 0
|
||||
self._headingType = None
|
||||
self._headingPoints = []
|
||||
|
||||
|
||||
def matchesTag(self, other):
|
||||
return False
|
||||
|
||||
|
||||
def __nonzero__(self):
|
||||
return bool(self.words)
|
||||
|
||||
|
||||
def all(self):
|
||||
while self is not None:
|
||||
#print self.__class__.__name__
|
||||
if self:
|
||||
yield self
|
||||
self = self.more
|
||||
|
||||
|
||||
def setIsHeading(self, headingType):
|
||||
self._headingType = headingType
|
||||
|
||||
|
||||
def isHeading(self):
|
||||
return bool(self._headingType)
|
||||
|
||||
def connect(self, more):
|
||||
self.more = more
|
||||
more.prev = self
|
||||
return more
|
||||
|
||||
def islist(self):
|
||||
return self.words and startslist(self.words[0])
|
||||
|
||||
def previousListPeer(self):
|
||||
"""
|
||||
Find a previous paragraph that is also a list element, of the same
|
||||
indentation level if one exists.
|
||||
"""
|
||||
previous = self.prev
|
||||
matched = None
|
||||
while previous:
|
||||
if not previous.words:
|
||||
previous = previous.prev
|
||||
continue
|
||||
if not previous.islist():
|
||||
break
|
||||
if previous.originalIndent <= self.originalIndent:
|
||||
return previous
|
||||
if previous.originalIndent > self.originalIndent:
|
||||
matched = previous
|
||||
previous = previous.prev
|
||||
if matched:
|
||||
return matched
|
||||
|
||||
def add(self, line):
|
||||
clean = self.pointTracker.peek(line)
|
||||
stripped = clean.strip()
|
||||
thisLineIndent = len(clean) - len(clean.lstrip())
|
||||
|
||||
if stripped:
|
||||
self._unwrappedLines += 1
|
||||
active = self
|
||||
firstword = list(self.pointTracker.filterWords(line.split()))[0]
|
||||
if beginsField(stripped):
|
||||
fp = FieldParagraph(pointTracker=self.pointTracker, originalIndent=thisLineIndent)
|
||||
fp.words.extend(line.split())
|
||||
active = active.connect(fp)
|
||||
elif isUnderline(stripped) and self._unwrappedLines == 2:
|
||||
# This paragraph is actually a section heading.
|
||||
active.setIsHeading(stripped[0])
|
||||
self._headingPoints = self.pointTracker.extractPoints(line)
|
||||
# FIXME: should respect leading indentation.
|
||||
active = active.connect(self.genRegular(originalIndent=thisLineIndent))
|
||||
elif startslist(firstword):
|
||||
# Aesthetically I prefer a 2-space indent here, but the
|
||||
# convention in the codebase seems to be 4 spaces.
|
||||
LIST_INDENT = 4
|
||||
# FIXME: this also needs to respect leading indentation so it
|
||||
# can properly represent nested lists.
|
||||
hangIndent = self.pointTracker.lengthOf(firstword) + 1
|
||||
fi = self.fixedIndent
|
||||
if not (self.words and startslist(self.words[0])):
|
||||
fi += (" " * LIST_INDENT)
|
||||
fp = RegularParagraph(
|
||||
pointTracker=self.pointTracker,
|
||||
fixedIndent=fi,
|
||||
hangIndent=" " * hangIndent,
|
||||
followIndent=self.followIndent,
|
||||
originalIndent=thisLineIndent,
|
||||
)
|
||||
fp.words.extend(line.split())
|
||||
fp.prev = self
|
||||
peer = fp.previousListPeer()
|
||||
if peer:
|
||||
if peer.originalIndent >= fp.originalIndent:
|
||||
fp.fixedIndent = peer.fixedIndent
|
||||
else:
|
||||
fp.fixedIndent = peer.fixedIndent + (" " * LIST_INDENT)
|
||||
active = active.connect(fp)
|
||||
else:
|
||||
self.words.extend(line.split())
|
||||
if stripped.endswith("::"):
|
||||
active = active.connect(PreFormattedParagraph(
|
||||
active,
|
||||
indentBegins=thisLineIndent
|
||||
))
|
||||
return active
|
||||
else:
|
||||
rawstrip = line.strip()
|
||||
if rawstrip:
|
||||
self.words.append(rawstrip)
|
||||
if len(list(self.pointTracker.filterWords(self.words))):
|
||||
return self.connect(self.genRegular(originalIndent=thisLineIndent))
|
||||
return self
|
||||
|
||||
|
||||
def wrap(self, output, indentation, width, initialBlank, singleSpace):
|
||||
maxWidthThisLine = width
|
||||
if not self.words:
|
||||
return
|
||||
if initialBlank:
|
||||
thisLine = self.firstIndent(indentation)
|
||||
else:
|
||||
thisLine = ''
|
||||
maxWidthThisLine -= (3 + len(indentation))
|
||||
first = True
|
||||
prevWord = ''
|
||||
for num, word in enumerate(self.words):
|
||||
if not self.pointTracker.isWord(word):
|
||||
thisLine += word
|
||||
continue
|
||||
normalPrevWord = self.pointTracker.peek(prevWord)
|
||||
if num == 1 and startslist(normalPrevWord):
|
||||
spaces = 1
|
||||
elif isSentenceEnd(normalPrevWord) and singleSpace:
|
||||
spaces = 2
|
||||
else:
|
||||
spaces = 1
|
||||
prevWord = word
|
||||
thisLineWidthWithThisWord = (self.pointTracker.lengthOf(thisLine) +
|
||||
self.pointTracker.lengthOf(word) +
|
||||
spaces)
|
||||
if thisLineWidthWithThisWord <= maxWidthThisLine or first:
|
||||
if first:
|
||||
first = not first
|
||||
else:
|
||||
thisLine += (" " * spaces)
|
||||
thisLine += word
|
||||
else:
|
||||
output.write(self.pointTracker.scan(thisLine, output.tell()))
|
||||
output.write("\n")
|
||||
maxWidthThisLine = width
|
||||
thisLine = self.restIndent(indentation) + word
|
||||
output.write(self.pointTracker.scan(thisLine, output.tell()))
|
||||
output.write("\n")
|
||||
if self.isHeading():
|
||||
indentText = self.firstIndent(indentation)
|
||||
lineSize = self.pointTracker.lengthOf(thisLine) - len(indentText)
|
||||
output.write(self.pointTracker.scan(
|
||||
indentText + ''.join(self._headingPoints) +
|
||||
(self._headingType * lineSize), output.tell()
|
||||
))
|
||||
output.write("\n")
|
||||
|
||||
|
||||
def firstIndent(self, indentation):
|
||||
return indentation + self.fixedIndent
|
||||
|
||||
|
||||
def restIndent(self, indentation):
|
||||
return (indentation + self.fixedIndent + self.hangIndent +
|
||||
self.otherIndent)
|
||||
|
||||
|
||||
def genRegular(self, originalIndent=0):
|
||||
return RegularParagraph(pointTracker=self.pointTracker,
|
||||
fixedIndent=self.nextIndent(),
|
||||
followIndent=self.nextIndent(),
|
||||
originalIndent=originalIndent)
|
||||
|
||||
|
||||
def nextIndent(self):
|
||||
return self.followIndent
|
||||
|
||||
|
||||
|
||||
class FieldParagraph(RegularParagraph):
|
||||
|
||||
@property
|
||||
def otherIndent(self):
|
||||
"""
|
||||
Compute the other indent appropriate to the length of a sphinx field,
|
||||
if we're wrapping a sphinx field.
|
||||
"""
|
||||
if self.words[0].startswith(':'):
|
||||
accumulatedLength = 0
|
||||
for word in self.words:
|
||||
word = self.pointTracker.peek(word)
|
||||
# Add the length of the word
|
||||
accumulatedLength += len(word)
|
||||
# Add the following space
|
||||
accumulatedLength += 1
|
||||
# If it gets too long then give up and go with the default.
|
||||
if accumulatedLength > 10:
|
||||
break
|
||||
if word.endswith(":"):
|
||||
return accumulatedLength * " "
|
||||
return " "
|
||||
|
||||
|
||||
def nextIndent(self):
|
||||
return " "
|
||||
|
||||
|
||||
def matchesTag(self, other):
|
||||
if isinstance(other, FieldParagraph):
|
||||
myWords = list(self.pointTracker.filterWords(self.words))
|
||||
theirWords = list(self.pointTracker.filterWords(other.words))
|
||||
if ( set([myWords[0], theirWords[0]]) ==
|
||||
set(["@return:", "@rtype:"]) ):
|
||||
# matching @return and @rtype fields.
|
||||
return True
|
||||
elif myWords[0][0] == theirWords[0][0] == ':':
|
||||
# hack for sphinx: prevailing style seems to be 'group @params
|
||||
# together'
|
||||
if myWords[0] == theirWords[0]:
|
||||
return True
|
||||
elif ( set([myWords[0], theirWords[0]]) ==
|
||||
set([":return:", ":rtype:"]) ):
|
||||
return True
|
||||
elif ( set([myWords[0], theirWords[0]]) ==
|
||||
set([":param", ":type"]) and
|
||||
len(myWords) > 1 and len(theirWords) > 1 and
|
||||
myWords[1] == theirWords[1]):
|
||||
# same as "matching @param and @type" below, but stricter;
|
||||
# FIXME: these should be merged.
|
||||
return True
|
||||
else:
|
||||
return False
|
||||
elif len(myWords) > 1 and len(theirWords) > 1:
|
||||
# matching @param and @type fields.
|
||||
return myWords[1] == theirWords[1]
|
||||
return False
|
||||
else:
|
||||
return False
|
||||
|
||||
|
||||
|
||||
class PreFormattedParagraph(object):
|
||||
|
||||
def __init__(self, before, indentBegins):
|
||||
self.lines = []
|
||||
self.before = before
|
||||
|
||||
pointTracker = before.pointTracker
|
||||
|
||||
fixedIndent = (before.fixedIndent + before.hangIndent +
|
||||
before.otherIndent)
|
||||
|
||||
self.indentBegins = indentBegins
|
||||
self.fixedIndent = fixedIndent
|
||||
self.more = None
|
||||
self.prev = None
|
||||
self.pointTracker = pointTracker
|
||||
|
||||
|
||||
def islist(self):
|
||||
"""
|
||||
It's not a list.
|
||||
"""
|
||||
return False
|
||||
|
||||
|
||||
def connect(self, more):
|
||||
self.more = more
|
||||
more.prev = self
|
||||
return more
|
||||
|
||||
|
||||
@property
|
||||
def originalIndent(self):
|
||||
return self.indentBegins
|
||||
|
||||
|
||||
@property
|
||||
def words(self):
|
||||
"""
|
||||
Used by wrapper below to see if there are any words in a given
|
||||
paragraph and whether it should be skipped.
|
||||
"""
|
||||
return bool(self.lines)
|
||||
|
||||
|
||||
def matchesTag(self, other):
|
||||
return False
|
||||
|
||||
|
||||
def add(self, line):
|
||||
actualLine = self.pointTracker.peek(line)
|
||||
|
||||
if actualLine.strip():
|
||||
if len(actualLine) - len(actualLine.lstrip()) <= self.indentBegins:
|
||||
next = self.connect(self.before.genRegular())
|
||||
return next.add(line)
|
||||
self.lines.append(line.rstrip())
|
||||
else:
|
||||
self.lines.append(line.strip())
|
||||
return self
|
||||
|
||||
|
||||
def fixIndentation(self):
|
||||
while self.lines and not self.lines[0].strip():
|
||||
self.lines.pop(0)
|
||||
while self.lines and not self.lines[-1].strip():
|
||||
self.lines.pop()
|
||||
if not self.lines:
|
||||
return
|
||||
cleanLines = list(map(self.pointTracker.peek, self.lines))
|
||||
commonLeadingIndent = min([len(x) - len(x.lstrip()) for x in cleanLines
|
||||
if x.strip()] or [0])
|
||||
newLines = []
|
||||
for actualLine, line in zip(cleanLines, self.lines):
|
||||
if actualLine != line and line[:commonLeadingIndent].strip():
|
||||
# There's a marker, and it's in the leading whitespace.
|
||||
# Explicitly reposition the marker at the beginning of the
|
||||
# fixed indentation.
|
||||
line = (self.pointTracker.marker +
|
||||
actualLine[commonLeadingIndent:])
|
||||
else:
|
||||
line = line.rstrip()[commonLeadingIndent:]
|
||||
newLines.append(line)
|
||||
self.lines = newLines
|
||||
|
||||
|
||||
def wrap(self, output, indentation, width, initialBlank, singleSpace):
|
||||
# OK, now we know about all the lines we're going to know about.
|
||||
self.fixIndentation()
|
||||
for line in self.lines:
|
||||
if self.pointTracker.peek(line):
|
||||
output.write(indentation + " " + self.fixedIndent)
|
||||
output.write(self.pointTracker.scan(line, output.tell()))
|
||||
output.write("\n")
|
||||
|
||||
|
||||
|
||||
class PointTracker(object):
|
||||
"""
|
||||
Object for keeping track of where the insertion points are.
|
||||
"""
|
||||
|
||||
def __init__(self, point):
|
||||
self.point = point
|
||||
self.marker = "{" + makeID() + "}"
|
||||
self.outPoints = []
|
||||
|
||||
|
||||
def annotate(self, text):
|
||||
"""
|
||||
Add point references to a block of text.
|
||||
"""
|
||||
return text[:self.point] + self.marker + text[self.point:]
|
||||
|
||||
|
||||
def filterWords(self, words):
|
||||
for word in words:
|
||||
if self.isWord(word):
|
||||
yield self.peek(word)
|
||||
|
||||
|
||||
def isWord(self, text):
|
||||
"""
|
||||
Is the given word actually a word, or just an artifact of the
|
||||
point-tracking process? If it's just the point marker by itself, then
|
||||
no, it isn't, and don't insert additional whitespace after it.
|
||||
"""
|
||||
return not (text == self.marker)
|
||||
|
||||
|
||||
def lengthOf(self, word):
|
||||
"""
|
||||
How long would this word be if it didn't have any point-markers in it?
|
||||
"""
|
||||
return len(self.peek(word))
|
||||
|
||||
|
||||
def peek(self, word):
|
||||
"""
|
||||
What would this word look like if it didn't have any point-markers in
|
||||
it?
|
||||
"""
|
||||
return word.replace(self.marker, "")
|
||||
|
||||
|
||||
def extractPoints(self, text):
|
||||
"""
|
||||
Return a C{list} of all point markers contained in the text.
|
||||
"""
|
||||
if self.marker in text:
|
||||
return [self.marker]
|
||||
return []
|
||||
|
||||
|
||||
def scan(self, text, offset):
|
||||
"""
|
||||
Scan some text for point markers, remember them, and remove them.
|
||||
"""
|
||||
idx = text.find(self.marker)
|
||||
if idx == -1:
|
||||
return text
|
||||
self.outPoints.append(idx + offset)
|
||||
return self.peek(text)
|
||||
|
||||
|
||||
|
||||
def wrapPythonDocstring(docstring, output, indentation=" ",
|
||||
width=79, point=0, initialBlank=True,
|
||||
singleSpace=False):
|
||||
"""
|
||||
Wrap a given Python docstring.
|
||||
|
||||
@param docstring: the docstring itself (just the stuff between the quotes).
|
||||
@type docstring: unicode
|
||||
|
||||
@param output: The unicode output file to write the wrapped docstring to.
|
||||
@type output: L{file}-like (C{write} takes unicode.)
|
||||
|
||||
@param indentation: a string (consisting only of spaces) indicating the
|
||||
amount of space to shift by. Don't adjust this. It's always 4 spaces.
|
||||
PEP8 says so.
|
||||
@type indentation: L{unicode}
|
||||
|
||||
@param width: The maximum number of characters allowed in a wrapped line.
|
||||
@type width: L{int}
|
||||
|
||||
@param point: The location of the cursor in the text, as an offset from the
|
||||
beginning of the docstring. If this function is being used from within
|
||||
a graphical editor, this parameter can be used (in addition to the
|
||||
return value of this function) to reposition the cursor at the relative
|
||||
position which the user will expect.
|
||||
|
||||
@param singleSpace: If true, use a single space between sentences instead
|
||||
of two.
|
||||
|
||||
@return: The new location of the cursor.
|
||||
"""
|
||||
# TODO: multiple points; usable, for example, for start and end of a
|
||||
# currently active selection.
|
||||
pt = PointTracker(point)
|
||||
start = paragraph = RegularParagraph(pt)
|
||||
docstring = pt.annotate(docstring)
|
||||
for line in docstring.split("\n"):
|
||||
paragraph = paragraph.add(line)
|
||||
prevp = None
|
||||
# output.write("{}".format(initialBlank))
|
||||
for paragraph in start.all():
|
||||
if initialBlank:
|
||||
if paragraph.words and not paragraph.matchesTag(prevp):
|
||||
output.write("\n")
|
||||
prevp = paragraph
|
||||
paragraph.wrap(output, indentation, width, initialBlank, singleSpace)
|
||||
initialBlank = True
|
||||
output.write(indentation)
|
||||
return pt.outPoints[0] if pt.outPoints else 0
|
||||
|
||||
|
||||
|
||||
def indentHeuristic(lines, io):
|
||||
"""
|
||||
Determine the indentation.
|
||||
"""
|
||||
for num, line in enumerate(lines):
|
||||
if num == 0:
|
||||
initialBlank = not bool(line)
|
||||
if not initialBlank:
|
||||
continue
|
||||
indentation = (len(line) - len(line.lstrip()))
|
||||
if indentation:
|
||||
return (initialBlank, indentation)
|
||||
# TODO: investigate the case where this happens.
|
||||
return True, 0
|
||||
|
||||
|
||||
|
||||
def sampleDocstring():
|
||||
"""This is a sample docstring where the last word is a little bit too long
|
||||
go go.
|
||||
|
||||
This is another part of the docstring.
|
||||
"""
|
||||
|
||||
|
||||
def main(argv, indata):
|
||||
parser = argparse.ArgumentParser()
|
||||
parser.add_argument("--offset", type = int)
|
||||
parser.add_argument("--indent", type = int)
|
||||
parser.add_argument("--width", type = int, default = 79)
|
||||
parser.add_argument("--linewise", action='store_true')
|
||||
parser.add_argument("--single-space", action='store_false')
|
||||
namespace = parser.parse_args(argv[1:])
|
||||
|
||||
io = StringIO()
|
||||
inlines = indata.split("\n")
|
||||
if namespace.linewise:
|
||||
inlines.insert(0, "")
|
||||
initialBlank, indentCount = indentHeuristic(inlines, io)
|
||||
point = 0
|
||||
width = namespace.width
|
||||
|
||||
if namespace.offset is not None:
|
||||
point = namespace.offset
|
||||
if namespace.indent is not None:
|
||||
indentCount = namespace.indent
|
||||
|
||||
offset = wrapPythonDocstring(
|
||||
indata, io,
|
||||
indentation=" " * indentCount,
|
||||
width=width,
|
||||
point=point,
|
||||
initialBlank=initialBlank,
|
||||
singleSpace=namespace.single_space
|
||||
)
|
||||
prefix = StringIO()
|
||||
if namespace.offset is not None:
|
||||
prefix.write("{:d}".format(offset))
|
||||
prefix.write(" ")
|
||||
|
||||
output = prefix.getvalue() + io.getvalue()
|
||||
if namespace.linewise:
|
||||
output = "\n".join(output.split("\n")[1:-1])
|
||||
return output
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
sys.stdout.write(
|
||||
toStdout(
|
||||
main(
|
||||
sys.argv,
|
||||
fromStdin(sys.stdin.read()),
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
sys.stdout.flush()
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
;;; python-docstring-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "python-docstring" "python-docstring.el" (0
|
||||
;;;;;; 0 0 0))
|
||||
;;; Generated autoloads from python-docstring.el
|
||||
|
||||
(autoload 'python-docstring-fill "python-docstring" "\
|
||||
Wrap Python docstrings as epytext or ReStructured Text.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'python-docstring-mode "python-docstring" "\
|
||||
Toggle python-docstring-mode.
|
||||
With no argument, this command toggles the mode.
|
||||
Non-null prefix argument turns on the mode.
|
||||
Null prefix argument turns off the mode.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(autoload 'python-docstring-install "python-docstring" "\
|
||||
Add python-docstring-mode as a hook to python.mode.
|
||||
|
||||
\(fn)" nil nil)
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "python-docstring" '("python-docstring-")))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("python-docstring-pkg.el") (0 0 0 0))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; python-docstring-autoloads.el ends here
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
(define-package "python-docstring" "20190716.921" "Smart Python docstring formatting" 'nil)
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
182
elpa/python-docstring-20190716.921/python-docstring.el
Normal file
182
elpa/python-docstring-20190716.921/python-docstring.el
Normal file
|
|
@ -0,0 +1,182 @@
|
|||
;;; python-docstring.el --- Smart Python docstring formatting
|
||||
|
||||
;; Copyright (c) 2014-2015 The Authors
|
||||
;;
|
||||
;; Permission is hereby granted, free of charge, to any person obtaining
|
||||
;; a copy of this software and associated documentation files (the
|
||||
;; "Software"), to deal in the Software without restriction, including
|
||||
;; without limitation the rights to use, copy, modify, merge, publish,
|
||||
;; distribute, sublicense, and/or sell copies of the Software, and to
|
||||
;; permit persons to whom the Software is furnished to do so, subject to
|
||||
;; the following conditions:
|
||||
;;
|
||||
;; The above copyright notice and this permission notice shall be
|
||||
;; included in all copies or substantial portions of the Software.
|
||||
;;
|
||||
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
|
||||
;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
|
||||
;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
|
||||
;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; python-docstring-mode.el is a minor mode for intelligently
|
||||
;; reformatting (refilling) and highlighting Python docstrings. It
|
||||
;; understands both epytext and Sphinx formats (even intermingled!),
|
||||
;; so it knows how to reflow them correctly. It will also highlight
|
||||
;; markup in your docstrings, including epytext and reStructuredText.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defcustom python-docstring-sentence-end-double-space t
|
||||
"If non-nil, use double spaces when formatting text.
|
||||
|
||||
Operates simililarly to `sentence-end-double-space'. When nil, a
|
||||
single space is used."
|
||||
:type 'boolean
|
||||
:group 'python-docstring)
|
||||
|
||||
(defvar python-docstring-script
|
||||
(concat (if load-file-name
|
||||
(file-name-directory load-file-name)
|
||||
default-directory)
|
||||
"docstring_wrap.py")
|
||||
"The location of the docstring_wrap.py script.")
|
||||
|
||||
;;;###autoload
|
||||
(defun python-docstring-fill ()
|
||||
"Wrap Python docstrings as epytext or ReStructured Text."
|
||||
(interactive)
|
||||
(let ((fill-it-anyway nil))
|
||||
(catch 'not-a-string
|
||||
(let* ((to-forward
|
||||
(save-excursion
|
||||
(let* ((orig-point (point))
|
||||
(syx (syntax-ppss))
|
||||
(in-string (if (nth 3 syx) t
|
||||
(progn
|
||||
(setf fill-it-anyway t)
|
||||
(throw 'not-a-string nil))))
|
||||
(string-start (+ (goto-char (nth 8 syx))
|
||||
3))
|
||||
(rawchar (if (eql (char-before (point)) ?r)
|
||||
1
|
||||
0))
|
||||
;; at the beginning of the screen here
|
||||
(indent-count (- (- string-start (+ rawchar 3))
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(point))))
|
||||
(string-end
|
||||
(- (condition-case () ; for unbalanced quotes
|
||||
(progn (forward-sexp)
|
||||
(point))
|
||||
(error (point-max)))
|
||||
3))
|
||||
(orig-offset (- orig-point string-start)))
|
||||
(let*
|
||||
((offset-within
|
||||
(progn
|
||||
(shell-command-on-region
|
||||
string-start string-end
|
||||
(format
|
||||
(concat "python3 %s --offset %s --indent %s --width %s"
|
||||
(unless python-docstring-sentence-end-double-space
|
||||
" --single-space"))
|
||||
(shell-quote-argument python-docstring-script)
|
||||
orig-offset
|
||||
indent-count
|
||||
fill-column
|
||||
)
|
||||
:replace t)
|
||||
(goto-char string-start)
|
||||
(forward-sexp)
|
||||
(string-to-number
|
||||
(buffer-substring-no-properties string-start orig-point))
|
||||
)))
|
||||
(delete-region string-start (+ 1 (point)))
|
||||
offset-within)))))
|
||||
(forward-char to-forward)))
|
||||
(if fill-it-anyway
|
||||
(call-interactively 'fill-paragraph))))
|
||||
|
||||
(defvar python-docstring-field-with-arg-re
|
||||
"^\\s-*\\([@:]\\)\\(param\\|parameter\\|arg\\|argument\\|type\\|keyword\\|kwarg\\|kwparam\\|raise\\|raises\\|except\\|exception\\|ivar\\|ivariable\\|cvar\\|cvariable\\|var\\|variable\\|type\\|group\\|todo\\|newfield\\)\\s-+\\([a-zA-Z_][a-zA-Z0-9_,. ]*?\\)\\(:\\)")
|
||||
|
||||
(defvar python-docstring-field-no-arg-re
|
||||
"^\\s-*\\([@:]\\)\\(raise\\|raises\\|return\\|returns\\|rtype\\|returntype\\|type\\|sort\\|see\\|seealso\\|note\\|attention\\|bug\\|warning\\|warn\\|version\\|todo\\|deprecated\\|since\\|status\\|change\\|changed\\|permission\\|requires\\|require\\|requirement\\|precondition\\|precond\\|postcondition\\|postcod\\|invariant\\|author\\|organization\\|org\\|copyright\\|(c)\\|license\\|contact\\|summary\\|params\\|param\\)\\(:\\)")
|
||||
|
||||
(defvar python-docstring-epytext-markup-link "[UL]{\\([^}]*?\\)\\(<.*?>\\|\\)?}")
|
||||
(defvar python-docstring-epytext-markup-style-code "C{\\(.*?\\)}")
|
||||
(defvar python-docstring-epytext-markup-style-italic "I{\\(.*?\\)}")
|
||||
(defvar python-docstring-epytext-markup-style-bold "B{\\(.*?\\)}")
|
||||
|
||||
;; hack for sphinx
|
||||
(defvar python-docstring-sphinx-markup-link "\\(:[^:]+?:\\)\\(`.+?`\\)")
|
||||
(defvar python-docstring-sphinx-markup-code "``\\(.+?\\)``")
|
||||
|
||||
(defvar python-docstring-keywords
|
||||
`((,python-docstring-field-with-arg-re 1 font-lock-keyword-face t)
|
||||
(,python-docstring-field-with-arg-re 2 font-lock-type-face t)
|
||||
(,python-docstring-field-with-arg-re 3 font-lock-variable-name-face t)
|
||||
(,python-docstring-field-with-arg-re 4 font-lock-keyword-face t)
|
||||
(,python-docstring-field-no-arg-re 1 font-lock-keyword-face t)
|
||||
(,python-docstring-field-no-arg-re 2 font-lock-type-face t)
|
||||
(,python-docstring-field-no-arg-re 3 font-lock-keyword-face t)
|
||||
|
||||
;; :foo:`bar`
|
||||
(,python-docstring-sphinx-markup-link 1 font-lock-function-name-face t)
|
||||
(,python-docstring-sphinx-markup-link 2 font-lock-constant-face t)
|
||||
;; ``bar``
|
||||
(,python-docstring-sphinx-markup-code 0 font-lock-constant-face t)
|
||||
;; inline markup - 1
|
||||
(,python-docstring-sphinx-markup-code 1 '(bold italic) t)
|
||||
|
||||
;; L/U - 1
|
||||
(,python-docstring-epytext-markup-link 0 font-lock-constant-face t)
|
||||
;; Inline Markup - 1
|
||||
(,python-docstring-epytext-markup-link 1 font-lock-function-name-face t)
|
||||
;; Link - 2
|
||||
(,python-docstring-epytext-markup-link 2 font-lock-keyword-face t)
|
||||
|
||||
;; C/I/B - 0
|
||||
(,python-docstring-epytext-markup-style-code 0 font-lock-constant-face t)
|
||||
;; inline markup - 1
|
||||
(,python-docstring-epytext-markup-style-code 1 '(bold italic) t)
|
||||
;; C/I/B - 0
|
||||
(,python-docstring-epytext-markup-style-bold 0 font-lock-constant-face t)
|
||||
;; inline markup - 1
|
||||
(,python-docstring-epytext-markup-style-bold 1 (quote bold) t)
|
||||
;; C/I/B - 0
|
||||
(,python-docstring-epytext-markup-style-italic 0 font-lock-constant-face t)
|
||||
;; inline markup - 1
|
||||
(,python-docstring-epytext-markup-style-italic 1 (quote italic) t)))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode python-docstring-mode
|
||||
"Toggle python-docstring-mode.
|
||||
With no argument, this command toggles the mode.
|
||||
Non-null prefix argument turns on the mode.
|
||||
Null prefix argument turns off the mode."
|
||||
;; The initial value.
|
||||
nil
|
||||
;; The indicator for the mode line.
|
||||
" DS"
|
||||
;; The minor mode bindings.
|
||||
`(([(meta q)] . python-docstring-fill))
|
||||
;; &rest BODY
|
||||
(if python-docstring-mode
|
||||
(font-lock-add-keywords nil python-docstring-keywords)
|
||||
(font-lock-remove-keywords nil python-docstring-keywords)))
|
||||
|
||||
;;;###autoload
|
||||
(defun python-docstring-install ()
|
||||
"Add python-docstring-mode as a hook to python.mode."
|
||||
(add-hook 'python-mode-hook (lambda () (python-docstring-mode t))))
|
||||
|
||||
(provide 'python-docstring)
|
||||
|
||||
;;; python-docstring.el ends here
|
||||
BIN
elpa/python-docstring-20190716.921/python-docstring.elc
Normal file
BIN
elpa/python-docstring-20190716.921/python-docstring.elc
Normal file
Binary file not shown.
44
elpa/restclient-20191009.1208/restclient-autoloads.el
Normal file
44
elpa/restclient-20191009.1208/restclient-autoloads.el
Normal file
|
|
@ -0,0 +1,44 @@
|
|||
;;; restclient-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "restclient" "restclient.el" (0 0 0 0))
|
||||
;;; Generated autoloads from restclient.el
|
||||
|
||||
(autoload 'restclient-http-send-current "restclient" "\
|
||||
Sends current request.
|
||||
Optional argument RAW don't reformat response if t.
|
||||
Optional argument STAY-IN-WINDOW do not move focus to response buffer if t.
|
||||
|
||||
\(fn &optional RAW STAY-IN-WINDOW)" t nil)
|
||||
|
||||
(autoload 'restclient-http-send-current-raw "restclient" "\
|
||||
Sends current request and get raw result (no reformatting or syntax highlight of XML, JSON or images).
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'restclient-http-send-current-stay-in-window "restclient" "\
|
||||
Send current request and keep focus in request window.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'restclient-mode "restclient" "\
|
||||
Turn on restclient mode.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "restclient" '("restclient-")))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; restclient-autoloads.el ends here
|
||||
2
elpa/restclient-20191009.1208/restclient-pkg.el
Normal file
2
elpa/restclient-20191009.1208/restclient-pkg.el
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "restclient" "20191009.1208" "An interactive HTTP client for Emacs" 'nil :commit "e8ca809ace13549a1ddffb4e4aaa5d5fce750f3d" :keywords '("http") :authors '(("Pavel Kurnosov" . "pashky@gmail.com")) :maintainer '("Pavel Kurnosov" . "pashky@gmail.com"))
|
||||
631
elpa/restclient-20191009.1208/restclient.el
Normal file
631
elpa/restclient-20191009.1208/restclient.el
Normal file
|
|
@ -0,0 +1,631 @@
|
|||
;;; restclient.el --- An interactive HTTP client for Emacs
|
||||
;;
|
||||
;; Public domain.
|
||||
|
||||
;; Author: Pavel Kurnosov <pashky@gmail.com>
|
||||
;; Maintainer: Pavel Kurnosov <pashky@gmail.com>
|
||||
;; Created: 01 Apr 2012
|
||||
;; Keywords: http
|
||||
;; Package-Version: 20191009.1208
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;; This file is public domain software. Do what you want.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This is a tool to manually explore and test HTTP REST
|
||||
;; webservices. Runs queries from a plain-text query sheet, displays
|
||||
;; results as a pretty-printed XML, JSON and even images.
|
||||
|
||||
;;; Code:
|
||||
;;
|
||||
(require 'url)
|
||||
(require 'json)
|
||||
(require 'outline)
|
||||
|
||||
(defgroup restclient nil
|
||||
"An interactive HTTP client for Emacs."
|
||||
:group 'tools)
|
||||
|
||||
(defcustom restclient-log-request t
|
||||
"Log restclient requests to *Messages*."
|
||||
:group 'restclient
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom restclient-same-buffer-response t
|
||||
"Re-use same buffer for responses or create a new one each time."
|
||||
:group 'restclient
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom restclient-same-buffer-response-name "*HTTP Response*"
|
||||
"Name for response buffer."
|
||||
:group 'restclient
|
||||
:type 'string)
|
||||
|
||||
(defcustom restclient-inhibit-cookies nil
|
||||
"Inhibit restclient from sending cookies implicitly."
|
||||
:group 'restclient
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom restclient-content-type-modes '(("text/xml" . xml-mode)
|
||||
("text/plain" . text-mode)
|
||||
("application/xml" . xml-mode)
|
||||
("application/json" . js-mode)
|
||||
("image/png" . image-mode)
|
||||
("image/jpeg" . image-mode)
|
||||
("image/jpg" . image-mode)
|
||||
("image/gif" . image-mode)
|
||||
("text/html" . html-mode))
|
||||
"An association list mapping content types to buffer modes"
|
||||
:group 'restclient
|
||||
:type '(alist :key-type string :value-type symbol))
|
||||
|
||||
(defgroup restclient-faces nil
|
||||
"Faces used in Restclient Mode"
|
||||
:group 'restclient
|
||||
:group 'faces)
|
||||
|
||||
(defface restclient-variable-name-face
|
||||
'((t (:inherit font-lock-preprocessor-face)))
|
||||
"Face for variable name."
|
||||
:group 'restclient-faces)
|
||||
|
||||
(defface restclient-variable-string-face
|
||||
'((t (:inherit font-lock-string-face)))
|
||||
"Face for variable value (string)."
|
||||
:group 'restclient-faces)
|
||||
|
||||
(defface restclient-variable-elisp-face
|
||||
'((t (:inherit font-lock-function-name-face)))
|
||||
"Face for variable value (Emacs lisp)."
|
||||
:group 'restclient-faces)
|
||||
|
||||
(defface restclient-variable-multiline-face
|
||||
'((t (:inherit font-lock-doc-face)))
|
||||
"Face for multi-line variable value marker."
|
||||
:group 'restclient-faces)
|
||||
|
||||
(defface restclient-variable-usage-face
|
||||
'((t (:inherit restclient-variable-name-face)))
|
||||
"Face for variable usage (only used when headers/body is represented as a single variable, not highlighted when variable appears in the middle of other text)."
|
||||
:group 'restclient-faces)
|
||||
|
||||
(defface restclient-method-face
|
||||
'((t (:inherit font-lock-keyword-face)))
|
||||
"Face for HTTP method."
|
||||
:group 'restclient-faces)
|
||||
|
||||
(defface restclient-url-face
|
||||
'((t (:inherit font-lock-function-name-face)))
|
||||
"Face for variable value (Emacs lisp)."
|
||||
:group 'restclient-faces)
|
||||
|
||||
(defface restclient-file-upload-face
|
||||
'((t (:inherit restclient-variable-multiline-face)))
|
||||
"Face for highlighting upload file paths."
|
||||
:group 'restclient-faces)
|
||||
|
||||
(defface restclient-header-name-face
|
||||
'((t (:inherit font-lock-variable-name-face)))
|
||||
"Face for HTTP header name."
|
||||
:group 'restclient-faces)
|
||||
|
||||
(defface restclient-header-value-face
|
||||
'((t (:inherit font-lock-string-face)))
|
||||
"Face for HTTP header value."
|
||||
:group 'restclient-faces)
|
||||
|
||||
(defvar restclient-within-call nil)
|
||||
|
||||
(defvar restclient-request-time-start nil)
|
||||
(defvar restclient-request-time-end nil)
|
||||
|
||||
(defvar restclient-response-loaded-hook nil
|
||||
"Hook run after response buffer is formatted.")
|
||||
|
||||
(defvar restclient-http-do-hook nil
|
||||
"Hook to run before making request.")
|
||||
|
||||
(defvar restclient-response-received-hook nil
|
||||
"Hook run after data is loaded into response buffer.")
|
||||
|
||||
(defcustom restclient-vars-max-passes 10
|
||||
"Maximum number of recursive variable references. This is to prevent hanging if two variables reference each other directly or indirectly."
|
||||
:group 'restclient
|
||||
:type 'integer)
|
||||
|
||||
(defconst restclient-comment-separator "#")
|
||||
(defconst restclient-comment-start-regexp (concat "^" restclient-comment-separator))
|
||||
(defconst restclient-comment-not-regexp (concat "^[^" restclient-comment-separator "]"))
|
||||
(defconst restclient-empty-line-regexp "^\\s-*$")
|
||||
|
||||
(defconst restclient-method-url-regexp
|
||||
"^\\(GET\\|POST\\|DELETE\\|PUT\\|HEAD\\|OPTIONS\\|PATCH\\) \\(.*\\)$")
|
||||
|
||||
(defconst restclient-header-regexp
|
||||
"^\\([^](),/:;@[\\{}= \t]+\\): \\(.*\\)$")
|
||||
|
||||
(defconst restclient-use-var-regexp
|
||||
"^\\(:[^: \n]+\\)$")
|
||||
|
||||
(defconst restclient-var-regexp
|
||||
(concat "^\\(:[^:= ]+\\)[ \t]*\\(:?\\)=[ \t]*\\(<<[ \t]*\n\\(\\(.*\n\\)*?\\)" restclient-comment-separator "\\|\\([^<].*\\)$\\)"))
|
||||
|
||||
(defconst restclient-svar-regexp
|
||||
"^\\(:[^:= ]+\\)[ \t]*=[ \t]*\\(.+?\\)$")
|
||||
|
||||
(defconst restclient-evar-regexp
|
||||
"^\\(:[^: ]+\\)[ \t]*:=[ \t]*\\(.+?\\)$")
|
||||
|
||||
(defconst restclient-mvar-regexp
|
||||
"^\\(:[^: ]+\\)[ \t]*:?=[ \t]*\\(<<\\)[ \t]*$")
|
||||
|
||||
(defconst restclient-file-regexp
|
||||
"^<[ \t]*\\([^<>\n\r]+\\)[ \t]*$")
|
||||
|
||||
(defconst restclient-content-type-regexp
|
||||
"^Content-[Tt]ype: \\(\\w+\\)/\\(?:[^\\+\r\n]*\\+\\)*\\([^;\r\n]+\\)")
|
||||
|
||||
;; The following disables the interactive request for user name and
|
||||
;; password should an API call encounter a permission-denied response.
|
||||
;; This API is meant to be usable without constant asking for username
|
||||
;; and password.
|
||||
(defadvice url-http-handle-authentication (around restclient-fix)
|
||||
(if restclient-within-call
|
||||
(setq ad-return-value t)
|
||||
ad-do-it))
|
||||
(ad-activate 'url-http-handle-authentication)
|
||||
|
||||
(defadvice url-cache-extract (around restclient-fix-2)
|
||||
(unless restclient-within-call
|
||||
ad-do-it))
|
||||
(ad-activate 'url-cache-extract)
|
||||
|
||||
(defadvice url-http-user-agent-string (around restclient-fix-3)
|
||||
(if restclient-within-call
|
||||
(setq ad-return-value nil)
|
||||
ad-do-it))
|
||||
(ad-activate 'url-http-user-agent-string)
|
||||
|
||||
(defun restclient-http-do (method url headers entity &rest handle-args)
|
||||
"Send ENTITY and HEADERS to URL as a METHOD request."
|
||||
(if restclient-log-request
|
||||
(message "HTTP %s %s Headers:[%s] Body:[%s]" method url headers entity))
|
||||
(let ((url-request-method (encode-coding-string method 'us-ascii))
|
||||
(url-request-extra-headers '())
|
||||
(url-request-data (encode-coding-string entity 'utf-8))
|
||||
(url-mime-charset-string (url-mime-charset-string))
|
||||
(url-mime-language-string nil)
|
||||
(url-mime-encoding-string nil)
|
||||
(url-mime-accept-string nil)
|
||||
(url-personal-mail-address nil))
|
||||
|
||||
(dolist (header headers)
|
||||
(let* ((mapped (assoc-string (downcase (car header))
|
||||
'(("from" . url-personal-mail-address)
|
||||
("accept-encoding" . url-mime-encoding-string)
|
||||
("accept-charset" . url-mime-charset-string)
|
||||
("accept-language" . url-mime-language-string)
|
||||
("accept" . url-mime-accept-string)))))
|
||||
|
||||
(if mapped
|
||||
(set (cdr mapped) (encode-coding-string (cdr header) 'us-ascii))
|
||||
(let* ((hkey (encode-coding-string (car header) 'us-ascii))
|
||||
(hvalue (encode-coding-string (cdr header) 'us-ascii)))
|
||||
(setq url-request-extra-headers (cons (cons hkey hvalue) url-request-extra-headers))))))
|
||||
|
||||
(setq restclient-within-call t)
|
||||
(setq restclient-request-time-start (current-time))
|
||||
(run-hooks 'restclient-http-do-hook)
|
||||
(url-retrieve url 'restclient-http-handle-response
|
||||
(append (list method url (if restclient-same-buffer-response
|
||||
restclient-same-buffer-response-name
|
||||
(format "*HTTP %s %s*" method url))) handle-args) nil restclient-inhibit-cookies)))
|
||||
|
||||
(defun restclient-prettify-response (method url)
|
||||
(save-excursion
|
||||
(let ((start (point)) (guessed-mode) (end-of-headers))
|
||||
(while (and (not (looking-at restclient-empty-line-regexp))
|
||||
(eq (progn
|
||||
(when (looking-at restclient-content-type-regexp)
|
||||
(setq guessed-mode
|
||||
(cdr (assoc-string (concat
|
||||
(match-string-no-properties 1)
|
||||
"/"
|
||||
(match-string-no-properties 2))
|
||||
restclient-content-type-modes
|
||||
t))))
|
||||
(forward-line)) 0)))
|
||||
(setq end-of-headers (point))
|
||||
(while (and (looking-at restclient-empty-line-regexp)
|
||||
(eq (forward-line) 0)))
|
||||
(unless guessed-mode
|
||||
(setq guessed-mode
|
||||
(or (assoc-default nil
|
||||
;; magic mode matches
|
||||
'(("<\\?xml " . xml-mode)
|
||||
("{\\s-*\"" . js-mode))
|
||||
(lambda (re _dummy)
|
||||
(looking-at re))) 'js-mode)))
|
||||
(let ((headers (buffer-substring-no-properties start end-of-headers)))
|
||||
(when guessed-mode
|
||||
(delete-region start (point))
|
||||
(unless (eq guessed-mode 'image-mode)
|
||||
(apply guessed-mode '())
|
||||
(if (fboundp 'font-lock-flush)
|
||||
(font-lock-flush)
|
||||
(with-no-warnings
|
||||
(font-lock-fontify-buffer))))
|
||||
|
||||
(cond
|
||||
((eq guessed-mode 'xml-mode)
|
||||
(goto-char (point-min))
|
||||
(while (search-forward-regexp "\>[ \\t]*\<" nil t)
|
||||
(backward-char) (insert "\n"))
|
||||
(indent-region (point-min) (point-max)))
|
||||
|
||||
((eq guessed-mode 'image-mode)
|
||||
(let* ((img (buffer-string)))
|
||||
(delete-region (point-min) (point-max))
|
||||
(fundamental-mode)
|
||||
(insert-image (create-image img nil t))))
|
||||
|
||||
((eq guessed-mode 'js-mode)
|
||||
(let ((json-special-chars (remq (assoc ?/ json-special-chars) json-special-chars))
|
||||
;; Emacs 27 json.el uses `replace-buffer-contents' for
|
||||
;; pretty-printing which is great because it keeps point and
|
||||
;; markers intact but can be very slow with huge minimalized
|
||||
;; JSON. We don't need that here.
|
||||
(json-pretty-print-max-secs 0))
|
||||
(ignore-errors (json-pretty-print-buffer)))
|
||||
(restclient-prettify-json-unicode)))
|
||||
|
||||
(goto-char (point-max))
|
||||
(or (eq (point) (point-min)) (insert "\n"))
|
||||
(let ((hstart (point)))
|
||||
(insert method " " url "\n" headers)
|
||||
(insert (format "Request duration: %fs\n" (float-time (time-subtract restclient-request-time-end restclient-request-time-start))))
|
||||
(unless (member guessed-mode '(image-mode text-mode))
|
||||
(comment-region hstart (point)))))))))
|
||||
|
||||
(defun restclient-prettify-json-unicode ()
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\\\\[Uu]\\([0-9a-fA-F]\\{4\\}\\)" nil t)
|
||||
(replace-match (char-to-string (decode-char 'ucs (string-to-number (match-string 1) 16))) t nil))))
|
||||
|
||||
(defun restclient-http-handle-response (status method url bufname raw stay-in-window)
|
||||
"Switch to the buffer returned by `url-retreive'.
|
||||
The buffer contains the raw HTTP response sent by the server."
|
||||
(setq restclient-within-call nil)
|
||||
(setq restclient-request-time-end (current-time))
|
||||
(if (= (point-min) (point-max))
|
||||
(signal (car (plist-get status :error)) (cdr (plist-get status :error)))
|
||||
(when (buffer-live-p (current-buffer))
|
||||
(with-current-buffer (restclient-decode-response
|
||||
(current-buffer)
|
||||
bufname
|
||||
restclient-same-buffer-response)
|
||||
(run-hooks 'restclient-response-received-hook)
|
||||
(unless raw
|
||||
(restclient-prettify-response method url))
|
||||
(buffer-enable-undo)
|
||||
(restclient-response-mode)
|
||||
(run-hooks 'restclient-response-loaded-hook)
|
||||
(if stay-in-window
|
||||
(display-buffer (current-buffer) t)
|
||||
(switch-to-buffer-other-window (current-buffer)))))))
|
||||
|
||||
(defun restclient-decode-response (raw-http-response-buffer target-buffer-name same-name)
|
||||
"Decode the HTTP response using the charset (encoding) specified in the Content-Type header. If no charset is specified, default to UTF-8."
|
||||
(let* ((charset-regexp "^Content-Type.*charset=\\([-A-Za-z0-9]+\\)")
|
||||
(image? (save-excursion
|
||||
(search-forward-regexp "^Content-Type.*[Ii]mage" nil t)))
|
||||
(encoding (if (save-excursion
|
||||
(search-forward-regexp charset-regexp nil t))
|
||||
(intern (downcase (match-string 1)))
|
||||
'utf-8)))
|
||||
(if image?
|
||||
;; Dont' attempt to decode. Instead, just switch to the raw HTTP response buffer and
|
||||
;; rename it to target-buffer-name.
|
||||
(with-current-buffer raw-http-response-buffer
|
||||
;; We have to kill the target buffer if it exists, or `rename-buffer'
|
||||
;; will raise an error.
|
||||
(when (get-buffer target-buffer-name)
|
||||
(kill-buffer target-buffer-name))
|
||||
(rename-buffer target-buffer-name)
|
||||
raw-http-response-buffer)
|
||||
;; Else, switch to the new, empty buffer that will contain the decoded HTTP
|
||||
;; response. Set its encoding, copy the content from the unencoded
|
||||
;; HTTP response buffer and decode.
|
||||
(let ((decoded-http-response-buffer
|
||||
(get-buffer-create
|
||||
(if same-name target-buffer-name (generate-new-buffer-name target-buffer-name)))))
|
||||
(with-current-buffer decoded-http-response-buffer
|
||||
(setq buffer-file-coding-system encoding)
|
||||
(save-excursion
|
||||
(erase-buffer)
|
||||
(insert-buffer-substring raw-http-response-buffer))
|
||||
(kill-buffer raw-http-response-buffer)
|
||||
(condition-case nil
|
||||
(decode-coding-region (point-min) (point-max) encoding)
|
||||
(error
|
||||
(message (concat "Error when trying to decode http response with encoding: "
|
||||
(symbol-name encoding)))))
|
||||
decoded-http-response-buffer)))))
|
||||
|
||||
(defun restclient-current-min ()
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(if (looking-at restclient-comment-start-regexp)
|
||||
(if (re-search-forward restclient-comment-not-regexp (point-max) t)
|
||||
(point-at-bol) (point-max))
|
||||
(if (re-search-backward restclient-comment-start-regexp (point-min) t)
|
||||
(point-at-bol 2)
|
||||
(point-min)))))
|
||||
|
||||
(defun restclient-current-max ()
|
||||
(save-excursion
|
||||
(if (re-search-forward restclient-comment-start-regexp (point-max) t)
|
||||
(max (- (point-at-bol) 1) 1)
|
||||
(progn (goto-char (point-max))
|
||||
(if (looking-at "^$") (- (point) 1) (point))))))
|
||||
|
||||
(defun restclient-replace-all-in-string (replacements string)
|
||||
(if replacements
|
||||
(let ((current string)
|
||||
(pass restclient-vars-max-passes)
|
||||
(continue t))
|
||||
(while (and continue (> pass 0))
|
||||
(setq pass (- pass 1))
|
||||
(setq current (replace-regexp-in-string (regexp-opt (mapcar 'car replacements))
|
||||
(lambda (key)
|
||||
(setq continue t)
|
||||
(cdr (assoc key replacements)))
|
||||
current t t)))
|
||||
current)
|
||||
string))
|
||||
|
||||
(defun restclient-replace-all-in-header (replacements header)
|
||||
(cons (car header)
|
||||
(restclient-replace-all-in-string replacements (cdr header))))
|
||||
|
||||
(defun restclient-chop (text)
|
||||
(if text (replace-regexp-in-string "\n$" "" text) nil))
|
||||
|
||||
(defun restclient-find-vars-before-point ()
|
||||
(let ((vars nil)
|
||||
(bound (point)))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (search-forward-regexp restclient-var-regexp bound t)
|
||||
(let ((name (match-string-no-properties 1))
|
||||
(should-eval (> (length (match-string 2)) 0))
|
||||
(value (or (restclient-chop (match-string-no-properties 4)) (match-string-no-properties 3))))
|
||||
(setq vars (cons (cons name (if should-eval (restclient-eval-var value) value)) vars))))
|
||||
vars)))
|
||||
|
||||
(defun restclient-eval-var (string)
|
||||
(with-output-to-string (princ (eval (read string)))))
|
||||
|
||||
(defun restclient-make-header (&optional string)
|
||||
(cons (match-string-no-properties 1 string)
|
||||
(match-string-no-properties 2 string)))
|
||||
|
||||
(defun restclient-parse-headers (string)
|
||||
(let ((start 0)
|
||||
(headers '()))
|
||||
(while (string-match restclient-header-regexp string start)
|
||||
(setq headers (cons (restclient-make-header string) headers)
|
||||
start (match-end 0)))
|
||||
headers))
|
||||
|
||||
(defun restclient-read-file (path)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents path)
|
||||
(buffer-string)))
|
||||
|
||||
(defun restclient-parse-body (entity vars)
|
||||
(if (= 0 (or (string-match restclient-file-regexp entity) 1))
|
||||
(restclient-read-file (match-string 1 entity))
|
||||
(restclient-replace-all-in-string vars entity)))
|
||||
|
||||
(defun restclient-http-parse-current-and-do (func &rest args)
|
||||
(save-excursion
|
||||
(goto-char (restclient-current-min))
|
||||
(when (re-search-forward restclient-method-url-regexp (point-max) t)
|
||||
(let ((method (match-string-no-properties 1))
|
||||
(url (match-string-no-properties 2))
|
||||
(vars (restclient-find-vars-before-point))
|
||||
(headers '()))
|
||||
(forward-line)
|
||||
(while (cond
|
||||
((and (looking-at restclient-header-regexp) (not (looking-at restclient-empty-line-regexp)))
|
||||
(setq headers (cons (restclient-replace-all-in-header vars (restclient-make-header)) headers)))
|
||||
((looking-at restclient-use-var-regexp)
|
||||
(setq headers (append headers (restclient-parse-headers (restclient-replace-all-in-string vars (match-string 1)))))))
|
||||
(forward-line))
|
||||
(when (looking-at restclient-empty-line-regexp)
|
||||
(forward-line))
|
||||
(let* ((cmax (restclient-current-max))
|
||||
(entity (restclient-parse-body (buffer-substring (min (point) cmax) cmax) vars))
|
||||
(url (restclient-replace-all-in-string vars url)))
|
||||
(apply func method url headers entity args))))))
|
||||
|
||||
(defun restclient-copy-curl-command ()
|
||||
"Formats the request as a curl command and copies the command to the clipboard."
|
||||
(interactive)
|
||||
(restclient-http-parse-current-and-do
|
||||
'(lambda (method url headers entity)
|
||||
(let ((header-args
|
||||
(apply 'append
|
||||
(mapcar (lambda (header)
|
||||
(list "-H" (format "%s: %s" (car header) (cdr header))))
|
||||
headers))))
|
||||
(kill-new (concat "curl "
|
||||
(mapconcat 'shell-quote-argument
|
||||
(append '("-i")
|
||||
header-args
|
||||
(list (concat "-X" method))
|
||||
(list url)
|
||||
(when (> (string-width entity) 0)
|
||||
(list "-d" entity)))
|
||||
" "))))
|
||||
(message "curl command copied to clipboard."))))
|
||||
|
||||
;;;###autoload
|
||||
(defun restclient-http-send-current (&optional raw stay-in-window)
|
||||
"Sends current request.
|
||||
Optional argument RAW don't reformat response if t.
|
||||
Optional argument STAY-IN-WINDOW do not move focus to response buffer if t."
|
||||
(interactive)
|
||||
(restclient-http-parse-current-and-do 'restclient-http-do raw stay-in-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun restclient-http-send-current-raw ()
|
||||
"Sends current request and get raw result (no reformatting or syntax highlight of XML, JSON or images)."
|
||||
(interactive)
|
||||
(restclient-http-send-current t))
|
||||
|
||||
;;;###autoload
|
||||
(defun restclient-http-send-current-stay-in-window ()
|
||||
"Send current request and keep focus in request window."
|
||||
(interactive)
|
||||
(restclient-http-send-current nil t))
|
||||
|
||||
(defun restclient-jump-next ()
|
||||
"Jump to next request in buffer."
|
||||
(interactive)
|
||||
(let ((last-min nil))
|
||||
(while (not (eq last-min (goto-char (restclient-current-min))))
|
||||
(goto-char (restclient-current-min))
|
||||
(setq last-min (point))))
|
||||
(goto-char (+ (restclient-current-max) 1))
|
||||
(goto-char (restclient-current-min)))
|
||||
|
||||
(defun restclient-jump-prev ()
|
||||
"Jump to previous request in buffer."
|
||||
(interactive)
|
||||
(let* ((current-min (restclient-current-min))
|
||||
(end-of-entity
|
||||
(save-excursion
|
||||
(progn (goto-char (restclient-current-min))
|
||||
(while (and (or (looking-at "^\s*\\(#.*\\)?$")
|
||||
(eq (point) current-min))
|
||||
(not (eq (point) (point-min))))
|
||||
(forward-line -1)
|
||||
(beginning-of-line))
|
||||
(point)))))
|
||||
(unless (eq (point-min) end-of-entity)
|
||||
(goto-char end-of-entity)
|
||||
(goto-char (restclient-current-min)))))
|
||||
|
||||
(defun restclient-mark-current ()
|
||||
"Mark current request."
|
||||
(interactive)
|
||||
(goto-char (restclient-current-min))
|
||||
(set-mark-command nil)
|
||||
(goto-char (restclient-current-max))
|
||||
(backward-char 1)
|
||||
(setq deactivate-mark nil))
|
||||
|
||||
(defun restclient-narrow-to-current ()
|
||||
"Narrow to region of current request"
|
||||
(interactive)
|
||||
(narrow-to-region (restclient-current-min) (restclient-current-max)))
|
||||
|
||||
(defun restclient-toggle-body-visibility ()
|
||||
(interactive)
|
||||
;; If we are not on the HTTP call line, don't do anything
|
||||
(let ((at-header (save-excursion
|
||||
(beginning-of-line)
|
||||
(looking-at restclient-method-url-regexp))))
|
||||
(when at-header
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
;; If the overlays at this point have 'invisible set, toggling
|
||||
;; must make the region visible. Else it must hide the region
|
||||
|
||||
;; This part of code is from org-hide-block-toggle method of
|
||||
;; Org mode
|
||||
(let ((overlays (overlays-at (point))))
|
||||
(if (memq t (mapcar
|
||||
(lambda (o)
|
||||
(eq (overlay-get o 'invisible) 'outline))
|
||||
overlays))
|
||||
(outline-flag-region (point) (restclient-current-max) nil)
|
||||
(outline-flag-region (point) (restclient-current-max) t)))) t)))
|
||||
|
||||
(defun restclient-toggle-body-visibility-or-indent ()
|
||||
(interactive)
|
||||
(unless (restclient-toggle-body-visibility)
|
||||
(indent-for-tab-command)))
|
||||
|
||||
(defconst restclient-mode-keywords
|
||||
(list (list restclient-method-url-regexp '(1 'restclient-method-face) '(2 'restclient-url-face))
|
||||
(list restclient-svar-regexp '(1 'restclient-variable-name-face) '(2 'restclient-variable-string-face))
|
||||
(list restclient-evar-regexp '(1 'restclient-variable-name-face) '(2 'restclient-variable-elisp-face t))
|
||||
(list restclient-mvar-regexp '(1 'restclient-variable-name-face) '(2 'restclient-variable-multiline-face t))
|
||||
(list restclient-use-var-regexp '(1 'restclient-variable-usage-face))
|
||||
(list restclient-file-regexp '(0 'restclient-file-upload-face))
|
||||
(list restclient-header-regexp '(1 'restclient-header-name-face t) '(2 'restclient-header-value-face t))
|
||||
))
|
||||
|
||||
(defconst restclient-mode-syntax-table
|
||||
(let ((table (make-syntax-table)))
|
||||
(modify-syntax-entry ?\# "<" table)
|
||||
(modify-syntax-entry ?\n ">#" table)
|
||||
table))
|
||||
|
||||
(defvar restclient-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "C-c C-c") 'restclient-http-send-current)
|
||||
(define-key map (kbd "C-c C-r") 'restclient-http-send-current-raw)
|
||||
(define-key map (kbd "C-c C-v") 'restclient-http-send-current-stay-in-window)
|
||||
(define-key map (kbd "C-c C-n") 'restclient-jump-next)
|
||||
(define-key map (kbd "C-c C-p") 'restclient-jump-prev)
|
||||
(define-key map (kbd "C-c C-.") 'restclient-mark-current)
|
||||
(define-key map (kbd "C-c C-u") 'restclient-copy-curl-command)
|
||||
(define-key map (kbd "C-c n n") 'restclient-narrow-to-current)
|
||||
map)
|
||||
"Keymap for restclient-mode.")
|
||||
|
||||
(define-minor-mode restclient-outline-mode
|
||||
"Minor mode to allow show/hide of request bodies by TAB."
|
||||
:init-value nil
|
||||
:lighter nil
|
||||
:keymap '(("\t" . restclient-toggle-body-visibility-or-indent)
|
||||
("\C-c\C-a" . restclient-toggle-body-visibility-or-indent))
|
||||
:group 'restclient)
|
||||
|
||||
(define-minor-mode restclient-response-mode
|
||||
"Minor mode to allow additional keybindings in restclient response buffer."
|
||||
:init-value nil
|
||||
:lighter nil
|
||||
:keymap '(("q" . (lambda ()
|
||||
(interactive)
|
||||
(quit-window (get-buffer-window (current-buffer))))))
|
||||
:group 'restclient)
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode restclient-mode fundamental-mode "REST Client"
|
||||
"Turn on restclient mode."
|
||||
(set (make-local-variable 'comment-start) "# ")
|
||||
(set (make-local-variable 'comment-start-skip) "# *")
|
||||
(set (make-local-variable 'comment-column) 48)
|
||||
|
||||
(set (make-local-variable 'font-lock-defaults) '(restclient-mode-keywords))
|
||||
;; We use outline-mode's method outline-flag-region to hide/show the
|
||||
;; body. As a part of it, it sets 'invisibility text property to
|
||||
;; 'outline. To get ellipsis, we need 'outline to be in
|
||||
;; buffer-invisibility-spec
|
||||
(add-to-invisibility-spec '(outline . t)))
|
||||
|
||||
(add-hook 'restclient-mode-hook 'restclient-outline-mode)
|
||||
|
||||
(provide 'restclient)
|
||||
|
||||
(eval-after-load 'helm
|
||||
'(ignore-errors (require 'restclient-helm)))
|
||||
|
||||
;;; restclient.el ends here
|
||||
BIN
elpa/restclient-20191009.1208/restclient.elc
Normal file
BIN
elpa/restclient-20191009.1208/restclient.elc
Normal file
Binary file not shown.
|
|
@ -0,0 +1,43 @@
|
|||
;;; restclient-test-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "restclient-test" "restclient-test.el" (0 0
|
||||
;;;;;; 0 0))
|
||||
;;; Generated autoloads from restclient-test.el
|
||||
|
||||
(autoload 'restclient-test-current "restclient-test" "\
|
||||
Test query at point.
|
||||
When the test contains an \"Expect\" entry, return `pass' if the
|
||||
test passed and `fail' if the test failed. Else return nil.'
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'restclient-test-buffer "restclient-test" "\
|
||||
Test every query in the current buffer.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'restclient-test-mode "restclient-test" "\
|
||||
Minor mode with key-bindings for restclient-test commands.
|
||||
With a prefix argument ARG, enable the mode if ARG is positive,
|
||||
and disable it otherwise. If called from Lisp, enable the mode
|
||||
if ARG is omitted or nil.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "restclient-test" '("restclient-test-")))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; restclient-test-autoloads.el ends here
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "restclient-test" "20180106.2046" "Run tests with restclient.el" '((emacs "24.4") (restclient "0")) :commit "4518561bc9661fedacb6fb352e9677207f45c418" :authors '(("Simen Heggestøyl" . "simenheg@gmail.com")) :maintainer '("Simen Heggestøyl" . "simenheg@gmail.com") :url "https://github.com/simenheg/restclient-test.el")
|
||||
146
elpa/restclient-test-20180106.2046/restclient-test.el
Normal file
146
elpa/restclient-test-20180106.2046/restclient-test.el
Normal file
|
|
@ -0,0 +1,146 @@
|
|||
;;; restclient-test.el --- Run tests with restclient.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2016-2018 Simen Heggestøyl
|
||||
|
||||
;; Author: Simen Heggestøyl <simenheg@gmail.com>
|
||||
;; Created: 14 May 2016
|
||||
;; Version: 0.2
|
||||
;; Package-Version: 20180106.2046
|
||||
;; Package-Requires: ((emacs "24.4") (restclient "0"))
|
||||
;; Homepage: https://github.com/simenheg/restclient-test.el
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Turn your restclient.el documents into interactive test suites!
|
||||
|
||||
;; See README.org for more information.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'restclient)
|
||||
(require 'subr-x)
|
||||
|
||||
(defun restclient-test--goto-entry (entry)
|
||||
"Move point to ENTRY and save it in the match data.
|
||||
The whole entry is saved in the match data at index 0, while its
|
||||
value is saved at index 1."
|
||||
(re-search-backward
|
||||
(concat "# " entry ":\\(.*\\)")
|
||||
(save-excursion (backward-sentence)) t))
|
||||
|
||||
(defun restclient-test--update-entry (entry value)
|
||||
"Update or create ENTRY with value VALUE."
|
||||
(let ((entry-header (concat "# " entry ":")))
|
||||
(save-excursion
|
||||
(when (restclient-test--goto-entry entry)
|
||||
(delete-region (point) (line-end-position))
|
||||
(backward-delete-char 1)))
|
||||
(insert entry-header " " value "\n")))
|
||||
|
||||
;;;###autoload
|
||||
(defun restclient-test-current ()
|
||||
"Test query at point.
|
||||
When the test contains an \"Expect\" entry, return `pass' if the
|
||||
test passed and `fail' if the test failed. Else return nil.'"
|
||||
(interactive)
|
||||
(save-window-excursion
|
||||
(save-excursion
|
||||
(goto-char (restclient-current-min))
|
||||
(if (not (looking-at-p restclient-method-url-regexp))
|
||||
(when (called-interactively-p 'interactive)
|
||||
(message "This doesn't look like a query"))
|
||||
(let ((buf (current-buffer)))
|
||||
(restclient-http-send-current t t)
|
||||
(while restclient-within-call
|
||||
(sit-for 0.05))
|
||||
(switch-to-buffer "*HTTP Response*")
|
||||
(let ((response (buffer-substring-no-properties
|
||||
(point-min) (line-end-position))))
|
||||
(switch-to-buffer buf)
|
||||
(restclient-test--update-entry "Response" response)
|
||||
(let ((expect
|
||||
(save-excursion
|
||||
(restclient-test--goto-entry "Expect")
|
||||
(match-string-no-properties 1))))
|
||||
(when expect
|
||||
(let ((passed
|
||||
(string-match-p (string-trim expect) response)))
|
||||
(restclient-test--update-entry
|
||||
"Result" (if passed "Passed" "Failed"))
|
||||
(if passed 'pass 'fail))))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun restclient-test-buffer ()
|
||||
"Test every query in the current buffer."
|
||||
(interactive)
|
||||
(let ((restclient-log-request nil)
|
||||
(num-pass 0)
|
||||
(num-fail 0))
|
||||
(save-excursion
|
||||
;; Attempt to find the first query in the buffer
|
||||
(goto-char (point-min))
|
||||
(restclient-jump-next)
|
||||
(restclient-jump-prev)
|
||||
(while (let ((res (restclient-test-current)))
|
||||
(cond
|
||||
((eq res 'pass) (setq num-pass (+ num-pass 1)))
|
||||
((eq res 'fail) (setq num-fail (+ num-fail 1))))
|
||||
(goto-char (restclient-current-min))
|
||||
(let ((prev (point)))
|
||||
(restclient-jump-next)
|
||||
(goto-char (restclient-current-min))
|
||||
(/= prev (point))))))
|
||||
(message "Test results: %d passed, %d failed" num-pass num-fail)))
|
||||
|
||||
(defun restclient-test-next-error (arg)
|
||||
"Jump to the first failed test found after point.
|
||||
The numeric argument ARG decides how many failed tests to jump
|
||||
forward, or backward with a negative argument."
|
||||
(interactive "p")
|
||||
(let ((orig-pos (point)))
|
||||
(if (< arg 0)
|
||||
(beginning-of-line)
|
||||
(end-of-line))
|
||||
(let ((found-failure (search-forward "Result: Failed" nil t arg)))
|
||||
(beginning-of-line)
|
||||
(unless found-failure
|
||||
(goto-char orig-pos)
|
||||
(message "No more failed tests %s point"
|
||||
(if (< arg 0) "before" "after"))))))
|
||||
|
||||
(defun restclient-test-previous-error (arg)
|
||||
"Jump to the first failed test found before point."
|
||||
(interactive "p")
|
||||
(restclient-test-next-error (* arg -1)))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode restclient-test-mode
|
||||
"Minor mode with key-bindings for restclient-test commands.
|
||||
With a prefix argument ARG, enable the mode if ARG is positive,
|
||||
and disable it otherwise. If called from Lisp, enable the mode
|
||||
if ARG is omitted or nil."
|
||||
:lighter " REST Test"
|
||||
:keymap `((,(kbd "C-c C-b") . restclient-test-buffer)
|
||||
(,(kbd "C-c C-t") . restclient-test-current)
|
||||
(,(kbd "M-g n") . restclient-test-next-error)
|
||||
(,(kbd "M-g M-n") . restclient-test-next-error)
|
||||
(,(kbd "M-g p") . restclient-test-previous-error)
|
||||
(,(kbd "M-g M-p") . restclient-test-previous-error)))
|
||||
|
||||
(provide 'restclient-test)
|
||||
;;; restclient-test.el ends here
|
||||
BIN
elpa/restclient-test-20180106.2046/restclient-test.elc
Normal file
BIN
elpa/restclient-test-20180106.2046/restclient-test.elc
Normal file
Binary file not shown.
22
elpa/s-20180406.808/s-autoloads.el
Normal file
22
elpa/s-20180406.808/s-autoloads.el
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
;;; s-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "s" "s.el" (0 0 0 0))
|
||||
;;; Generated autoloads from s.el
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "s" '("s-")))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; s-autoloads.el ends here
|
||||
2
elpa/s-20180406.808/s-pkg.el
Normal file
2
elpa/s-20180406.808/s-pkg.el
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "s" "20180406.808" "The long lost Emacs string manipulation library." 'nil :commit "03410e6a7a2b11e47e1fea3b7d9899c7df26435e" :keywords '("strings") :authors '(("Magnar Sveen" . "magnars@gmail.com")) :maintainer '("Magnar Sveen" . "magnars@gmail.com"))
|
||||
747
elpa/s-20180406.808/s.el
Normal file
747
elpa/s-20180406.808/s.el
Normal file
|
|
@ -0,0 +1,747 @@
|
|||
;;; s.el --- The long lost Emacs string manipulation library.
|
||||
|
||||
;; Copyright (C) 2012-2015 Magnar Sveen
|
||||
|
||||
;; Author: Magnar Sveen <magnars@gmail.com>
|
||||
;; Version: 1.12.0
|
||||
;; Package-Version: 20180406.808
|
||||
;; Keywords: strings
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; The long lost Emacs string manipulation library.
|
||||
;;
|
||||
;; See documentation on https://github.com/magnars/s.el#functions
|
||||
|
||||
;;; Code:
|
||||
|
||||
;; Silence byte-compiler
|
||||
(defvar ucs-normalize-combining-chars) ; Defined in `ucs-normalize'
|
||||
(autoload 'slot-value "eieio")
|
||||
|
||||
(defun s-trim-left (s)
|
||||
"Remove whitespace at the beginning of S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(save-match-data
|
||||
(if (string-match "\\`[ \t\n\r]+" s)
|
||||
(replace-match "" t t s)
|
||||
s)))
|
||||
|
||||
(defun s-trim-right (s)
|
||||
"Remove whitespace at the end of S."
|
||||
(save-match-data
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(if (string-match "[ \t\n\r]+\\'" s)
|
||||
(replace-match "" t t s)
|
||||
s)))
|
||||
|
||||
(defun s-trim (s)
|
||||
"Remove whitespace at the beginning and end of S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(s-trim-left (s-trim-right s)))
|
||||
|
||||
(defun s-collapse-whitespace (s)
|
||||
"Convert all adjacent whitespace characters to a single space."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(replace-regexp-in-string "[ \t\n\r]+" " " s))
|
||||
|
||||
(defun s-split (separator s &optional omit-nulls)
|
||||
"Split S into substrings bounded by matches for regexp SEPARATOR.
|
||||
If OMIT-NULLS is non-nil, zero-length substrings are omitted.
|
||||
|
||||
This is a simple wrapper around the built-in `split-string'."
|
||||
(declare (side-effect-free t))
|
||||
(save-match-data
|
||||
(split-string s separator omit-nulls)))
|
||||
|
||||
(defun s-split-up-to (separator s n &optional omit-nulls)
|
||||
"Split S up to N times into substrings bounded by matches for regexp SEPARATOR.
|
||||
|
||||
If OMIT-NULLS is non-nil, zero-length substrings are omitted.
|
||||
|
||||
See also `s-split'."
|
||||
(declare (side-effect-free t))
|
||||
(save-match-data
|
||||
(let ((op 0)
|
||||
(r nil))
|
||||
(with-temp-buffer
|
||||
(insert s)
|
||||
(setq op (goto-char (point-min)))
|
||||
(while (and (re-search-forward separator nil t)
|
||||
(< 0 n))
|
||||
(let ((sub (buffer-substring op (match-beginning 0))))
|
||||
(unless (and omit-nulls
|
||||
(equal sub ""))
|
||||
(push sub r)))
|
||||
(setq op (goto-char (match-end 0)))
|
||||
(setq n (1- n)))
|
||||
(let ((sub (buffer-substring op (point-max))))
|
||||
(unless (and omit-nulls
|
||||
(equal sub ""))
|
||||
(push sub r))))
|
||||
(nreverse r))))
|
||||
|
||||
(defun s-lines (s)
|
||||
"Splits S into a list of strings on newline characters."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(s-split "\\(\r\n\\|[\n\r]\\)" s))
|
||||
|
||||
(defun s-join (separator strings)
|
||||
"Join all the strings in STRINGS with SEPARATOR in between."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(mapconcat 'identity strings separator))
|
||||
|
||||
(defun s-concat (&rest strings)
|
||||
"Join all the string arguments into one string."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(apply 'concat strings))
|
||||
|
||||
(defun s-prepend (prefix s)
|
||||
"Concatenate PREFIX and S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(concat prefix s))
|
||||
|
||||
(defun s-append (suffix s)
|
||||
"Concatenate S and SUFFIX."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(concat s suffix))
|
||||
|
||||
(defun s-repeat (num s)
|
||||
"Make a string of S repeated NUM times."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let (ss)
|
||||
(while (> num 0)
|
||||
(setq ss (cons s ss))
|
||||
(setq num (1- num)))
|
||||
(apply 'concat ss)))
|
||||
|
||||
(defun s-chop-suffix (suffix s)
|
||||
"Remove SUFFIX if it is at end of S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((pos (- (length suffix))))
|
||||
(if (and (>= (length s) (length suffix))
|
||||
(string= suffix (substring s pos)))
|
||||
(substring s 0 pos)
|
||||
s)))
|
||||
|
||||
(defun s-chop-suffixes (suffixes s)
|
||||
"Remove SUFFIXES one by one in order, if they are at the end of S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(while suffixes
|
||||
(setq s (s-chop-suffix (car suffixes) s))
|
||||
(setq suffixes (cdr suffixes)))
|
||||
s)
|
||||
|
||||
(defun s-chop-prefix (prefix s)
|
||||
"Remove PREFIX if it is at the start of S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((pos (length prefix)))
|
||||
(if (and (>= (length s) (length prefix))
|
||||
(string= prefix (substring s 0 pos)))
|
||||
(substring s pos)
|
||||
s)))
|
||||
|
||||
(defun s-chop-prefixes (prefixes s)
|
||||
"Remove PREFIXES one by one in order, if they are at the start of S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(while prefixes
|
||||
(setq s (s-chop-prefix (car prefixes) s))
|
||||
(setq prefixes (cdr prefixes)))
|
||||
s)
|
||||
|
||||
(defun s-shared-start (s1 s2)
|
||||
"Returns the longest prefix S1 and S2 have in common."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((search-length (min (length s1) (length s2)))
|
||||
(i 0))
|
||||
(while (and (< i search-length)
|
||||
(= (aref s1 i) (aref s2 i)))
|
||||
(setq i (1+ i)))
|
||||
(substring s1 0 i)))
|
||||
|
||||
(defun s-shared-end (s1 s2)
|
||||
"Returns the longest suffix S1 and S2 have in common."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let* ((l1 (length s1))
|
||||
(l2 (length s2))
|
||||
(search-length (min l1 l2))
|
||||
(i 0))
|
||||
(while (and (< i search-length)
|
||||
(= (aref s1 (- l1 i 1)) (aref s2 (- l2 i 1))))
|
||||
(setq i (1+ i)))
|
||||
;; If I is 0, then it means that there's no common suffix between
|
||||
;; S1 and S2.
|
||||
;;
|
||||
;; However, since (substring s (- 0)) will return the whole
|
||||
;; string, `s-shared-end' should simply return the empty string
|
||||
;; when I is 0.
|
||||
(if (zerop i)
|
||||
""
|
||||
(substring s1 (- i)))))
|
||||
|
||||
(defun s-chomp (s)
|
||||
"Remove one trailing `\\n`, `\\r` or `\\r\\n` from S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(s-chop-suffixes '("\n" "\r") s))
|
||||
|
||||
(defun s-truncate (len s &optional ellipsis)
|
||||
"If S is longer than LEN, cut it down and add ELLIPSIS to the end.
|
||||
|
||||
The resulting string, including ellipsis, will be LEN characters
|
||||
long.
|
||||
|
||||
When not specified, ELLIPSIS defaults to ‘...’."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(unless ellipsis
|
||||
(setq ellipsis "..."))
|
||||
(if (> (length s) len)
|
||||
(format "%s%s" (substring s 0 (- len (length ellipsis))) ellipsis)
|
||||
s))
|
||||
|
||||
(defun s-word-wrap (len s)
|
||||
"If S is longer than LEN, wrap the words with newlines."
|
||||
(declare (side-effect-free t))
|
||||
(save-match-data
|
||||
(with-temp-buffer
|
||||
(insert s)
|
||||
(let ((fill-column len))
|
||||
(fill-region (point-min) (point-max)))
|
||||
(buffer-substring (point-min) (point-max)))))
|
||||
|
||||
(defun s-center (len s)
|
||||
"If S is shorter than LEN, pad it with spaces so it is centered."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((extra (max 0 (- len (length s)))))
|
||||
(concat
|
||||
(make-string (ceiling extra 2) ? )
|
||||
s
|
||||
(make-string (floor extra 2) ? ))))
|
||||
|
||||
(defun s-pad-left (len padding s)
|
||||
"If S is shorter than LEN, pad it with PADDING on the left."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((extra (max 0 (- len (length s)))))
|
||||
(concat (make-string extra (string-to-char padding))
|
||||
s)))
|
||||
|
||||
(defun s-pad-right (len padding s)
|
||||
"If S is shorter than LEN, pad it with PADDING on the right."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((extra (max 0 (- len (length s)))))
|
||||
(concat s
|
||||
(make-string extra (string-to-char padding)))))
|
||||
|
||||
(defun s-left (len s)
|
||||
"Returns up to the LEN first chars of S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(if (> (length s) len)
|
||||
(substring s 0 len)
|
||||
s))
|
||||
|
||||
(defun s-right (len s)
|
||||
"Returns up to the LEN last chars of S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((l (length s)))
|
||||
(if (> l len)
|
||||
(substring s (- l len) l)
|
||||
s)))
|
||||
|
||||
(defun s-ends-with? (suffix s &optional ignore-case)
|
||||
"Does S end with SUFFIX?
|
||||
|
||||
If IGNORE-CASE is non-nil, the comparison is done without paying
|
||||
attention to case differences.
|
||||
|
||||
Alias: `s-suffix?'"
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((start-pos (- (length s) (length suffix))))
|
||||
(and (>= start-pos 0)
|
||||
(eq t (compare-strings suffix nil nil
|
||||
s start-pos nil ignore-case)))))
|
||||
|
||||
(defun s-starts-with? (prefix s &optional ignore-case)
|
||||
"Does S start with PREFIX?
|
||||
|
||||
If IGNORE-CASE is non-nil, the comparison is done without paying
|
||||
attention to case differences.
|
||||
|
||||
Alias: `s-prefix?'. This is a simple wrapper around the built-in
|
||||
`string-prefix-p'."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(string-prefix-p prefix s ignore-case))
|
||||
|
||||
(defun s--truthy? (val)
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(not (null val)))
|
||||
|
||||
(defun s-contains? (needle s &optional ignore-case)
|
||||
"Does S contain NEEDLE?
|
||||
|
||||
If IGNORE-CASE is non-nil, the comparison is done without paying
|
||||
attention to case differences."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((case-fold-search ignore-case))
|
||||
(s--truthy? (string-match-p (regexp-quote needle) s))))
|
||||
|
||||
(defun s-equals? (s1 s2)
|
||||
"Is S1 equal to S2?
|
||||
|
||||
This is a simple wrapper around the built-in `string-equal'."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(string-equal s1 s2))
|
||||
|
||||
(defun s-less? (s1 s2)
|
||||
"Is S1 less than S2?
|
||||
|
||||
This is a simple wrapper around the built-in `string-lessp'."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(string-lessp s1 s2))
|
||||
|
||||
(defun s-matches? (regexp s &optional start)
|
||||
"Does REGEXP match S?
|
||||
If START is non-nil the search starts at that index.
|
||||
|
||||
This is a simple wrapper around the built-in `string-match-p'."
|
||||
(declare (side-effect-free t))
|
||||
(s--truthy? (string-match-p regexp s start)))
|
||||
|
||||
(defun s-blank? (s)
|
||||
"Is S nil or the empty string?"
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(or (null s) (string= "" s)))
|
||||
|
||||
(defun s-blank-str? (s)
|
||||
"Is S nil or the empty string or string only contains whitespace?"
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(or (s-blank? s) (s-blank? (s-trim s))))
|
||||
|
||||
(defun s-present? (s)
|
||||
"Is S anything but nil or the empty string?"
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(not (s-blank? s)))
|
||||
|
||||
(defun s-presence (s)
|
||||
"Return S if it's `s-present?', otherwise return nil."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(and (s-present? s) s))
|
||||
|
||||
(defun s-lowercase? (s)
|
||||
"Are all the letters in S in lower case?"
|
||||
(declare (side-effect-free t))
|
||||
(let ((case-fold-search nil))
|
||||
(not (string-match-p "[[:upper:]]" s))))
|
||||
|
||||
(defun s-uppercase? (s)
|
||||
"Are all the letters in S in upper case?"
|
||||
(declare (side-effect-free t))
|
||||
(let ((case-fold-search nil))
|
||||
(not (string-match-p "[[:lower:]]" s))))
|
||||
|
||||
(defun s-mixedcase? (s)
|
||||
"Are there both lower case and upper case letters in S?"
|
||||
(let ((case-fold-search nil))
|
||||
(s--truthy?
|
||||
(and (string-match-p "[[:lower:]]" s)
|
||||
(string-match-p "[[:upper:]]" s)))))
|
||||
|
||||
(defun s-capitalized? (s)
|
||||
"In S, is the first letter upper case, and all other letters lower case?"
|
||||
(declare (side-effect-free t))
|
||||
(let ((case-fold-search nil))
|
||||
(s--truthy?
|
||||
(string-match-p "^[[:upper:]][^[:upper:]]*$" s))))
|
||||
|
||||
(defun s-numeric? (s)
|
||||
"Is S a number?"
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(s--truthy?
|
||||
(string-match-p "^[0-9]+$" s)))
|
||||
|
||||
(defun s-replace (old new s)
|
||||
"Replaces OLD with NEW in S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(replace-regexp-in-string (regexp-quote old) new s t t))
|
||||
|
||||
(defalias 's-replace-regexp 'replace-regexp-in-string)
|
||||
|
||||
(defun s--aget (alist key)
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(cdr (assoc-string key alist)))
|
||||
|
||||
(defun s-replace-all (replacements s)
|
||||
"REPLACEMENTS is a list of cons-cells. Each `car` is replaced with `cdr` in S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(replace-regexp-in-string (regexp-opt (mapcar 'car replacements))
|
||||
(lambda (it) (s--aget replacements it))
|
||||
s t t))
|
||||
|
||||
(defun s-downcase (s)
|
||||
"Convert S to lower case.
|
||||
|
||||
This is a simple wrapper around the built-in `downcase'."
|
||||
(declare (side-effect-free t))
|
||||
(downcase s))
|
||||
|
||||
(defun s-upcase (s)
|
||||
"Convert S to upper case.
|
||||
|
||||
This is a simple wrapper around the built-in `upcase'."
|
||||
(declare (side-effect-free t))
|
||||
(upcase s))
|
||||
|
||||
(defun s-capitalize (s)
|
||||
"Convert the first word's first character to upper case and the rest to lower case in S."
|
||||
(declare (side-effect-free t))
|
||||
(concat (upcase (substring s 0 1)) (downcase (substring s 1))))
|
||||
|
||||
(defun s-titleize (s)
|
||||
"Convert each word's first character to upper case and the rest to lower case in S.
|
||||
|
||||
This is a simple wrapper around the built-in `capitalize'."
|
||||
(declare (side-effect-free t))
|
||||
(capitalize s))
|
||||
|
||||
(defmacro s-with (s form &rest more)
|
||||
"Threads S through the forms. Inserts S as the last item
|
||||
in the first form, making a list of it if it is not a list
|
||||
already. If there are more forms, inserts the first form as the
|
||||
last item in second form, etc."
|
||||
(declare (debug (form &rest [&or (function &rest form) fboundp])))
|
||||
(if (null more)
|
||||
(if (listp form)
|
||||
`(,(car form) ,@(cdr form) ,s)
|
||||
(list form s))
|
||||
`(s-with (s-with ,s ,form) ,@more)))
|
||||
|
||||
(put 's-with 'lisp-indent-function 1)
|
||||
|
||||
(defun s-index-of (needle s &optional ignore-case)
|
||||
"Returns first index of NEEDLE in S, or nil.
|
||||
|
||||
If IGNORE-CASE is non-nil, the comparison is done without paying
|
||||
attention to case differences."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((case-fold-search ignore-case))
|
||||
(string-match-p (regexp-quote needle) s)))
|
||||
|
||||
(defun s-reverse (s)
|
||||
"Return the reverse of S."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(save-match-data
|
||||
(if (multibyte-string-p s)
|
||||
(let ((input (string-to-list s))
|
||||
output)
|
||||
(require 'ucs-normalize)
|
||||
(while input
|
||||
;; Handle entire grapheme cluster as a single unit
|
||||
(let ((grapheme (list (pop input))))
|
||||
(while (memql (car input) ucs-normalize-combining-chars)
|
||||
(push (pop input) grapheme))
|
||||
(setq output (nconc (nreverse grapheme) output))))
|
||||
(concat output))
|
||||
(concat (nreverse (string-to-list s))))))
|
||||
|
||||
(defun s-match-strings-all (regex string)
|
||||
"Return a list of matches for REGEX in STRING.
|
||||
|
||||
Each element itself is a list of matches, as per
|
||||
`match-string'. Multiple matches at the same position will be
|
||||
ignored after the first."
|
||||
(declare (side-effect-free t))
|
||||
(save-match-data
|
||||
(let ((all-strings ())
|
||||
(i 0))
|
||||
(while (and (< i (length string))
|
||||
(string-match regex string i))
|
||||
(setq i (1+ (match-beginning 0)))
|
||||
(let (strings
|
||||
(num-matches (/ (length (match-data)) 2))
|
||||
(match 0))
|
||||
(while (/= match num-matches)
|
||||
(push (match-string match string) strings)
|
||||
(setq match (1+ match)))
|
||||
(push (nreverse strings) all-strings)))
|
||||
(nreverse all-strings))))
|
||||
|
||||
(defun s-matched-positions-all (regexp string &optional subexp-depth)
|
||||
"Return a list of matched positions for REGEXP in STRING.
|
||||
SUBEXP-DEPTH is 0 by default."
|
||||
(declare (side-effect-free t))
|
||||
(if (null subexp-depth)
|
||||
(setq subexp-depth 0))
|
||||
(save-match-data
|
||||
(let ((pos 0) result)
|
||||
(while (and (string-match regexp string pos)
|
||||
(< pos (length string)))
|
||||
(let ((m (match-end subexp-depth)))
|
||||
(push (cons (match-beginning subexp-depth) (match-end subexp-depth)) result)
|
||||
(setq pos (match-end 0))))
|
||||
(nreverse result))))
|
||||
|
||||
(defun s-match (regexp s &optional start)
|
||||
"When the given expression matches the string, this function returns a list
|
||||
of the whole matching string and a string for each matched subexpressions.
|
||||
If it did not match the returned value is an empty list (nil).
|
||||
|
||||
When START is non-nil the search will start at that index."
|
||||
(declare (side-effect-free t))
|
||||
(save-match-data
|
||||
(if (string-match regexp s start)
|
||||
(let ((match-data-list (match-data))
|
||||
result)
|
||||
(while match-data-list
|
||||
(let* ((beg (car match-data-list))
|
||||
(end (cadr match-data-list))
|
||||
(subs (if (and beg end) (substring s beg end) nil)))
|
||||
(setq result (cons subs result))
|
||||
(setq match-data-list
|
||||
(cddr match-data-list))))
|
||||
(nreverse result)))))
|
||||
|
||||
(defun s-slice-at (regexp s)
|
||||
"Slices S up at every index matching REGEXP."
|
||||
(declare (side-effect-free t))
|
||||
(if (= 0 (length s)) (list "")
|
||||
(save-match-data
|
||||
(let (i)
|
||||
(setq i (string-match regexp s 1))
|
||||
(if i
|
||||
(cons (substring s 0 i)
|
||||
(s-slice-at regexp (substring s i)))
|
||||
(list s))))))
|
||||
|
||||
(defun s-split-words (s)
|
||||
"Split S into list of words."
|
||||
(declare (side-effect-free t))
|
||||
(s-split
|
||||
"[^[:word:]0-9]+"
|
||||
(let ((case-fold-search nil))
|
||||
(replace-regexp-in-string
|
||||
"\\([[:lower:]]\\)\\([[:upper:]]\\)" "\\1 \\2"
|
||||
(replace-regexp-in-string "\\([[:upper:]]\\)\\([[:upper:]][0-9[:lower:]]\\)" "\\1 \\2" s)))
|
||||
t))
|
||||
|
||||
(defun s--mapcar-head (fn-head fn-rest list)
|
||||
"Like MAPCAR, but applies a different function to the first element."
|
||||
(if list
|
||||
(cons (funcall fn-head (car list)) (mapcar fn-rest (cdr list)))))
|
||||
|
||||
(defun s-lower-camel-case (s)
|
||||
"Convert S to lowerCamelCase."
|
||||
(declare (side-effect-free t))
|
||||
(s-join "" (s--mapcar-head 'downcase 'capitalize (s-split-words s))))
|
||||
|
||||
(defun s-upper-camel-case (s)
|
||||
"Convert S to UpperCamelCase."
|
||||
(declare (side-effect-free t))
|
||||
(s-join "" (mapcar 'capitalize (s-split-words s))))
|
||||
|
||||
(defun s-snake-case (s)
|
||||
"Convert S to snake_case."
|
||||
(declare (side-effect-free t))
|
||||
(s-join "_" (mapcar 'downcase (s-split-words s))))
|
||||
|
||||
(defun s-dashed-words (s)
|
||||
"Convert S to dashed-words."
|
||||
(declare (side-effect-free t))
|
||||
(s-join "-" (mapcar 'downcase (s-split-words s))))
|
||||
|
||||
(defun s-capitalized-words (s)
|
||||
"Convert S to Capitalized words."
|
||||
(declare (side-effect-free t))
|
||||
(let ((words (s-split-words s)))
|
||||
(s-join " " (cons (capitalize (car words)) (mapcar 'downcase (cdr words))))))
|
||||
|
||||
(defun s-titleized-words (s)
|
||||
"Convert S to Titleized Words."
|
||||
(declare (side-effect-free t))
|
||||
(s-join " " (mapcar 's-titleize (s-split-words s))))
|
||||
|
||||
(defun s-word-initials (s)
|
||||
"Convert S to its initials."
|
||||
(declare (side-effect-free t))
|
||||
(s-join "" (mapcar (lambda (ss) (substring ss 0 1))
|
||||
(s-split-words s))))
|
||||
|
||||
;; Errors for s-format
|
||||
(progn
|
||||
(put 's-format-resolve
|
||||
'error-conditions
|
||||
'(error s-format s-format-resolve))
|
||||
(put 's-format-resolve
|
||||
'error-message
|
||||
"Cannot resolve a template to values"))
|
||||
|
||||
(defun s-format (template replacer &optional extra)
|
||||
"Format TEMPLATE with the function REPLACER.
|
||||
|
||||
REPLACER takes an argument of the format variable and optionally
|
||||
an extra argument which is the EXTRA value from the call to
|
||||
`s-format'.
|
||||
|
||||
Several standard `s-format' helper functions are recognized and
|
||||
adapted for this:
|
||||
|
||||
(s-format \"${name}\" 'gethash hash-table)
|
||||
(s-format \"${name}\" 'aget alist)
|
||||
(s-format \"$0\" 'elt sequence)
|
||||
|
||||
The REPLACER function may be used to do any other kind of
|
||||
transformation."
|
||||
(let ((saved-match-data (match-data)))
|
||||
(unwind-protect
|
||||
(replace-regexp-in-string
|
||||
"\\$\\({\\([^}]+\\)}\\|[0-9]+\\)"
|
||||
(lambda (md)
|
||||
(let ((var
|
||||
(let ((m (match-string 2 md)))
|
||||
(if m m
|
||||
(string-to-number (match-string 1 md)))))
|
||||
(replacer-match-data (match-data)))
|
||||
(unwind-protect
|
||||
(let ((v
|
||||
(cond
|
||||
((eq replacer 'gethash)
|
||||
(funcall replacer var extra))
|
||||
((eq replacer 'aget)
|
||||
(funcall 's--aget extra var))
|
||||
((eq replacer 'elt)
|
||||
(funcall replacer extra var))
|
||||
((eq replacer 'oref)
|
||||
(funcall #'slot-value extra (intern var)))
|
||||
(t
|
||||
(set-match-data saved-match-data)
|
||||
(if extra
|
||||
(funcall replacer var extra)
|
||||
(funcall replacer var))))))
|
||||
(if v (format "%s" v) (signal 's-format-resolve md)))
|
||||
(set-match-data replacer-match-data)))) template
|
||||
;; Need literal to make sure it works
|
||||
t t)
|
||||
(set-match-data saved-match-data))))
|
||||
|
||||
(defvar s-lex-value-as-lisp nil
|
||||
"If `t' interpolate lisp values as lisp.
|
||||
|
||||
`s-lex-format' inserts values with (format \"%S\").")
|
||||
|
||||
(defun s-lex-fmt|expand (fmt)
|
||||
"Expand FMT into lisp."
|
||||
(declare (side-effect-free t))
|
||||
(list 's-format fmt (quote 'aget)
|
||||
(append '(list)
|
||||
(mapcar
|
||||
(lambda (matches)
|
||||
(list
|
||||
'cons
|
||||
(cadr matches)
|
||||
`(format
|
||||
(if s-lex-value-as-lisp "%S" "%s")
|
||||
,(intern (cadr matches)))))
|
||||
(s-match-strings-all "${\\([^}]+\\)}" fmt)))))
|
||||
|
||||
(defmacro s-lex-format (format-str)
|
||||
"`s-format` with the current environment.
|
||||
|
||||
FORMAT-STR may use the `s-format' variable reference to refer to
|
||||
any variable:
|
||||
|
||||
(let ((x 1))
|
||||
(s-lex-format \"x is: ${x}\"))
|
||||
|
||||
The values of the variables are interpolated with \"%s\" unless
|
||||
the variable `s-lex-value-as-lisp' is `t' and then they are
|
||||
interpolated with \"%S\"."
|
||||
(declare (debug (form)))
|
||||
(s-lex-fmt|expand format-str))
|
||||
|
||||
(defun s-count-matches (regexp s &optional start end)
|
||||
"Count occurrences of `regexp' in `s'.
|
||||
|
||||
`start', inclusive, and `end', exclusive, delimit the part of `s' to
|
||||
match. `start' and `end' are both indexed starting at 1; the initial
|
||||
character in `s' is index 1.
|
||||
|
||||
This function starts looking for the next match from the end of the
|
||||
previous match. Hence, it ignores matches that overlap a previously
|
||||
found match. To count overlapping matches, use
|
||||
`s-count-matches-all'."
|
||||
(declare (side-effect-free t))
|
||||
(save-match-data
|
||||
(with-temp-buffer
|
||||
(insert s)
|
||||
(goto-char (point-min))
|
||||
(count-matches regexp (or start 1) (or end (point-max))))))
|
||||
|
||||
(defun s-count-matches-all (regexp s &optional start end)
|
||||
"Count occurrences of `regexp' in `s'.
|
||||
|
||||
`start', inclusive, and `end', exclusive, delimit the part of `s' to
|
||||
match. `start' and `end' are both indexed starting at 1; the initial
|
||||
character in `s' is index 1.
|
||||
|
||||
This function starts looking for the next match from the second
|
||||
character of the previous match. Hence, it counts matches that
|
||||
overlap a previously found match. To ignore matches that overlap a
|
||||
previously found match, use `s-count-matches'."
|
||||
(declare (side-effect-free t))
|
||||
(let* ((anchored-regexp (format "^%s" regexp))
|
||||
(match-count 0)
|
||||
(i 0)
|
||||
(narrowed-s (substring s
|
||||
(when start (1- start))
|
||||
(when end (1- end)))))
|
||||
(save-match-data
|
||||
(while (< i (length narrowed-s))
|
||||
(when (s-matches? anchored-regexp (substring narrowed-s i))
|
||||
(setq match-count (1+ match-count)))
|
||||
(setq i (1+ i))))
|
||||
match-count))
|
||||
|
||||
(defun s-wrap (s prefix &optional suffix)
|
||||
"Wrap string S with PREFIX and optionally SUFFIX.
|
||||
|
||||
Return string S with PREFIX prepended. If SUFFIX is present, it
|
||||
is appended, otherwise PREFIX is used as both prefix and
|
||||
suffix."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(concat prefix s (or suffix prefix)))
|
||||
|
||||
|
||||
;;; Aliases
|
||||
|
||||
(defalias 's-blank-p 's-blank?)
|
||||
(defalias 's-blank-str-p 's-blank-str?)
|
||||
(defalias 's-capitalized-p 's-capitalized?)
|
||||
(defalias 's-contains-p 's-contains?)
|
||||
(defalias 's-ends-with-p 's-ends-with?)
|
||||
(defalias 's-equals-p 's-equals?)
|
||||
(defalias 's-less-p 's-less?)
|
||||
(defalias 's-lowercase-p 's-lowercase?)
|
||||
(defalias 's-matches-p 's-matches?)
|
||||
(defalias 's-mixedcase-p 's-mixedcase?)
|
||||
(defalias 's-numeric-p 's-numeric?)
|
||||
(defalias 's-prefix-p 's-starts-with?)
|
||||
(defalias 's-prefix? 's-starts-with?)
|
||||
(defalias 's-present-p 's-present?)
|
||||
(defalias 's-starts-with-p 's-starts-with?)
|
||||
(defalias 's-suffix-p 's-ends-with?)
|
||||
(defalias 's-suffix? 's-ends-with?)
|
||||
(defalias 's-uppercase-p 's-uppercase?)
|
||||
|
||||
|
||||
(provide 's)
|
||||
;;; s.el ends here
|
||||
BIN
elpa/s-20180406.808/s.elc
Normal file
BIN
elpa/s-20180406.808/s.elc
Normal file
Binary file not shown.
14
elpa/slime-20191114.1625/contrib/README.md
Normal file
14
elpa/slime-20191114.1625/contrib/README.md
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
This directory contains source code which may be useful to some Slime
|
||||
users. `*.el` files are Emacs Lisp source and `*.lisp` files contain
|
||||
Common Lisp source code. If not otherwise stated in the file itself,
|
||||
the files are placed in the Public Domain.
|
||||
|
||||
The components in this directory are more or less detached from the
|
||||
rest of Slime. They are essentially "add-ons". But Slime can also be
|
||||
used without them. The code is maintained by the respective authors.
|
||||
|
||||
See the top level README.md for how to use packages in this directory.
|
||||
|
||||
Finally, the contrib `slime-fancy` is specially noteworthy, as it
|
||||
represents a meta-contrib that'll load a bunch of commonly used
|
||||
contribs. Look into `slime-fancy.el` to find out which.
|
||||
472
elpa/slime-20191114.1625/contrib/bridge.el
Normal file
472
elpa/slime-20191114.1625/contrib/bridge.el
Normal file
|
|
@ -0,0 +1,472 @@
|
|||
;;; -*-Emacs-Lisp-*-
|
||||
;;;%Header
|
||||
;;; Bridge process filter, V1.0
|
||||
;;; Copyright (C) 1991 Chris McConnell, ccm@cs.cmu.edu
|
||||
;;;
|
||||
;;; Send mail to ilisp@cons.org if you have problems.
|
||||
;;;
|
||||
;;; Send mail to majordomo@cons.org if you want to be on the
|
||||
;;; ilisp mailing list.
|
||||
|
||||
;;; This file is part of GNU Emacs.
|
||||
|
||||
;;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;;; but WITHOUT ANY WARRANTY. No author or distributor
|
||||
;;; accepts responsibility to anyone for the consequences of using it
|
||||
;;; or for whether it serves any particular purpose or works at all,
|
||||
;;; unless he says so in writing. Refer to the GNU Emacs General Public
|
||||
;;; License for full details.
|
||||
|
||||
;;; Everyone is granted permission to copy, modify and redistribute
|
||||
;;; GNU Emacs, but only under the conditions described in the
|
||||
;;; GNU Emacs General Public License. A copy of this license is
|
||||
;;; supposed to have been given to you along with GNU Emacs so you
|
||||
;;; can know your rights and responsibilities. It should be in a
|
||||
;;; file named COPYING. Among other things, the copyright notice
|
||||
;;; and this notice must be preserved on all copies.
|
||||
|
||||
;;; Send any bugs or comments. Thanks to Todd Kaufmann for rewriting
|
||||
;;; the process filter for continuous handlers.
|
||||
|
||||
;;; USAGE: M-x install-bridge will add a process output filter to the
|
||||
;;; current buffer. Any output that the process does between
|
||||
;;; bridge-start-regexp and bridge-end-regexp will be bundled up and
|
||||
;;; passed to the first handler on bridge-handlers that matches the
|
||||
;;; output using string-match. If bridge-prompt-regexp shows up
|
||||
;;; before bridge-end-regexp, the bridge will be cancelled. If no
|
||||
;;; handler matches the output, the first symbol in the output is
|
||||
;;; assumed to be a buffer name and the rest of the output will be
|
||||
;;; sent to that buffer's process. This can be used to communicate
|
||||
;;; between processes or to set up two way interactions between Emacs
|
||||
;;; and an inferior process.
|
||||
|
||||
;;; You can write handlers that process the output in special ways.
|
||||
;;; See bridge-send-handler for the default handler. The command
|
||||
;;; hand-bridge is useful for testing. Keep in mind that all
|
||||
;;; variables are buffer local.
|
||||
|
||||
;;; YOUR .EMACS FILE:
|
||||
;;;
|
||||
;;; ;;; Set up load path to include bridge
|
||||
;;; (setq load-path (cons "/bridge-directory/" load-path))
|
||||
;;; (autoload 'install-bridge "bridge" "Install a process bridge." t)
|
||||
;;; (setq bridge-hook
|
||||
;;; '(lambda ()
|
||||
;;; ;; Example options
|
||||
;;; (setq bridge-source-insert nil) ;Don't insert in source buffer
|
||||
;;; (setq bridge-destination-insert nil) ;Don't insert in dest buffer
|
||||
;;; ;; Handle copy-it messages yourself
|
||||
;;; (setq bridge-handlers
|
||||
;;; '(("copy-it" . my-copy-handler)))))
|
||||
|
||||
;;; EXAMPLE:
|
||||
;;; # This pipes stdin to the named buffer in a Unix shell
|
||||
;;; alias devgnu '(echo -n "\!* "; cat -; echo -n " ")'
|
||||
;;;
|
||||
;;; ls | devgnu *scratch*
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
;;;%Parameters
|
||||
(defvar bridge-hook nil
|
||||
"Hook called when a bridge is installed by install-hook.")
|
||||
|
||||
(defvar bridge-start-regexp ""
|
||||
"*Regular expression to match the start of a process bridge in
|
||||
process output. It should be followed by a buffer name, the data to
|
||||
be sent and a bridge-end-regexp.")
|
||||
|
||||
(defvar bridge-end-regexp " "
|
||||
"*Regular expression to match the end of a process bridge in process
|
||||
output.")
|
||||
|
||||
(defvar bridge-prompt-regexp nil
|
||||
"*Regular expression for detecting a prompt. If there is a
|
||||
comint-prompt-regexp, it will be initialized to that. A prompt before
|
||||
a bridge-end-regexp will stop the process bridge.")
|
||||
|
||||
(defvar bridge-handlers nil
|
||||
"Alist of (regexp . handler) for handling process output delimited
|
||||
by bridge-start-regexp and bridge-end-regexp. The first entry on the
|
||||
list whose regexp matches the output will be called on the process and
|
||||
the delimited output.")
|
||||
|
||||
(defvar bridge-source-insert t
|
||||
"*T to insert bridge input in the source buffer minus delimiters.")
|
||||
|
||||
(defvar bridge-destination-insert t
|
||||
"*T for bridge-send-handler to insert bridge input into the
|
||||
destination buffer minus delimiters.")
|
||||
|
||||
(defvar bridge-chunk-size 512
|
||||
"*Long inputs send to comint processes are broken up into chunks of
|
||||
this size. If your process is choking on big inputs, try lowering the
|
||||
value.")
|
||||
|
||||
;;;%Internal variables
|
||||
(defvar bridge-old-filter nil
|
||||
"Old filter for a bridged process buffer.")
|
||||
|
||||
(defvar bridge-string nil
|
||||
"The current output in the process bridge.")
|
||||
|
||||
(defvar bridge-in-progress nil
|
||||
"The current handler function, if any, that bridge passes strings on to,
|
||||
or nil if none.")
|
||||
|
||||
(defvar bridge-leftovers nil
|
||||
"Because of chunking you might get an incomplete bridge signal - start but the end is in the next packet. Save the overhanging text here.")
|
||||
|
||||
(defvar bridge-send-to-buffer nil
|
||||
"The buffer that the default bridge-handler (bridge-send-handler) is
|
||||
currently sending to, or nil if it hasn't started yet. Your handler
|
||||
function can use this variable also.")
|
||||
|
||||
(defvar bridge-last-failure ()
|
||||
"Last thing that broke the bridge handler. First item is function call
|
||||
(eval'able); last item is error condition which resulted. This is provided
|
||||
to help handler-writers in their debugging.")
|
||||
|
||||
(defvar bridge-insert-function nil
|
||||
"If non-nil use this instead of `bridge-insert'")
|
||||
|
||||
;;;%Utilities
|
||||
(defun bridge-insert (output &optional _dummy)
|
||||
"Insert process OUTPUT into the current buffer."
|
||||
(if bridge-insert-function
|
||||
(funcall bridge-insert-function output)
|
||||
(if output
|
||||
(let* ((buffer (current-buffer))
|
||||
(process (get-buffer-process buffer))
|
||||
(mark (process-mark process))
|
||||
(window (selected-window))
|
||||
(at-end nil))
|
||||
(if (eq (window-buffer window) buffer)
|
||||
(setq at-end (= (point) mark))
|
||||
(setq window (get-buffer-window buffer)))
|
||||
(save-excursion
|
||||
(goto-char mark)
|
||||
(insert output)
|
||||
(set-marker mark (point)))
|
||||
(if window
|
||||
(progn
|
||||
(if at-end (goto-char mark))
|
||||
(if (not (pos-visible-in-window-p (point) window))
|
||||
(let ((original (selected-window)))
|
||||
(save-excursion
|
||||
(select-window window)
|
||||
(recenter '(center))
|
||||
(select-window original))))))))))
|
||||
|
||||
;;;
|
||||
;(defun bridge-send-string (process string)
|
||||
; "Send PROCESS the contents of STRING as input.
|
||||
;This is equivalent to process-send-string, except that long input strings
|
||||
;are broken up into chunks of size comint-input-chunk-size. Processes
|
||||
;are given a chance to output between chunks. This can help prevent processes
|
||||
;from hanging when you send them long inputs on some OS's."
|
||||
; (let* ((len (length string))
|
||||
; (i (min len bridge-chunk-size)))
|
||||
; (process-send-string process (substring string 0 i))
|
||||
; (while (< i len)
|
||||
; (let ((next-i (+ i bridge-chunk-size)))
|
||||
; (accept-process-output)
|
||||
; (process-send-string process (substring string i (min len next-i)))
|
||||
; (setq i next-i)))))
|
||||
|
||||
;;;
|
||||
(defun bridge-call-handler (handler proc string)
|
||||
"Funcall HANDLER on PROC, STRING carefully. Error is caught if happens,
|
||||
and user is signaled. State is put in bridge-last-failure. Returns t if
|
||||
handler executed without error."
|
||||
(let ((inhibit-quit nil)
|
||||
(failed nil))
|
||||
(condition-case err
|
||||
(funcall handler proc string)
|
||||
(error
|
||||
(ding)
|
||||
(setq failed t)
|
||||
(message "bridge-handler \"%s\" failed %s (see bridge-last-failure)"
|
||||
handler err)
|
||||
(setq bridge-last-failure
|
||||
`((funcall ',handler ',proc ,string)
|
||||
"Caused: "
|
||||
,err))))
|
||||
(not failed)))
|
||||
|
||||
;;;%Handlers
|
||||
(defun bridge-send-handler (process input)
|
||||
"Send PROCESS INPUT to the buffer name found at the start of the
|
||||
input. The input after the buffer name is sent to the buffer's
|
||||
process if it has one. If bridge-destination-insert is T, the input
|
||||
will be inserted into the buffer. If it does not have a process, it
|
||||
will be inserted at the end of the buffer."
|
||||
(if (null input)
|
||||
(setq bridge-send-to-buffer nil) ; end of bridge
|
||||
(let (buffer-and-start buffer-name dest to)
|
||||
;; if this is first time, get the buffer out of the first line
|
||||
(cond ((not bridge-send-to-buffer)
|
||||
(setq buffer-and-start (read-from-string input)
|
||||
buffer-name (format "%s" (car (read-from-string input)))
|
||||
dest (get-buffer buffer-name)
|
||||
to (get-buffer-process dest)
|
||||
input (substring input (cdr buffer-and-start)))
|
||||
(setq bridge-send-to-buffer dest))
|
||||
(t
|
||||
(setq buffer-name bridge-send-to-buffer
|
||||
dest (get-buffer buffer-name)
|
||||
to (get-buffer-process dest)
|
||||
)))
|
||||
(if dest
|
||||
(let ((buffer (current-buffer)))
|
||||
(if bridge-destination-insert
|
||||
(unwind-protect
|
||||
(progn
|
||||
(set-buffer dest)
|
||||
(if to
|
||||
(bridge-insert process input)
|
||||
(goto-char (point-max))
|
||||
(insert input)))
|
||||
(set-buffer buffer)))
|
||||
(if to
|
||||
;; (bridge-send-string to input)
|
||||
(process-send-string to input)
|
||||
))
|
||||
(error "%s is not a buffer" buffer-name)))))
|
||||
|
||||
;;;%Filter
|
||||
(defun bridge-filter (process output)
|
||||
"Given PROCESS and some OUTPUT, check for the presence of
|
||||
bridge-start-regexp. Everything prior to this will be passed to the
|
||||
normal filter function or inserted in the buffer if it is nil. The
|
||||
output up to bridge-end-regexp will be sent to the first handler on
|
||||
bridge-handlers that matches the string. If no handlers match, the
|
||||
input will be sent to bridge-send-handler. If bridge-prompt-regexp is
|
||||
encountered before the bridge-end-regexp, the bridge will be cancelled."
|
||||
(let ((inhibit-quit t)
|
||||
(match-data (match-data))
|
||||
(buffer (current-buffer))
|
||||
(process-buffer (process-buffer process))
|
||||
(case-fold-search t)
|
||||
(start 0) (end 0)
|
||||
function
|
||||
b-start b-start-end b-end)
|
||||
(set-buffer process-buffer) ;; access locals
|
||||
|
||||
;; Handle bridge messages that straddle a packet by prepending
|
||||
;; them to this packet.
|
||||
|
||||
(when bridge-leftovers
|
||||
(setq output (concat bridge-leftovers output))
|
||||
(setq bridge-leftovers nil))
|
||||
|
||||
(setq function bridge-in-progress)
|
||||
|
||||
;; How it works:
|
||||
;;
|
||||
;; start, end delimit the part of string we are interested in;
|
||||
;; initially both 0; after an iteration we move them to next string.
|
||||
|
||||
;; b-start, b-end delimit part of string to bridge (possibly whole string);
|
||||
;; this will be string between corresponding regexps.
|
||||
|
||||
;; There are two main cases when we come into loop:
|
||||
|
||||
;; bridge in progress
|
||||
;;0 setq b-start = start
|
||||
;;1 setq b-end (or end-pattern end)
|
||||
;;4 process string
|
||||
;;5 remove handler if end found
|
||||
|
||||
;; no bridge in progress
|
||||
;;0 setq b-start if see start-pattern
|
||||
;;1 setq b-end if bstart to (or end-pattern end)
|
||||
;;2 send (substring start b-start) to normal place
|
||||
;;3 find handler (in b-start, b-end) if not set
|
||||
;;4 process string
|
||||
;;5 remove handler if end found
|
||||
|
||||
;; equivalent sections have the same numbers here;
|
||||
;; we fold them together in this code.
|
||||
|
||||
(block bridge-filter
|
||||
(unwind-protect
|
||||
(while (< end (length output))
|
||||
|
||||
;;0 setq b-start if find
|
||||
(setq b-start
|
||||
(cond (bridge-in-progress
|
||||
(setq b-start-end start)
|
||||
start)
|
||||
((string-match bridge-start-regexp output start)
|
||||
(setq b-start-end (match-end 0))
|
||||
(match-beginning 0))
|
||||
(t nil)))
|
||||
;;1 setq b-end
|
||||
(setq b-end
|
||||
(if b-start
|
||||
(let ((end-seen (string-match bridge-end-regexp
|
||||
output b-start-end)))
|
||||
(if end-seen (setq end (match-end 0)))
|
||||
|
||||
end-seen)))
|
||||
|
||||
;; Detect and save partial bridge messages
|
||||
(when (and b-start b-start-end (not b-end))
|
||||
(setq bridge-leftovers (substring output b-start))
|
||||
)
|
||||
|
||||
(if (and b-start (not b-end))
|
||||
(setq end b-start)
|
||||
(if (not b-end)
|
||||
(setq end (length output))))
|
||||
|
||||
;;1.5 - if see prompt before end, remove current
|
||||
(if (and b-start b-end)
|
||||
(let ((prompt (string-match bridge-prompt-regexp
|
||||
output b-start-end)))
|
||||
(if (and prompt (<= (match-end 0) b-end))
|
||||
(setq b-start nil ; b-start-end start
|
||||
b-end start
|
||||
end (match-end 0)
|
||||
bridge-in-progress nil
|
||||
))))
|
||||
|
||||
;;2 send (substring start b-start) to old filter, if any
|
||||
(when (not (equal start (or b-start end))) ; don't bother on empty string
|
||||
(let ((pass-on (substring output start (or b-start end))))
|
||||
(if bridge-old-filter
|
||||
(let ((old bridge-old-filter))
|
||||
(store-match-data match-data)
|
||||
(funcall old process pass-on)
|
||||
;; if filter changed, re-install ourselves
|
||||
(let ((new (process-filter process)))
|
||||
(if (not (eq new 'bridge-filter))
|
||||
(progn (setq bridge-old-filter new)
|
||||
(set-process-filter process 'bridge-filter)))))
|
||||
(set-buffer process-buffer)
|
||||
(bridge-insert pass-on))))
|
||||
|
||||
(if (and b-start-end (not b-end))
|
||||
(return-from bridge-filter t) ; when last bit has prematurely ending message, exit early.
|
||||
(progn
|
||||
;;3 find handler (in b-start, b-end) if none current
|
||||
(if (and b-start (not bridge-in-progress))
|
||||
(let ((handlers bridge-handlers))
|
||||
(while (and handlers (not function))
|
||||
(let* ((handler (car handlers))
|
||||
(m (string-match (car handler) output b-start-end)))
|
||||
(if (and m (< m b-end))
|
||||
(setq function (cdr handler))
|
||||
(setq handlers (cdr handlers)))))
|
||||
;; Set default handler if none
|
||||
(if (null function)
|
||||
(setq function 'bridge-send-handler))
|
||||
(setq bridge-in-progress function)))
|
||||
;;4 process strin
|
||||
(if function
|
||||
(let ((ok t))
|
||||
(if (/= b-start-end b-end)
|
||||
(let ((send (substring output b-start-end b-end)))
|
||||
;; also, insert the stuff in buffer between
|
||||
;; iff bridge-source-insert.
|
||||
(if bridge-source-insert (bridge-insert send))
|
||||
;; call handler on string
|
||||
(setq ok (bridge-call-handler function process send))))
|
||||
;;5 remove handler if end found
|
||||
;; if function removed then tell it that's all
|
||||
(if (or (not ok) (/= b-end end)) ;; saw end before end-of-string
|
||||
(progn
|
||||
(bridge-call-handler function process nil)
|
||||
;; have to remove function too for next time around
|
||||
(setq function nil
|
||||
bridge-in-progress nil)
|
||||
))
|
||||
))
|
||||
|
||||
;; continue looping, in case there's more string
|
||||
(setq start end))
|
||||
))
|
||||
;; protected forms: restore buffer, match-data
|
||||
(set-buffer buffer)
|
||||
(store-match-data match-data)
|
||||
))))
|
||||
|
||||
|
||||
;;;%Interface
|
||||
(defun install-bridge ()
|
||||
"Set up a process bridge in the current buffer."
|
||||
(interactive)
|
||||
(if (not (get-buffer-process (current-buffer)))
|
||||
(error "%s does not have a process" (buffer-name (current-buffer)))
|
||||
(make-local-variable 'bridge-start-regexp)
|
||||
(make-local-variable 'bridge-end-regexp)
|
||||
(make-local-variable 'bridge-prompt-regexp)
|
||||
(make-local-variable 'bridge-handlers)
|
||||
(make-local-variable 'bridge-source-insert)
|
||||
(make-local-variable 'bridge-destination-insert)
|
||||
(make-local-variable 'bridge-chunk-size)
|
||||
(make-local-variable 'bridge-old-filter)
|
||||
(make-local-variable 'bridge-string)
|
||||
(make-local-variable 'bridge-in-progress)
|
||||
(make-local-variable 'bridge-send-to-buffer)
|
||||
(make-local-variable 'bridge-leftovers)
|
||||
(setq bridge-string nil bridge-in-progress nil
|
||||
bridge-send-to-buffer nil)
|
||||
(if (boundp 'comint-prompt-regexp)
|
||||
(setq bridge-prompt-regexp comint-prompt-regexp))
|
||||
(let ((process (get-buffer-process (current-buffer))))
|
||||
(if process
|
||||
(if (not (eq (process-filter process) 'bridge-filter))
|
||||
(progn
|
||||
(setq bridge-old-filter (process-filter process))
|
||||
(set-process-filter process 'bridge-filter)))
|
||||
(error "%s does not have a process"
|
||||
(buffer-name (current-buffer)))))
|
||||
(run-hooks 'bridge-hook)
|
||||
(message "Process bridge is installed")))
|
||||
|
||||
;;;
|
||||
(defun reset-bridge ()
|
||||
"Must be called from the process's buffer. Removes any active bridge."
|
||||
(interactive)
|
||||
;; for when things get wedged
|
||||
(if bridge-in-progress
|
||||
(unwind-protect
|
||||
(funcall bridge-in-progress (get-buffer-process
|
||||
(current-buffer))
|
||||
nil)
|
||||
(setq bridge-in-progress nil))
|
||||
(message "No bridge in progress.")))
|
||||
|
||||
;;;
|
||||
(defun remove-bridge ()
|
||||
"Remove bridge from the current buffer."
|
||||
(interactive)
|
||||
(let ((process (get-buffer-process (current-buffer))))
|
||||
(if (or (not process) (not (eq (process-filter process) 'bridge-filter)))
|
||||
(error "%s has no bridge" (buffer-name (current-buffer)))
|
||||
;; remove any bridge-in-progress
|
||||
(reset-bridge)
|
||||
(set-process-filter process bridge-old-filter)
|
||||
(funcall bridge-old-filter process bridge-string)
|
||||
(message "Process bridge is removed."))))
|
||||
|
||||
;;;% Utility for testing
|
||||
(defun hand-bridge (start end)
|
||||
"With point at bridge-start, sends bridge-start + string +
|
||||
bridge-end to bridge-filter. With prefix, use current region to send."
|
||||
(interactive "r")
|
||||
(let ((p0 (if current-prefix-arg (min start end)
|
||||
(if (looking-at bridge-start-regexp) (point)
|
||||
(error "Not looking at bridge-start-regexp"))))
|
||||
(p1 (if current-prefix-arg (max start end)
|
||||
(if (re-search-forward bridge-end-regexp nil t)
|
||||
(point) (error "Didn't see bridge-end-regexp")))))
|
||||
|
||||
(bridge-filter (get-buffer-process (current-buffer))
|
||||
(buffer-substring-no-properties p0 p1))
|
||||
))
|
||||
|
||||
(provide 'bridge)
|
||||
BIN
elpa/slime-20191114.1625/contrib/bridge.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/bridge.elc
Normal file
Binary file not shown.
133
elpa/slime-20191114.1625/contrib/inferior-slime.el
Normal file
133
elpa/slime-20191114.1625/contrib/inferior-slime.el
Normal file
|
|
@ -0,0 +1,133 @@
|
|||
;;; inferior-slime.el --- Minor mode with Slime keys for comint buffers
|
||||
;;
|
||||
;; Author: Luke Gorrie <luke@synap.se>
|
||||
;; License: GNU GPL (same license as Emacs)
|
||||
;;
|
||||
;;; Installation:
|
||||
;;
|
||||
;; Add something like this to your .emacs:
|
||||
;;
|
||||
;; (add-to-list 'load-path "<directory-of-this-file>")
|
||||
;; (add-hook 'slime-load-hook (lambda () (require 'inferior-slime)))
|
||||
;; (add-hook 'inferior-lisp-mode-hook (lambda () (inferior-slime-mode 1)))
|
||||
(require 'slime)
|
||||
(require 'cl-lib)
|
||||
|
||||
(define-minor-mode inferior-slime-mode
|
||||
"\\<slime-mode-map>\
|
||||
Inferior SLIME mode: The Inferior Superior Lisp Mode for Emacs.
|
||||
|
||||
This mode is intended for use with `inferior-lisp-mode'. It provides a
|
||||
subset of the bindings from `slime-mode'.
|
||||
|
||||
\\{inferior-slime-mode-map}"
|
||||
:keymap
|
||||
;; Fake binding to coax `define-minor-mode' to create the keymap
|
||||
'((" " 'undefined))
|
||||
|
||||
(slime-setup-completion)
|
||||
(setq-local tab-always-indent 'complete))
|
||||
|
||||
(defun inferior-slime-return ()
|
||||
"Handle the return key in the inferior-lisp buffer.
|
||||
The current input should only be sent if a whole expression has been
|
||||
entered, i.e. the parenthesis are matched.
|
||||
|
||||
A prefix argument disables this behaviour."
|
||||
(interactive)
|
||||
(if (or current-prefix-arg (inferior-slime-input-complete-p))
|
||||
(comint-send-input)
|
||||
(insert "\n")
|
||||
(inferior-slime-indent-line)))
|
||||
|
||||
(defun inferior-slime-indent-line ()
|
||||
"Indent the current line, ignoring everything before the prompt."
|
||||
(interactive)
|
||||
(save-restriction
|
||||
(let ((indent-start
|
||||
(save-excursion
|
||||
(goto-char (process-mark (get-buffer-process (current-buffer))))
|
||||
(let ((inhibit-field-text-motion t))
|
||||
(beginning-of-line 1))
|
||||
(point))))
|
||||
(narrow-to-region indent-start (point-max)))
|
||||
(lisp-indent-line)))
|
||||
|
||||
(defun inferior-slime-input-complete-p ()
|
||||
"Return true if the input is complete in the inferior lisp buffer."
|
||||
(slime-input-complete-p (process-mark (get-buffer-process (current-buffer)))
|
||||
(point-max)))
|
||||
|
||||
(defun inferior-slime-closing-return ()
|
||||
"Send the current expression to Lisp after closing any open lists."
|
||||
(interactive)
|
||||
(goto-char (point-max))
|
||||
(save-restriction
|
||||
(narrow-to-region (process-mark (get-buffer-process (current-buffer)))
|
||||
(point-max))
|
||||
(while (ignore-errors (save-excursion (backward-up-list 1) t))
|
||||
(insert ")")))
|
||||
(comint-send-input))
|
||||
|
||||
(defun inferior-slime-change-directory (directory)
|
||||
"Set default-directory in the *inferior-lisp* buffer to DIRECTORY."
|
||||
(let* ((proc (slime-process))
|
||||
(buffer (and proc (process-buffer proc))))
|
||||
(when buffer
|
||||
(with-current-buffer buffer
|
||||
(cd-absolute directory)))))
|
||||
|
||||
(defun inferior-slime-init-keymap ()
|
||||
(let ((map inferior-slime-mode-map))
|
||||
(set-keymap-parent map slime-parent-map)
|
||||
(slime-define-keys map
|
||||
([return] 'inferior-slime-return)
|
||||
([(control return)] 'inferior-slime-closing-return)
|
||||
([(meta control ?m)] 'inferior-slime-closing-return)
|
||||
;;("\t" 'slime-indent-and-complete-symbol)
|
||||
(" " 'slime-space))))
|
||||
|
||||
(inferior-slime-init-keymap)
|
||||
|
||||
(defun inferior-slime-hook-function ()
|
||||
(inferior-slime-mode 1))
|
||||
|
||||
(defun inferior-slime-switch-to-repl-buffer ()
|
||||
(switch-to-buffer (process-buffer (slime-inferior-process))))
|
||||
|
||||
(defun inferior-slime-show-transcript (string)
|
||||
(remove-hook 'comint-output-filter-functions
|
||||
'inferior-slime-show-transcript t)
|
||||
(with-current-buffer (process-buffer (slime-inferior-process))
|
||||
(let ((window (display-buffer (current-buffer) t)))
|
||||
(set-window-point window (point-max)))))
|
||||
|
||||
(defun inferior-slime-start-transcript ()
|
||||
(let ((proc (slime-inferior-process)))
|
||||
(when proc
|
||||
(with-current-buffer (process-buffer proc)
|
||||
(add-hook 'comint-output-filter-functions
|
||||
'inferior-slime-show-transcript
|
||||
nil t)))))
|
||||
|
||||
(defun inferior-slime-stop-transcript ()
|
||||
(let ((proc (slime-inferior-process)))
|
||||
(when proc
|
||||
(with-current-buffer (process-buffer (slime-inferior-process))
|
||||
(run-with-timer 0.2 nil
|
||||
(lambda (buffer)
|
||||
(with-current-buffer buffer
|
||||
(remove-hook 'comint-output-filter-functions
|
||||
'inferior-slime-show-transcript t)))
|
||||
(current-buffer))))))
|
||||
|
||||
(defun inferior-slime-init ()
|
||||
(add-hook 'slime-inferior-process-start-hook 'inferior-slime-hook-function)
|
||||
(add-hook 'slime-change-directory-hooks 'inferior-slime-change-directory)
|
||||
(add-hook 'slime-transcript-start-hook 'inferior-slime-start-transcript)
|
||||
(add-hook 'slime-transcript-stop-hook 'inferior-slime-stop-transcript)
|
||||
(def-slime-selector-method ?r
|
||||
"SLIME Read-Eval-Print-Loop."
|
||||
(process-buffer (slime-inferior-process))))
|
||||
|
||||
(provide 'inferior-slime)
|
||||
BIN
elpa/slime-20191114.1625/contrib/inferior-slime.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/inferior-slime.elc
Normal file
Binary file not shown.
313
elpa/slime-20191114.1625/contrib/slime-asdf.el
Normal file
313
elpa/slime-20191114.1625/contrib/slime-asdf.el
Normal file
|
|
@ -0,0 +1,313 @@
|
|||
(require 'slime)
|
||||
(require 'cl-lib)
|
||||
(require 'grep)
|
||||
|
||||
(define-slime-contrib slime-asdf
|
||||
"ASDF support."
|
||||
(:authors "Daniel Barlow <dan@telent.net>"
|
||||
"Marco Baringer <mb@bese.it>"
|
||||
"Edi Weitz <edi@agharta.de>"
|
||||
"Stas Boukarev <stassats@gmail.com>"
|
||||
"Tobias C Rittweiler <tcr@freebits.de>")
|
||||
(:license "GPL")
|
||||
(:slime-dependencies slime-repl)
|
||||
(:swank-dependencies swank-asdf)
|
||||
(:on-load
|
||||
(add-to-list 'slime-edit-uses-xrefs :depends-on t)
|
||||
(define-key slime-who-map [?d] 'slime-who-depends-on)))
|
||||
|
||||
;;; NOTE: `system-name' is a predefined variable in Emacs. Try to
|
||||
;;; avoid it as local variable name.
|
||||
|
||||
;;; Utilities
|
||||
|
||||
(defgroup slime-asdf nil
|
||||
"ASDF support for Slime."
|
||||
:prefix "slime-asdf-"
|
||||
:group 'slime)
|
||||
|
||||
(defvar slime-system-history nil
|
||||
"History list for ASDF system names.")
|
||||
|
||||
(defun slime-read-system-name (&optional prompt
|
||||
default-value
|
||||
determine-default-accurately)
|
||||
"Read a system name from the minibuffer, prompting with PROMPT.
|
||||
If no `default-value' is given, one is tried to be determined: if
|
||||
`determine-default-accurately' is true, by an RPC request which
|
||||
grovels through all defined systems; if it's not true, by looking
|
||||
in the directory of the current buffer."
|
||||
(let* ((completion-ignore-case nil)
|
||||
(prompt (or prompt "System"))
|
||||
(system-names (slime-eval `(swank:list-asdf-systems)))
|
||||
(default-value
|
||||
(or default-value
|
||||
(if determine-default-accurately
|
||||
(slime-determine-asdf-system (buffer-file-name)
|
||||
(slime-current-package))
|
||||
(slime-find-asd-file (or default-directory
|
||||
(buffer-file-name))
|
||||
system-names))))
|
||||
(prompt (concat prompt (if default-value
|
||||
(format " (default `%s'): " default-value)
|
||||
": "))))
|
||||
(completing-read prompt (slime-bogus-completion-alist system-names)
|
||||
nil nil nil
|
||||
'slime-system-history default-value)))
|
||||
|
||||
|
||||
|
||||
(defun slime-find-asd-file (directory system-names)
|
||||
"Tries to find an ASDF system definition file in the
|
||||
`directory' and returns it if it's in `system-names'."
|
||||
(let ((asd-files
|
||||
(directory-files (file-name-directory directory) nil "\.asd$")))
|
||||
(cl-loop for system in asd-files
|
||||
for candidate = (file-name-sans-extension system)
|
||||
when (cl-find candidate system-names :test #'string-equal)
|
||||
do (cl-return candidate))))
|
||||
|
||||
(defun slime-determine-asdf-system (filename buffer-package)
|
||||
"Try to determine the asdf system that `filename' belongs to."
|
||||
(slime-eval
|
||||
`(swank:asdf-determine-system ,(and filename
|
||||
(slime-to-lisp-filename filename))
|
||||
,buffer-package)))
|
||||
|
||||
(defun slime-who-depends-on-rpc (system)
|
||||
(slime-eval `(swank:who-depends-on ,system)))
|
||||
|
||||
(defcustom slime-asdf-collect-notes t
|
||||
"Collect and display notes produced by the compiler.
|
||||
|
||||
See also `slime-highlight-compiler-notes' and
|
||||
`slime-compilation-finished-hook'."
|
||||
:group 'slime-asdf)
|
||||
|
||||
(defun slime-asdf-operation-finished-function (system)
|
||||
(if slime-asdf-collect-notes
|
||||
#'slime-compilation-finished
|
||||
(slime-curry (lambda (system result)
|
||||
(let (slime-highlight-compiler-notes
|
||||
slime-compilation-finished-hook)
|
||||
(slime-compilation-finished result)))
|
||||
system)))
|
||||
|
||||
(defun slime-oos (system operation &rest keyword-args)
|
||||
"Operate On System."
|
||||
(slime-save-some-lisp-buffers)
|
||||
(slime-display-output-buffer)
|
||||
(message "Performing ASDF %S%s on system %S"
|
||||
operation (if keyword-args (format " %S" keyword-args) "")
|
||||
system)
|
||||
(slime-repl-shortcut-eval-async
|
||||
`(swank:operate-on-system-for-emacs ,system ',operation ,@keyword-args)
|
||||
(slime-asdf-operation-finished-function system)))
|
||||
|
||||
|
||||
;;; Interactive functions
|
||||
|
||||
(defun slime-load-system (&optional system)
|
||||
"Compile and load an ASDF system.
|
||||
|
||||
Default system name is taken from first file matching *.asd in current
|
||||
buffer's working directory"
|
||||
(interactive (list (slime-read-system-name)))
|
||||
(slime-oos system 'load-op))
|
||||
|
||||
(defun slime-open-system (name &optional load interactive)
|
||||
"Open all files in an ASDF system."
|
||||
(interactive (list (slime-read-system-name) nil t))
|
||||
(when (or load
|
||||
(and interactive
|
||||
(not (slime-eval `(swank:asdf-system-loaded-p ,name)))
|
||||
(y-or-n-p "Load it? ")))
|
||||
(slime-load-system name))
|
||||
(slime-eval-async
|
||||
`(swank:asdf-system-files ,name)
|
||||
(lambda (files)
|
||||
(when files
|
||||
(let ((files (mapcar 'slime-from-lisp-filename
|
||||
(nreverse files))))
|
||||
(find-file-other-window (car files))
|
||||
(mapc 'find-file (cdr files)))))))
|
||||
|
||||
(defun slime-browse-system (name)
|
||||
"Browse files in an ASDF system using Dired."
|
||||
(interactive (list (slime-read-system-name)))
|
||||
(slime-eval-async `(swank:asdf-system-directory ,name)
|
||||
(lambda (directory)
|
||||
(when directory
|
||||
(dired (slime-from-lisp-filename directory))))))
|
||||
|
||||
(if (fboundp 'rgrep)
|
||||
(defun slime-rgrep-system (sys-name regexp)
|
||||
"Run `rgrep' on the base directory of an ASDF system."
|
||||
(interactive (progn (grep-compute-defaults)
|
||||
(list (slime-read-system-name nil nil t)
|
||||
(grep-read-regexp))))
|
||||
(rgrep regexp "*.lisp"
|
||||
(slime-from-lisp-filename
|
||||
(slime-eval `(swank:asdf-system-directory ,sys-name)))))
|
||||
(defun slime-rgrep-system ()
|
||||
(interactive)
|
||||
(error "This command is only supported on GNU Emacs >21.x.")))
|
||||
|
||||
(if (boundp 'multi-isearch-next-buffer-function)
|
||||
(defun slime-isearch-system (sys-name)
|
||||
"Run `isearch-forward' on the files of an ASDF system."
|
||||
(interactive (list (slime-read-system-name nil nil t)))
|
||||
(let* ((files (mapcar 'slime-from-lisp-filename
|
||||
(slime-eval `(swank:asdf-system-files ,sys-name))))
|
||||
(multi-isearch-next-buffer-function
|
||||
(lexical-let*
|
||||
((buffers-forward (mapcar #'find-file-noselect files))
|
||||
(buffers-backward (reverse buffers-forward)))
|
||||
#'(lambda (current-buffer wrap)
|
||||
;; Contrarily to the docstring of
|
||||
;; `multi-isearch-next-buffer-function', the first
|
||||
;; arg is not necessarily a buffer. Report sent
|
||||
;; upstream. (2009-11-17)
|
||||
(setq current-buffer (or current-buffer (current-buffer)))
|
||||
(let* ((buffers (if isearch-forward
|
||||
buffers-forward
|
||||
buffers-backward)))
|
||||
(if wrap
|
||||
(car buffers)
|
||||
(second (memq current-buffer buffers))))))))
|
||||
(isearch-forward)))
|
||||
(defun slime-isearch-system ()
|
||||
(interactive)
|
||||
(error "This command is only supported on GNU Emacs >23.1.x.")))
|
||||
|
||||
(defun slime-read-query-replace-args (format-string &rest format-args)
|
||||
(let* ((minibuffer-setup-hook (slime-minibuffer-setup-hook))
|
||||
(minibuffer-local-map slime-minibuffer-map)
|
||||
(common (query-replace-read-args (apply #'format format-string
|
||||
format-args)
|
||||
t t)))
|
||||
(list (nth 0 common) (nth 1 common) (nth 2 common))))
|
||||
|
||||
(defun slime-query-replace-system (name from to &optional delimited)
|
||||
"Run `query-replace' on an ASDF system."
|
||||
(interactive (let ((system (slime-read-system-name nil nil t)))
|
||||
(cons system (slime-read-query-replace-args
|
||||
"Query replace throughout `%s'" system))))
|
||||
(condition-case c
|
||||
;; `tags-query-replace' actually uses `query-replace-regexp'
|
||||
;; internally.
|
||||
(tags-query-replace (regexp-quote from) to delimited
|
||||
'(mapcar 'slime-from-lisp-filename
|
||||
(slime-eval `(swank:asdf-system-files ,name))))
|
||||
(error
|
||||
;; Kludge: `tags-query-replace' does not actually return but
|
||||
;; signals an unnamed error with the below error
|
||||
;; message. (<=23.1.2, at least.)
|
||||
(unless (string-equal (error-message-string c) "All files processed")
|
||||
(signal (car c) (cdr c))) ; resignal
|
||||
t)))
|
||||
|
||||
(defun slime-query-replace-system-and-dependents
|
||||
(name from to &optional delimited)
|
||||
"Run `query-replace' on an ASDF system and all the systems
|
||||
depending on it."
|
||||
(interactive (let ((system (slime-read-system-name nil nil t)))
|
||||
(cons system (slime-read-query-replace-args
|
||||
"Query replace throughout `%s'+dependencies"
|
||||
system))))
|
||||
(slime-query-replace-system name from to delimited)
|
||||
(dolist (dep (slime-who-depends-on-rpc name))
|
||||
(when (y-or-n-p (format "Descend into system `%s'? " dep))
|
||||
(slime-query-replace-system dep from to delimited))))
|
||||
|
||||
(defun slime-delete-system-fasls (name)
|
||||
"Delete FASLs produced by compiling a system."
|
||||
(interactive (list (slime-read-system-name)))
|
||||
(slime-repl-shortcut-eval-async
|
||||
`(swank:delete-system-fasls ,name)
|
||||
'message))
|
||||
|
||||
(defun slime-reload-system (system)
|
||||
"Reload an ASDF system without reloading its dependencies."
|
||||
(interactive (list (slime-read-system-name)))
|
||||
(slime-save-some-lisp-buffers)
|
||||
(slime-display-output-buffer)
|
||||
(message "Performing ASDF LOAD-OP on system %S" system)
|
||||
(slime-repl-shortcut-eval-async
|
||||
`(swank:reload-system ,system)
|
||||
(slime-asdf-operation-finished-function system)))
|
||||
|
||||
(defun slime-who-depends-on (system-name)
|
||||
(interactive (list (slime-read-system-name)))
|
||||
(slime-xref :depends-on system-name))
|
||||
|
||||
(defun slime-save-system (system)
|
||||
"Save files belonging to an ASDF system."
|
||||
(interactive (list (slime-read-system-name)))
|
||||
(slime-eval-async
|
||||
`(swank:asdf-system-files ,system)
|
||||
(lambda (files)
|
||||
(dolist (file files)
|
||||
(let ((buffer (get-file-buffer (slime-from-lisp-filename file))))
|
||||
(when buffer
|
||||
(with-current-buffer buffer
|
||||
(save-buffer buffer)))))
|
||||
(message "Done."))))
|
||||
|
||||
|
||||
;;; REPL shortcuts
|
||||
|
||||
(defslime-repl-shortcut slime-repl-load/force-system ("force-load-system")
|
||||
(:handler (lambda ()
|
||||
(interactive)
|
||||
(slime-oos (slime-read-system-name) 'load-op :force t)))
|
||||
(:one-liner "Recompile and load an ASDF system."))
|
||||
|
||||
(defslime-repl-shortcut slime-repl-load-system ("load-system")
|
||||
(:handler (lambda ()
|
||||
(interactive)
|
||||
(slime-oos (slime-read-system-name) 'load-op)))
|
||||
(:one-liner "Compile (as needed) and load an ASDF system."))
|
||||
|
||||
(defslime-repl-shortcut slime-repl-test/force-system ("force-test-system")
|
||||
(:handler (lambda ()
|
||||
(interactive)
|
||||
(slime-oos (slime-read-system-name) 'test-op :force t)))
|
||||
(:one-liner "Recompile and test an ASDF system."))
|
||||
|
||||
(defslime-repl-shortcut slime-repl-test-system ("test-system")
|
||||
(:handler (lambda ()
|
||||
(interactive)
|
||||
(slime-oos (slime-read-system-name) 'test-op)))
|
||||
(:one-liner "Compile (as needed) and test an ASDF system."))
|
||||
|
||||
(defslime-repl-shortcut slime-repl-compile-system ("compile-system")
|
||||
(:handler (lambda ()
|
||||
(interactive)
|
||||
(slime-oos (slime-read-system-name) 'compile-op)))
|
||||
(:one-liner "Compile (but not load) an ASDF system."))
|
||||
|
||||
(defslime-repl-shortcut slime-repl-compile/force-system
|
||||
("force-compile-system")
|
||||
(:handler (lambda ()
|
||||
(interactive)
|
||||
(slime-oos (slime-read-system-name) 'compile-op :force t)))
|
||||
(:one-liner "Recompile (but not completely load) an ASDF system."))
|
||||
|
||||
(defslime-repl-shortcut slime-repl-open-system ("open-system")
|
||||
(:handler 'slime-open-system)
|
||||
(:one-liner "Open all files in an ASDF system."))
|
||||
|
||||
(defslime-repl-shortcut slime-repl-browse-system ("browse-system")
|
||||
(:handler 'slime-browse-system)
|
||||
(:one-liner "Browse files in an ASDF system using Dired."))
|
||||
|
||||
(defslime-repl-shortcut slime-repl-delete-system-fasls ("delete-system-fasls")
|
||||
(:handler 'slime-delete-system-fasls)
|
||||
(:one-liner "Delete FASLs of an ASDF system."))
|
||||
|
||||
(defslime-repl-shortcut slime-repl-reload-system ("reload-system")
|
||||
(:handler 'slime-reload-system)
|
||||
(:one-liner "Recompile and load an ASDF system."))
|
||||
|
||||
(provide 'slime-asdf)
|
||||
BIN
elpa/slime-20191114.1625/contrib/slime-asdf.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-asdf.elc
Normal file
Binary file not shown.
216
elpa/slime-20191114.1625/contrib/slime-autodoc.el
Normal file
216
elpa/slime-20191114.1625/contrib/slime-autodoc.el
Normal file
|
|
@ -0,0 +1,216 @@
|
|||
(require 'slime)
|
||||
(require 'eldoc)
|
||||
(require 'cl-lib)
|
||||
(require 'slime-parse)
|
||||
|
||||
(define-slime-contrib slime-autodoc
|
||||
"Show fancy arglist in echo area."
|
||||
(:license "GPL")
|
||||
(:authors "Luke Gorrie <luke@bluetail.com>"
|
||||
"Lawrence Mitchell <wence@gmx.li>"
|
||||
"Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>"
|
||||
"Tobias C. Rittweiler <tcr@freebits.de>")
|
||||
(:slime-dependencies slime-parse)
|
||||
(:swank-dependencies swank-arglists)
|
||||
(:on-load (slime-autodoc--enable))
|
||||
(:on-unload (slime-autodoc--disable)))
|
||||
|
||||
(defcustom slime-autodoc-accuracy-depth 10
|
||||
"Number of paren levels that autodoc takes into account for
|
||||
context-sensitive arglist display (local functions. etc)"
|
||||
:type 'integer
|
||||
:group 'slime-ui)
|
||||
|
||||
;;;###autoload
|
||||
(defcustom slime-autodoc-mode-string (purecopy " adoc")
|
||||
"String to display in mode line when Autodoc Mode is enabled; nil for none."
|
||||
:type '(choice string (const :tag "None" nil))
|
||||
:group 'slime-ui)
|
||||
|
||||
|
||||
|
||||
(defun slime-arglist (name)
|
||||
"Show the argument list for NAME."
|
||||
(interactive (list (slime-read-symbol-name "Arglist of: " t)))
|
||||
(let ((arglist (slime-retrieve-arglist name)))
|
||||
(if (eq arglist :not-available)
|
||||
(error "Arglist not available")
|
||||
(message "%s" (slime-autodoc--fontify arglist)))))
|
||||
|
||||
;; used also in slime-c-p-c.el.
|
||||
(defun slime-retrieve-arglist (name)
|
||||
(let ((name (cl-etypecase name
|
||||
(string name)
|
||||
(symbol (symbol-name name)))))
|
||||
(car (slime-eval `(swank:autodoc '(,name ,slime-cursor-marker))))))
|
||||
|
||||
(defun slime-autodoc-manually ()
|
||||
"Like autodoc informtion forcing multiline display."
|
||||
(interactive)
|
||||
(let ((doc (slime-autodoc t)))
|
||||
(cond (doc (eldoc-message doc))
|
||||
(t (eldoc-message nil)))))
|
||||
|
||||
;; Must call eldoc-add-command otherwise (eldoc-display-message-p)
|
||||
;; returns nil and eldoc clears the echo area instead.
|
||||
(eldoc-add-command 'slime-autodoc-manually)
|
||||
|
||||
(defun slime-autodoc-space (n)
|
||||
"Like `slime-space' but nicer."
|
||||
(interactive "p")
|
||||
(self-insert-command n)
|
||||
(let ((doc (slime-autodoc)))
|
||||
(when doc
|
||||
(eldoc-message doc))))
|
||||
|
||||
(eldoc-add-command 'slime-autodoc-space)
|
||||
|
||||
|
||||
;;;; Autodoc cache
|
||||
|
||||
(defvar slime-autodoc--cache-last-context nil)
|
||||
(defvar slime-autodoc--cache-last-autodoc nil)
|
||||
|
||||
(defun slime-autodoc--cache-get (context)
|
||||
"Return the cached autodoc documentation for `context', or nil."
|
||||
(and (equal context slime-autodoc--cache-last-context)
|
||||
slime-autodoc--cache-last-autodoc))
|
||||
|
||||
(defun slime-autodoc--cache-put (context autodoc)
|
||||
"Update the autodoc cache for CONTEXT with AUTODOC."
|
||||
(setq slime-autodoc--cache-last-context context)
|
||||
(setq slime-autodoc--cache-last-autodoc autodoc))
|
||||
|
||||
|
||||
;;;; Formatting autodoc
|
||||
|
||||
(defsubst slime-autodoc--canonicalize-whitespace (string)
|
||||
(replace-regexp-in-string "[ \n\t]+" " " string))
|
||||
|
||||
(defun slime-autodoc--format (doc multilinep)
|
||||
(let ((doc (slime-autodoc--fontify doc)))
|
||||
(cond (multilinep doc)
|
||||
(t (slime-oneliner (slime-autodoc--canonicalize-whitespace doc))))))
|
||||
|
||||
(defun slime-autodoc--fontify (string)
|
||||
"Fontify STRING as `font-lock-mode' does in Lisp mode."
|
||||
(with-current-buffer (get-buffer-create (slime-buffer-name :fontify 'hidden))
|
||||
(erase-buffer)
|
||||
(unless (eq major-mode 'lisp-mode)
|
||||
;; Just calling (lisp-mode) will turn slime-mode on in that buffer,
|
||||
;; which may interfere with this function
|
||||
(setq major-mode 'lisp-mode)
|
||||
(lisp-mode-variables t))
|
||||
(insert string)
|
||||
(let ((font-lock-verbose nil))
|
||||
(font-lock-fontify-buffer))
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "===> \\(\\(.\\|\n\\)*\\) <===" nil t)
|
||||
(let ((highlight (match-string 1)))
|
||||
;; Can't use (replace-match highlight) here -- broken in Emacs 21
|
||||
(delete-region (match-beginning 0) (match-end 0))
|
||||
(slime-insert-propertized '(face eldoc-highlight-function-argument) highlight)))
|
||||
(buffer-substring (point-min) (point-max))))
|
||||
|
||||
(define-obsolete-function-alias 'slime-fontify-string
|
||||
'slime-autodoc--fontify
|
||||
"SLIME 2.10")
|
||||
|
||||
|
||||
;;;; Autodocs (automatic context-sensitive help)
|
||||
|
||||
(defun slime-autodoc (&optional force-multiline)
|
||||
"Returns the cached arglist information as string, or nil.
|
||||
If it's not in the cache, the cache will be updated asynchronously."
|
||||
(save-excursion
|
||||
(save-match-data
|
||||
(let ((context (slime-autodoc--parse-context)))
|
||||
(when context
|
||||
(let* ((cached (slime-autodoc--cache-get context))
|
||||
(multilinep (or force-multiline
|
||||
eldoc-echo-area-use-multiline-p)))
|
||||
(cond (cached (slime-autodoc--format cached multilinep))
|
||||
(t
|
||||
(when (slime-background-activities-enabled-p)
|
||||
(slime-autodoc--async context multilinep))
|
||||
nil))))))))
|
||||
|
||||
;; Return the context around point that can be passed to
|
||||
;; swank:autodoc. nil is returned if nothing reasonable could be
|
||||
;; found.
|
||||
(defun slime-autodoc--parse-context ()
|
||||
(and (slime-autodoc--parsing-safe-p)
|
||||
(let ((levels slime-autodoc-accuracy-depth))
|
||||
(slime-parse-form-upto-point levels))))
|
||||
|
||||
(defun slime-autodoc--parsing-safe-p ()
|
||||
(cond ((fboundp 'slime-repl-inside-string-or-comment-p)
|
||||
(not (slime-repl-inside-string-or-comment-p)))
|
||||
(t
|
||||
(not (slime-inside-string-or-comment-p)))))
|
||||
|
||||
(defun slime-autodoc--async (context multilinep)
|
||||
(slime-eval-async
|
||||
`(swank:autodoc ',context ;; FIXME: misuse of quote
|
||||
:print-right-margin ,(window-width (minibuffer-window)))
|
||||
(slime-curry #'slime-autodoc--async% context multilinep)))
|
||||
|
||||
(defun slime-autodoc--async% (context multilinep doc)
|
||||
(cl-destructuring-bind (doc &optional cache-p) doc
|
||||
(unless (eq doc :not-available)
|
||||
(when cache-p
|
||||
(slime-autodoc--cache-put context doc))
|
||||
;; Now that we've got our information,
|
||||
;; get it to the user ASAP.
|
||||
(when (eldoc-display-message-p)
|
||||
(eldoc-message (slime-autodoc--format doc multilinep))))))
|
||||
|
||||
|
||||
;;; Minor mode definition
|
||||
|
||||
;; Compute the prefix for slime-doc-map, usually this is C-c C-d.
|
||||
(defun slime-autodoc--doc-map-prefix ()
|
||||
(concat
|
||||
(car (rassoc '(slime-prefix-map) slime-parent-bindings))
|
||||
(car (rassoc '(slime-doc-map) slime-prefix-bindings))))
|
||||
|
||||
(define-minor-mode slime-autodoc-mode
|
||||
"Toggle echo area display of Lisp objects at point."
|
||||
:lighter slime-autodoc-mode-string
|
||||
:keymap (let ((prefix (slime-autodoc--doc-map-prefix)))
|
||||
`((,(concat prefix "A") . slime-autodoc-manually)
|
||||
(,(concat prefix (kbd "C-A")) . slime-autodoc-manually)
|
||||
(,(kbd "SPC") . slime-autodoc-space)))
|
||||
(set (make-local-variable 'eldoc-documentation-function) 'slime-autodoc)
|
||||
(set (make-local-variable 'eldoc-minor-mode-string) nil)
|
||||
(setq slime-autodoc-mode (eldoc-mode arg))
|
||||
(when (called-interactively-p 'interactive)
|
||||
(message "Slime autodoc mode %s."
|
||||
(if slime-autodoc-mode "enabled" "disabled"))))
|
||||
|
||||
|
||||
;;; Noise to enable/disable slime-autodoc-mode
|
||||
|
||||
(defun slime-autodoc--on () (slime-autodoc-mode 1))
|
||||
(defun slime-autodoc--off () (slime-autodoc-mode 0))
|
||||
|
||||
(defvar slime-autodoc--relevant-hooks
|
||||
'(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
|
||||
|
||||
(defun slime-autodoc--enable ()
|
||||
(dolist (h slime-autodoc--relevant-hooks)
|
||||
(add-hook h 'slime-autodoc--on))
|
||||
(dolist (b (buffer-list))
|
||||
(with-current-buffer b
|
||||
(when slime-mode
|
||||
(slime-autodoc--on)))))
|
||||
|
||||
(defun slime-autodoc--disable ()
|
||||
(dolist (h slime-autodoc--relevant-hooks)
|
||||
(remove-hook h 'slime-autodoc--on))
|
||||
(dolist (b (buffer-list))
|
||||
(with-current-buffer b
|
||||
(when slime-autodoc-mode
|
||||
(slime-autodoc--off)))))
|
||||
|
||||
(provide 'slime-autodoc)
|
||||
BIN
elpa/slime-20191114.1625/contrib/slime-autodoc.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-autodoc.elc
Normal file
Binary file not shown.
35
elpa/slime-20191114.1625/contrib/slime-banner.el
Normal file
35
elpa/slime-20191114.1625/contrib/slime-banner.el
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
(require 'slime)
|
||||
(require 'slime-repl)
|
||||
|
||||
(define-slime-contrib slime-banner
|
||||
"Persistent header line and startup animation."
|
||||
(:authors "Helmut Eller <heller@common-lisp.net>"
|
||||
"Luke Gorrie <luke@synap.se>")
|
||||
(:license "GPL")
|
||||
(:on-load (setq slime-repl-banner-function 'slime-startup-message))
|
||||
(:on-unload (setq slime-repl-banner-function 'slime-repl-insert-banner)))
|
||||
|
||||
(defcustom slime-startup-animation (fboundp 'animate-string)
|
||||
"Enable the startup animation."
|
||||
:type '(choice (const :tag "Enable" t) (const :tag "Disable" nil))
|
||||
:group 'slime-ui)
|
||||
|
||||
(defcustom slime-header-line-p (boundp 'header-line-format)
|
||||
"If non-nil, display a header line in Slime buffers."
|
||||
:type 'boolean
|
||||
:group 'slime-repl)
|
||||
|
||||
(defun slime-startup-message ()
|
||||
(when slime-header-line-p
|
||||
(setq header-line-format
|
||||
(format "%s Port: %s Pid: %s"
|
||||
(slime-lisp-implementation-type)
|
||||
(slime-connection-port (slime-connection))
|
||||
(slime-pid))))
|
||||
(when (zerop (buffer-size))
|
||||
(let ((welcome (concat "; SLIME " slime-version)))
|
||||
(if slime-startup-animation
|
||||
(animate-string welcome 0 0)
|
||||
(insert welcome)))))
|
||||
|
||||
(provide 'slime-banner)
|
||||
BIN
elpa/slime-20191114.1625/contrib/slime-banner.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-banner.elc
Normal file
Binary file not shown.
36
elpa/slime-20191114.1625/contrib/slime-buffer-streams.el
Normal file
36
elpa/slime-20191114.1625/contrib/slime-buffer-streams.el
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
(eval-and-compile
|
||||
(require 'slime))
|
||||
|
||||
(define-slime-contrib slime-buffer-streams
|
||||
"Lisp streams that output to an emacs buffer"
|
||||
(:authors "Ed Langley <el-github@elangley.org>")
|
||||
(:license "GPL")
|
||||
(:swank-dependencies swank-buffer-streams))
|
||||
|
||||
(defslimefun slime-make-buffer-stream-target (thread name)
|
||||
(message "making target %s" name)
|
||||
(slime-buffer-streams--get-target-marker name)
|
||||
`(:stream-target-created ,thread ,name))
|
||||
|
||||
(defun slime-buffer-streams--get-target-name (target)
|
||||
(format "*slime-target %s*" target))
|
||||
|
||||
(defvar-local slime-buffer-stream-target nil)
|
||||
|
||||
;; TODO: tell backend that the buffer has been closed, so it can close
|
||||
;; the stream
|
||||
(defun slime-buffer-streams--cleanup-markers ()
|
||||
(when slime-buffer-stream-target
|
||||
(message "Removing target: %s" slime-buffer-stream-target)
|
||||
(remhash slime-buffer-stream-target slime-output-target-to-marker)))
|
||||
|
||||
(defun slime-buffer-streams--get-target-marker (target)
|
||||
(or (gethash target slime-output-target-to-marker)
|
||||
(with-current-buffer
|
||||
(generate-new-buffer (slime-buffer-streams--get-target-name target))
|
||||
(setq slime-buffer-stream-target target)
|
||||
(add-hook 'kill-buffer-hook 'slime-buffer-streams--cleanup-markers)
|
||||
(setf (gethash target slime-output-target-to-marker)
|
||||
(point-marker)))))
|
||||
|
||||
(provide 'slime-buffer-streams)
|
||||
BIN
elpa/slime-20191114.1625/contrib/slime-buffer-streams.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-buffer-streams.elc
Normal file
Binary file not shown.
305
elpa/slime-20191114.1625/contrib/slime-c-p-c.el
Normal file
305
elpa/slime-20191114.1625/contrib/slime-c-p-c.el
Normal file
|
|
@ -0,0 +1,305 @@
|
|||
(require 'slime)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defvar slime-c-p-c-init-undo-stack nil)
|
||||
|
||||
(define-slime-contrib slime-c-p-c
|
||||
"ILISP style Compound Prefix Completion."
|
||||
(:authors "Luke Gorrie <luke@synap.se>"
|
||||
"Edi Weitz <edi@agharta.de>"
|
||||
"Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>"
|
||||
"Tobias C. Rittweiler <tcr@freebits.de>")
|
||||
(:license "GPL")
|
||||
(:slime-dependencies slime-parse slime-editing-commands slime-autodoc)
|
||||
(:swank-dependencies swank-c-p-c)
|
||||
(:on-load
|
||||
(push
|
||||
`(progn
|
||||
(remove-hook 'slime-completion-at-point-functions
|
||||
#'slime-c-p-c-completion-at-point)
|
||||
(remove-hook 'slime-connected-hook 'slime-c-p-c-on-connect)
|
||||
,@(when (featurep 'slime-repl)
|
||||
`((define-key slime-mode-map "\C-c\C-s"
|
||||
',(lookup-key slime-mode-map "\C-c\C-s"))
|
||||
(define-key slime-repl-mode-map "\C-c\C-s"
|
||||
',(lookup-key slime-repl-mode-map "\C-c\C-s")))))
|
||||
slime-c-p-c-init-undo-stack)
|
||||
(add-hook 'slime-completion-at-point-functions
|
||||
#'slime-c-p-c-completion-at-point)
|
||||
(define-key slime-mode-map "\C-c\C-s" 'slime-complete-form)
|
||||
(when (featurep 'slime-repl)
|
||||
(define-key slime-repl-mode-map "\C-c\C-s" 'slime-complete-form)))
|
||||
(:on-unload
|
||||
(while slime-c-p-c-init-undo-stack
|
||||
(eval (pop slime-c-p-c-init-undo-stack)))))
|
||||
|
||||
(defcustom slime-c-p-c-unambiguous-prefix-p t
|
||||
"If true, set point after the unambigous prefix.
|
||||
If false, move point to the end of the inserted text."
|
||||
:type 'boolean
|
||||
:group 'slime-ui)
|
||||
|
||||
(defcustom slime-complete-symbol*-fancy nil
|
||||
"Use information from argument lists for DWIM'ish symbol completion."
|
||||
:group 'slime-mode
|
||||
:type 'boolean)
|
||||
|
||||
|
||||
;; FIXME: this is the old code to display completions. Remove it once
|
||||
;; `slime-complete-symbol*' and `slime-fuzzy-complete-symbol' can be
|
||||
;; used together with `completion-at-point'.
|
||||
|
||||
(defvar slime-completions-buffer-name "*Completions*")
|
||||
|
||||
;; FIXME: can probably use quit-window instead
|
||||
(make-variable-buffer-local
|
||||
(defvar slime-complete-saved-window-configuration nil
|
||||
"Window configuration before we show the *Completions* buffer.
|
||||
This is buffer local in the buffer where the completion is
|
||||
performed."))
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar slime-completions-window nil
|
||||
"The window displaying *Completions* after saving window configuration.
|
||||
If this window is no longer active or displaying the completions
|
||||
buffer then we can ignore `slime-complete-saved-window-configuration'."))
|
||||
|
||||
(defun slime-complete-maybe-save-window-configuration ()
|
||||
"Maybe save the current window configuration.
|
||||
Return true if the configuration was saved."
|
||||
(unless (or slime-complete-saved-window-configuration
|
||||
(get-buffer-window slime-completions-buffer-name))
|
||||
(setq slime-complete-saved-window-configuration
|
||||
(current-window-configuration))
|
||||
t))
|
||||
|
||||
(defun slime-complete-delay-restoration ()
|
||||
(add-hook 'pre-command-hook
|
||||
'slime-complete-maybe-restore-window-configuration
|
||||
'append
|
||||
'local))
|
||||
|
||||
(defun slime-complete-forget-window-configuration ()
|
||||
(setq slime-complete-saved-window-configuration nil)
|
||||
(setq slime-completions-window nil))
|
||||
|
||||
(defun slime-complete-restore-window-configuration ()
|
||||
"Restore the window config if available."
|
||||
(remove-hook 'pre-command-hook
|
||||
'slime-complete-maybe-restore-window-configuration)
|
||||
(when (and slime-complete-saved-window-configuration
|
||||
(slime-completion-window-active-p))
|
||||
(save-excursion (set-window-configuration
|
||||
slime-complete-saved-window-configuration))
|
||||
(setq slime-complete-saved-window-configuration nil)
|
||||
(when (buffer-live-p slime-completions-buffer-name)
|
||||
(kill-buffer slime-completions-buffer-name))))
|
||||
|
||||
(defun slime-complete-maybe-restore-window-configuration ()
|
||||
"Restore the window configuration, if the following command
|
||||
terminates a current completion."
|
||||
(remove-hook 'pre-command-hook
|
||||
'slime-complete-maybe-restore-window-configuration)
|
||||
(condition-case err
|
||||
(cond ((cl-find last-command-event "()\"'`,# \r\n:")
|
||||
(slime-complete-restore-window-configuration))
|
||||
((not (slime-completion-window-active-p))
|
||||
(slime-complete-forget-window-configuration))
|
||||
(t
|
||||
(slime-complete-delay-restoration)))
|
||||
(error
|
||||
;; Because this is called on the pre-command-hook, we mustn't let
|
||||
;; errors propagate.
|
||||
(message "Error in slime-complete-restore-window-configuration: %S"
|
||||
err))))
|
||||
|
||||
(defun slime-completion-window-active-p ()
|
||||
"Is the completion window currently active?"
|
||||
(and (window-live-p slime-completions-window)
|
||||
(equal (buffer-name (window-buffer slime-completions-window))
|
||||
slime-completions-buffer-name)))
|
||||
|
||||
(defun slime-display-completion-list (completions start end)
|
||||
(let ((savedp (slime-complete-maybe-save-window-configuration)))
|
||||
(with-output-to-temp-buffer slime-completions-buffer-name
|
||||
(display-completion-list completions)
|
||||
(with-current-buffer standard-output
|
||||
(setq completion-base-position (list start end))
|
||||
(set-syntax-table lisp-mode-syntax-table)))
|
||||
(when savedp
|
||||
(setq slime-completions-window
|
||||
(get-buffer-window slime-completions-buffer-name)))))
|
||||
|
||||
(defun slime-display-or-scroll-completions (completions start end)
|
||||
(cond ((and (eq last-command this-command)
|
||||
(slime-completion-window-active-p))
|
||||
(slime-scroll-completions))
|
||||
(t
|
||||
(slime-display-completion-list completions start end)))
|
||||
(slime-complete-delay-restoration))
|
||||
|
||||
(defun slime-scroll-completions ()
|
||||
(let ((window slime-completions-window))
|
||||
(with-current-buffer (window-buffer window)
|
||||
(if (pos-visible-in-window-p (point-max) window)
|
||||
(set-window-start window (point-min))
|
||||
(save-selected-window
|
||||
(select-window window)
|
||||
(scroll-up))))))
|
||||
|
||||
(defun slime-minibuffer-respecting-message (format &rest format-args)
|
||||
"Display TEXT as a message, without hiding any minibuffer contents."
|
||||
(let ((text (format " [%s]" (apply #'format format format-args))))
|
||||
(if (minibuffer-window-active-p (minibuffer-window))
|
||||
(minibuffer-message text)
|
||||
(message "%s" text))))
|
||||
|
||||
(defun slime-maybe-complete-as-filename ()
|
||||
"If point is at a string starting with \", complete it as filename.
|
||||
Return nil if point is not at filename."
|
||||
(when (save-excursion (re-search-backward "\"[^ \t\n]+\\="
|
||||
(max (point-min)
|
||||
(- (point) 1000)) t))
|
||||
(let ((comint-completion-addsuffix '("/" . "\"")))
|
||||
(comint-replace-by-expanded-filename)
|
||||
t)))
|
||||
|
||||
|
||||
(defun slime-complete-symbol* ()
|
||||
"Expand abbreviations and complete the symbol at point."
|
||||
;; NB: It is only the name part of the symbol that we actually want
|
||||
;; to complete -- the package prefix, if given, is just context.
|
||||
(or (slime-maybe-complete-as-filename)
|
||||
(slime-expand-abbreviations-and-complete)))
|
||||
|
||||
(defun slime-c-p-c-completion-at-point ()
|
||||
#'slime-complete-symbol*)
|
||||
|
||||
;; FIXME: factorize
|
||||
(defun slime-expand-abbreviations-and-complete ()
|
||||
(let* ((end (move-marker (make-marker) (slime-symbol-end-pos)))
|
||||
(beg (move-marker (make-marker) (slime-symbol-start-pos)))
|
||||
(prefix (buffer-substring-no-properties beg end))
|
||||
(completion-result (slime-contextual-completions beg end))
|
||||
(completion-set (cl-first completion-result))
|
||||
(completed-prefix (cl-second completion-result)))
|
||||
(if (null completion-set)
|
||||
(progn (slime-minibuffer-respecting-message
|
||||
"Can't find completion for \"%s\"" prefix)
|
||||
(ding)
|
||||
(slime-complete-restore-window-configuration))
|
||||
;; some XEmacs issue makes this distinction necessary
|
||||
(cond ((> (length completed-prefix) (- end beg))
|
||||
(goto-char end)
|
||||
(insert-and-inherit completed-prefix)
|
||||
(delete-region beg end)
|
||||
(goto-char (+ beg (length completed-prefix))))
|
||||
(t nil))
|
||||
(cond ((and (member completed-prefix completion-set)
|
||||
(slime-length= completion-set 1))
|
||||
(slime-minibuffer-respecting-message "Sole completion")
|
||||
(when slime-complete-symbol*-fancy
|
||||
(slime-complete-symbol*-fancy-bit))
|
||||
(slime-complete-restore-window-configuration))
|
||||
;; Incomplete
|
||||
(t
|
||||
(when (member completed-prefix completion-set)
|
||||
(slime-minibuffer-respecting-message
|
||||
"Complete but not unique"))
|
||||
(when slime-c-p-c-unambiguous-prefix-p
|
||||
(let ((unambiguous-completion-length
|
||||
(cl-loop for c in completion-set
|
||||
minimizing (or (cl-mismatch completed-prefix c)
|
||||
(length completed-prefix)))))
|
||||
(goto-char (+ beg unambiguous-completion-length))))
|
||||
(slime-display-or-scroll-completions completion-set
|
||||
beg
|
||||
(max (point) end)))))))
|
||||
|
||||
(defun slime-complete-symbol*-fancy-bit ()
|
||||
"Do fancy tricks after completing a symbol.
|
||||
\(Insert a space or close-paren based on arglist information.)"
|
||||
(let ((arglist (slime-retrieve-arglist (slime-symbol-at-point))))
|
||||
(unless (eq arglist :not-available)
|
||||
(let ((args
|
||||
;; Don't intern these symbols
|
||||
(let ((obarray (make-vector 10 0)))
|
||||
(cdr (read arglist))))
|
||||
(function-call-position-p
|
||||
(save-excursion
|
||||
(backward-sexp)
|
||||
(equal (char-before) ?\())))
|
||||
(when function-call-position-p
|
||||
(if (null args)
|
||||
(execute-kbd-macro ")")
|
||||
(execute-kbd-macro " ")
|
||||
(when (and (slime-background-activities-enabled-p)
|
||||
(not (minibuffer-window-active-p (minibuffer-window))))
|
||||
(slime-echo-arglist))))))))
|
||||
|
||||
(cl-defun slime-contextual-completions (beg end)
|
||||
"Return a list of completions of the token from BEG to END in the
|
||||
current buffer."
|
||||
(let ((token (buffer-substring-no-properties beg end)))
|
||||
(cond
|
||||
((and (< beg (point-max))
|
||||
(string= (buffer-substring-no-properties beg (1+ beg)) ":"))
|
||||
;; Contextual keyword completion
|
||||
(let ((completions
|
||||
(slime-completions-for-keyword token
|
||||
(save-excursion
|
||||
(goto-char beg)
|
||||
(slime-parse-form-upto-point)))))
|
||||
(when (cl-first completions)
|
||||
(cl-return-from slime-contextual-completions completions))
|
||||
;; If no matching keyword was found, do regular symbol
|
||||
;; completion.
|
||||
))
|
||||
((and (>= (length token) 2)
|
||||
(string= (cl-subseq token 0 2) "#\\"))
|
||||
;; Character name completion
|
||||
(cl-return-from slime-contextual-completions
|
||||
(slime-completions-for-character token))))
|
||||
;; Regular symbol completion
|
||||
(slime-completions token)))
|
||||
|
||||
(defun slime-completions (prefix)
|
||||
(slime-eval `(swank:completions ,prefix ',(slime-current-package))))
|
||||
|
||||
(defun slime-completions-for-keyword (prefix buffer-form)
|
||||
(slime-eval `(swank:completions-for-keyword ,prefix ',buffer-form)))
|
||||
|
||||
(defun slime-completions-for-character (prefix)
|
||||
(cl-labels ((append-char-syntax (string) (concat "#\\" string)))
|
||||
(let ((result (slime-eval `(swank:completions-for-character
|
||||
,(cl-subseq prefix 2)))))
|
||||
(when (car result)
|
||||
(list (mapcar #'append-char-syntax (car result))
|
||||
(append-char-syntax (cadr result)))))))
|
||||
|
||||
|
||||
;;; Complete form
|
||||
|
||||
(defun slime-complete-form ()
|
||||
"Complete the form at point.
|
||||
This is a superset of the functionality of `slime-insert-arglist'."
|
||||
(interactive)
|
||||
;; Find the (possibly incomplete) form around point.
|
||||
(let ((buffer-form (slime-parse-form-upto-point)))
|
||||
(let ((result (slime-eval `(swank:complete-form ',buffer-form))))
|
||||
(if (eq result :not-available)
|
||||
(error "Could not generate completion for the form `%s'" buffer-form)
|
||||
(progn
|
||||
(just-one-space (if (looking-back "\\s(" (1- (point)))
|
||||
0
|
||||
1))
|
||||
(save-excursion
|
||||
(insert result)
|
||||
(let ((slime-close-parens-limit 1))
|
||||
(slime-close-all-parens-in-sexp)))
|
||||
(save-excursion
|
||||
(backward-up-list 1)
|
||||
(indent-sexp)))))))
|
||||
|
||||
(provide 'slime-c-p-c)
|
||||
|
||||
BIN
elpa/slime-20191114.1625/contrib/slime-c-p-c.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-c-p-c.elc
Normal file
Binary file not shown.
1821
elpa/slime-20191114.1625/contrib/slime-cl-indent.el
Normal file
1821
elpa/slime-20191114.1625/contrib/slime-cl-indent.el
Normal file
File diff suppressed because it is too large
Load diff
BIN
elpa/slime-20191114.1625/contrib/slime-cl-indent.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-cl-indent.elc
Normal file
Binary file not shown.
172
elpa/slime-20191114.1625/contrib/slime-clipboard.el
Normal file
172
elpa/slime-20191114.1625/contrib/slime-clipboard.el
Normal file
|
|
@ -0,0 +1,172 @@
|
|||
(require 'slime)
|
||||
(require 'slime-repl)
|
||||
(require 'cl-lib)
|
||||
(eval-when-compile
|
||||
(require 'cl)) ; lexical-let
|
||||
|
||||
(define-slime-contrib slime-clipboard
|
||||
"This add a few commands to put objects into a clipboard and to
|
||||
insert textual references to those objects.
|
||||
|
||||
The clipboard command prefix is C-c @.
|
||||
|
||||
C-c @ + adds an object to the clipboard
|
||||
C-c @ @ inserts a reference to an object in the clipboard
|
||||
C-c @ ? displays the clipboard
|
||||
|
||||
This package also also binds the + key in the inspector and
|
||||
debugger to add the object at point to the clipboard."
|
||||
(:authors "Helmut Eller <heller@common-lisp.net>")
|
||||
(:license "GPL")
|
||||
(:swank-dependencies swank-clipboard))
|
||||
|
||||
(define-derived-mode slime-clipboard-mode fundamental-mode
|
||||
"Slime-Clipboard"
|
||||
"SLIME Clipboad Mode.
|
||||
|
||||
\\{slime-clipboard-mode-map}")
|
||||
|
||||
(slime-define-keys slime-clipboard-mode-map
|
||||
("g" 'slime-clipboard-redisplay)
|
||||
((kbd "C-k") 'slime-clipboard-delete-entry)
|
||||
("i" 'slime-clipboard-inspect))
|
||||
|
||||
(defvar slime-clipboard-map (make-sparse-keymap))
|
||||
|
||||
(slime-define-keys slime-clipboard-map
|
||||
("?" 'slime-clipboard-display)
|
||||
("+" 'slime-clipboard-add)
|
||||
("@" 'slime-clipboard-ref))
|
||||
|
||||
(define-key slime-mode-map (kbd "C-c @") slime-clipboard-map)
|
||||
(define-key slime-repl-mode-map (kbd "C-c @") slime-clipboard-map)
|
||||
|
||||
(slime-define-keys slime-inspector-mode-map
|
||||
("+" 'slime-clipboard-add-from-inspector))
|
||||
|
||||
(slime-define-keys sldb-mode-map
|
||||
("+" 'slime-clipboard-add-from-sldb))
|
||||
|
||||
(defun slime-clipboard-add (exp package)
|
||||
"Add an object to the clipboard."
|
||||
(interactive (list (slime-read-from-minibuffer
|
||||
"Add to clipboard (evaluated): "
|
||||
(slime-sexp-at-point))
|
||||
(slime-current-package)))
|
||||
(slime-clipboard-add-internal `(:string ,exp ,package)))
|
||||
|
||||
(defun slime-clipboard-add-internal (datum)
|
||||
(slime-eval-async `(swank-clipboard:add ',datum)
|
||||
(lambda (result) (message "%s" result))))
|
||||
|
||||
(defun slime-clipboard-display ()
|
||||
"Display the content of the clipboard."
|
||||
(interactive)
|
||||
(slime-eval-async `(swank-clipboard:entries)
|
||||
#'slime-clipboard-display-entries))
|
||||
|
||||
(defun slime-clipboard-display-entries (entries)
|
||||
(slime-with-popup-buffer ((slime-buffer-name :clipboard)
|
||||
:mode 'slime-clipboard-mode)
|
||||
(slime-clipboard-insert-entries entries)))
|
||||
|
||||
(defun slime-clipboard-insert-entries (entries)
|
||||
(let ((fstring "%2s %3s %s\n"))
|
||||
(insert (format fstring "Nr" "Id" "Value")
|
||||
(format fstring "--" "--" "-----" ))
|
||||
(save-excursion
|
||||
(cl-loop for i from 0 for (ref . value) in entries do
|
||||
(slime-insert-propertized `(slime-clipboard-entry ,i
|
||||
slime-clipboard-ref ,ref)
|
||||
(format fstring i ref value))))))
|
||||
|
||||
(defun slime-clipboard-redisplay ()
|
||||
"Update the clipboard buffer."
|
||||
(interactive)
|
||||
(lexical-let ((saved (point)))
|
||||
(slime-eval-async
|
||||
`(swank-clipboard:entries)
|
||||
(lambda (entries)
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(slime-clipboard-insert-entries entries)
|
||||
(when (< saved (point-max))
|
||||
(goto-char saved)))))))
|
||||
|
||||
(defun slime-clipboard-entry-at-point ()
|
||||
(or (get-text-property (point) 'slime-clipboard-entry)
|
||||
(error "No clipboard entry at point")))
|
||||
|
||||
(defun slime-clipboard-ref-at-point ()
|
||||
(or (get-text-property (point) 'slime-clipboard-ref)
|
||||
(error "No clipboard ref at point")))
|
||||
|
||||
(defun slime-clipboard-inspect (&optional entry)
|
||||
"Inspect the current clipboard entry."
|
||||
(interactive (list (slime-clipboard-ref-at-point)))
|
||||
(slime-inspect (prin1-to-string `(swank-clipboard::clipboard-ref ,entry))))
|
||||
|
||||
(defun slime-clipboard-delete-entry (&optional entry)
|
||||
"Delete the current entry from the clipboard."
|
||||
(interactive (list (slime-clipboard-entry-at-point)))
|
||||
(slime-eval-async `(swank-clipboard:delete-entry ,entry)
|
||||
(lambda (result)
|
||||
(slime-clipboard-redisplay)
|
||||
(message "%s" result))))
|
||||
|
||||
(defun slime-clipboard-ref ()
|
||||
"Ask for a clipboard entry number and insert a reference to it."
|
||||
(interactive)
|
||||
(slime-clipboard-read-entry-number #'slime-clipboard-insert-ref))
|
||||
|
||||
;; insert a reference to clipboard entry ENTRY at point. The text
|
||||
;; receives a special 'display property to make it look nicer. We
|
||||
;; remove this property in a modification when a user tries to modify
|
||||
;; he real text.
|
||||
(defun slime-clipboard-insert-ref (entry)
|
||||
(cl-destructuring-bind (ref . string)
|
||||
(slime-eval `(swank-clipboard:entry-to-ref ,entry))
|
||||
(slime-insert-propertized
|
||||
`(display ,(format "#@%d%s" ref string)
|
||||
modification-hooks (slime-clipboard-ref-modified)
|
||||
rear-nonsticky t)
|
||||
(format "(swank-clipboard::clipboard-ref %d)" ref))))
|
||||
|
||||
(defun slime-clipboard-ref-modified (start end)
|
||||
(when (get-text-property start 'display)
|
||||
(let ((inhibit-modification-hooks t))
|
||||
(save-excursion
|
||||
(goto-char start)
|
||||
(cl-destructuring-bind (dstart dend) (slime-property-bounds 'display)
|
||||
(unless (and (= start dstart) (= end dend))
|
||||
(remove-list-of-text-properties
|
||||
dstart dend '(display modification-hooks))))))))
|
||||
|
||||
;; Read a entry number.
|
||||
;; Written in CPS because the display the clipboard before reading.
|
||||
(defun slime-clipboard-read-entry-number (k)
|
||||
(slime-eval-async
|
||||
`(swank-clipboard:entries)
|
||||
(slime-rcurry
|
||||
(lambda (entries window-config k)
|
||||
(slime-clipboard-display-entries entries)
|
||||
(let ((entry (unwind-protect
|
||||
(read-from-minibuffer "Entry number: " nil nil t)
|
||||
(set-window-configuration window-config))))
|
||||
(funcall k entry)))
|
||||
(current-window-configuration)
|
||||
k)))
|
||||
|
||||
(defun slime-clipboard-add-from-inspector ()
|
||||
(interactive)
|
||||
(let ((part (or (get-text-property (point) 'slime-part-number)
|
||||
(error "No part at point"))))
|
||||
(slime-clipboard-add-internal `(:inspector ,part))))
|
||||
|
||||
(defun slime-clipboard-add-from-sldb ()
|
||||
(interactive)
|
||||
(slime-clipboard-add-internal
|
||||
`(:sldb ,(sldb-frame-number-at-point)
|
||||
,(sldb-var-number-at-point))))
|
||||
|
||||
(provide 'slime-clipboard)
|
||||
BIN
elpa/slime-20191114.1625/contrib/slime-clipboard.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-clipboard.elc
Normal file
Binary file not shown.
184
elpa/slime-20191114.1625/contrib/slime-compiler-notes-tree.el
Normal file
184
elpa/slime-20191114.1625/contrib/slime-compiler-notes-tree.el
Normal file
|
|
@ -0,0 +1,184 @@
|
|||
(require 'slime)
|
||||
(require 'cl-lib)
|
||||
|
||||
(define-slime-contrib slime-compiler-notes-tree
|
||||
"Display compiler messages in tree layout.
|
||||
|
||||
M-x slime-list-compiler-notes display the compiler notes in a tree
|
||||
grouped by severity.
|
||||
|
||||
`slime-maybe-list-compiler-notes' can be used as
|
||||
`slime-compilation-finished-hook'.
|
||||
"
|
||||
(:authors "Helmut Eller <heller@common-lisp.net>")
|
||||
(:license "GPL"))
|
||||
|
||||
(defun slime-maybe-list-compiler-notes (notes)
|
||||
"Show the compiler notes if appropriate."
|
||||
;; don't pop up a buffer if all notes are already annotated in the
|
||||
;; buffer itself
|
||||
(unless (cl-every #'slime-note-has-location-p notes)
|
||||
(slime-list-compiler-notes notes)))
|
||||
|
||||
(defun slime-list-compiler-notes (notes)
|
||||
"Show the compiler notes NOTES in tree view."
|
||||
(interactive (list (slime-compiler-notes)))
|
||||
(with-temp-message "Preparing compiler note tree..."
|
||||
(slime-with-popup-buffer ((slime-buffer-name :notes)
|
||||
:mode 'slime-compiler-notes-mode)
|
||||
(when (null notes)
|
||||
(insert "[no notes]"))
|
||||
(let ((collapsed-p))
|
||||
(dolist (tree (slime-compiler-notes-to-tree notes))
|
||||
(when (slime-tree.collapsed-p tree) (setf collapsed-p t))
|
||||
(slime-tree-insert tree "")
|
||||
(insert "\n"))
|
||||
(goto-char (point-min))))))
|
||||
|
||||
(defvar slime-tree-printer 'slime-tree-default-printer)
|
||||
|
||||
(defun slime-tree-for-note (note)
|
||||
(make-slime-tree :item (slime-note.message note)
|
||||
:plist (list 'note note)
|
||||
:print-fn slime-tree-printer))
|
||||
|
||||
(defun slime-tree-for-severity (severity notes collapsed-p)
|
||||
(make-slime-tree :item (format "%s (%d)"
|
||||
(slime-severity-label severity)
|
||||
(length notes))
|
||||
:kids (mapcar #'slime-tree-for-note notes)
|
||||
:collapsed-p collapsed-p))
|
||||
|
||||
(defun slime-compiler-notes-to-tree (notes)
|
||||
(let* ((alist (slime-alistify notes #'slime-note.severity #'eq))
|
||||
(collapsed-p (slime-length> alist 1)))
|
||||
(cl-loop for (severity . notes) in alist
|
||||
collect (slime-tree-for-severity severity notes
|
||||
collapsed-p))))
|
||||
|
||||
(defvar slime-compiler-notes-mode-map)
|
||||
|
||||
(define-derived-mode slime-compiler-notes-mode fundamental-mode
|
||||
"Compiler-Notes"
|
||||
"\\<slime-compiler-notes-mode-map>\
|
||||
\\{slime-compiler-notes-mode-map}
|
||||
\\{slime-popup-buffer-mode-map}
|
||||
"
|
||||
(slime-set-truncate-lines))
|
||||
|
||||
(slime-define-keys slime-compiler-notes-mode-map
|
||||
((kbd "RET") 'slime-compiler-notes-default-action-or-show-details)
|
||||
([return] 'slime-compiler-notes-default-action-or-show-details)
|
||||
([mouse-2] 'slime-compiler-notes-default-action-or-show-details/mouse))
|
||||
|
||||
(defun slime-compiler-notes-default-action-or-show-details/mouse (event)
|
||||
"Invoke the action pointed at by the mouse, or show details."
|
||||
(interactive "e")
|
||||
(cl-destructuring-bind (mouse-2 (w pos &rest _) &rest __) event
|
||||
(save-excursion
|
||||
(goto-char pos)
|
||||
(let ((fn (get-text-property (point)
|
||||
'slime-compiler-notes-default-action)))
|
||||
(if fn (funcall fn) (slime-compiler-notes-show-details))))))
|
||||
|
||||
(defun slime-compiler-notes-default-action-or-show-details ()
|
||||
"Invoke the action at point, or show details."
|
||||
(interactive)
|
||||
(let ((fn (get-text-property (point) 'slime-compiler-notes-default-action)))
|
||||
(if fn (funcall fn) (slime-compiler-notes-show-details))))
|
||||
|
||||
(defun slime-compiler-notes-show-details ()
|
||||
(interactive)
|
||||
(let* ((tree (slime-tree-at-point))
|
||||
(note (plist-get (slime-tree.plist tree) 'note))
|
||||
(inhibit-read-only t))
|
||||
(cond ((not (slime-tree-leaf-p tree))
|
||||
(slime-tree-toggle tree))
|
||||
(t
|
||||
(slime-show-source-location (slime-note.location note) t)))))
|
||||
|
||||
|
||||
;;;;;; Tree Widget
|
||||
|
||||
(cl-defstruct (slime-tree (:conc-name slime-tree.))
|
||||
item
|
||||
(print-fn #'slime-tree-default-printer :type function)
|
||||
(kids '() :type list)
|
||||
(collapsed-p t :type boolean)
|
||||
(prefix "" :type string)
|
||||
(start-mark nil)
|
||||
(end-mark nil)
|
||||
(plist '() :type list))
|
||||
|
||||
(defun slime-tree-leaf-p (tree)
|
||||
(not (slime-tree.kids tree)))
|
||||
|
||||
(defun slime-tree-default-printer (tree)
|
||||
(princ (slime-tree.item tree) (current-buffer)))
|
||||
|
||||
(defun slime-tree-decoration (tree)
|
||||
(cond ((slime-tree-leaf-p tree) "-- ")
|
||||
((slime-tree.collapsed-p tree) "[+] ")
|
||||
(t "-+ ")))
|
||||
|
||||
(defun slime-tree-insert-list (list prefix)
|
||||
"Insert a list of trees."
|
||||
(cl-loop for (elt . rest) on list
|
||||
do (cond (rest
|
||||
(insert prefix " |")
|
||||
(slime-tree-insert elt (concat prefix " |"))
|
||||
(insert "\n"))
|
||||
(t
|
||||
(insert prefix " `")
|
||||
(slime-tree-insert elt (concat prefix " "))))))
|
||||
|
||||
(defun slime-tree-insert-decoration (tree)
|
||||
(insert (slime-tree-decoration tree)))
|
||||
|
||||
(defun slime-tree-indent-item (start end prefix)
|
||||
"Insert PREFIX at the beginning of each but the first line.
|
||||
This is used for labels spanning multiple lines."
|
||||
(save-excursion
|
||||
(goto-char end)
|
||||
(beginning-of-line)
|
||||
(while (< start (point))
|
||||
(insert-before-markers prefix)
|
||||
(forward-line -1))))
|
||||
|
||||
(defun slime-tree-insert (tree prefix)
|
||||
"Insert TREE prefixed with PREFIX at point."
|
||||
(with-struct (slime-tree. print-fn kids collapsed-p start-mark end-mark) tree
|
||||
(let ((line-start (line-beginning-position)))
|
||||
(setf start-mark (point-marker))
|
||||
(slime-tree-insert-decoration tree)
|
||||
(funcall print-fn tree)
|
||||
(slime-tree-indent-item start-mark (point) (concat prefix " "))
|
||||
(add-text-properties line-start (point) (list 'slime-tree tree))
|
||||
(set-marker-insertion-type start-mark t)
|
||||
(when (and kids (not collapsed-p))
|
||||
(terpri (current-buffer))
|
||||
(slime-tree-insert-list kids prefix))
|
||||
(setf (slime-tree.prefix tree) prefix)
|
||||
(setf end-mark (point-marker)))))
|
||||
|
||||
(defun slime-tree-at-point ()
|
||||
(cond ((get-text-property (point) 'slime-tree))
|
||||
(t (error "No tree at point"))))
|
||||
|
||||
(defun slime-tree-delete (tree)
|
||||
"Delete the region for TREE."
|
||||
(delete-region (slime-tree.start-mark tree)
|
||||
(slime-tree.end-mark tree)))
|
||||
|
||||
(defun slime-tree-toggle (tree)
|
||||
"Toggle the visibility of TREE's children."
|
||||
(with-struct (slime-tree. collapsed-p start-mark end-mark prefix) tree
|
||||
(setf collapsed-p (not collapsed-p))
|
||||
(slime-tree-delete tree)
|
||||
(insert-before-markers " ") ; move parent's end-mark
|
||||
(backward-char 1)
|
||||
(slime-tree-insert tree prefix)
|
||||
(delete-char 1)
|
||||
(goto-char start-mark)))
|
||||
|
||||
(provide 'slime-compiler-notes-tree)
|
||||
BIN
elpa/slime-20191114.1625/contrib/slime-compiler-notes-tree.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-compiler-notes-tree.elc
Normal file
Binary file not shown.
183
elpa/slime-20191114.1625/contrib/slime-editing-commands.el
Normal file
183
elpa/slime-20191114.1625/contrib/slime-editing-commands.el
Normal file
|
|
@ -0,0 +1,183 @@
|
|||
(require 'slime)
|
||||
(require 'slime-repl)
|
||||
(require 'cl-lib)
|
||||
|
||||
(define-slime-contrib slime-editing-commands
|
||||
"Editing commands without server interaction."
|
||||
(:authors "Thomas F. Burdick <tfb@OCF.Berkeley.EDU>"
|
||||
"Luke Gorrie <luke@synap.se>"
|
||||
"Bill Clementson <billclem@gmail.com>"
|
||||
"Tobias C. Rittweiler <tcr@freebits.de>")
|
||||
(:license "GPL")
|
||||
(:on-load
|
||||
(define-key slime-mode-map "\M-\C-a" 'slime-beginning-of-defun)
|
||||
(define-key slime-mode-map "\M-\C-e" 'slime-end-of-defun)
|
||||
(define-key slime-mode-map "\C-c\M-q" 'slime-reindent-defun)
|
||||
(define-key slime-mode-map "\C-c\C-]" 'slime-close-all-parens-in-sexp)))
|
||||
|
||||
(defun slime-beginning-of-defun ()
|
||||
(interactive)
|
||||
(if (and (boundp 'slime-repl-input-start-mark)
|
||||
slime-repl-input-start-mark)
|
||||
(slime-repl-beginning-of-defun)
|
||||
(let ((this-command 'beginning-of-defun)) ; needed for push-mark
|
||||
(call-interactively 'beginning-of-defun))))
|
||||
|
||||
(defun slime-end-of-defun ()
|
||||
(interactive)
|
||||
(if (eq major-mode 'slime-repl-mode)
|
||||
(slime-repl-end-of-defun)
|
||||
(end-of-defun)))
|
||||
|
||||
(defvar slime-comment-start-regexp
|
||||
"\\(\\(^\\|[^\n\\\\]\\)\\([\\\\][\\\\]\\)*\\);+[ \t]*"
|
||||
"Regexp to match the start of a comment.")
|
||||
|
||||
(defun slime-beginning-of-comment ()
|
||||
"Move point to beginning of comment.
|
||||
If point is inside a comment move to beginning of comment and return point.
|
||||
Otherwise leave point unchanged and return NIL."
|
||||
(let ((boundary (point)))
|
||||
(beginning-of-line)
|
||||
(cond ((re-search-forward slime-comment-start-regexp boundary t)
|
||||
(point))
|
||||
(t (goto-char boundary)
|
||||
nil))))
|
||||
|
||||
(defvar slime-close-parens-limit nil
|
||||
"Maxmimum parens for `slime-close-all-sexp' to insert. NIL
|
||||
means to insert as many parentheses as necessary to correctly
|
||||
close the form.")
|
||||
|
||||
(defun slime-close-all-parens-in-sexp (&optional region)
|
||||
"Balance parentheses of open s-expressions at point.
|
||||
Insert enough right parentheses to balance unmatched left parentheses.
|
||||
Delete extra left parentheses. Reformat trailing parentheses
|
||||
Lisp-stylishly.
|
||||
|
||||
If REGION is true, operate on the region. Otherwise operate on
|
||||
the top-level sexp before point."
|
||||
(interactive "P")
|
||||
(let ((sexp-level 0)
|
||||
point)
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(when region
|
||||
(narrow-to-region (region-beginning) (region-end))
|
||||
(goto-char (point-max)))
|
||||
;; skip over closing parens, but not into comment
|
||||
(skip-chars-backward ") \t\n")
|
||||
(when (slime-beginning-of-comment)
|
||||
(forward-line)
|
||||
(skip-chars-forward " \t"))
|
||||
(setq point (point))
|
||||
;; count sexps until either '(' or comment is found at first column
|
||||
(while (and (not (looking-at "^[(;]"))
|
||||
(ignore-errors (backward-up-list 1) t))
|
||||
(incf sexp-level))))
|
||||
(when (> sexp-level 0)
|
||||
;; insert correct number of right parens
|
||||
(goto-char point)
|
||||
(dotimes (i sexp-level) (insert ")"))
|
||||
;; delete extra right parens
|
||||
(setq point (point))
|
||||
(skip-chars-forward " \t\n)")
|
||||
(skip-chars-backward " \t\n")
|
||||
(let* ((deleted-region (delete-and-extract-region point (point)))
|
||||
(deleted-text (substring-no-properties deleted-region))
|
||||
(prior-parens-count (cl-count ?\) deleted-text)))
|
||||
;; Remember: we always insert as many parentheses as necessary
|
||||
;; and only afterwards delete the superfluously-added parens.
|
||||
(when slime-close-parens-limit
|
||||
(let ((missing-parens (- sexp-level prior-parens-count
|
||||
slime-close-parens-limit)))
|
||||
(dotimes (i (max 0 missing-parens))
|
||||
(delete-char -1))))))))
|
||||
|
||||
(defun slime-insert-balanced-comments (arg)
|
||||
"Insert a set of balanced comments around the s-expression
|
||||
containing the point. If this command is invoked repeatedly
|
||||
\(without any other command occurring between invocations), the
|
||||
comment progressively moves outward over enclosing expressions.
|
||||
If invoked with a positive prefix argument, the s-expression arg
|
||||
expressions out is enclosed in a set of balanced comments."
|
||||
(interactive "*p")
|
||||
(save-excursion
|
||||
(when (eq last-command this-command)
|
||||
(when (search-backward "#|" nil t)
|
||||
(save-excursion
|
||||
(delete-char 2)
|
||||
(while (and (< (point) (point-max)) (not (looking-at " *|#")))
|
||||
(forward-sexp))
|
||||
(replace-match ""))))
|
||||
(while (> arg 0)
|
||||
(backward-char 1)
|
||||
(cond ((looking-at ")") (incf arg))
|
||||
((looking-at "(") (decf arg))))
|
||||
(insert "#|")
|
||||
(forward-sexp)
|
||||
(insert "|#")))
|
||||
|
||||
(defun slime-remove-balanced-comments ()
|
||||
"Remove a set of balanced comments enclosing point."
|
||||
(interactive "*")
|
||||
(save-excursion
|
||||
(when (search-backward "#|" nil t)
|
||||
(delete-char 2)
|
||||
(while (and (< (point) (point-max)) (not (looking-at " *|#")))
|
||||
(forward-sexp))
|
||||
(replace-match ""))))
|
||||
|
||||
|
||||
;; SLIME-CLOSE-PARENS-AT-POINT is obsolete:
|
||||
|
||||
;; It doesn't work correctly on the REPL, because there
|
||||
;; BEGINNING-OF-DEFUN-FUNCTION and END-OF-DEFUN-FUNCTION is bound to
|
||||
;; SLIME-REPL-MODE-BEGINNING-OF-DEFUN (and
|
||||
;; SLIME-REPL-MODE-END-OF-DEFUN respectively) which compromises the
|
||||
;; way how they're expect to work (i.e. END-OF-DEFUN does not signal
|
||||
;; an UNBOUND-PARENTHESES error.)
|
||||
|
||||
;; Use SLIME-CLOSE-ALL-PARENS-IN-SEXP instead.
|
||||
|
||||
;; (defun slime-close-parens-at-point ()
|
||||
;; "Close parenthesis at point to complete the top-level-form. Simply
|
||||
;; inserts ')' characters at point until `beginning-of-defun' and
|
||||
;; `end-of-defun' execute without errors, or `slime-close-parens-limit'
|
||||
;; is exceeded."
|
||||
;; (interactive)
|
||||
;; (loop for i from 1 to slime-close-parens-limit
|
||||
;; until (save-excursion
|
||||
;; (slime-beginning-of-defun)
|
||||
;; (ignore-errors (slime-end-of-defun) t))
|
||||
;; do (insert ")")))
|
||||
|
||||
(defun slime-reindent-defun (&optional force-text-fill)
|
||||
"Reindent the current defun, or refill the current paragraph.
|
||||
If point is inside a comment block, the text around point will be
|
||||
treated as a paragraph and will be filled with `fill-paragraph'.
|
||||
Otherwise, it will be treated as Lisp code, and the current defun
|
||||
will be reindented. If the current defun has unbalanced parens,
|
||||
an attempt will be made to fix it before reindenting.
|
||||
|
||||
When given a prefix argument, the text around point will always
|
||||
be treated as a paragraph. This is useful for filling docstrings."
|
||||
(interactive "P")
|
||||
(save-excursion
|
||||
(if (or force-text-fill (slime-beginning-of-comment))
|
||||
(fill-paragraph nil)
|
||||
(let ((start (progn (unless (or (and (zerop (current-column))
|
||||
(eq ?\( (char-after)))
|
||||
(and slime-repl-input-start-mark
|
||||
(slime-repl-at-prompt-start-p)))
|
||||
(slime-beginning-of-defun))
|
||||
(point)))
|
||||
(end (ignore-errors (slime-end-of-defun) (point))))
|
||||
(unless end
|
||||
(forward-paragraph)
|
||||
(slime-close-all-parens-in-sexp)
|
||||
(slime-end-of-defun)
|
||||
(setf end (point)))
|
||||
(indent-region start end nil)))))
|
||||
|
||||
(provide 'slime-editing-commands)
|
||||
BIN
elpa/slime-20191114.1625/contrib/slime-editing-commands.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-editing-commands.elc
Normal file
Binary file not shown.
226
elpa/slime-20191114.1625/contrib/slime-enclosing-context.el
Normal file
226
elpa/slime-20191114.1625/contrib/slime-enclosing-context.el
Normal file
|
|
@ -0,0 +1,226 @@
|
|||
(require 'slime)
|
||||
(require 'slime-parse)
|
||||
(require 'cl-lib)
|
||||
|
||||
(define-slime-contrib slime-enclosing-context
|
||||
"Utilities on top of slime-parse."
|
||||
(:authors "Tobias C. Rittweiler <tcr@freebits.de>")
|
||||
(:license "GPL"))
|
||||
|
||||
(defun slime-parse-sexp-at-point (&optional n)
|
||||
"Returns the sexps at point as a list of strings, otherwise nil.
|
||||
\(If there are not as many sexps as N, a list with < N sexps is
|
||||
returned.\)
|
||||
If SKIP-BLANKS-P is true, leading whitespaces &c are skipped.
|
||||
"
|
||||
(interactive "p") (or n (setq n 1))
|
||||
(save-excursion
|
||||
(let ((result nil))
|
||||
(dotimes (i n)
|
||||
;; Is there an additional sexp in front of us?
|
||||
(save-excursion
|
||||
(unless (slime-point-moves-p (ignore-errors (forward-sexp)))
|
||||
(cl-return)))
|
||||
(push (slime-sexp-at-point) result)
|
||||
;; Skip current sexp
|
||||
(ignore-errors (forward-sexp) (skip-chars-forward "[:space:]")))
|
||||
(nreverse result))))
|
||||
|
||||
(defun slime-has-symbol-syntax-p (string)
|
||||
(if (and string (not (zerop (length string))))
|
||||
(member (char-syntax (aref string 0))
|
||||
'(?w ?_ ?\' ?\\))))
|
||||
|
||||
(defun slime-beginning-of-string ()
|
||||
(let* ((parser-state (slime-current-parser-state))
|
||||
(inside-string-p (nth 3 parser-state))
|
||||
(string-start-pos (nth 8 parser-state)))
|
||||
(if inside-string-p
|
||||
(goto-char string-start-pos)
|
||||
(error "We're not within a string"))))
|
||||
|
||||
(defun slime-enclosing-form-specs (&optional max-levels)
|
||||
"Return the list of ``raw form specs'' of all the forms
|
||||
containing point from right to left.
|
||||
|
||||
As a secondary value, return a list of indices: Each index tells
|
||||
for each corresponding form spec in what argument position the
|
||||
user's point is.
|
||||
|
||||
As tertiary value, return the positions of the operators that are
|
||||
contained in the returned form specs.
|
||||
|
||||
When MAX-LEVELS is non-nil, go up at most this many levels of
|
||||
parens.
|
||||
|
||||
\(See SWANK::PARSE-FORM-SPEC for more information about what
|
||||
exactly constitutes a ``raw form specs'')
|
||||
|
||||
Examples:
|
||||
|
||||
A return value like the following
|
||||
|
||||
(values ((\"quux\") (\"bar\") (\"foo\")) (3 2 1) (p1 p2 p3))
|
||||
|
||||
can be interpreted as follows:
|
||||
|
||||
The user point is located in the 3rd argument position of a
|
||||
form with the operator name \"quux\" (which starts at P1.)
|
||||
|
||||
This form is located in the 2nd argument position of a form
|
||||
with the operator name \"bar\" (which starts at P2.)
|
||||
|
||||
This form again is in the 1st argument position of a form
|
||||
with the operator name \"foo\" (which itself begins at P3.)
|
||||
|
||||
For instance, the corresponding buffer content could have looked
|
||||
like `(foo (bar arg1 (quux 1 2 |' where `|' denotes point.
|
||||
"
|
||||
(let ((level 1)
|
||||
(parse-sexp-lookup-properties nil)
|
||||
(initial-point (point))
|
||||
(result '()) (arg-indices '()) (points '()))
|
||||
;; The expensive lookup of syntax-class text properties is only
|
||||
;; used for interactive balancing of #<...> in presentations; we
|
||||
;; do not need them in navigating through the nested lists.
|
||||
;; This speeds up this function significantly.
|
||||
(ignore-errors
|
||||
(save-excursion
|
||||
;; Make sure we get the whole thing at point.
|
||||
(if (not (slime-inside-string-p))
|
||||
(slime-end-of-symbol)
|
||||
(slime-beginning-of-string)
|
||||
(forward-sexp))
|
||||
(save-restriction
|
||||
;; Don't parse more than 20000 characters before point, so we don't spend
|
||||
;; too much time.
|
||||
(narrow-to-region (max (point-min) (- (point) 20000)) (point-max))
|
||||
(narrow-to-region (save-excursion (beginning-of-defun) (point))
|
||||
(min (1+ (point)) (point-max)))
|
||||
(while (or (not max-levels)
|
||||
(<= level max-levels))
|
||||
(let ((arg-index 0))
|
||||
;; Move to the beginning of the current sexp if not already there.
|
||||
(if (or (and (char-after)
|
||||
(member (char-syntax (char-after)) '(?\( ?')))
|
||||
(member (char-syntax (char-before)) '(?\ ?>)))
|
||||
(cl-incf arg-index))
|
||||
(ignore-errors (backward-sexp 1))
|
||||
(while (and (< arg-index 64)
|
||||
(ignore-errors (backward-sexp 1)
|
||||
(> (point) (point-min))))
|
||||
(cl-incf arg-index))
|
||||
(backward-up-list 1)
|
||||
(when (member (char-syntax (char-after)) '(?\( ?'))
|
||||
(cl-incf level)
|
||||
(forward-char 1)
|
||||
(let ((name (slime-symbol-at-point)))
|
||||
(push (and name `(,name)) result)
|
||||
(push arg-index arg-indices)
|
||||
(push (point) points))
|
||||
(backward-up-list 1)))))))
|
||||
(cl-values
|
||||
(nreverse result)
|
||||
(nreverse arg-indices)
|
||||
(nreverse points))))
|
||||
|
||||
(defvar slime-variable-binding-ops-alist
|
||||
'((let &bindings &body)
|
||||
(let* &bindings &body)))
|
||||
|
||||
(defvar slime-function-binding-ops-alist
|
||||
'((flet &bindings &body)
|
||||
(labels &bindings &body)
|
||||
(macrolet &bindings &body)))
|
||||
|
||||
(defun slime-lookup-binding-op (op &optional binding-type)
|
||||
(cl-labels ((lookup-in (list) (cl-assoc op list :test 'cl-equalp :key 'symbol-name)))
|
||||
(cond ((eq binding-type :variable) (lookup-in slime-variable-binding-ops-alist))
|
||||
((eq binding-type :function) (lookup-in slime-function-binding-ops-alist))
|
||||
(t (or (lookup-in slime-variable-binding-ops-alist)
|
||||
(lookup-in slime-function-binding-ops-alist))))))
|
||||
|
||||
(defun slime-binding-op-p (op &optional binding-type)
|
||||
(and (slime-lookup-binding-op op binding-type) t))
|
||||
|
||||
(defun slime-binding-op-body-pos (op)
|
||||
(let ((special-lambda-list (slime-lookup-binding-op op)))
|
||||
(if special-lambda-list (cl-position '&body special-lambda-list))))
|
||||
|
||||
(defun slime-binding-op-bindings-pos (op)
|
||||
(let ((special-lambda-list (slime-lookup-binding-op op)))
|
||||
(if special-lambda-list (cl-position '&bindings special-lambda-list))))
|
||||
|
||||
(defun slime-enclosing-bound-names ()
|
||||
"Returns all bound function names as first value, and the
|
||||
points where their bindings are established as second value."
|
||||
(cl-multiple-value-call #'slime-find-bound-names
|
||||
(slime-enclosing-form-specs)))
|
||||
|
||||
(defun slime-find-bound-names (ops indices points)
|
||||
(let ((binding-names) (binding-start-points))
|
||||
(save-excursion
|
||||
(cl-loop for (op . nil) in ops
|
||||
for index in indices
|
||||
for point in points
|
||||
do (when (and (slime-binding-op-p op)
|
||||
;; Are the bindings of OP in scope?
|
||||
(>= index (slime-binding-op-body-pos op)))
|
||||
(goto-char point)
|
||||
(forward-sexp (slime-binding-op-bindings-pos op))
|
||||
(down-list)
|
||||
(ignore-errors
|
||||
(cl-loop
|
||||
(down-list)
|
||||
(push (slime-symbol-at-point) binding-names)
|
||||
(push (save-excursion (backward-up-list) (point))
|
||||
binding-start-points)
|
||||
(up-list)))))
|
||||
(cl-values (nreverse binding-names) (nreverse binding-start-points)))))
|
||||
|
||||
|
||||
(defun slime-enclosing-bound-functions ()
|
||||
(cl-multiple-value-call #'slime-find-bound-functions
|
||||
(slime-enclosing-form-specs)))
|
||||
|
||||
(defun slime-find-bound-functions (ops indices points)
|
||||
(let ((names) (arglists) (start-points))
|
||||
(save-excursion
|
||||
(cl-loop for (op . nil) in ops
|
||||
for index in indices
|
||||
for point in points
|
||||
do (when (and (slime-binding-op-p op :function)
|
||||
;; Are the bindings of OP in scope?
|
||||
(>= index (slime-binding-op-body-pos op)))
|
||||
(goto-char point)
|
||||
(forward-sexp (slime-binding-op-bindings-pos op))
|
||||
(down-list)
|
||||
;; If we're at the end of the bindings, an error will
|
||||
;; be signalled by the `down-list' below.
|
||||
(ignore-errors
|
||||
(cl-loop
|
||||
(down-list)
|
||||
(cl-destructuring-bind (name arglist)
|
||||
(slime-parse-sexp-at-point 2)
|
||||
(cl-assert (slime-has-symbol-syntax-p name))
|
||||
(cl-assert arglist)
|
||||
(push name names)
|
||||
(push arglist arglists)
|
||||
(push (save-excursion (backward-up-list) (point))
|
||||
start-points))
|
||||
(up-list)))))
|
||||
(cl-values (nreverse names)
|
||||
(nreverse arglists)
|
||||
(nreverse start-points)))))
|
||||
|
||||
|
||||
(defun slime-enclosing-bound-macros ()
|
||||
(cl-multiple-value-call #'slime-find-bound-macros
|
||||
(slime-enclosing-form-specs)))
|
||||
|
||||
(defun slime-find-bound-macros (ops indices points)
|
||||
;; Kludgy!
|
||||
(let ((slime-function-binding-ops-alist '((macrolet &bindings &body))))
|
||||
(slime-find-bound-functions ops indices points)))
|
||||
|
||||
(provide 'slime-enclosing-context)
|
||||
BIN
elpa/slime-20191114.1625/contrib/slime-enclosing-context.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-enclosing-context.elc
Normal file
Binary file not shown.
42
elpa/slime-20191114.1625/contrib/slime-fancy-inspector.el
Normal file
42
elpa/slime-20191114.1625/contrib/slime-fancy-inspector.el
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
(eval-and-compile
|
||||
(require 'slime))
|
||||
|
||||
(define-slime-contrib slime-fancy-inspector
|
||||
"Fancy inspector for CLOS objects."
|
||||
(:authors "Marco Baringer <mb@bese.it> and others")
|
||||
(:license "GPL")
|
||||
(:slime-dependencies slime-parse)
|
||||
(:swank-dependencies swank-fancy-inspector)
|
||||
(:on-load
|
||||
(add-hook 'slime-edit-definition-hooks 'slime-edit-inspector-part))
|
||||
(:on-unload
|
||||
(remove-hook 'slime-edit-definition-hooks 'slime-edit-inspector-part)))
|
||||
|
||||
(defun slime-inspect-definition ()
|
||||
"Inspect definition at point"
|
||||
(interactive)
|
||||
(slime-inspect (slime-definition-at-point)))
|
||||
|
||||
(defun slime-disassemble-definition ()
|
||||
"Disassemble definition at point"
|
||||
(interactive)
|
||||
(slime-eval-describe `(swank:disassemble-form
|
||||
,(slime-definition-at-point t))))
|
||||
|
||||
(defun slime-edit-inspector-part (name &optional where)
|
||||
(and (eq major-mode 'slime-inspector-mode)
|
||||
(cl-destructuring-bind (&optional property value)
|
||||
(slime-inspector-property-at-point)
|
||||
(when (eq property 'slime-part-number)
|
||||
(let ((location (slime-eval `(swank:find-definition-for-thing
|
||||
(swank:inspector-nth-part ,value))))
|
||||
(name (format "Inspector part %s" value)))
|
||||
(when (and (consp location)
|
||||
(not (eq (car location) :error)))
|
||||
(slime-edit-definition-cont
|
||||
(list (make-slime-xref :dspec `(,name)
|
||||
:location location))
|
||||
name
|
||||
where)))))))
|
||||
|
||||
(provide 'slime-fancy-inspector)
|
||||
BIN
elpa/slime-20191114.1625/contrib/slime-fancy-inspector.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-fancy-inspector.elc
Normal file
Binary file not shown.
68
elpa/slime-20191114.1625/contrib/slime-fancy-trace.el
Normal file
68
elpa/slime-20191114.1625/contrib/slime-fancy-trace.el
Normal file
|
|
@ -0,0 +1,68 @@
|
|||
(eval-and-compile
|
||||
(require 'slime))
|
||||
|
||||
(define-slime-contrib slime-fancy-trace
|
||||
"Enhanced version of slime-trace capable of tracing local functions,
|
||||
methods, setf functions, and other entities supported by specific
|
||||
swank:swank-toggle-trace backends. Invoke via C-u C-t."
|
||||
(:authors "Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>"
|
||||
"Tobias C. Rittweiler <tcr@freebits.de>")
|
||||
(:license "GPL")
|
||||
(:slime-dependencies slime-parse))
|
||||
|
||||
(defun slime-trace-query (spec)
|
||||
"Ask the user which function to trace; SPEC is the default.
|
||||
The result is a string."
|
||||
(cond ((null spec)
|
||||
(slime-read-from-minibuffer "(Un)trace: "))
|
||||
((stringp spec)
|
||||
(slime-read-from-minibuffer "(Un)trace: " spec))
|
||||
((symbolp spec) ; `slime-extract-context' can return symbols.
|
||||
(slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec)))
|
||||
(t
|
||||
(slime-dcase spec
|
||||
((setf n)
|
||||
(slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec)))
|
||||
((:defun n)
|
||||
(slime-read-from-minibuffer "(Un)trace: " (prin1-to-string n)))
|
||||
((:defgeneric n)
|
||||
(let* ((name (prin1-to-string n))
|
||||
(answer (slime-read-from-minibuffer "(Un)trace: " name)))
|
||||
(cond ((and (string= name answer)
|
||||
(y-or-n-p (concat "(Un)trace also all "
|
||||
"methods implementing "
|
||||
name "? ")))
|
||||
(prin1-to-string `(:defgeneric ,n)))
|
||||
(t
|
||||
answer))))
|
||||
((:defmethod &rest _)
|
||||
(slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec)))
|
||||
((:call caller callee)
|
||||
(let* ((callerstr (prin1-to-string caller))
|
||||
(calleestr (prin1-to-string callee))
|
||||
(answer (slime-read-from-minibuffer "(Un)trace: "
|
||||
calleestr)))
|
||||
(cond ((and (string= calleestr answer)
|
||||
(y-or-n-p (concat "(Un)trace only when " calleestr
|
||||
" is called by " callerstr "? ")))
|
||||
(prin1-to-string `(:call ,caller ,callee)))
|
||||
(t
|
||||
answer))))
|
||||
(((:labels :flet) &rest _)
|
||||
(slime-read-from-minibuffer "(Un)trace local function: "
|
||||
(prin1-to-string spec)))
|
||||
(t (error "Don't know how to trace the spec %S" spec))))))
|
||||
|
||||
(defun slime-toggle-fancy-trace (&optional using-context-p)
|
||||
"Toggle trace."
|
||||
(interactive "P")
|
||||
(let* ((spec (if using-context-p
|
||||
(slime-extract-context)
|
||||
(slime-symbol-at-point)))
|
||||
(spec (slime-trace-query spec)))
|
||||
(message "%s" (slime-eval `(swank:swank-toggle-trace ,spec)))))
|
||||
|
||||
;; override slime-toggle-trace-fdefinition
|
||||
(define-key slime-prefix-map "\C-t" 'slime-toggle-fancy-trace)
|
||||
|
||||
(provide 'slime-fancy-trace)
|
||||
BIN
elpa/slime-20191114.1625/contrib/slime-fancy-trace.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-fancy-trace.elc
Normal file
Binary file not shown.
38
elpa/slime-20191114.1625/contrib/slime-fancy.el
Normal file
38
elpa/slime-20191114.1625/contrib/slime-fancy.el
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
(require 'slime)
|
||||
|
||||
(define-slime-contrib slime-fancy
|
||||
"Make SLIME fancy."
|
||||
(:authors "Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>"
|
||||
"Tobias C Rittweiler <tcr@freebits.de>")
|
||||
(:license "GPL")
|
||||
(:slime-dependencies slime-repl
|
||||
slime-autodoc
|
||||
slime-c-p-c
|
||||
slime-editing-commands
|
||||
slime-fancy-inspector
|
||||
slime-fancy-trace
|
||||
slime-fuzzy
|
||||
slime-mdot-fu
|
||||
slime-macrostep
|
||||
slime-presentations
|
||||
slime-scratch
|
||||
slime-references
|
||||
slime-package-fu
|
||||
slime-fontifying-fu
|
||||
slime-trace-dialog)
|
||||
(:on-load
|
||||
(slime-trace-dialog-init)
|
||||
(slime-repl-init)
|
||||
(slime-autodoc-init)
|
||||
(slime-c-p-c-init)
|
||||
(slime-editing-commands-init)
|
||||
(slime-fancy-inspector-init)
|
||||
(slime-fancy-trace-init)
|
||||
(slime-fuzzy-init)
|
||||
(slime-presentations-init)
|
||||
(slime-scratch-init)
|
||||
(slime-references-init)
|
||||
(slime-package-fu-init)
|
||||
(slime-fontifying-fu-init)))
|
||||
|
||||
(provide 'slime-fancy)
|
||||
BIN
elpa/slime-20191114.1625/contrib/slime-fancy.elc
Normal file
BIN
elpa/slime-20191114.1625/contrib/slime-fancy.elc
Normal file
Binary file not shown.
231
elpa/slime-20191114.1625/contrib/slime-fontifying-fu.el
Normal file
231
elpa/slime-20191114.1625/contrib/slime-fontifying-fu.el
Normal file
|
|
@ -0,0 +1,231 @@
|
|||
(require 'slime)
|
||||
(require 'slime-parse)
|
||||
(require 'slime-autodoc)
|
||||
(require 'font-lock)
|
||||
(require 'cl-lib)
|
||||
|
||||
;;; Fontify WITH-FOO, DO-FOO, and DEFINE-FOO like standard macros.
|
||||
;;; Fontify CHECK-FOO like CHECK-TYPE.
|
||||
(defvar slime-additional-font-lock-keywords
|
||||
'(("(\\(\\(\\s_\\|\\w\\)*:\\(define-\\|do-\\|with-\\|without-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
|
||||
("(\\(\\(define-\\|do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
|
||||
("(\\(check-\\(\\s_\\|\\w\\)*\\)" 1 font-lock-warning-face)
|
||||
("(\\(assert-\\(\\s_\\|\\w\\)*\\)" 1 font-lock-warning-face)))
|
||||
|
||||
;;;; Specially fontify forms suppressed by a reader conditional.
|
||||
(defcustom slime-highlight-suppressed-forms t
|
||||
"Display forms disabled by reader conditionals as comments."
|
||||
:type '(choice (const :tag "Enable" t) (const :tag "Disable" nil))
|
||||
:group 'slime-mode)
|
||||
|
||||
(define-slime-contrib slime-fontifying-fu
|
||||
"Additional fontification tweaks:
|
||||
Fontify WITH-FOO, DO-FOO, DEFINE-FOO like standard macros.
|
||||
Fontify CHECK-FOO like CHECK-TYPE."
|
||||
(:authors "Tobias C. Rittweiler <tcr@freebits.de>")
|
||||
(:license "GPL")
|
||||
(:on-load
|
||||
(font-lock-add-keywords
|
||||
'lisp-mode slime-additional-font-lock-keywords)
|
||||
(when slime-highlight-suppressed-forms
|
||||
(slime-activate-font-lock-magic)))
|
||||
(:on-unload
|
||||
;; FIXME: remove `slime-search-suppressed-forms', and remove the
|
||||
;; extend-region hook.
|
||||
(font-lock-remove-keywords
|
||||
'lisp-mode slime-additional-font-lock-keywords)))
|
||||
|
||||
(defface slime-reader-conditional-face
|
||||
'((t (:inherit font-lock-comment-face)))
|
||||
"Face for compiler notes while selected."
|
||||
:group 'slime-mode-faces)
|
||||
|
||||
(defvar slime-search-suppressed-forms-match-data (list nil nil))
|
||||
|
||||
(defun slime-search-suppressed-forms-internal (limit)
|
||||
(when (search-forward-regexp slime-reader-conditionals-regexp limit t)
|
||||
(let ((start (match-beginning 0)) ; save match data
|
||||
(state (slime-current-parser-state)))
|
||||
(if (or (nth 3 state) (nth 4 state)) ; inside string or comment?
|
||||
(slime-search-suppressed-forms-internal limit)
|
||||
(let* ((char (char-before))
|
||||
(expr (read (current-buffer)))
|
||||
(val (slime-eval-feature-expression expr)))
|
||||
(when (<= (point) limit)
|
||||
(if (or (and (eq char ?+) (not val))
|
||||
(and (eq char ?-) val))
|
||||
;; If `slime-extend-region-for-font-lock' did not
|
||||
;; fully extend the region, the assertion below may
|
||||
;; fail. This should only happen on XEmacs and older
|
||||
;; versions of GNU Emacs.
|
||||
(ignore-errors
|
||||
(forward-sexp) (backward-sexp)
|
||||
;; Try to suppress as far as possible.
|
||||
(slime-forward-sexp)
|
||||
(cl-assert (<= (point) limit))
|
||||
(let ((md (match-data nil slime-search-suppressed-forms-match-data)))
|
||||
(setf (cl-first md) start)
|
||||
(setf (cl-second md) (point))
|
||||
(set-match-data md)
|
||||
t))
|
||||
(slime-search-suppressed-forms-internal limit))))))))
|
||||
|
||||
(defun slime-search-suppressed-forms (limit)
|
||||
"Find reader conditionalized forms where the test is false."
|
||||
(when (and slime-highlight-suppressed-forms
|
||||
(slime-connected-p))
|
||||
(let ((result 'retry))
|
||||
(while (and (eq result 'retry) (<= (point) limit))
|
||||
(condition-case condition
|
||||
(setq result (slime-search-suppressed-forms-internal limit))
|
||||
(end-of-file ; e.g. #+(
|
||||
(setq result nil))
|
||||
;; We found a reader conditional we couldn't process for
|
||||
;; some reason; however, there may still be other reader
|
||||
;; conditionals before `limit'.
|
||||
(invalid-read-syntax ; e.g. #+#.foo
|
||||
(setq result 'retry))
|
||||
(scan-error ; e.g. #+nil (foo ...
|
||||
(setq result 'retry))
|
||||
(slime-incorrect-feature-expression ; e.g. #+(not foo bar)
|
||||
(setq result 'retry))
|
||||
(slime-unknown-feature-expression ; e.g. #+(foo)
|
||||
(setq result 'retry))
|
||||
(error
|
||||
(setq result nil)
|
||||
(slime-display-warning
|
||||
(concat "Caught error during fontification while searching for forms\n"
|
||||
"that are suppressed by reader-conditionals. The error was: %S.")
|
||||
condition))))
|
||||
result)))
|
||||
|
||||
|
||||
(defun slime-search-directly-preceding-reader-conditional ()
|
||||
"Search for a directly preceding reader conditional. Return its
|
||||
position, or nil."
|
||||
;;; We search for a preceding reader conditional. Then we check that
|
||||
;;; between the reader conditional and the point where we started is
|
||||
;;; no other intervening sexp, and we check that the reader
|
||||
;;; conditional is at the same nesting level.
|
||||
(condition-case nil
|
||||
(let* ((orig-pt (point))
|
||||
(reader-conditional-pt
|
||||
(search-backward-regexp slime-reader-conditionals-regexp
|
||||
;; We restrict the search to the
|
||||
;; beginning of the /previous/ defun.
|
||||
(save-excursion
|
||||
(beginning-of-defun)
|
||||
(point))
|
||||
t)))
|
||||
(when reader-conditional-pt
|
||||
(let* ((parser-state
|
||||
(parse-partial-sexp
|
||||
(progn (goto-char (+ reader-conditional-pt 2))
|
||||
(forward-sexp) ; skip feature expr.
|
||||
(point))
|
||||
orig-pt))
|
||||
(paren-depth (car parser-state))
|
||||
(last-sexp-pt (cl-caddr parser-state)))
|
||||
(if (and paren-depth
|
||||
(not (cl-plusp paren-depth)) ; no '(' in between?
|
||||
(not last-sexp-pt)) ; no complete sexp in between?
|
||||
reader-conditional-pt
|
||||
nil))))
|
||||
(scan-error nil))) ; improper feature expression
|
||||
|
||||
|
||||
;;; We'll push this onto `font-lock-extend-region-functions'. In past,
|
||||
;;; we didn't do so which made our reader-conditional font-lock magic
|
||||
;;; pretty unreliable (it wouldn't highlight all suppressed forms, and
|
||||
;;; worked quite non-deterministic in general.)
|
||||
;;;
|
||||
;;; Cf. _Elisp Manual_, 23.6.10 Multiline Font Lock Constructs.
|
||||
;;;
|
||||
;;; We make sure that `font-lock-beg' and `font-lock-end' always point
|
||||
;;; to the beginning or end of a toplevel form. So we never miss a
|
||||
;;; reader-conditional, or point in mid of one.
|
||||
(defvar font-lock-beg) ; shoosh compiler
|
||||
(defvar font-lock-end)
|
||||
|
||||
(defun slime-extend-region-for-font-lock ()
|
||||
(when slime-highlight-suppressed-forms
|
||||
(condition-case c
|
||||
(let (changedp)
|
||||
(cl-multiple-value-setq (changedp font-lock-beg font-lock-end)
|
||||
(slime-compute-region-for-font-lock font-lock-beg font-lock-end))
|
||||
changedp)
|
||||
(error
|
||||
(slime-display-warning
|
||||
(concat "Caught error when trying to extend the region for fontification.\n"
|
||||
"The error was: %S\n"
|
||||
"Further: font-lock-beg=%d, font-lock-end=%d.")
|
||||
c font-lock-beg font-lock-end)))))
|
||||
|
||||
(defun slime-beginning-of-tlf ()
|
||||
(let ((pos (syntax-ppss-toplevel-pos (slime-current-parser-state))))
|
||||
(if pos (goto-char pos))))
|
||||
|
||||
(defun slime-compute-region-for-font-lock (orig-beg orig-end)
|
||||
(let ((beg orig-beg)
|
||||
(end orig-end))
|
||||
(goto-char beg)
|
||||
(inline (slime-beginning-of-tlf))
|
||||
(cl-assert (not (cl-plusp (nth 0 (slime-current-parser-state)))))
|
||||
(setq beg (let ((pt (point)))
|
||||
(cond ((> (- beg pt) 20000) beg)
|
||||
((slime-search-directly-preceding-reader-conditional))
|
||||
(t pt))))
|
||||
(goto-char end)
|
||||
(while (search-backward-regexp slime-reader-conditionals-regexp beg t)
|
||||
(setq end (max end (save-excursion
|
||||
(ignore-errors (slime-forward-reader-conditional))
|
||||
(point)))))
|
||||
(cl-values (or (/= beg orig-beg) (/= end orig-end)) beg end)))
|
||||
|
||||
|
||||
(defun slime-activate-font-lock-magic ()
|
||||
(if (featurep 'xemacs)
|
||||
(let ((pattern `((slime-search-suppressed-forms
|
||||
(0 slime-reader-conditional-face t)))))
|
||||
(dolist (sym '(lisp-font-lock-keywords
|
||||
lisp-font-lock-keywords-1
|
||||
lisp-font-lock-keywords-2))
|
||||
(set sym (append (symbol-value sym) pattern))))
|
||||
(font-lock-add-keywords
|
||||
'lisp-mode
|
||||
`((slime-search-suppressed-forms 0 ,''slime-reader-conditional-face t)))
|
||||
|
||||
(add-hook 'lisp-mode-hook
|
||||
#'(lambda ()
|
||||
(add-hook 'font-lock-extend-region-functions
|
||||
'slime-extend-region-for-font-lock t t)))))
|
||||
|
||||
(let ((byte-compile-warnings '()))
|
||||
(mapc (lambda (sym)
|
||||
(cond ((fboundp sym)
|
||||
(unless (byte-code-function-p (symbol-function sym))
|
||||
(byte-compile sym)))
|
||||
(t (error "%S is not fbound" sym))))
|
||||
'(slime-extend-region-for-font-lock
|
||||
slime-compute-region-for-font-lock
|
||||
slime-search-directly-preceding-reader-conditional
|
||||
slime-search-suppressed-forms
|
||||
slime-beginning-of-tlf)))
|
||||
|
||||
(cl-defun slime-initialize-lisp-buffer-for-test-suite
|
||||
(&key (font-lock-magic t) (autodoc t))
|
||||
(let ((hook lisp-mode-hook))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(set (make-local-variable 'slime-highlight-suppressed-forms)
|
||||
font-lock-magic)
|
||||
(setq lisp-mode-hook nil)
|
||||
(lisp-mode)
|
||||
(slime-mode 1)
|
||||
(when (boundp 'slime-autodoc-mode)
|
||||
(if autodoc
|
||||
(slime-autodoc-mode 1)
|
||||
(slime-autodoc-mode -1))))
|
||||
(setq lisp-mode-hook hook))))
|
||||
|
||||
(provide 'slime-fontifying-fu)
|
||||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Reference in a new issue