mprodrigues/emacs.d
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Initial commit

Browse Source
This commit is contained in:
Mateus Pinto Rodrigues
2017-11-11 15:15:10 -02:00
commit 58c3bd6728
1202 changed files with 434097 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
elpa/polymode-20170307.322/.dir-locals.el Normal file
View File

@@ -0,0 +1,16 @@
;;; Directory Local Variables
;;; See Info node `(emacs) Directory Variables' for more information.
((nil
(require-final-newline . t)
;; not tabs in code
(indent-tabs-mode)
;; checkdoc, one space is enough
(sentence-end-double-space . nil)
;; checkdoc, don't botch English grammar
(checkdoc-arguments-in-order-flag . nil)
;; checkdoc, we don't want docs for internal vars
(checkdoc-force-docstrings-flag . nil))
(emacs-lisp-mode
;; remove trailing whitespace
(eval . (add-hook 'before-save-hook 'delete-trailing-whitespace nil t))))

459
elpa/polymode-20170307.322/poly-R.el Normal file
View File

@@ -0,0 +1,459 @@
;;; poly-R.el --- Popymodes for R
;;
;; Filename: poly-R.el
;; Author: Spinu Vitalie
;; Maintainer: Spinu Vitalie
;; Copyright (C) 2013-2014, Spinu Vitalie, all rights reserved.
;; Version: 1.0
;; URL: https://github.com/vitoshka/polymode
;; Keywords: emacs
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'polymode)
(defcustom pm-poly/R
(pm-polymode-one "R"
:hostmode 'pm-host/R
:innermode 'pm-inner/fundamental)
"R root polymode. Not intended to be used directly."
:group 'polymodes
:type 'object)
;; NOWEB
(require 'poly-noweb)
(defcustom pm-poly/noweb+R
(clone pm-poly/noweb :innermode 'pm-inner/noweb+R)
"Noweb for R configuration"
:group 'polymodes
:type 'object)
(defcustom pm-inner/noweb+R
(clone pm-inner/noweb
:mode 'R-mode)
"Noweb for R"
:group 'innermodes
:type 'object)
;;;###autoload (autoload 'poly-noweb+r-mode "poly-R")
(define-polymode poly-noweb+r-mode pm-poly/noweb+R :lighter " PM-Rnw")
;; MARKDOWN
(require 'poly-markdown)
;;;###autoload (autoload 'poly-markdown+r-mode "poly-R")
(define-polymode poly-markdown+r-mode pm-poly/markdown :lighter " PM-Rmd")
;; RAPPORT
(defcustom pm-poly/rapport
(clone pm-poly/markdown "rapport"
:innermodes '(pm-inner/brew+R
pm-inner/rapport+YAML))
"Rapport template configuration"
:group 'polymodes
:type 'object)
(defcustom pm-inner/rapport+YAML
(pm-hbtchunkmode "rapport+YAML"
:mode 'yaml-mode
:head-reg "<!--head"
:tail-reg "head-->")
"YAML header in Rapport files"
:group 'innermodes
:type 'object)
;;;###autoload (autoload 'poly-rapport-mode "poly-R")
(define-polymode poly-rapport-mode pm-poly/rapport nil)
;; HTML
(defcustom pm-poly/html+R
(clone pm-poly/html "html+R" :innermode 'pm-inner/html+R)
"HTML + R configuration"
:group 'polymodes
:type 'object)
(defcustom pm-inner/html+R
(pm-hbtchunkmode "html+R"
:mode 'R-mode
:head-reg "<!--[ \t]*begin.rcode"
:tail-reg "end.rcode[ \t]*-->")
"HTML KnitR innermode."
:group 'innermodes
:type 'object)
;;;###autoload (autoload 'poly-html+r-mode "poly-R")
(define-polymode poly-html+r-mode pm-poly/html+R)
;;; R-brew
(defcustom pm-poly/brew+R
(clone pm-poly/brew "brew+R"
:innermode 'pm-inner/brew+R)
"Brew + R configuration"
:group 'polymodes
:type 'object)
(defcustom pm-inner/brew+R
(pm-hbtchunkmode "brew+R"
:mode 'R-mode
:head-reg "<%[=%]?"
:tail-reg "[#=%=-]?%>")
"Brew R chunk."
:group 'innermodes
:type 'object)
;;;###autoload (autoload 'poly-brew+r-mode "poly-R")
(define-polymode poly-brew+r-mode pm-poly/brew+R)
;;; R+C++
;; todo: move into :matcher-subexp functionality?
(defun pm--R+C++-head-matcher (ahead)
(when (re-search-forward "cppFunction(\\(['\"]\n\\)"
nil t ahead)
(cons (match-beginning 1) (match-end 1))))
(defun pm--R+C++-tail-matcher (ahead)
(when (< ahead 0)
(goto-char (car (pm--R+C++-head-matcher -1))))
(goto-char (max 1 (1- (point))))
(let ((end (or (ignore-errors (scan-sexps (point) 1))
(buffer-end 1))))
(cons (max 1 (1- end)) end)))
(defcustom pm-poly/R+C++
(clone pm-poly/R "R+C++" :innermode 'pm-inner/R+C++)
"R + C++ configuration"
:group 'polymodes
:type 'object)
(defcustom pm-inner/R+C++
(pm-hbtchunkmode "R+C++"
:mode 'c++-mode
:head-mode 'host
:head-reg 'pm--R+C++-head-matcher
:tail-reg 'pm--R+C++-tail-matcher
:font-lock-narrow nil)
"HTML KnitR chunk."
:group 'innermodes
:type 'object)
;;;###autoload (autoload 'poly-r+c++-mode "poly-R")
(define-polymode poly-r+c++-mode pm-poly/R+C++)
;;; C++R
(defun pm--C++R-head-matcher (ahead)
(when (re-search-forward "^[ \t]*/[*]+[ \t]*R" nil t ahead)
(cons (match-beginning 0) (match-end 0))))
(defun pm--C++R-tail-matcher (ahead)
(when (< ahead 0)
(error "backwards tail match not implemented"))
;; may be rely on syntactic lookup ?
(when (re-search-forward "^[ \t]*\\*/")
(cons (match-beginning 0) (match-end 0))))
(defcustom pm-poly/C++R
(clone pm-poly/C++ "C++R" :innermode 'pm-inner/C++R)
"R + C++ configuration"
:group 'polymodes
:type 'object)
(defcustom pm-inner/C++R
(pm-hbtchunkmode "C++R"
:mode 'R-mode
:head-reg 'pm--C++R-head-matcher
:tail-reg 'pm--C++R-tail-matcher)
"HTML KnitR chunk."
:group 'polymodes
:type 'object)
;;;###autoload (autoload 'poly-c++r-mode "poly-R")
(define-polymode poly-c++r-mode pm-poly/C++R)
;;; R help
(defcustom pm-poly/ess-help+R
(pm-polymode-one "ess-R-help"
:innermode 'pm-inner/ess-help+R)
"ess-R-help"
:group 'polymodes
:type 'object)
(defcustom pm-inner/ess-help+R
(pm-hbtchunkmode "ess-help+R"
:mode 'R-mode
:head-reg "^Examples:"
:tail-reg "\\'"
:indent-offset 5
:switch-buffer-functions '(pm--ess-help+R-turn-off-read-only))
"Ess help R chunk"
:group 'innermodes
:type 'object)
(defun pm--ess-help+R-turn-off-read-only (&rest ignore)
;; don't transfer read only status from main help buffer
(cl-case pm/type
(body (read-only-mode -1))
(head (read-only-mode 1))))
;;;###autoload (autoload 'poly-ess-help+r-mode "poly-R")
(define-polymode poly-ess-help+r-mode pm-poly/ess-help+R)
(add-hook 'ess-help-mode-hook '(lambda ()
(when (string= ess-dialect "R")
(poly-ess-help+r-mode))))
(defun pm--Rd-examples-head-matcher (ahead)
(when (re-search-forward "\\examples *\\({\n\\)" nil t ahead)
(cons (match-beginning 1) (match-end 1))))
(defun pm--Rd-examples-tail-matcher (ahead)
(when (< ahead 0)
(goto-char (car (pm--R+C++-head-matcher -1))))
(let ((end (or (ignore-errors (scan-sexps (point) 1))
(buffer-end 1))))
(cons (max 1 (- end 1)) end)))
(defcustom pm-poly/Rd
(pm-polymode-one "R-documentation"
:innermode 'pm-inner/Rd)
"R polymode for Rd files"
:group 'polymodes
:type 'object)
(defcustom pm-inner/Rd
(pm-hbtchunkmode "R+C++"
:mode 'R-mode
:head-mode 'host
:head-reg 'pm--Rd-examples-head-matcher
:tail-reg 'pm--Rd-examples-tail-matcher)
"Rd examples chunk."
:group 'innermodes
:type 'object)
;;;###autoload (autoload 'poly-Rd-mode "poly-R")
(define-polymode poly-Rd-mode pm-poly/Rd)
(add-hook 'Rd-mode-hook 'poly-Rd-mode)
;; Rmarkdown
(defcustom pm-exporter/Rmarkdown
(pm-shell-exporter "Rmarkdown"
:from
'(("Rmarkdown" "\\.[rR]?md\\|rapport\\'" "R Markdown"
"Rscript -e \"rmarkdown::render('%i', output_format = '%t', output_file = '%o')\""))
:to
'(("auto" . pm--rmarkdown-shell-auto-selector)
("html" "html" "html document" "html_document")
("pdf" "pdf" "pdf document" "pdf_document")
("word" "docx" "word document" "word_document")
("md" "md" "md document" "md_document")
("ioslides" "html" "ioslides presentation" "ioslides_presentation")
("slidy" "html" "slidy presentation" "slidy_presentation")
("beamer" "pdf" "beamer presentation" "beamer_presentation")))
"R Markdown exporter.
Please not that with 'AUTO DETECT' export options, output file
names are inferred by Rmarkdown from YAML description
block. Thus, output file names don't comply with
`polymode-exporter-output-file-format'."
:group 'polymode-export
:type 'object)
(polymode-register-exporter pm-exporter/Rmarkdown nil
pm-poly/markdown pm-poly/rapport)
(defun pm--rmarkdown-shell-auto-selector (action &rest ignore)
(cl-case action
(doc "AUTO DETECT")
(command "Rscript -e \"rmarkdown::render('%i', output_format = 'all')\"")
(output-file #'pm--rmarkdown-output-file-sniffer)))
(defcustom pm-exporter/Rmarkdown-ESS
(pm-callback-exporter "Rmarkdown-ESS"
:from
'(("Rmarkdown" "\\.[rR]?md\\|rapport\\'" "R Markdown"
"rmarkdown::render('%I', output_format = '%t', output_file = '%O')\n"))
:to
'(("auto" . pm--rmarkdown-callback-auto-selector)
("html" "html" "html document" "html_document")
("pdf" "pdf" "pdf document" "pdf_document")
("word" "docx" "word document" "word_document")
("md" "md" "md document" "md_document")
("ioslides" "html" "ioslides presentation" "ioslides_presentation")
("slidy" "html" "slidy presentation" "slidy_presentation")
("beamer" "pdf" "beamer presentation" "beamer_presentation"))
:function 'pm--ess-run-command
:callback 'pm--ess-callback)
"R Markdown exporter.
Please not that with 'AUTO DETECT' export options, output file
names are inferred by Rmarkdown from YAML description
block. Thus, output file names don't comply with
`polymode-exporter-output-file-format'."
:group 'polymode-export
:type 'object)
(polymode-register-exporter pm-exporter/Rmarkdown-ESS nil
pm-poly/markdown pm-poly/rapport)
(defun pm--rmarkdown-callback-auto-selector (action &rest ignore)
(cl-case action
(doc "AUTO DETECT")
;; last file is not auto-detected unless we cat new line
(command "rmarkdown::render('%I', output_format = 'all')")
(output-file #'pm--rmarkdown-output-file-sniffer)))
(defun pm--rmarkdown-output-file-sniffer ()
(goto-char (point-min))
(let (files)
(while (re-search-forward "Output created: +\\(.*\\)" nil t)
(push (expand-file-name (match-string 1)) files))
(reverse (delete-dups files))))
;; KnitR
(defcustom pm-weaver/knitR
(pm-shell-weaver "knitr"
:from-to
'(("latex" "\\.\\(tex\\|[rR]nw\\)\\'" "tex" "LaTeX" "Rscript -e \"knitr::knit('%i', output='%o')\"")
("html" "\\.x?html?\\'" "html" "HTML" "Rscript -e \"knitr::knit('%i', output='%o')\"")
("markdown" "\\.[rR]?md]\\'" "md" "Markdown" "Rscript -e \"knitr::knit('%i', output='%o')\"")
("rst" "\\.rst" "rst" "ReStructuredText" "Rscript -e \"knitr::knit('%i', output='%o')\"")
("brew" "\\.[rR]?brew\\'" "brew" "Brew" "Rscript -e \"knitr::knit('%i', output='%o')\"")
("asciidoc" "\\.asciidoc\\'" "txt" "AsciiDoc" "Rscript -e \"knitr::knit('%i', output='%o')\"")
("textile" "\\.textile\\'" "textile" "Textile" "Rscript -e \"knitr::knit('%i', output='%o')\"")))
"Shell knitR weaver."
:group 'polymode-weave
:type 'object)
(polymode-register-weaver pm-weaver/knitR nil
pm-poly/noweb+R pm-poly/markdown
pm-poly/rapport pm-poly/html+R)
(defcustom pm-weaver/knitR-ESS
(pm-callback-weaver "knitR-ESS"
:from-to
'(("latex" "\\.\\(tex\\|rnw\\)\\'" "tex" "LaTeX" "knitr::knit('%I', output='%O')")
("html" "\\.x?html?\\'" "html" "HTML" "knitr::knit('%I', output='%O')")
("markdown" "\\.r?md\\'" "md" "Markdown" "knitr::knit('%I', output='%O')")
("rst" "\\.rst\\'" "rst" "ReStructuredText" "knitr::knit('%I', output='%O')")
("brew" "\\.r?brew\\'" "brew" "Brew" "knitr::knit('%I', output='%O')")
("asciidoc" "\\.asciidoc\\'" "txt" "AsciiDoc" "knitr::knit('%I', output='%O')")
("textile" "\\.textile\\'" "textile" "Textile" "knitr::knit('%I', output='%O')"))
:function 'pm--ess-run-command
:callback 'pm--ess-callback)
"ESS knitR weaver."
:group 'polymode-weave
:type 'object)
(polymode-register-weaver pm-weaver/knitR-ESS nil
pm-poly/noweb+R pm-poly/markdown
pm-poly/rapport pm-poly/html+R)
(defcustom pm-weaver/Sweave-ESS
(pm-callback-weaver "ESS-Sweave"
:from-to '(("latex" "\\.\\(tex\\|r?s?nw\\)\\'" "tex"
"LaTeX" "Sweave('%I', output='%O')"))
:function 'pm--ess-run-command
:callback 'pm--ess-callback)
"ESS 'Sweave' weaver."
:group 'polymode-weave
:type 'object)
(polymode-register-weaver pm-weaver/Sweave-ESS nil
pm-poly/noweb+R)
;; Sweave
(defcustom pm-weaver/Sweave
(pm-shell-weaver "sweave"
:from-to
'(("latex" "\\.\\(tex\\|r?s?nw\\)\\'"
"tex" "LaTeX" "R CMD Sweave %i --options=\"output='%o'\"")))
"Shell 'Sweave' weaver."
:group 'polymode-weave
:type 'object)
(polymode-register-weaver pm-weaver/Sweave nil
pm-poly/noweb+R)
;; ESS command
(declare-function ess-async-command nil)
(declare-function ess-force-buffer-current nil)
(declare-function ess-process-get nil)
(declare-function ess-process-put nil)
(declare-function comint-previous-prompt nil)
(defun pm--ess-callback (proc string)
(let ((ofile (process-get proc :output-file)))
;; This is getting silly. Ess splits output for optimization reasons. So we
;; are collecting output from 3 places:
;; - most recent STRING
;; - string in accumulation buffer 'accum-buffer-name
;; - string already in output buffer
(with-current-buffer (process-get proc 'accum-buffer-name)
(setq string (concat (buffer-substring (point-min) (point-max))
string)))
(with-current-buffer (process-buffer proc)
(setq string (concat (buffer-substring (or ess--tb-last-input (comint-previous-prompt)) (point-max))
string)))
(with-temp-buffer
(insert string)
(when (string-match-p "Error\\(:\\| +in\\)" string)
(error "Errors durring ESS async command"))
(unless (stringp ofile)
(setq ofile (funcall ofile))))
ofile))
(defun pm--ess-run-command (command callback &rest ignore)
(require 'ess)
(let ((ess-eval-visibly t)
(ess-dialect "R"))
(ess-force-buffer-current)
(ess-process-put :output-file pm--output-file)
(ess-process-put 'callbacks (list callback))
(ess-process-put 'interruptable? t)
(ess-process-put 'running-async? t)
(ess-eval-linewise command)))
;; COMPAT
(when (fboundp 'advice-add)
(advice-add 'ess-eval-paragraph :around 'pm-execute-narrowed-to-span)
(advice-add 'ess-eval-buffer :around 'pm-execute-narrowed-to-span)
(advice-add 'ess-beginning-of-function :around 'pm-execute-narrowed-to-span))
(provide 'poly-R)

BIN
elpa/polymode-20170307.322/poly-R.elc Normal file
View File

Binary file not shown.

109
elpa/polymode-20170307.322/poly-base.el Normal file
View File

@@ -0,0 +1,109 @@
;;; CORE POLYMODE AND HOST OBJECTS
;;; POLYMODE objects
;; These are simple generic configuration objects. More specialized
;; configuration objects are defined in language-specific files (e.g. poly-R.el,
;; poly-markdown.el etc).
(defcustom pm-inner/fallback
(pm-chunkmode "FallBack" :mode 'poly-fallback-mode)
"Polymode fall back inner mode."
:group 'hostmodes
:type 'object)
(defcustom pm-poly/brew
(pm-polymode-one "brew"
:hostmode 'pm-host/text
:innermode 'pm-inner/fallback)
"Typical Brew configuration"
:group 'polymodes
:type 'object)
(defcustom pm-poly/html
;; fixme: should probably be pm-polymode-multi
(pm-polymode-one "html"
:hostmode 'pm-host/html
:innermode 'pm-inner/fallback)
"HTML typical configuration"
:group 'polymodes
:type 'object)
(defcustom pm-poly/C++
(pm-polymode-one "C++"
:hostmode 'pm-host/C++
:innermode 'pm-inner/fallback)
"C++ typical configuration"
:group 'polymodes
:type 'object)
;; HOST MODES
(defcustom pm-host/blank
(pm-bchunkmode "FallBack" :mode nil)
"Blank. Used as a placeholder for currently installed mode.
It is specifically intended to be used with minor modes."
:group 'hostmodes
:type 'object)
(defcustom pm-host/fallback
(pm-bchunkmode "FallBack"
:mode 'poly-fallback-mode)
"Polymode fall back host mode."
:group 'hostmodes
:type 'object)
(defcustom pm-host/fundamental
(pm-bchunkmode "fundamental"
:mode 'fundamental-mode)
"Fundamental host mode"
:group 'hostmodes
:type 'object)
(defcustom pm-host/latex
(pm-bchunkmode "latex"
:mode 'latex-mode)
"Latex host chunkmode"
:group 'hostmodes
:type 'object)
(defcustom pm-host/html
(pm-bchunkmode "html"
:mode 'html-mode)
"HTML host chunkmode"
:group 'hostmodes
:type 'object)
(defcustom pm-host/R
(pm-bchunkmode "R"
:mode 'R-mode)
"R host chunkmode"
:group 'hostmodes
:type 'object)
(defcustom pm-host/C++
(pm-bchunkmode "C++"
:mode 'c++-mode
:font-lock-narrow nil)
"C++ host chunkmode"
:group 'hostmodes
:type 'object)
(defcustom pm-host/text
(pm-bchunkmode "text"
:mode 'text-mode)
"Text host chunkmode"
:group 'hostmodes
:type 'object)
(defcustom pm-host/yaml
(pm-bchunkmode "YAML"
:mode 'yaml-mode)
"YAML chunkmode"
:group 'hostmodes
:type 'object)
(provide 'poly-base)

BIN
elpa/polymode-20170307.322/poly-base.elc Normal file
View File

Binary file not shown.

53
elpa/polymode-20170307.322/poly-c.el Normal file
View File

@@ -0,0 +1,53 @@
;;; poly-C.el --- Popymodes for C and C++
;;
;; Filename: poly-C.el
;; Author: Spinu Vitalie
;; Maintainer: Spinu Vitalie
;; Copyright (C) 2013-2014, Spinu Vitalie, all rights reserved.
;; Version: 1.0
;; URL: https://github.com/vitoshka/polymode
;; Keywords: emacs
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'polymode)
(require 'poly-noweb)
(defcustom pm-poly/noweb+c
(clone pm-poly/noweb
:innermode 'pm-inner/noweb+c)
"Noweb polymode for c"
:group 'polymodes
:type 'object)
(defcustom pm-inner/noweb+c
(clone pm-inner/noweb
:mode 'c-mode)
"Noweb innermode for C"
:group 'innermodes
:type 'object)
;;;###autoload (autoload 'poly-noweb+c-mode "poly-c")
(define-polymode poly-noweb+c-mode pm-poly/noweb+c :lighter " PM-Cnw")
(provide 'poly-c)

BIN
elpa/polymode-20170307.322/poly-c.elc Normal file
View File

Binary file not shown.

60
elpa/polymode-20170307.322/poly-erb.el Normal file
View File

@@ -0,0 +1,60 @@
(require 'polymode)
(defcustom pm-host/coffee
(pm-bchunkmode "coffee" :mode 'coffee-mode)
"coffee host chunkmode"
:group 'hostmodes
:type 'object)
(defcustom pm-host/javascript
(pm-bchunkmode "javascript" :mode 'js-mode)
"javascript host chunkmode"
:group 'hostmodes
:type 'object)
(defcustom pm-inner/erb
(pm-hbtchunkmode "erb"
:mode 'ruby-mode
:head-reg "\"?\<\% *[-=]?"
:tail-reg "\%\>\"?")
"erb typical chunk."
:group 'innermodes
:type 'object)
(defcustom pm-poly/coffee-erb
(pm-polymode-one "coffee-erb"
:hostmode 'pm-host/coffee
:innermode 'pm-inner/erb)
"coffee-erb typical polymode."
:group 'polymodes
:type 'object)
;;;###autoload (autoload 'poly-coffee+erb-mode "poly-erb")
(define-polymode poly-coffee+erb-mode pm-poly/coffee-erb)
(define-obsolete-function-alias 'poly-coffee-erb-mode 'poly-coffee+erb-mode)
(defcustom pm-poly/javascript-erb
(pm-polymode-one "javascript-erb"
:hostmode 'pm-host/javascript
:innermode 'pm-inner/erb)
"javascript-erb typical polymode."
:group 'polymodes
:type 'object)
;;;###autoload (autoload 'poly-javascript+erb-mode "poly-erb")
(define-polymode poly-javascript+erb-mode pm-poly/javascript-erb)
(define-obsolete-function-alias 'poly-javascript-erb-mode 'poly-javascript+erb-mode)
(defcustom pm-poly/html-erb
(pm-polymode-one "html-erb"
:hostmode 'pm-host/html
:innermode 'pm-inner/erb)
"html-erb typical polymode."
:group 'polymodes
:type 'object)
;;;###autoload (autoload 'poly-html+erb-mode "poly-erb")
(define-polymode poly-html+erb-mode pm-poly/html-erb)
(define-obsolete-function-alias 'poly-html-erb-mode 'poly-html+erb-mode)
(provide 'poly-erb)

BIN
elpa/polymode-20170307.322/poly-erb.elc Normal file
View File

Binary file not shown.

219
elpa/polymode-20170307.322/poly-lock.el Normal file
View File

@@ -0,0 +1,219 @@
;; `font-lock-mode' call graph:
;; -> font-lock-function <- we are replacing this with `poly-lock-mode'
;; -> font-lock-default-function
;; -> font-lock-mode-internal
;; -> font-lock-turn-on-thing-lock
;; -> font-lock-turn-on-thing-lock
;; -> (setq font-lock-flush-function jit-lock-refontify)
;; -> (setq font-lock-ensure-function jit-lock-fontify-now)
;; -> (setq font-lock-fontify-buffer-function jit-lock-refontify)
;; -> (jit-lock-register #'font-lock-fontify-region)
;; -> (add-hook 'jit-lock-functions #'font-lock-fontify-region nil t)
;; -> jit-lock-mode
(require 'polymode-core)
(require 'polymode-compat)
(defvar poly-lock-fontification-in-progress nil)
(defvar-local poly-lock-mode nil)
(defvar-local poly-lock--fontify-region-original nil)
(eval-when-compile
(defmacro with-buffer-prepared-for-poly-lock (&rest body)
"Execute BODY in current buffer, overriding several variables.
Preserves the `buffer-modified-p' state of the current buffer."
(declare (debug t))
`(let ((inhibit-point-motion-hooks t))
(with-silent-modifications
,@body))))
(defun poly-lock-no-jit-lock-in-polymode-buffers (orig-fun arg)
"Don't activate `jit-lock-mode' when in `polymode' buffers.
We are reusing some of the jit-lock functionality but don't want
to activate jit-lock."
(unless (and polymode-mode pm/polymode)
(funcall orig-fun arg)))
(pm-around-advice 'jit-lock-mode #'poly-lock-no-jit-lock-in-polymode-buffers)
(defun poly-lock-mode (arg)
;; value of `font-lock-function' in polymode buffers
(unless polymode-mode
(error "Trying to (de)activate `poly-lock-mode' in a non-polymode buffer (%s)" (current-buffer)))
(setq poly-lock-mode arg)
(if arg
(progn
;; a lot of the following is inspired by what jit-lock does in
;; `font-lock-turn-on-thing-lock'
(setq-local font-lock-support-mode 'poly-lock-mode)
(setq-local font-lock-dont-widen t)
;; re-use jit-lock registration. Some minor modes (adaptive-wrap)
;; register extra functionality.
(jit-lock-register 'font-lock-fontify-region)
;; don't allow other functions
(setq-local fontification-functions '(poly-lock-fontification-function))
(setq-local font-lock-flush-function 'poly-lock-refontify)
(setq-local font-lock-ensure-function 'poly-lock-fontify-now)
(setq-local font-lock-fontify-buffer-function 'poly-lock-refontify)
;; There are some more, jit-lock doesn't change those, neither do we:
;; font-lock-unfontify-region-function (defaults to font-lock-default-unfontify-region)
;; font-lock-unfontify-buffer-function (defualts to font-lock-default-unfontify-buffer)
;; Don't fontify eagerly (and don't abort if the buffer is large). This
;; is probably not needed but let it be.
(setq-local font-lock-fontified t)
;; Now we can finally call `font-lock-default-function' because
;; `font-lock-support-mode' is set to "unrecognizible" value, only core
;; font-lock setup happens.
(font-lock-default-function arg)
;; Must happen after call to `font-lock-default-function'
(remove-hook 'after-change-functions 'font-lock-after-change-function t)
(remove-hook 'after-change-functions 'jit-lock-after-change t)
(add-hook 'after-change-functions 'poly-lock-after-change nil t)
;; Reusing jit-lock var becuase mode populate it directly. We are using
;; this in `poly-lock-after-change' below. Taken from `jit-lock
;; initialization.
(add-hook 'jit-lock-after-change-extend-region-functions
'font-lock-extend-jit-lock-region-after-change
nil t))
(remove-hook 'after-change-functions 'poly-lock-after-change t)
(remove-hook 'fontification-functions 'poly-lock-fontification-function t))
(current-buffer))
(defun poly-lock-fontification-function (start)
"The only function in `fontification-functions'.
This is the entry point called by the display engine. START is
defined in `fontification-functions'. This function is has the
same scope as `jit-lock-function'."
(unless pm-initialization-in-progress
(if pm-allow-fontification
(when (and poly-lock-mode (not memory-full))
(unless (input-pending-p)
(let ((end (or (text-property-any start (point-max) 'fontified t)
(point-max))))
(when (< start end)
(poly-lock-fontify-now start end)))))
(with-buffer-prepared-for-poly-lock
(put-text-property start (point-max) 'fontified t)))))
(defun poly-lock-fontify-now (beg end &optional verbose)
"Polymode font-lock fontification function.
Fontifies chunk-by chunk within the region BEG END."
(unless (or poly-lock-fontification-in-progress
pm-initialization-in-progress)
(let* ((font-lock-dont-widen t)
(pmarker (point-marker))
(dbuffer (current-buffer))
;; Fontification in one buffer can trigger fontification in another
;; buffer. Particularly, this happens when new indirect buffers are
;; created and `normal-mode' triggers font-lock in those buffers. We
;; avoid this by dynamically binding
;; `poly-lock-fontification-in-progress' and un-setting
;; `fontification-functions' in case re-display suddenly decides to
;; fontify something else in other buffer.
(poly-lock-fontification-in-progress t)
(fontification-functions nil))
(save-restriction
(widen)
(save-excursion
(pm-map-over-spans
(lambda ()
(with-buffer-prepared-for-poly-lock
(let ((sbeg (nth 1 *span*))
(send (nth 2 *span*)))
(when (> send sbeg)
(if (not (and font-lock-mode font-lock-keywords))
;; when no font-lock, set to t to avoid repeated calls
;; from display engine
(put-text-property sbeg send 'fontified t)
(let ((new-beg (max sbeg beg))
(new-end (min send end)))
(condition-case-unless-debug err
;; (if (oref pm/chunkmode :font-lock-narrow)
;; (pm-with-narrowed-to-span *span*
;; (font-lock-unfontify-region new-beg new-end)
;; (font-lock-fontify-region new-beg new-end verbose))
;; (font-lock-unfontify-region new-beg new-end)
;; (font-lock-fontify-region new-beg new-end verbose))
(if (oref pm/chunkmode :font-lock-narrow)
(pm-with-narrowed-to-span *span*
(jit-lock-fontify-now new-beg new-end))
(jit-lock-fontify-now new-beg new-end))
(error (message "(poly-lock-fontify-now %s %s) -> (%s %s %s %s): %s "
beg end poly-lock--fontify-region-original new-beg new-end verbose
(error-message-string err))))
;; even if failed set to t
(put-text-property new-beg new-end 'fontified t))
(pm--adjust-chunk-face sbeg send (pm-get-adjust-face pm/chunkmode)))))))
beg end))))
(current-buffer)))
(defun poly-lock-refontify (&optional beg end)
"Force refontification of the region BEG..END.
END is extended to the next chunk separator. This function is
pleased in `font-lock-flush-function' and
`font-lock-ensure-function'"
(when (and pm-allow-fontification
(not poly-lock-fontification-in-progress)
(not pm-initialization-in-progress))
(with-buffer-prepared-for-poly-lock
(save-restriction
(widen)
(cond ((and beg end)
(setq end (cdr (pm-get-innermost-range end))))
(beg
(setq end (cdr (pm-get-innermost-range beg))))
(t
(setq beg (point-min)
end (point-max))))
(put-text-property beg end 'fontified nil)))))
(defun poly-lock-after-change (beg end old-len)
"Mark changed region as not fontified after change.
Installed on `after-change-functions'."
(save-match-data
(when (and poly-lock-mode
pm-allow-after-change-hook
(not memory-full))
(let ((jit-lock-start beg)
(jit-lock-end end)
;; useful info for tracing
(gl-beg end)
(gl-end beg)
exp-error)
(save-excursion
(condition-case err
;; set jit-lock-start and jit-lock-end locally
(run-hook-with-args 'jit-lock-after-change-extend-region-functions
beg end old-len)
(error (message "(poly-lock-after-change:jl-expand (%s %s %s)): %s"
beg end old-len (error-message-string err))
(setq jit-lock-start beg
jit-lock-end end)))
(setq beg (min beg jit-lock-start)
end (max end jit-lock-end))
(pm-map-over-spans
(lambda ()
(with-buffer-prepared-for-poly-lock
(let ((sbeg (nth 1 *span*))
(send (nth 2 *span*)))
(save-restriction
(widen)
(setq gl-beg (min gl-beg (max jit-lock-start sbeg))
gl-end (max gl-beg jit-lock-end send))
(put-text-property gl-beg gl-end 'fontified nil)))))
beg end nil nil nil 'no-cache)
(cons gl-beg gl-end))))))
(provide 'poly-lock)

BIN
elpa/polymode-20170307.322/poly-lock.elc Normal file
View File

Binary file not shown.

71
elpa/polymode-20170307.322/poly-markdown.el Normal file
View File

@@ -0,0 +1,71 @@
;;; poly-markdown.el
;;
;; Filename: poly-markdown.el
;; Author: Spinu Vitalie
;; Maintainer: Spinu Vitalie
;; Copyright (C) 2013-2014, Spinu Vitalie, all rights reserved.
;; Version: 1.0
;; URL: https://github.com/vitoshka/polymode
;; Keywords: emacs
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'polymode)
;; (require 'markdown-mode)
(defcustom pm-host/markdown
(pm-bchunkmode "Markdown"
:mode 'markdown-mode
:init-functions '(poly-markdown-remove-markdown-hooks))
"Markdown host chunkmode"
:group 'hostmodes
:type 'object)
(defcustom pm-inner/markdown
(pm-hbtchunkmode-auto "markdown"
:head-reg "^[ \t]*```[{ \t]*\\w.*$"
:tail-reg "^[ \t]*```[ \t]*$"
:retriever-regexp "```[ ]*{?\\(?:lang *= *\\)?\\([^ \n;=,}]+\\)"
:font-lock-narrow t)
"Markdown typical chunk."
:group 'innermodes
:type 'object)
(defcustom pm-poly/markdown
(pm-polymode-multi-auto "markdown"
:hostmode 'pm-host/markdown
:auto-innermode 'pm-inner/markdown)
"Markdown typical configuration"
:group 'polymodes
:type 'object)
;;;###autoload (autoload 'poly-markdown-mode "poly-markdown")
(define-polymode poly-markdown-mode pm-poly/markdown)
;;; FIXES:
(defun poly-markdown-remove-markdown-hooks ()
;; get rid of awful hooks
(remove-hook 'window-configuration-change-hook 'markdown-fontify-buffer-wiki-links t)
(remove-hook 'after-change-functions 'markdown-check-change-for-wiki-link t))
(provide 'poly-markdown)

BIN
elpa/polymode-20170307.322/poly-markdown.elc Normal file
View File

Binary file not shown.

123
elpa/polymode-20170307.322/poly-noweb.el Normal file
View File

@@ -0,0 +1,123 @@
;;; poly-noweb.el
;;
;; Filename: poly-noweb.el
;; Author: Spinu Vitalie
;; Maintainer: Spinu Vitalie
;; Copyright (C) 2013-2014, Spinu Vitalie, all rights reserved.
;; Version: 1.0
;; URL: https://github.com/vitoshka/polymode
;; Keywords: emacs
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'polymode)
(defcustom pm-poly/noweb
(pm-polymode-one "noweb"
:hostmode 'pm-host/latex
:innermode 'pm-inner/noweb
:exporters '(pm-exporter/latexmk
pm-exporter/pdflatex
pm-exporter/lualatex
pm-exporter/xelatex)
:map '(("<" . poly-noweb-electric-<)))
"Noweb typical configuration"
:group 'polymodes
:type 'object)
(defcustom pm-inner/noweb
(pm-hbtchunkmode "noweb"
:head-reg "^[ \t]*<<\\(.*\\)>>="
:tail-reg "^[ \t]*@ *\\(%def.*\\)?$")
"Noweb typical chunk."
:group 'innermodes
:type 'object)
;;;###autoload (autoload 'poly-noweb-mode "poly-noweb")
(define-polymode poly-noweb-mode pm-poly/noweb)
(defun poly-noweb-electric-< (arg)
"Auto insert noweb chunk if at bol followed by white space.
If given an numerical argument, it simply insert `<'. Otherwise,
if at the beginning of a line in a host chunk insert \"<<>>=\", a
closing \"@\" and a newline if necessary."
(interactive "P")
(if (or arg (not (eq pm/type 'host)))
(self-insert-command (if (numberp arg) arg 1))
(if (not (looking-back "^[ \t]*"))
(self-insert-command 1)
(insert "<<")
(save-excursion
(insert ">>=\n\n@ ")
(unless(looking-at "\\s *$")
(newline)))
(ess-noweb-update-chunk-vector))))
(defcustom pm-exporter/pdflatex
(pm-shell-exporter "pdflatex"
:from
'(("latex" "\\.tex\\'" "LaTeX" "pdflatex -jobname %b %t %i"))
:to
'(("pdf" "pdf" "PDF" ""))
:quote t)
"Shell pdflatex exporter."
:group 'polymode-export
:type 'object)
(defcustom pm-exporter/lualatex
(pm-shell-exporter "LuaLaTeX"
:from
'(("latex" "\\.tex\\'" "LuaLaTeX" "lualatex -jobname %b %t %i"))
:to
'(("pdf" "pdf" "PDF" ""))
:quote t)
"Shell pdflatex exporter."
:group 'polymode-export
:type 'object)
(defcustom pm-exporter/xelatex
(pm-shell-exporter "XeLaTeX"
:from
'(("latex" "\\.tex\\'" "XeLaTeX" "xelatex -jobname %b %t %i"))
:to
'(("pdf" "pdf" "PDF" ""))
:quote t)
"Shell pdflatex exporter."
:group 'polymode-export
:type 'object)
(defcustom pm-exporter/latexmk
(pm-shell-exporter "latexmk"
:from
'(("latex" "\\.tex\\'" "LaTeX(MK)" "latexmk -jobname=%b %t %i"))
:to
'(("pdf" "pdf" "latex" "-pdf")
("xelatex" "pdf" "xe" "-xelatex")
("lualatex" "pdf" "lua" "-lualatex")
("ps" "ps" "latex" "-ps")
("dvi" "dvi" "latex" "-dvi"))
:quote t)
"Shell latexmk dvi, ps and pdf exporter."
:group 'polymode-export
:type 'object)
(provide 'poly-noweb)

BIN
elpa/polymode-20170307.322/poly-noweb.elc Normal file
View File

Binary file not shown.

67
elpa/polymode-20170307.322/poly-org.el Normal file
View File

@@ -0,0 +1,67 @@
;;; poly-org.el
;;
;; Filename: poly-org.el
;; Author: Spinu Vitalie
;; Maintainer: Spinu Vitalie
;; Copyright (C) 2013-2014, Spinu Vitalie, all rights reserved.
;; Version: 1.0
;; URL: https://github.com/vitoshka/polymode
;; Keywords: emacs
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'org-src)
(require 'polymode)
(defcustom pm-host/org
(pm-bchunkmode "Org mode"
:mode 'org-mode)
"Org host innermode"
:group 'hostmodes
:type 'object)
(defcustom pm-inner/org
(pm-hbtchunkmode-auto "org"
:head-reg "^[ \t]*#\\+begin_src .*$"
:tail-reg "^[ \t]*#\\+end_src"
:head-mode 'host
:tail-mode 'host
:retriever-regexp "#\\+begin_src +\\(\\(\\w\\|\\s_\\)+\\)"
:indent-offset org-edit-src-content-indentation
:font-lock-narrow t)
"Org typical chunk."
:group 'innermodes
:type 'object)
(defcustom pm-poly/org
(pm-polymode-multi-auto "org"
:hostmode 'pm-host/org
:auto-innermode 'pm-inner/org)
"Org typical configuration"
:group 'polymodes
:type 'object)
;;;###autoload (autoload 'poly-org-mode "poly-org")
(define-polymode poly-org-mode pm-poly/org)
(provide 'poly-org)

BIN
elpa/polymode-20170307.322/poly-org.elc Normal file
View File

Binary file not shown.

107
elpa/polymode-20170307.322/poly-slim.el Normal file
View File

@@ -0,0 +1,107 @@
(require 'polymode)
;; We cannot have all these "requires" as part of polymode
;; https://github.com/vspinu/polymode/issues/69
;; (require 'css-mode)
;; (require 'scss-mode)
;; (require 'coffee-mode)
;; (require 'slim-mode)
;; (require 'ruby-mode)
;; (require 'markdown-mode)
(defcustom pm-host/slim
(pm-bchunkmode "slim" :mode 'slim-mode)
"slim host chunkmode"
:group 'hostmodes
:type 'object)
(pm-create-indented-block-matchers "slim-coffee" "^[^ ]*\\(.*:? *coffee: *\\)$")
(defcustom pm-inner/slim-coffee
(pm-hbtchunkmode "slim coffee include"
:mode 'coffee-mode
:head-mode 'slim-mode
:tail-mode 'slim-mode
:head-reg 'pm-slim-coffee-head-matcher
:tail-reg 'pm-slim-coffee-tail-matcher)
"slim-coffee typical chunk."
:group 'innermodes
:type 'object)
(pm-create-indented-block-matchers "slim-css" "^[^ ]*\\(.*:? *css: *\\)$")
(defcustom pm-inner/slim-css
(pm-hbtchunkmode "slim css include"
:mode 'css-mode
:head-mode 'slim-mode
:tail-mode 'slim-mode
:head-reg 'pm-slim-css-head-matcher
:tail-reg 'pm-slim-css-tail-matcher)
"slim-css typical chunk."
:group 'innermodes
:type 'object)
(pm-create-indented-block-matchers "slim-scss" "^[^ ]*\\(.*:? *scss: *\\)$")
(defcustom pm-inner/slim-scss
(pm-hbtchunkmode "slim scss include"
:mode 'scss-mode
:head-mode 'slim-mode
:tail-mode 'slim-mode
:head-reg 'pm-slim-scss-head-matcher
:tail-reg 'pm-slim-scss-tail-matcher)
"slim-scss typical chunk."
:group 'innermodes
:type 'object)
(pm-create-indented-block-matchers "slim-ruby" "^[^ ]*\\(.*:? *ruby: *\\)$")
(defcustom pm-inner/slim-ruby
(pm-hbtchunkmode "slim ruby include"
:mode 'ruby-mode
:head-mode 'slim-mode
:tail-mode 'slim-mode
:head-reg 'pm-slim-ruby-head-matcher
:tail-reg 'pm-slim-ruby-tail-matcher)
"slim-ruby typical chunk."
:group 'innermodes
:type 'object)
(pm-create-indented-block-matchers "slim-js" "^[^ ]*\\(.*:? *javascript: *\\)$")
(defcustom pm-inner/slim-js
(pm-hbtchunkmode "slim js include"
:mode 'js-mode
:head-mode 'slim-mode
:tail-mode 'slim-mode
:head-reg 'pm-slim-js-head-matcher
:tail-reg 'pm-slim-js-tail-matcher)
"slim-js typical chunk."
:group 'innermodes
:type 'object)
(pm-create-indented-block-matchers "slim-md" "^[^ ]*\\(.*:? *markdown: *\\)$")
(defcustom pm-inner/slim-md
(pm-hbtchunkmode "slim markdown include"
:mode 'markdown-mode
:head-mode 'slim-mode
:tail-mode 'slim-mode
:head-reg 'pm-slim-md-head-matcher
:tail-reg 'pm-slim-md-tail-matcher)
"slim-markdown typical chunk."
:group 'innermodes
:type 'object)
(defcustom pm-poly/slim
(pm-polymode-multi "slim"
:hostmode 'pm-host/slim
:innermodes '(pm-inner/slim-coffee
pm-inner/slim-css
pm-inner/slim-scss
pm-inner/slim-js
pm-inner/slim-md
pm-inner/slim-ruby))
"slim typical polymode."
:group 'polymodes
:type 'object)
;;;###autoload (autoload 'poly-slim-mode "poly-slim")
(define-polymode poly-slim-mode pm-poly/slim)
(provide 'poly-slim)

BIN
elpa/polymode-20170307.322/poly-slim.elc Normal file
View File

Binary file not shown.

131
elpa/polymode-20170307.322/polymode-autoloads.el Normal file
View File

@@ -0,0 +1,131 @@
;;; polymode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "poly-R" "poly-R.el" (22987 56199 915383 887000))
;;; Generated autoloads from poly-R.el
(autoload 'poly-noweb+r-mode "poly-R")
(autoload 'poly-markdown+r-mode "poly-R")
(autoload 'poly-rapport-mode "poly-R")
(autoload 'poly-html+r-mode "poly-R")
(autoload 'poly-brew+r-mode "poly-R")
(autoload 'poly-r+c++-mode "poly-R")
(autoload 'poly-c++r-mode "poly-R")
(autoload 'poly-ess-help+r-mode "poly-R")
(autoload 'poly-Rd-mode "poly-R")
;;;***
;;;### (autoloads nil "poly-c" "poly-c.el" (22987 56199 825383 755000))
;;; Generated autoloads from poly-c.el
(autoload 'poly-noweb+c-mode "poly-c")
;;;***
;;;### (autoloads nil "poly-erb" "poly-erb.el" (22987 56199 785383
;;;;;; 697000))
;;; Generated autoloads from poly-erb.el
(autoload 'poly-coffee+erb-mode "poly-erb")
(autoload 'poly-javascript+erb-mode "poly-erb")
(autoload 'poly-html+erb-mode "poly-erb")
;;;***
;;;### (autoloads nil "poly-markdown" "poly-markdown.el" (22987 56199
;;;;;; 885383 843000))
;;; Generated autoloads from poly-markdown.el
(autoload 'poly-markdown-mode "poly-markdown")
;;;***
;;;### (autoloads nil "poly-noweb" "poly-noweb.el" (22987 56199 795383
;;;;;; 711000))
;;; Generated autoloads from poly-noweb.el
(autoload 'poly-noweb-mode "poly-noweb")
;;;***
;;;### (autoloads nil "poly-org" "poly-org.el" (22987 56199 895383
;;;;;; 864000))
;;; Generated autoloads from poly-org.el
(autoload 'poly-org-mode "poly-org")
;;;***
;;;### (autoloads nil "poly-slim" "poly-slim.el" (22987 56199 875383
;;;;;; 829000))
;;; Generated autoloads from poly-slim.el
(autoload 'poly-slim-mode "poly-slim")
;;;***
;;;### (autoloads nil "polymode" "polymode.el" (22987 56199 865383
;;;;;; 820000))
;;; Generated autoloads from polymode.el
(autoload 'define-polymode "polymode" "\
Define a new polymode MODE.
This macro defines command MODE and an indicator variable MODE
which becomes t when MODE is active and nil otherwise.
MODE command is similar to standard emacs major modes and it can
be used in `auto-mode-alist'. Standard hook MODE-hook is run at
the end of the initialization of each polymode buffer (both
indirect and base buffers). Additionally MODE-map is created
based on the CONFIG's :map slot and the value of the :keymap
argument; see below.
CONFIG is a name of a config object representing the mode.
MODE command can also be use as a minor mode. Current major mode
is not reinitialized if it coincides with the :mode slot of
CONFIG object or if the :mode slot is nil.
BODY contains code to be executed after the complete
initialization of the polymode (`pm-initialize') and before
running MODE-hook. Before the BODY code, you can write keyword
arguments, i.e. alternating keywords and values. The following
special keywords are supported:
:lighter SPEC Optional LIGHTER is displayed in the mode line when
the mode is on. If omitted, it defaults to
the :lighter slot of CONFIG object.
:keymap MAP Same as the KEYMAP argument.
If nil, a new MODE-map keymap is created what
directly inherits from the keymap defined by
the :map slot of CONFIG object. In most cases it
is a simple map inheriting form
`polymode-mode-map'. If t or an alist (of
bindings suitable to be passed to
`easy-mmode-define-keymap') a keymap MODE-MAP is
build by mergin this alist with the :map
specification of the CONFIG object. If a symbol,
it should be a variable whose value is a
keymap. No MODE-MAP is automatically created in
the latter case and :map slot of the CONFIG
object is ignored.
:after-hook A single lisp form which is evaluated after the mode hooks
have been run. It should not be quoted.
\(fn MODE CONFIG &optional KEYMAP &rest BODY)" nil t)
;;;***
;;;### (autoloads nil nil ("poly-base.el" "poly-lock.el" "polymode-classes.el"
;;;;;; "polymode-compat.el" "polymode-configuration.el" "polymode-core.el"
;;;;;; "polymode-debug.el" "polymode-export.el" "polymode-methods.el"
;;;;;; "polymode-pkg.el" "polymode-tangle.el" "polymode-weave.el")
;;;;;; (22987 56199 935383 917000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; polymode-autoloads.el ends here

375
elpa/polymode-20170307.322/polymode-classes.el Normal file
View File

@@ -0,0 +1,375 @@
(require 'eieio)
(require 'polymode-core)
;;; ROOT CLASS
(if (fboundp 'eieio-named)
(progn
(defclass pm-root (eieio-instance-inheritor eieio-named)
((-props
:initform '()
:type list
:documentation "Internal. Used to store various user
history values. Use `pm--prop-get' and `pm--prop-put' to
place key value pairs into this list."))
"Root polymode class.")
(when (fboundp 'defmethod)
;; bug #22840
(defmethod clone ((obj eieio-named) &rest params)
"Clone OBJ, initializing `:parent' to OBJ.
All slots are unbound, except those initialized with
PARAMS."
(let* ((newname (and (stringp (car params)) (pop params)))
(nobj (apply #'call-next-method obj params))
(nm (slot-value obj 'object-name)))
(eieio-oset nobj 'object-name
(or newname
(save-match-data
(if (and nm (string-match "-\\([0-9]+\\)" nm))
(let ((num (1+ (string-to-number
(match-string 1 nm)))))
(concat (substring nm 0 (match-beginning 0))
"-" (int-to-string num)))
(concat nm "-1")))))
nobj))))
(defclass pm-root (eieio-instance-inheritor)
((-props
:initform '()
:type list
:documentation "Internal. Plist used to store various extra
metadata such as user history. Use `pm--prop-get' and
`pm--prop-put' to place key value pairs into this list."))
"Root polymode class."))
;;; CONFIG
(defclass pm-polymode (pm-root)
((hostmode
:initarg :hostmode
:initform 'pm-host/blank
:type symbol
:custom symbol
:documentation
"Symbol pointing to an object of class pm-chunkmode
representing the host chunkmode.")
(minor-mode
:initarg :minor-mode
:initform 'polymode-minor-mode
:type symbol
:custom symbol
:documentation
"Symbol pointing to minor-mode function that should be
activated in all buffers (base and indirect). This is a
\"glue\" mode and is `polymode-minor-mode' by default. You
will rarely need to change this.")
(lighter
:initarg :lighter
:initform " PM"
:type string
:custom string
:documentation "Modline lighter.")
(exporters
:initarg :exporters
:initform '(pm-exporter/pandoc)
:type list
:custom list
:documentation
"List of names of polymode exporters available for this polymode.")
(exporter
:initarg :exporter
:initform nil
:type (or null symbol)
:custom symbol
:documentation
"Current exporter name. If non-nil should be the name of the
default exporter for this polymode. Can be set with
`polymode-set-exporter' command.")
(weavers
:initarg :weavers
:initform '()
:type list
:custom list
:documentation
"List of names of polymode weavers available for this polymode.")
(weaver
:initarg :weaver
:initform nil
:type (or null symbol)
:custom symbol
:documentation
"Current weaver name. If non-nil this is the default weaver
for this polymode. Can be dynamically set with
`polymode-set-weaver'")
(map
:initarg :map
:initform 'polymode-mode-map
:type (or symbol list)
:documentation
"Has a similar role as the :keymap argument in
`define-polymode' with the difference that this argument is
inherited through cloning, but :keymap argument is not. That
is, child objects derived through clone will inherit
the :map argument of its parents through the following
scheme: if :map is nil or an alist of keys, the parent is
inspected for :map argument and the keys are merged
recursively from parent to parent till a symbol :map slot is
met. If :map is a symbol, it must be a keymap, in which case
this keymap is used and no parents are further inspected
for :map slot. If :map is an alist it must be suitable for
`easy-mmode-define-keymap'.")
(init-functions
:initarg :init-functions
:initform '()
:type list
:documentation
"List of functions to run at the initialization time.
All init-functions in the inheritance chain are called. Parents
hooks first. So, if current config object C inherits from object
B, which in turn inherits from object A. Then A's init-functions
are called first, then B's and then C's.
Either customize this slot or use `object-add-to-list' function.")
(switch-buffer-functions
:initarg :switch-buffer-functions
:initform '()
:type list
:documentation
"List of functions to run at polymode buffer switch.
Each function is run with two arguments, OLD-BUFFER and
NEW-BUFFER.")
(-hostmode
:type (or null pm-chunkmode)
:documentation
"Dynamically populated `pm-chunkmode' object.")
(-innermodes
:type list
:initform '()
:documentation
"Dynamically populated list of chunkmodes objects that
inherit from `pm-hbtchunkmode'.")
(-buffers
:initform '()
:type list
:documentation
"Holds all buffers associated with current buffer. Dynamically populated."))
"Configuration for a polymode. Each polymode buffer contains a local
variable `pm/polymode' instantiated from this class or a subclass
of this class.")
(defclass pm-polymode-one (pm-polymode)
((innermode
:initarg :innermode
:type symbol
:custom symbol
:documentation
"Symbol of the chunkmode. At run time this object is cloned
and placed in -innermodes slot."))
"Configuration for a simple polymode that allows only one
innermode. For example noweb.")
(defclass pm-polymode-multi (pm-polymode)
((innermodes
:initarg :innermodes
:type list
:custom list
:initform nil
:documentation
"List of names of the chunkmode objects that are associated
with this configuration. At initialization time, all of
these are cloned and plased in -innermodes slot."))
"Configuration for a polymode that allows multiple (known in
advance) innermodes.")
(defclass pm-polymode-multi-auto (pm-polymode-multi)
((auto-innermode
:initarg :auto-innermode
:type symbol
:custom symbol
:documentation
"Name of pm-hbtchunkmode-auto object (a symbol). At run time
this object is cloned and placed in -auto-innermodes with
coresponding :mode slot initialized at run time.")
(-auto-innermodes
:type list
:initform '()
:documentation
"List of chunkmode objects that are auto-generated in
`pm-get-span' method for this class."))
"Configuration for a polymode that allows multiple innermodes
that are not known in advance. Examples are org-mode and markdown.")
;;; CHUNKMODE CLASSES
(defclass pm-chunkmode (pm-root)
((mode :initarg :mode
:type symbol
:initform nil
:custom symbol)
(protect-indent-line :initarg :protect-indent-line
:type boolean
:initform t
:custom boolean
:documentation
"Whether to modify local `indent-line-function' by narrowing
to current span first")
(indent-offset :initarg :indent-offset
:type integer
:initform 0
:documentation
"Offset to add when indenting chunk's line. Takes effect only
when :protect-indent-line is non-nil.")
(font-lock-narrow :initarg :font-lock-narrow
:type boolean
:initform t
:documentation
"Whether to narrow to span during font lock")
(adjust-face :initarg :adjust-face
:type (or number face list)
:custom (or number face list)
:initform nil
:documentation
"Fontification adjustments chunk face. It should be either,
nil, number, face or a list of text properties as in
`put-text-property' specification. If nil no highlighting
occurs. If a face, use that face. If a number, it is a
percentage by which to lighten/darken the default chunk
background. If positive - lighten the background on dark
themes and darken on light thems. If negative - darken in
dark thems and lighten in light thems.")
(init-functions
:initarg :init-functions
:initform '()
:type list
:documentation
"List of functions to called after the initialization of chunkmode has finished.
Functions are called the buffer associated with this
chunkmode. All init-functions in the inheritance chain are
called. Parents hooks first. So, if current config object C
inherits from object B, which in turn inherits from object
A. Then A's init-functions are called first, then B's and
then C's. Either customize this slot or use
`object-add-to-list' function.")
(switch-buffer-functions
:initarg :switch-buffer-functions
:initform '()
:type list
:documentation
"List of functions to run at polymode buffer switch.
Each function is run with two arguments, OLD-BUFFER and
NEW-BUFFER. In contrast to identically named slot in
`pm-polymode' class, these functions are run only when
NEW-BUFFER is associated with this chunkmode.")
(-buffer
:type (or null buffer)
:initform nil))
"Representatioin of a generic chunkmode object.")
(defclass pm-bchunkmode (pm-chunkmode)
()
"Representation of the body-only chunkmodes. Body-only
chunkmodes are commonly used as host modes. For example for a
the web-mdoe the hostmode is `html-mode', for nowweb mode the
host mode is usually `latex-mode', etc.")
(defclass pm-hbtchunkmode (pm-chunkmode)
((head-mode
:initarg :head-mode
:type symbol
:initform 'poly-head-tail-mode
:custom symbol
:documentation
"Chunk's header mode. If set to 'body, the head is considered
part of the chunk body. If set to 'host, head is considered
part of the surrounding host mode.")
(tail-mode
:initarg :tail-mode
:type symbol
:initform nil
:custom symbol
:documentation
"Chunk's tail mode. If nil, or 'head, the mode is picked
from :HEAD-MODE slot. If set to 'body, the tail's mode is the
same as chunk's body mode. If set to 'host, the mode will be
of the parent host.")
(head-reg
:initarg :head-reg
:initform ""
:type (or string symbol)
:custom (or string symbol)
:documentation "Regexp for the chunk start (aka head), or a
function returning the start and end positions of the head.
See `pm--default-matcher' for an example function.")
(tail-reg
:initarg :tail-reg
:initform ""
:type (or string symbol)
:custom (or string symbol)
:documentation "Regexp for chunk end (aka tail), or a
function returning the start and end positions of the tail.
See `pm--default-matcher' for an example function.")
(adjust-face
:initform 2)
(head-adjust-face
:initarg :head-adjust-face
:initform font-lock-type-face
:type (or null number face list)
:custom (or null number face list)
:documentation
"Can be a number, list or face.")
(tail-adjust-face
:initarg :tail-adjust-face
:initform nil
:type (or null number face list)
:custom (or null number face list)
:documentation
"Can be a number, list or face. If nil, take the
configuration from :head-adjust-face.")
(-head-buffer
:type (or null buffer)
:initform nil
:documentation
"This buffer is set automatically to -buffer if :head-mode is
'body, and to base-buffer if :head-mode is 'host")
(-tail-buffer
:initform nil
:type (or null buffer)))
"Representation of an inner Head-Body-Tail chunkmode.")
(defclass pm-hbtchunkmode-auto (pm-hbtchunkmode)
((retriever-regexp :initarg :retriever-regexp
:type (or null string)
:custom string
:initform nil
:documentation
"Regexp that is used to retrive the modes symbol from the
head of the chunkmode chunk. fixme: elaborate")
(retriever-num :initarg :retriever-num
:type integer
:custom integer
:initform 1
:documentation
"Subexpression to be matched by :retriver-regexp")
(retriever-function :initarg :retriever-function
:type symbol
:custom symbol
:initform nil
:documentation
"Function symbol used to retrive the modes symbol from the
head of the chunkmode chunk. It is called with no arguments
with the point positioned at the beginning of the chunk
header. It must return the mode name string or symbol (need
not include '-mode' postfix).)"))
"Representation of an inner chunkmode")
(provide 'polymode-classes)

BIN
elpa/polymode-20170307.322/polymode-classes.elc Normal file
View File

Binary file not shown.

251
elpa/polymode-20170307.322/polymode-compat.el Normal file
View File

@@ -0,0 +1,251 @@
;;; COMPATIBILITY and FIXES
(require 'polymode-core)
(require 'advice nil t)
(defgroup polymode-compat nil
"Polymode compatibility settings."
:group 'polymode)
;;; Various Wrappers for Around Advice
(defvar *span* nil)
;; advice doesn't provide named symbols. So we need to define specialized
;; wrappers for some key functions (unfinished)
(defmacro pm-define-wrapp-protected (fun)
"Declare protected function with the name fun--pm-wrapped.
Return new name (symbol). FUN is an unquoted name of a function."
(let* ((fun-name (symbol-name fun))
(new-fun (intern (format "%s--pm-wrapped" fun-name)))
(new-doc (format " Error Protected function created with `pm-define-protected-wrapp'.\n\n%s"
(or (documentation fun) ""))))
`(progn
(defun ,new-fun (&rest args)
,new-doc
(condition-case err
(apply ',fun args)
(error (message "(%s %s): %s"
,fun-name
(mapconcat (lambda (x) (format "%s" x)) args " ")
(error-message-string err)))))
',new-fun)))
(defun pm-apply-protected (fun args)
(when fun
(condition-case-unless-debug err
(apply fun args)
(error (message "(%s %s): %s %s"
(if (symbolp fun)
(symbol-name fun)
"anonymous")
(mapconcat (lambda (x) (format "%s" x)) args " ")
(error-message-string err)
;; (or (and (symbolp fun) "")
;; (replace-regexp-in-string "\n" "" (format "[%s]" fun)))
"[M-x pm-debug-mode RET for more info]"
)
(when pm-debug-mode
(backtrace))
nil))))
(defun pm-override-output-position (orig-fun &rest args)
"Restrict returned value of ORIG-FUN to fall into the current span.
*span* in `pm-map-over-spans` has precedence over span at point.'"
(if (and polymode-mode pm/polymode)
(let ((range (or (pm-span-to-range *span*)
(pm-get-innermost-range)))
(pos (pm-apply-protected orig-fun args)))
(and pos
(min (max pos (car range))
(cdr range))))
(apply orig-fun args)))
(defun pm-override-output-cons (orig-fun &rest args)
"Restrict returned (beg . end) of ORIG-FUN to fall into the current span.
*span* in `pm-map-over-spans` has precedence over span at point.'"
(if (and polymode-mode pm/polymode)
(let ((range (or (pm-span-to-range *span*)
(pm-get-innermost-range)))
(be (pm-apply-protected orig-fun args)))
(and be
(cons (min (max (car be) (car range))
(cdr range))
(max (min (cdr be) (cdr range))
(car range)))))
(apply orig-fun args)))
(defun pm-substitute-beg-end (orig-fun beg end &rest args)
"Execute orig-fun with first two arguments limited to current span.
*span* in `pm-map-over-spans` has precedence over span at point."
(if (and polymode-mode pm/polymode)
(let* ((pos (if (and (<= (point) end) (>= (point) beg))
(point)
end))
(range (or (pm-span-to-range *span*)
(pm-get-innermost-range pos)))
(new-beg (max beg (car range)))
(new-end (min end (cdr range))))
(pm-apply-protected orig-fun (append (list new-beg new-end) args)))
(apply orig-fun beg end args)))
(defun pm-execute-narrowed-to-span (orig-fun &rest args)
"Execute ORIG-FUN narrowed to the current span.
*span* in `pm-map-over-spans` has precedence over span at point."
(if (and polymode-mode pm/polymode)
(pm-with-narrowed-to-span *span*
(pm-apply-protected orig-fun args))
(apply orig-fun args)))
(defun pm-execute-with-no-polymode-hooks (orig-fun &rest args)
"Execute ORIG-FUN without allowing polymode core hooks.
That is, bind `pm-allow-post-command-hook' and
`pm-allow-after-change-hook' to nil. *span* in
`pm-map-over-spans' has precedence over span at point."
;; this advice is nowhere used yet
(if (and polymode-mode pm/polymode)
(let ((pm-allow-post-command-hook t)
(pm-allow-after-change-hook t))
;; This advice might be useful when functions can switch buffers to work
;; inside the base buffer (like basic-save-buffer does). Thus, we sync
;; points first.
(pm--synchronize-points)
;; save-excursion might be also often necessary
(apply orig-fun args))
(apply orig-fun args)))
(defun pm-execute-with-save-excursion (orig-fun &rest args)
"Execute ORIG-FUN within save-excursion."
;; This advice is required when other functions switch buffers to work inside
;; base buffer and don't restore the point. For some not very clear reason
;; this seem to be necessary for save-buffer which saves buffer but not point.
(if (and polymode-mode pm/polymode)
(progn
(pm--synchronize-points)
(save-excursion
(apply orig-fun args)))
(apply orig-fun args)))
(defun pm-around-advice (fun advice)
"Apply around ADVICE to FUN.
Check for if new advice is available and if FUN is a symbol, do
nothing otherwise. If FUN is a list, apply advice to each element
in a list. "
(when (and fun (fboundp 'advice-add))
(cond ((listp fun)
(dolist (el fun) (pm-around-advice el advice)))
((and (symbolp fun)
(not (advice-member-p advice fun)))
(advice-add fun :around advice)))))
;;; Syntax
(defun pm-execute-syntax-propertize-narrowed-to-span (orig-fun pos)
"Execute `syntax-propertize' narrowed to the current span.
Don't throw errors, but give relevant messages instead."
;; in emacs 25.1 internal--syntax-propertize is called from C. We
;; cannot advice it, but we can check for its argument. Very hackish
;; but I don't see another way besides re-defining that function.
(if (and polymode-mode pm/polymode)
(condition-case err
(save-excursion
(when (< syntax-propertize--done pos)
(pm-map-over-spans
(lambda ()
(when (< syntax-propertize--done pos)
(pm-with-narrowed-to-span *span*
(funcall orig-fun (min pos (point-max)))
(let ((new--done syntax-propertize--done))
(dolist (buff (oref pm/polymode -buffers))
(with-current-buffer buff
(setq-local syntax-propertize--done new--done)))))))
syntax-propertize--done pos)))
(error (message "(syntax-propertize %s): %s [M-x pm-debug-info RET to see backtrace]"
pos (error-message-string err))
(and pm-debug-mode
(backtrace))))
(funcall orig-fun pos)))
(pm-around-advice 'syntax-propertize 'pm-execute-syntax-propertize-narrowed-to-span)
;;; Flyspel
(defun pm--flyspel-dont-highlight-in-chunkmodes (beg end poss)
(or (get-text-property beg :pm-span-type)
(get-text-property end :pm-span-type)))
;;; C/C++/Java
(pm-around-advice 'c-before-context-fl-expand-region #'pm-override-output-cons)
(pm-around-advice 'c-state-semi-safe-place #'pm-override-output-position)
;; (advice-remove 'c-state-semi-safe-place #'pm-override-output-position)
;; c-font-lock-fontify-region calls it directly
;; (pm-around-advice 'font-lock-default-fontify-region #'pm-substitute-beg-end)
(pm-around-advice 'c-determine-limit #'pm-execute-narrowed-to-span)
;;; Python
(defun pm--python-dont-indent-to-0 (fun)
"Don't cycle to 0 indentation in polymode chunks."
(if (and polymode-mode pm/type)
(let ((last-command (unless (eq (pm--first-line-indent) (current-indentation))
last-command)))
(funcall fun))
(funcall fun)))
(pm-around-advice 'python-indent-line-function #'pm--python-dont-indent-to-0)
;;; Core Font Lock
(defun pm-check-for-real-change-in-extend-multiline (fun)
"Fix `font-lock-extend-region-multiline' which causes infloops on point-max.
Propagate only real change."
;; fixme: report this ASAP!
(let ((obeg font-lock-beg)
(oend font-lock-end)
(change (funcall fun)))
(and change
(not (eq obeg font-lock-beg))
(not (eq oend font-lock-end)))))
(pm-around-advice 'font-lock-extend-region-multiline #'pm-check-for-real-change-in-extend-multiline)
;;; Editing
(pm-around-advice 'fill-paragraph #'pm-execute-narrowed-to-span)
;; `save-buffer` misbehaves because after each replacement modification hooks
;; are triggered and poly buffer is switched in unpredictable fashion.
;;
;; https://github.com/vspinu/polymode/issues/93 It can be
;; reproduced with (add-hook 'before-save-hook 'delete-trailing-whitespace nil
;; t) in the base buffer.
;;
;; save-excursion is probably not quite right fix for this but it seem to work
(pm-around-advice 'basic-save-buffer #'pm-execute-with-save-excursion)
;; Query replace were probably misbehaving due to unsaved match data.
;; (https://github.com/vspinu/polymode/issues/92) The following is probably not
;; necessary.
;; (pm-around-advice 'perform-replace 'pm-execute-inhibit-modification-hooks)
;;; EVIL
(defun polymode-switch-buffer-keep-evil-state-maybe (old-buffer new-buffer)
(when (and (boundp 'evil-state)
evil-state)
(let ((old-state (buffer-local-value 'evil-state old-buffer))
(new-state (buffer-local-value 'evil-state new-buffer)))
(unless (eq old-state new-state)
(with-current-buffer new-buffer
(evil-change-state old-state))))))
(eval-after-load 'evil-core
'(add-hook 'polymode-switch-buffer-hook 'polymode-switch-buffer-keep-evil-state-maybe))
(provide 'polymode-compat)

BIN
elpa/polymode-20170307.322/polymode-compat.elc Normal file
View File

Binary file not shown.

29
elpa/polymode-20170307.322/polymode-configuration.el Normal file
View File

@@ -0,0 +1,29 @@
;; Examples of polymode configuration. Choose what suits your needs and place
;; into your .emacs file.
;;; MARKDOWN
(add-to-list 'auto-mode-alist '("\\.md$" . poly-markdown-mode))
;;; ORG
;; org is not working presently
;; (add-to-list 'auto-mode-alist '("\\.org" . poly-org-mode))
;;; R related modes
(add-to-list 'auto-mode-alist '("\\.Snw$" . poly-noweb+r-mode))
(add-to-list 'auto-mode-alist '("\\.Rnw$" . poly-noweb+r-mode))
(add-to-list 'auto-mode-alist '("\\.Rmd$" . poly-markdown+r-mode))
(add-to-list 'auto-mode-alist '("\\.rapport$" . poly-rapport-mode))
(add-to-list 'auto-mode-alist '("\\.Rhtml$" . poly-html+r-mode))
(add-to-list 'auto-mode-alist '("\\.Rbrew$" . poly-brew+r-mode))
(add-to-list 'auto-mode-alist '("\\.Rcpp$" . poly-r+c++-mode))
(add-to-list 'auto-mode-alist '("\\.cppR$" . poly-c++r-mode))
;;; ERB modes
(add-to-list 'auto-mode-alist '("\\.js.erb$" . poly-javascript+erb-mode))
(add-to-list 'auto-mode-alist '("\\.coffee.erb$" . poly-coffee+erb-mode))
(add-to-list 'auto-mode-alist '("\\.html.erb$" . poly-html+erb-mode))
;;; Slim mode
(add-to-list 'auto-mode-alist '("\\.slim$" . poly-slim-mode))
(provide 'polymode-configuration)

BIN
elpa/polymode-20170307.322/polymode-configuration.elc Normal file
View File

Binary file not shown.

660
elpa/polymode-20170307.322/polymode-core.el Normal file
View File

@@ -0,0 +1,660 @@
;; -*- lexical-binding: t -*-
;; COMMON INITIALIZATION, UTILITIES and INTERNALS which didn't fit anywhere else
(require 'cl)
(require 'font-lock)
(require 'color)
(require 'eieio)
(require 'eieio-base)
(require 'eieio-custom)
(require 'format-spec)
(defgroup polymode nil
"Object oriented framework for multiple modes based on indirect buffers"
:link '(emacs-commentary-link "polymode")
:group 'tools)
(defgroup polymodes nil
"Polymode Configuration Objects"
:group 'polymode)
(defgroup hostmodes nil
"Polymode Host Chunkmode Objects"
:group 'polymode)
(defgroup innermodes nil
"Polymode Chunkmode Objects"
:group 'polymode)
(defcustom polymode-display-process-buffers t
"When non-nil, display weaving and exporting process buffers."
:group 'polymode
:type 'boolean)
(defcustom polymode-skip-processing-when-unmodified t
"If non-nil, consider modification times of input and output files.
Skip weaving or exporting process when output file is more recent
than the input file."
:group 'polymode
:type 'boolean)
(defcustom polymode-mode-name-override-alist '((elisp . emacs-lisp))
"An alist of inner mode overrides.
When inner mode is automatically detected from the header of the
inner chunk (such as in markdown mode), the detected symbol might
not correspond to the desired mode. This alist maps discovered
symbols into desired modes.
For example
(add-to-list 'polymode-mode-name-override-alist '(julia . ess-julia))
will cause installation of `ess-julia-mode' in markdown ```julia chunks."
:group 'polymode
:type 'alist)
(defvar polymode-switch-buffer-hook nil
"Hook run on switching to a different buffer.
Each function is run with two arguments `old-buffer' and
`new-buffer'. This hook is commonly used to transfer state
between buffers. The hook is run in a new buffer, but you should
not rely on that. Slot :switch-buffer-functions in `pm-polymode'
and `pm-chunkmode' objects provides same functionality for
narrower scope.")
(defvar polymode-init-host-hook nil
"Hook run on initialization of every hostmode.
Ran in a base buffer from `pm-initialze'
methods. Slot :init-functions in `pm-polymode' objects provides
similar hook for more focused scope. See
`polymode-init-inner-hook' and :init-functions slot in
`pm-chunkmode' objects for similar hooks for inner chunkmodes.")
(defvar polymode-init-inner-hook nil
"Hook run on initialization of every `pm-chunkmode' object.
The hook is run in chunkmode's body buffer from `pm-initialze'
`pm-chunkmode' methods. Slot :init-functions `pm-chunkmode'
objects provides same functionality for narrower scope. See also
`polymode-init-host-hook'.")
;; esential vars
(defvar-local pm/polymode nil)
(defvar-local pm/chunkmode nil)
(defvar-local pm/type nil)
(defvar-local pm--indent-line-function-original nil)
;; (defvar-local pm--killed-once nil)
(defvar-local polymode-mode nil
"This variable is t if current \"mode\" is a polymode.")
;; silence the compiler for now
(defvar pm--output-file nil)
(defvar pm--input-buffer nil)
(defvar pm--input-file nil)
(defvar pm--export-spec nil)
(defvar pm--input-not-real nil)
(defvar pm--output-not-real nil)
(defvar pm/type)
(defvar pm/polymode)
(defvar pm/chunkmode)
(defvar *span*)
(defvar pm-allow-fontification t)
(defvar pm-allow-after-change-hook t)
(defvar pm-allow-post-command-hook t)
(defvar pm-initialization-in-progress nil
;; We need this during cascading call-next-method in pm-initialize.
;; -innermodes are initialized after the hostmode setup has taken place. This
;; means that pm-get-span and all the functionality that relies on it will
;; fail to work correctly during the initialization in the call-next-method.
;; This is particularly relevant to font-lock setup and user hooks.
"Non nil during polymode objects initialization.
If this variable is non-nil, various chunk manipulation commands
relying on `pm-get-span' might not function correctly.")
;; methods api from polymode-methods.el
(declare-function pm-initialize "polymode-methods")
(declare-function pm-get-buffer-create "polymode-methods")
(declare-function pm-select-buffer "polymode-methods")
(declare-function pm-get-adjust-face "polymode-methods")
(declare-function pm-get-span "polymode-methods")
(declare-function pm-indent-line "polymode-methods")
;;; CORE
(defsubst pm-base-buffer ()
;; fixme: redundant with :base-buffer
"Return base buffer of current buffer, or the current buffer if it's direct."
(or (buffer-base-buffer (current-buffer))
(current-buffer)))
(defun pm-get-cached-span (&optional pos)
"Get cached span at POS"
(let ((span (get-text-property (or pos (point)) :pm-span)))
(when span
(save-restriction
(widen)
(let* ((beg (nth 1 span))
(end (max beg (1- (nth 2 span)))))
(when (<= end (point-max))
(and (eq span (get-text-property beg :pm-span))
(eq span (get-text-property end :pm-span))
span)))))))
(defun pm-get-innermost-span (&optional pos no-cache)
"Get span object at POS.
If NO-CACHE is non-nil, don't use cache and force re-computation
of the span."
(save-excursion
(save-restriction
(widen)
(let* ((span (or (and (not no-cache)
(pm-get-cached-span pos))
(pm-get-span pm/polymode pos)))
(beg (nth 1 span))
(end (nth 2 span)))
;; might be used by external applications like flyspell
(with-silent-modifications
(add-text-properties beg end
(list :pm-span span
:pm-span-type (car span)
:pm-span-beg beg
:pm-span-end end)))
span))))
(defun pm-span-to-range (span)
(and span (cons (nth 1 span) (nth 2 span))))
(defun pm-get-innermost-range (&optional pos no-cache)
(pm-span-to-range (pm-get-innermost-span pos no-cache)))
(defvar pm--select-buffer-visibly nil)
(defun pm-switch-to-buffer (&optional pos-or-span)
"Bring the appropriate polymode buffer to front.
This is done visually for the user with `switch-to-buffer'. All
necessary adjustment like overlay and undo history transport are
performed."
(let ((span (if (or (null pos-or-span)
(number-or-marker-p pos-or-span))
(pm-get-innermost-span pos-or-span)
pos-or-span))
(pm--select-buffer-visibly t))
(pm-select-buffer (car (last span)) span)))
(defun pm-set-buffer (&optional pos-or-span)
"Set buffer to polymode buffer appropriate for POS-OR-SPAN.
This is done with `set-buffer' and no visual adjustments are
done."
(let ((span (if (or (null pos-or-span)
(number-or-marker-p pos-or-span))
(pm-get-innermost-span pos-or-span)
pos-or-span))
(pm--select-buffer-visibly nil))
(pm-select-buffer (car (last span)) span)))
(defun pm-map-over-spans (fun beg end &optional count backwardp visiblyp no-cache)
"For all spans between BEG and END, execute FUN.
FUN is a function of no args. It is executed with point at the
beginning of the span. Buffer is *not* narrowed to the span. If
COUNT is non-nil, jump at most that many times. If BACKWARDP is
non-nil, map backwards. During the call of FUN, a dynamically
bound variable *span* holds the current innermost span."
;; Important! Never forget to save-excursion when calling
;; map-overs-spans. Mapping can end different buffer and invalidate whatever
;; caller that used your function.
(save-restriction
(widen)
(setq end (min end (point-max)))
(goto-char (if backwardp end beg))
(let* ((nr 1)
(*span* (pm-get-innermost-span (point) no-cache))
old-span
moved)
;; if beg (end) coincide with span's end (beg) don't process previous (next) span
(if backwardp
(and (eq end (nth 1 *span*))
(setq moved t)
(not (bobp))
(forward-char -1))
(and (eq beg (nth 2 *span*))
(setq moved t)
(not (eobp))
(forward-char 1)))
(when moved
(setq *span* (pm-get-innermost-span (point) no-cache)))
(while (and (if backwardp
(> (point) beg)
(< (point) end))
(or (null count)
(< nr count)))
(let ((pm--select-buffer-visibly visiblyp))
(pm-select-buffer (car (last *span*)) *span*)) ;; object and span
;; FUN might change buffer and invalidate our *span*. How can we
;; intelligently check for this? After-change functions have not been
;; run yet (or did they?). We can track buffer modification time
;; explicitly (can we?)
(goto-char (nth 1 *span*))
(save-excursion
(funcall fun))
;; enter next/previous chunk as head-tails don't include their boundaries
(if backwardp
(goto-char (max 1 (1- (nth 1 *span*))))
(goto-char (min (point-max) (1+ (nth 2 *span*)))))
(setq old-span *span*)
(setq *span* (pm-get-innermost-span (point) no-cache)
nr (1+ nr))
;; Ensure progress and avoid infloop due to bad regexp or who knows
;; what. Move char by char till we get higher/lower span. Cache is not
;; used.
(while (and (not (eobp))
(if backwardp
(> (nth 2 *span*) (nth 1 old-span))
(< (nth 1 *span*) (nth 2 old-span))))
(forward-char 1)
(setq *span* (pm-get-innermost-span (point) t)))))))
(defun pm--reset-ppss-last (&optional span-start force)
"Reset `syntax-ppss-last' cache if it was recorded before SPAN-START.
If SPAN-START is nil, use span at point. If force, reset
regardless of the position `syntax-ppss-last' was recorder at."
;; syntax-ppss has its own condition-case for this case, but that means
;; throwing an error each time it calls parse-partial-sexp
(setq span-start (or span-start (car (pm-get-innermost-range))))
(when (or force
(and syntax-ppss-last
(car syntax-ppss-last)
;; non-strict is intentional (occasionally ppss is screwed)
(<= (car syntax-ppss-last) span-start)))
(setq syntax-ppss-last
(cons span-start (list 0 nil span-start nil nil nil 0)))))
(defun pm-narrow-to-span (&optional span)
"Narrow to current chunk."
(interactive)
(unless (= (point-min) (point-max))
(let ((span (or span
(pm-get-innermost-span))))
(let ((sbeg (nth 1 span))
(send (nth 2 span)))
(pm--reset-ppss-last sbeg t)
(narrow-to-region sbeg send)))))
(defmacro pm-with-narrowed-to-span (span &rest body)
(declare (indent 1) (debug body))
`(save-restriction
(pm-narrow-to-span ,span)
,@body))
;;; UTILITIES
(defvar polymode-display-output-file t
"When non-nil automatically display output file in emacs.
This is temporary variable, it might be changed or removed in the
near future.")
(defun pm--display-file (ofile)
(when ofile
;; errors might occur (most notably with open-with package errors are intentional)
;; We need to catch those if we want to display multiple files like with Rmarkdown
(condition-case err
(let ((buff (get-file-buffer ofile)))
;; silently kill and re-open
(when buff
(with-current-buffer buff
(revert-buffer t t)))
(when polymode-display-output-file
(if (string-match-p "html\\|htm$" ofile)
(browse-url ofile)
(display-buffer (find-file-noselect ofile 'nowarn)))))
(error (message "Error while displaying '%s': %s"
(file-name-nondirectory ofile)
(error-message-string err))))))
(defun pm--symbol-name (str-or-symbol)
(if (symbolp str-or-symbol)
(symbol-name str-or-symbol)
str-or-symbol))
(defun pm--get-mode-symbol-from-name (str &optional no-fallback)
"Guess and return mode function."
(let* ((str (pm--symbol-name
(or (cdr (assq (intern (pm--symbol-name str))
polymode-mode-name-override-alist))
str)))
(mname (if (string-match-p "-mode$" str)
str
(concat str "-mode"))))
(or (pm--get-existent-mode (intern mname) t)
(pm--get-existent-mode (intern (downcase mname))) no-fallback)))
(defun pm--get-existent-mode (mode &optional no-fallback)
"Check if MODE symbol is defined and is a valid function.
If so, return it, otherwise return `poly-fallback-mode' and issue
a warning."
(cond ((fboundp mode) mode)
(no-fallback nil)
(t (message "Cannot find function `%s', using `poly-fallback-mode'" mode)
'poly-fallback-mode)))
(defun pm--oref-with-parents (object slot)
"Merge slots SLOT from the OBJECT and all its parent instances."
(let (VALS)
(while object
(setq VALS (append (and (slot-boundp object slot) ; don't cascade
(eieio-oref object slot))
VALS)
object (and (slot-boundp object :parent-instance)
(oref object :parent-instance))))
VALS))
(defun pm--abrev-names (list abrev-regexp)
"Abbreviate names in LIST by replacing abrev-regexp with empty string."
(mapcar (lambda (nm)
(let ((str-nm (if (symbolp nm)
(symbol-name nm)
nm)))
(cons (replace-regexp-in-string abrev-regexp "" str-nm)
str-nm)))
list))
(defun pm--prop-put (key val &optional object)
(oset (or object pm/polymode) -props
(plist-put (oref (or object pm/polymode) -props) key val)))
(defun pm--prop-get (key &optional object)
(plist-get (oref (or object pm/polymode) -props) key))
(defun pm--comment-region (beg end)
;; mark as syntactic comment
(when (> end 1)
(with-silent-modifications
(let ((beg (or beg (region-beginning)))
(end (or end (region-end))))
(let ((ch-beg (char-after beg))
(ch-end (char-before end)))
(add-text-properties beg (1+ beg)
(list 'syntax-table (cons 11 ch-beg)
'rear-nonsticky t
'polymode-comment 'start))
(add-text-properties (1- end) end
(list 'syntax-table (cons 12 ch-end)
'rear-nonsticky t
'polymode-comment 'end)))))))
(defun pm--uncomment-region (beg end)
;; Remove all syntax-table properties.
;; fixme: this beggs for problems
(when (> end 1)
(with-silent-modifications
(let ((props '(syntax-table nil rear-nonsticky nil polymode-comment nil)))
(remove-text-properties (max beg (point-min)) (min end (point-max)) props)
;; (remove-text-properties beg (1+ beg) props)
;; (remove-text-properties end (1- end) props)
))))
(defun pm--synchronize-points (&rest ignore)
"Synchronize points in all buffers.
IGNORE is there to allow this function in advises."
(when polymode-mode
(let ((pos (point))
(cbuff (current-buffer)))
(dolist (buff (oref pm/polymode -buffers))
(when (and (not (eq buff cbuff))
(buffer-live-p buff))
(with-current-buffer buff
(goto-char pos)))))))
(defun pm--completing-read (prompt collection &optional predicate require-match initial-input hist def inherit-input-method)
"Wrapper for `completing-read'.
Takes care when collection is an alist of (name . meta-info). If
so, asks for names, but returns meta-info for that name. Enforce
require-match = t. Also takes care of adding the most relevant
DEF from history."
(if (and (listp collection)
(listp (car collection)))
(let* ((candidates (mapcar #'car collection))
(thist (and hist
(delq nil (mapcar (lambda (x) (car (member x candidates)))
(symbol-value hist)))))
(def (or def (car thist))))
(assoc (completing-read prompt candidates predicate t initial-input hist def inherit-input-method)
collection))
(completing-read prompt candidates predicate require-match initial-input hist def inherit-input-method)))
;; Weaving and Exporting common utilities
(defun pm--wrap-callback (processor slot ifile)
;; replace processor :sentinel or :callback temporally in order to export-spec as a
;; followup step or display the result
(let ((sentinel1 (eieio-oref processor slot))
(cur-dir default-directory)
(exporter (symbol-value (oref pm/polymode :exporter)))
(obuffer (current-buffer)))
(if pm--export-spec
(let ((espec pm--export-spec))
(lambda (&rest args)
(with-current-buffer obuffer
(let ((wfile (apply sentinel1 args))
(pm--export-spec nil)
(pm--input-not-real t))
;; If no wfile, probably errors occurred. So we stop.
(when wfile
(when (listp wfile)
;; In an unlikely situation weaver can generate multiple
;; files. Pick the first one.
(setq wfile (car wfile)))
(pm-export exporter (car espec) (cdr espec) wfile))))))
(lambda (&rest args)
(with-current-buffer obuffer
(let ((ofile (apply sentinel1 args)))
(when ofile
(let ((ofiles (if (listp ofile) ofile (list ofile))))
(dolist (f ofiles)
(pm--display-file (expand-file-name f cur-dir)))))))))))
(defun pm--file-mod-time (file)
(and (stringp file)
(file-exists-p file)
(nth 5 (file-attributes file))))
(defvar-local pm--process-buffer nil)
(defun pm--run-shell-command (command sentinel buff-name message)
"Run shell command interactively.
Run command in a buffer (in comint-shell-mode) in order to be
able to accept user interaction."
;; simplified version of TeX-run-TeX
(require 'comint)
(let* ((buffer (get-buffer-create buff-name))
(process nil)
(command-buff (current-buffer))
(ofile pm--output-file)
;; weave/export buffers are re-usable; need to transfer some vars
(dd default-directory)
;; (command (shell-quote-argument command))
)
(with-current-buffer buffer
(setq-local default-directory dd)
(read-only-mode -1)
(erase-buffer)
(insert message)
(comint-exec buffer buff-name shell-file-name nil
(list shell-command-switch command))
(setq process (get-buffer-process buffer))
(comint-mode)
(set-process-sentinel process sentinel)
(setq pm--process-buffer t)
(set-marker (process-mark process) (point-max))
;; for communication with sentinel
(process-put process :output-file pm--output-file)
(process-put process :output-file-mod-time (pm--file-mod-time pm--output-file))
(process-put process :input-file pm--input-file)
(when polymode-display-process-buffers
(display-buffer buffer `(nil . ((inhibit-same-window . ,pop-up-windows)))))
nil)))
(defun pm--make-shell-command-sentinel (action)
(lambda (process name)
"Sentinel built with `pm--make-shell-command-sentinel'."
(let ((buff (process-buffer process))
(status (process-exit-status process)))
(if (> status 0)
(progn
(message "Errors during %s; process exit status %d" action status)
(ding) (sit-for 1)
nil)
(with-current-buffer buff
(let ((ofile (process-get process :output-file)))
(cond
;; 1. output-file guesser
((functionp ofile) (funcall ofile))
;; 2. string
(ofile
(let ((otime (process-get process :output-file-mod-time))
(ntime (pm--file-mod-time ofile)))
(if (or (null ntime)
(and otime
(not (time-less-p otime ntime))))
;; mod time didn't change
;; tothink: shall we still return ofile for display?
(progn
(display-buffer (current-buffer))
(message "Output file unchanged. Either input unchanged or errors during %s." action)
(ding) (sit-for 1)
ofile)
;; else, all is good, we return the file name
;; (display-buffer (current-buffer))
(message "Done with %s" action)
ofile)))
;; 3. output file is not known; display process buffer
(t (display-buffer (current-buffer)) nil))))))))
(fset 'pm-default-export-sentinel (pm--make-shell-command-sentinel "export"))
(fset 'pm-default-shell-weave-sentinel (pm--make-shell-command-sentinel "weaving"))
(defun pm--make-selector (specs elements)
(cond ((listp elements)
(let ((spec-alist (cl-mapcar #'cons specs elements)))
(lambda (selsym &rest ignore)
(cdr (assoc selsym spec-alist)))))
((functionp elements) elements)
(t (error "elements argument must be either a list or a function"))))
(defun pm--selector (processor type id)
(let ((spec (or (assoc id (eieio-oref processor type))
(error "%s spec '%s' cannot be found in '%s'"
(symbol-name type) id (eieio-object-name processor))))
(names (cond
;; exporter slots
((eq type :from) '(regexp doc command))
((eq type :to) '(ext doc t-spec))
;; weaver slot
((eq type :from-to) '(regexp ext doc command))
(t (error "invalid type '%s'" type)))))
(pm--make-selector names (cdr spec))))
(defun pm--selector-match (selector &optional file)
(or (funcall selector 'match file)
(string-match-p (funcall selector 'regexp)
(or file buffer-file-name))))
(defun pm--selectors (processor type)
(let ((ids (mapcar #'car (eieio-oref processor type))))
(mapcar (lambda (id) (cons id (pm--selector processor type id))) ids)))
(defun pm--output-command.file (output-file-format sfrom &optional sto quote)
;; !!Must be run in input buffer!!
(cl-flet ((squote (arg) (or (and (stringp arg)
(if quote (shell-quote-argument arg) arg))
"")))
(let* ((base-ofile (or (funcall (or sto sfrom) 'output-file)
(let ((ext (funcall (or sto sfrom) 'ext)))
(when ext
(concat (format output-file-format
(file-name-base buffer-file-name))
"." ext)))))
(ofile (and (stringp base-ofile)
(expand-file-name base-ofile)))
(oname (and (stringp base-ofile)
(file-name-base base-ofile)))
(t-spec (and sto (funcall sto 't-spec)))
(command-w-formats (or (and sto (funcall sto 'command))
(and (listp t-spec) (car t-spec))
(funcall sfrom 'command)))
(command (format-spec command-w-formats
(list (cons ?i (squote (file-name-nondirectory buffer-file-name)))
(cons ?I (squote buffer-file-name))
(cons ?o (squote base-ofile))
(cons ?O (squote ofile))
(cons ?b (squote oname))
(cons ?t (squote t-spec))))))
(cons command (or ofile base-ofile)))))
(defun pm--process-internal (processor from to ifile &optional callback quote)
(let ((is-exporter (object-of-class-p processor 'pm-exporter)))
(if is-exporter
(unless (and from to)
(error "For exporter both FROM and TO must be supplied (from: %s, to: %s)" from to))
(unless from
;; it represents :from-to slot
(error "For weaver FROM must be supplied (from: %s)" from)))
(let* ((sfrom (if is-exporter
(pm--selector processor :from from)
(pm--selector processor :from-to from)))
(sto (and is-exporter (pm--selector processor :to to)))
(ifile (or ifile buffer-file-name))
;; fixme: nowarn is only right for inputs from weavers, you need to
;; save otherwise
(ibuffer (if pm--input-not-real
;; for exporter input we silently re-fetch the file
;; even if it was modified
(find-file-noselect ifile t)
;; if real user file, get it or fetch it
(or (get-file-buffer ifile)
(find-file-noselect ifile))))
(output-format (if is-exporter
polymode-exporter-output-file-format
polymode-weave-output-file-format)))
(with-current-buffer ibuffer
(save-buffer)
(let ((comm.ofile (pm--output-command.file output-format sfrom sto quote)))
(message "%s '%s' with '%s' ..." (if is-exporter "Exporting" "Weaving")
(file-name-nondirectory ifile) (eieio-object-name processor))
(let* ((pm--output-file (cdr comm.ofile))
(pm--input-file ifile)
;; skip weaving step if possible
;; :fixme this should not happen after weaver/exporter change
;; or after errors in previous exporter
(omt (and polymode-skip-processing-when-unmodified
(stringp pm--output-file)
(pm--file-mod-time pm--output-file)))
(imt (and omt (pm--file-mod-time pm--input-file)))
(ofile (or (and imt (time-less-p imt omt) pm--output-file)
(let ((fun (oref processor :function))
(args (delq nil (list callback from to))))
(apply fun (car comm.ofile) args)))))
;; ofile is non-nil in two cases:
;; -- synchronous back-ends (very uncommon)
;; -- when output is transitional (not real) and mod time of input < output
(when ofile
(if pm--export-spec
;; same logic as in pm--wrap-callback
(let ((pm--input-not-real t)
(espec pm--export-spec)
(pm--export-spec nil))
(when (listp ofile)
(setq ofile (car ofile)))
(pm-export (symbol-value (oref pm/polymode :exporter))
(car espec) (cdr espec)
ofile))
(pm--display-file ofile)))))))))
(provide 'polymode-core)

BIN
elpa/polymode-20170307.322/polymode-core.elc Normal file
View File

Binary file not shown.

339
elpa/polymode-20170307.322/polymode-debug.el Normal file
View File

@@ -0,0 +1,339 @@
;;; polymode.el --- Various tools for debugging and tracing polymode
(defvar pm--underline-overlay
(let ((overlay (make-overlay (point) (point))))
(overlay-put overlay 'face '(:underline (:color "red" :style wave)))
overlay)
"Overlay used in `pm-debug-mode'.")
(defvar pm--inverse-video-overlay
(let ((overlay (make-overlay (point) (point))))
(overlay-put overlay 'face '(:inverse-video t))
overlay)
"Overlay used by `pm-debug-map-over-spans-and-highlight'.")
(defvar pm-debug-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "M-n M-i") 'pm-debug-info-on-current-span)
(define-key map (kbd "M-n i") 'pm-debug-info-on-current-span)
(define-key map (kbd "M-n M-p") 'pm-debug-print-relevant-variables)
(define-key map (kbd "M-n M-t m") 'pm-debug-toogle-info-message)
(define-key map (kbd "M-n M-t f") 'pm-debug-toggle-fontification)
(define-key map (kbd "M-n M-t M-f") 'pm-debug-toggle-fontification)
(define-key map (kbd "M-n M-t p") 'pm-debug-toggle-post-command)
(define-key map (kbd "M-n M-t c") 'pm-debug-toggle-after-change)
(define-key map (kbd "M-n M-t M-c") 'pm-debug-toggle-after-change)
(define-key map (kbd "M-n M-t a") 'pm-debug-toggle-all)
(define-key map (kbd "M-n M-t M-a") 'pm-debug-toggle-all)
(define-key map (kbd "M-n M-t t") 'pm-debug-trace-relevant-functions)
(define-key map (kbd "M-n M-t M-t") 'pm-debug-trace-relevant-functions)
(define-key map (kbd "M-n M-t u") 'pm-debug-untrace-relevant-functions)
(define-key map (kbd "M-n M-t M-u") 'pm-debug-untrace-relevant-functions)
(define-key map (kbd "M-n M-h") 'pm-debug-map-over-spans-and-highlight)
(define-key map (kbd "M-n M-f t") 'pm-debug-toggle-fontification)
(define-key map (kbd "M-n M-f s") 'pm-debug-fontify-current-span)
(define-key map (kbd "M-n M-f e") 'pm-debug-fontify-last-font-lock-error)
(define-key map (kbd "M-n M-f h") 'pm-debug-highlight-last-font-lock-error-region)
(define-key map (kbd "M-n M-f M-t") 'pm-debug-toggle-fontification)
(define-key map (kbd "M-n M-f M-s") 'pm-debug-fontify-current-span)
(define-key map (kbd "M-n M-f M-e") 'pm-debug-fontify-last-font-lock-error)
map))
(define-minor-mode pm-debug-minor-mode
"Turns on/off useful facilities for debugging polymode.
Key bindings:
\\{pm-debug-minor-mode-map}"
nil
" PMDBG"
:group 'polymode
(interactive)
(if pm-debug-minor-mode
(progn
;; this is global hook. No need to complicate with local hooks
(add-hook 'post-command-hook 'pm-debug-highlight-current-span))
(delete-overlay pm--underline-overlay)
(delete-overlay pm--inverse-video-overlay)
(remove-hook 'post-command-hook 'pm-debug-highlight-current-span)))
(defun pm-debug-minor-mode-on ()
;; activating everywhere (in case font-lock infloops in a polymode buffer )
;; this doesn't activate in fundamental mode
(pm-debug-minor-mode t))
(define-globalized-minor-mode pm-debug-mode pm-debug-minor-mode pm-debug-minor-mode-on)
(defun pm-debug-highlight-current-span ()
(when polymode-mode
(unless (memq this-command '(pm-debug-info-on-current-span
pm-debug-highlight-last-font-lock-error-region))
(delete-overlay pm--inverse-video-overlay))
(condition-case err
(let ((span (pm-get-innermost-span)))
(when pm-debug-display-info-message
(pm--debug-info span))
(move-overlay pm--underline-overlay (nth 1 span) (nth 2 span) (current-buffer)))
(error (message "%s" (error-message-string err))))))
(defgeneric pm-debug-info (chunkmode))
(defmethod pm-debug-info (chunkmode)
(format "class:%s" (eieio-object-class-name chunkmode)))
(defmethod pm-debug-info ((chunkmode pm-hbtchunkmode))
(format "head-reg:\"%s\" tail-reg:\"%s\" %s"
(oref chunkmode :head-reg) (oref chunkmode :tail-reg)
(call-next-method)))
(defmethod pm-debug-info ((chunkmode pm-hbtchunkmode))
(format "head-reg:\"%s\" tail-reg:\"%s\" %s"
(oref chunkmode :head-reg) (oref chunkmode :tail-reg)
(call-next-method)))
(defmethod pm-debug-info ((chunkmode pm-hbtchunkmode-auto))
(call-next-method))
(defun pm--debug-info (&optional span)
(let* ((span (or span (and polymode-mode (pm-get-innermost-span))))
(message-log-max nil)
(beg (nth 1 span))
(end (nth 2 span))
(obj (nth 3 span))
(type (and span (or (car span) 'host))))
(list (current-buffer)
(point-min) (point) (point-max)
major-mode
type beg end
(and obj (pm-debug-info obj))
(format "lppss:%s"
syntax-ppss-last))))
(defun pm-debug-info-on-current-span ()
(interactive)
(if (not polymode-mode)
(message "not in a polymode buffer")
(let ((span (pm-get-innermost-span)))
(apply 'message "min:%d pos:%d max:%d || (%s) type:%s span:%s-%s %s" (pm--debug-info span))
(move-overlay pm--inverse-video-overlay (nth 1 span) (nth 2 span) (current-buffer)))))
(defvar pm-debug-display-info-message nil)
(defun pm-debug-toogle-info-message ()
(interactive)
(setq pm-debug-display-info-message (not pm-debug-display-info-message)))
(defun pm-debug-toggle-fontification ()
(interactive)
(if pm-allow-fontification
(progn
(message "fontificaiton disabled")
(setq pm-allow-fontification nil))
(message "fontificaiton enabled")
(setq pm-allow-fontification t)))
(defun pm-debug-toggle-after-change ()
(interactive)
(if pm-allow-after-change-hook
(progn
(message "after-change disabled")
(setq pm-allow-after-change-hook nil))
(message "after-change enabled")
(setq pm-allow-after-change-hook t)))
(defun pm-debug-toggle-post-command ()
(interactive)
(if pm-allow-post-command-hook
(progn
(message "post-command disabled")
(setq pm-allow-post-command-hook nil))
(message "post-command enabled")
(setq pm-allow-post-command-hook t)))
(defun pm-debug-toggle-all ()
(interactive)
(if pm-allow-fontification
(progn
(message "fontificaiton, after-chnage and command-hook disabled")
(setq pm-allow-fontification nil
pm-allow-after-change-hook nil
pm-allow-post-command-hook nil))
(message "fontificaiton, after-change and command-hook enabled")
(setq pm-allow-fontification t
pm-allow-after-change-hook t
pm-allow-post-command-hook t)))
(defun pm-debug-fontify-current-span ()
(interactive)
(let ((span (pm-get-innermost-span))
(pm-allow-fontification t))
(poly-lock-fontify-region (nth 1 span) (nth 2 span))))
(defun pm-debug-fontify-last-font-lock-error ()
(interactive)
(let ((reg (pm--debug-get-last-fl-error))
(pm-allow-fontification t))
(if reg
(progn
;; (pm-debug-blink-region (car reg) (cdr reg) 2)
(poly-lock-fontify-region (car reg) (cdr reg)))
(message "No last font-lock errors found"))))
(defun pm--debug-get-last-fl-error ()
(with-current-buffer (messages-buffer)
(goto-char (point-max))
(when (re-search-backward "(poly-lock-fontify-region \\([0-9]+\\) \\([0-9]+\\))" nil t)
(cons (string-to-number (match-string 1))
(string-to-number (match-string 2))))))
(defun pm-debug-highlight-last-font-lock-error-region ()
(interactive)
(let ((reg (pm--debug-get-last-fl-error)))
(if reg
(progn
(goto-char (car reg))
(recenter)
(move-overlay pm--inverse-video-overlay (car reg) (cdr reg) (current-buffer))
(message "Region %s" reg))
(message "No last font-lock errors found"))))
(defvar pm-debug-relevant-functions-alist
'((polymode-initialization . (pm-initialize pm--mode-setup pm--common-setup
pm--get-chunkmode-buffer-create))
(poly-lock . (poly-lock-mode poly-lock-fontify-region
poly-lock-fontification-function
poly-lock-after-change
poly-lock-refontify
poly-lock--fontify-region-original))
(jit-loc . (jit-lock-refontify jit-lock-mode jit-lock-fontify-now))
(font-lock . (;; font-lock-mode turn-on-font-lock-if-desired
turn-on-font-lock
font-lock-after-change-function
font-lock-default-fontify-region
font-lock-fontify-syntactically-region
font-lock-extend-region-wholelines
font-lock-extend-region-multiline
font-lock-fontify-syntactic-keywords-region
font-lock-fontify-keywords-region
font-lock-unfontify-region
font-lock-fontify-region font-lock-flush
font-lock-fontify-buffer font-lock-ensure))
(methods . (pm-select-buffer pm-get-buffer-create))
(select . (pm-get-innermost-span pm-map-over-spans))
(insert . (self-insert-command))))
(defun pm-debug-trace-background-1 (fn)
(interactive (trace--read-args "Trace function in background: "))
(unless (symbolp fn)
(error "can trace symbols only"))
(unless (get fn 'cl--class)
(trace-function-background fn nil
'(lambda ()
(format " [buf:%s pos:%s type:%s (%f)]"
(current-buffer) (point)
(get-text-property (point) :pm-span-type)
(float-time))))))
(defun pm-debug-trace-relevant-functions (&optional group)
"GROUP is either a string or a list of functions to trace.
If string, it must b an entry in
`pm-debug-relevant-functions-alist'."
(interactive)
(require 'trace)
(if (and group (listp group))
(mapc #'pm-debug-trace-background-1 group)
(let* ((groups (append '("*ALL*") (mapcar #'car pm-debug-relevant-functions-alist)))
(group-name (or group (completing-read "Trace group: " groups nil t))))
(if (equal group-name "*ALL*")
(mapc (lambda (group)
(mapc #'pm-debug-trace-background-1
(assoc group pm-debug-relevant-functions-alist)))
(cdr groups))
(mapc #'pm-debug-trace-background-1
(assoc (intern group-name) pm-debug-relevant-functions-alist))))))
(defun pm-debug-trace-functions-by-regexp (regexp)
"Trace all functions whose name matched REGEXP."
(cl-loop for sym being the symbols
when (and (fboundp sym)
(not (eq sym 'pm-debug-trace-background-1)))
when (string-match regexp (symbol-name sym))
do (pm-debug-trace-background-1 sym)))
(defvar pm-debug-relevant-variables '(fontification-functions
font-lock-flush-function
font-lock-ensure-function
font-lock-fontify-region-function
font-lock-fontify-buffer-function
font-lock-unfontify-region-function
font-lock-unfontify-buffer-function
post-command-hook
indent-line-function))
(defun pm-debug-print-relevant-variables ()
(interactive)
(let ((buff (get-buffer-create "*polymode-vars*"))
(vars (mapcar (lambda (v) (cons v (buffer-local-value v (current-buffer))))
pm-debug-relevant-variables))
(cbuff (current-buffer)))
(require 'pp)
(with-current-buffer buff
(goto-char (point-max))
(insert "===============================================================\n")
(insert (format "relevant vars in buffer: %s\n" cbuff))
(insert (pp-to-string vars))
(toggle-truncate-lines -1))
(display-buffer buff)))
(defun pm-debug-untrace-relevant-functions ()
(interactive)
(require 'trace)
(let* ((groups (append `("*ALL*") (mapcar #'car pm-debug-relevant-functions-alist)))
(group-name (completing-read "Trace group: " groups nil t)))
(if (equal group-name "*ALL*")
(mapc (lambda (group)
(mapc #'untrace-function (assoc group pm-debug-relevant-functions-alist)))
(cdr groups))
(mapc #'untrace-function (assoc groups pm-debug-relevant-functions-alist)))))
(defun pm-debug-blink-region (start end &optional delay)
(move-overlay pm--inverse-video-overlay start end (current-buffer))
(run-with-timer (or delay 0.4) nil (lambda () (delete-overlay pm--inverse-video-overlay))))
(defun pm-debug-map-over-spans-and-highlight ()
(interactive)
(pm-map-over-spans (lambda ()
(let ((start (nth 1 *span*))
(end (nth 2 *span*)))
(pm-debug-blink-region start end)
(sit-for 1)))
(point-min) (point-max) nil nil t))
(defun pm--highlight-span (&optional hd-matcher tl-matcher)
(interactive)
(let* ((hd-matcher (or hd-matcher (oref pm/chunkmode :head-reg)))
(tl-matcher (or tl-matcher (oref pm/chunkmode :tail-reg)))
(span (pm--span-at-point hd-matcher tl-matcher)))
(pm-debug-blink-region (nth 1 span) (nth 2 span))
(message "span: %s" span)))
(defun pm-debug-run-over-check ()
(interactive)
(goto-char (point-min))
(let ((start (current-time))
(count 1))
(pm-switch-to-buffer)
(while (< (point) (point-max))
(setq count (1+ count))
(forward-char)
(pm-switch-to-buffer))
(let ((elapsed (float-time (time-subtract (current-time) start))))
(message "elapsed: %s per-char: %s" elapsed (/ elapsed count)))))
(defun pm-dbg (msg &rest args)
(let ((cbuf (current-buffer))
(cpos (point)))
(with-current-buffer (get-buffer-create "*pm-dbg*")
(save-excursion
(goto-char (point-max))
(insert "\n")
(insert (apply 'format (concat "%f [%s at %d]: " msg)
(float-time) cbuf cpos args))))))
(provide 'polymode-debug)

BIN
elpa/polymode-20170307.322/polymode-debug.elc Normal file
View File

Binary file not shown.

392
elpa/polymode-20170307.322/polymode-export.el Normal file
View File

@@ -0,0 +1,392 @@
(require 'polymode-core)
(require 'polymode-classes)
(defgroup polymode-export nil
"Polymode Exporters"
:group 'polymode)
(defcustom polymode-exporter-output-file-format "%s[exported]"
"Format of the exported files.
%s is substituted with the current file name sans extension."
:group 'polymode-export
:type 'string)
(defclass pm-exporter (pm-root)
((from
:initarg :from
:initform '()
:type list
:custom list
:documentation
"Input exporter specifications.
This is an alist of elements of the form (id regexp doc
commmand) or (id . selector). ID is the unique identifier of
the spec. REGEXP is a regexp which, if matched on current
file name, implies that the current file can be exported
with this specification. DOC is a short help string shown
during interactive export. COMMAND is the exporter
command (string). It can contain the following format specs:
%i - input file (no dir)
%I - input file (full path)
%o - output file (no dir)
%O - output file (full path)
%b - output file (base name only)
%t - 4th element of the :to spec
When specification is of the form (id . selector), SELECTOR
is a function of variable arguments that accepts at least
one argument ACTION. ACTION is a symbol and can be one of
the following:
match - must return non-nil if this specification
applies to the file that current buffer is visiting,
or :nomatch if specification does not apply. This
selector can receive an optional file-name
argument. In that case the decision must be made
solely on that file and current buffer must be
ignored. This is useful for matching exporters to
weavers when exported file does not exist yet.
regexp - return a string which is used to match input
file name. If nil, `match' selector must return
non-nil value. This selector is ignored if `match'
returned non-nil.
doc - return documentation string
commmand - return a string with optional %i, %f,
etc. format specs as described above. It will be
passed to the processing :function.")
(to
:initarg :to
:initform '()
:type list
:custom list
:documentation
"Output specifications alist. Each element is either a list
of the form (id ext doc t-spec) or a cons (id . selector).
In the former case EXT is an extension of the output
file. DOC is a short documentation string. t-spec is a
string what is substituted instead of %t in :from spec
commmand. `t-spec' can be a list of one element '(command),
in which case the whole :from spec command is substituted
with command from %t-spec.
When specification is of the form (id . selector), SELECTOR
is a function of variable arguments that accepts at least
one argument ACTION. This function is called in a buffer
visiting input file. ACTION is a symbol and can one of the
following:
output-file - return an output file name or a list of file
names. Receives input-file as argument. If this
command returns nil, the output is built from input
file and value of 'output-ext command.
This selector can also return a function. This
function will be called in the callback or sentinel of
the weaving process after the weaving was
completed. This function should sniff the output of
the process for errors or file names. It must return a
file name, a list of file names or nil if no such
files have been detected.
ext - extension of output file. If nil and
`output' also returned nil, the exporter won't be able
to identify the output file and no automatic display
or preview will be available.
doc - return documentation string
command - return a string to be used instead of
the :from command. If nil, :from spec command is used.
t-spec - return a string to be substituted as %t :from
spec in :from command. If `command' selector returned
non-nil, this spec is ignored.")
(function
:initarg :function
:initform (lambda (command from to)
(error "Function not defined for this exporter"))
:type (or symbol function)
:documentation
"Function to process the commmand. Must take 3 arguments
COMMAND, FROM-ID and TO-ID. COMMAND is the 4th argument
of :from spec with all the formats substituted. FROM-ID is
the id of requested :from spec, TO-ID is the id of the :to
spec."))
"Root exporter class.")
(defclass pm-callback-exporter (pm-exporter)
((callback
:initarg :callback
:initform (lambda (&optional rest)
(error "No callback defined for this exporter."))
:type (or symbol function)
:documentation
"Callback function to be called by :function. There is no
default callback. Callback must return the output file
name."))
"Class to represent asynchronous exporters.")
(defclass pm-shell-exporter (pm-exporter)
((function
:initform 'pm-default-shell-export-function)
(sentinel
:initarg :sentinel
:initform 'pm-default-export-sentinel
:type (or symbol function)
:documentation
"Sentinel function to be called by :function when a shell
call is involved. Sentinel should return the output file
name.")
(quote
:initarg :quote
:initform nil
:type boolean
:documentation "Non-nil when file arguments must be quoted
with `shell-quote-argument'."))
"Class to represent exporters that call external processes.")
(defun pm-default-shell-export-function (command sentinel from to)
"Run exporting command interactively.
Run command in a buffer (in comint-shell-mode) so that it accepts
user interaction. This is a default function in all exporters
that call a shell command"
(pm--run-shell-command command sentinel "*polymode export*"
(concat "Exporting " from "-->" to " with command:\n\n "
command "\n\n")))
;;; METHODS
(defgeneric pm-export (exporter from to &optional ifile)
"Process IFILE with EXPORTER.")
(defmethod pm-export ((exporter pm-exporter) from to &optional ifile)
(pm--process-internal exporter from to ifile))
(defmethod pm-export ((exporter pm-callback-exporter) from to &optional ifile)
(let ((cb (pm--wrap-callback exporter :callback ifile)))
(pm--process-internal exporter from to ifile cb)))
(defmethod pm-export ((exporter pm-shell-exporter) from to &optional ifile)
(let ((cb (pm--wrap-callback exporter :sentinel ifile)))
(pm--process-internal exporter from to ifile cb (oref exporter :quote))))
;; UI
(defvar pm--exporter-hist nil)
(defvar pm--export:from-hist nil)
(defvar pm--export:from-last nil)
(defvar pm--export:to-hist nil)
(defvar pm--export:to-last nil)
(declare-function polymode-set-weaver "polymode-weave")
(declare-function pm-weave "polymode-weave")
(defun polymode-export (&optional from to)
"Export current file.
FROM and TO are the ids of the :from and :to slots of the current
exporter. If the current exporter hasn't been set yet, set the
exporter with `polymode-set-exporter'. You can always change the
exporter manually by invoking `polymode-set-exporter'.
When FROM or TO are missing they are determined automatically
from the current exporter's specifications and file's
extension. If no appropriate export specification has been found,
look into current weaver and try to match weaver's output to
exporters input extension. When such combination is possible,
settle on weaving first and exporting the weaved output. When
none of the above worked, ask the user for `from' and `to' specs.
When called interactively with C-u argument, ask for FROM and TO
interactively. See class `pm-exporter' for the complete
specification."
(interactive "P")
(cl-flet ((to-name.id (el) (let* ((ext (funcall (cdr el) 'ext))
(name (if ext
(format "%s (%s)" (funcall (cdr el) 'doc) ext)
(funcall (cdr el) 'doc))))
(cons name (car el))))
(from-name.id (el) (cons (funcall (cdr el) 'doc) (car el))))
(let* ((exporter (symbol-value (or (oref pm/polymode :exporter)
(polymode-set-exporter))))
(fname (file-name-nondirectory buffer-file-name))
(gprompt nil)
(case-fold-search t)
(from-opts (mapcar #'from-name.id (pm--selectors exporter :from)))
(from-id
(cond
;; A: guess from spec
((null from)
(or
;; 1. repeated export; don't ask
pm--export:from-last
;; 2. select :from entries which match to current file
(let ((matched (cl-loop for el in (pm--selectors exporter :from)
when (pm--selector-match (cdr el))
collect (from-name.id el))))
(when matched
(if (> (length matched) 1)
(cdr (pm--completing-read "Multiple `from' specs matched. Choose one: " matched))
(cdar matched))))
;; 3. guess from weaver and return a cons (weaver-id . exporter-id)
(let ((weaver (symbol-value (or (oref pm/polymode :weaver)
(progn
(setq gprompt "Choose `from' spec: ")
(polymode-set-weaver))))))
(when weaver
;; fixme: weaver was not yet ported to selectors
;; fixme: currently only first match is returned
(let ((pair (cl-loop for w in (oref weaver :from-to)
;; weaver input extension matches the filename
if (string-match-p (nth 1 w) fname)
return (cl-loop for el in (pm--selectors exporter :from)
;; input exporter extensnion matches weaver output extension
when (pm--selector-match (cdr el) (concat "dummy." (nth 2 w)))
return (cons (car w) (car el))))))
(when pair
(message "Matching weaver found. Weaving to '%s' first." (car pair))
pair))))
;; 4. nothing matched; ask
(let* ((prompt (or gprompt
(format "No `from' specs matched. Choose one: "
(file-name-nondirectory fname) (eieio-object-name-string exporter))))
(sel (pm--completing-read prompt from-opts nil t nil 'pm--export:from-hist)))
(cdr sel))))
;; B: C-u, force a :from spec
((equal from '(4))
(cdr (if (> (length from-opts) 1)
(pm--completing-read "Input type: " from-opts nil t nil 'pm--export:from-hist)
(car from-opts))))
;; C. string
((stringp from)
(if (assoc from (oref exporter :from))
from
(error "Cannot find `from' spec '%s' in %s exporter"
from (eieio-object-name exporter))))
;; D. error
(t (error "'from' argument must be nil, universal argument or a string"))))
(to-opts (mapcar #'to-name.id (pm--selectors exporter :to)))
(to-id
(cond
;; A. guess from spec
((null to)
(or
;; 1. repeated export; don't ask and use first entry in history
(unless (equal from '(4))
pm--export:to-last)
;; 2. First export or C-u
(cdr (pm--completing-read "Export to: " to-opts nil t nil 'pm--export:to-hist))))
;; B. string
((stringp to)
(if (assoc to (oref exporter :to))
to
(error "Cannot find output spec '%s' in %s exporter"
to (eieio-object-name exporter))))
;; C . Error
(t (error "'to' argument must be nil or a string")))))
(setq-local pm--export:from-last from-id)
(setq-local pm--export:to-last to-id)
(if (consp from-id)
;; run through weaver
(let ((pm--export-spec (cons (cdr from-id) to-id))
(pm--output-not-real t))
(pm-weave (symbol-value (oref pm/polymode :weaver)) (car from-id)))
(pm-export exporter from-id to-id)))))
(defun polymode-set-exporter ()
"Interactively set exporter for the current file."
(interactive)
(unless pm/polymode
(error "No pm/polymode object found. Not in polymode buffer?"))
(let* ((exporters (pm--abrev-names
(delete-dups (pm--oref-with-parents pm/polymode :exporters))
"pm-exporter/"))
(sel (pm--completing-read "Choose exporter: " exporters nil t nil 'pm--exporter-hist))
(out (intern (cdr sel))))
(setq-local pm--export:from-last nil)
(setq-local pm--export:to-last nil)
(oset pm/polymode :exporter out)
out))
(defmacro polymode-register-exporter (exporter defaultp &rest configs)
"Add EXPORTER to :exporters slot of all config objects in CONFIGS.
When DEFAULT? is non-nil, also make EXPORTER the default exporter
for each polymode in CONFIGS."
`(dolist (pm ',configs)
(object-add-to-list (symbol-value pm) :exporters ',exporter)
(when ,defaultp (oset (symbol-value pm) :exporter ',exporter))))
;;; GLOBAL EXPORTERS
(defcustom pm-exporter/pandoc
(pm-shell-exporter "pandoc"
:from
'(;; ("json" "\\.json\\'" "JSON native AST" "pandoc %i -f json -t %t -o %o")
("markdown" "\\.md\\'" "pandoc's markdown" "pandoc %i -f markdown -t %t -o %o")
("markdown_strict" "\\.md\\'" "original markdown" "pandoc %i -f markdown_strict -t %t -o %o")
("markdown_phpextra" "\\.md\\'" "PHP markdown" "pandoc %i -f markdown_phpextra -t %t -o %o")
("markdown_phpextra" "\\.md\\'" "github markdown" "pandoc %i -f markdown_phpextra -t %t -o %o")
("textile" "\\.textile\\'" "Textile" "pandoc %i -f textile -t %t -o %o")
("rst" "\\.rst\\'" "reStructuredText" "pandoc %i -f rst -t %t -o %o")
("html" "\\.x?html?\\'" "HTML" "pandoc %i -f html -t %t -o %o")
("doocbook" "\\.xml\\'" "DocBook" "pandoc %i -f doocbook -t %t -o %o")
("mediawiki" "\\.wiki\\'" "MediaWiki" "pandoc %i -f mediawiki -t %t -o %o")
("latex" "\\.tex\\'" "LaTeX" "pandoc %i -f latex -t %t -o %o")
)
:to
'(;; ("json" "json" "JSON version of native AST" "json")
("plain" "txt" "plain text" "plain")
("markdown" "md" "pandoc's extended markdown" "markdown")
("markdown_strict" "md" "original markdown" "markdown_strict")
("markdown_phpextra" "md" "PHP extended markdown" "markdown_phpextra")
("markdown_github" "md" "github extended markdown" "markdown_github")
("rst" "rst" "reStructuredText" "rst")
("html" "html" "XHTML 1" "html")
("html5" "html" "HTML 5" "html5")
("latex" "tex" "LaTeX" "latex")
("beamer" "tex" "LaTeX beamer" "beamer")
("context" "tex" "ConTeXt" "context")
("man" "man" "groff man" "man")
("mediawiki" "wiki" "MediaWiki markup" "mediawiki")
("textile" "textile" "Textile" "textile")
("org" "org" "Emacs Org-Mode" "org")
("texinfo" "info" "GNU Texinfo" "texinfo")
("docbook" "xml" "DocBook XML" "docbook")
("opendocument" "xml" "OpenDocument XML" "opendocument")
("odt" "odt" "OpenOffice text document" "odt")
("docx" "docx" "Word docx" "docx")
("epub" "epub" "EPUB book" "epub")
("epub3" "epub" "EPUB v3" "epub3")
("fb2" "fb" "FictionBook2 e-book" "fb2")
("asciidoc" "txt" "AsciiDoc" "asciidoc")
("slidy" "html" "Slidy HTML slide show" "slidy")
("slideous" "html" "Slideous HTML slide show" "slideous")
("dzslides" "html" "HTML5 slide show" "dzslides")
("s5" "html" "S5 HTML slide show" "s5")
("rtf" "rtf" "rich text format" "rtf"))
:function 'pm-default-shell-export-function
:sentinel 'pm-default-export-sentinel)
"Pandoc exporter"
:group 'polymode-export
:type 'object)
(provide 'polymode-export)

BIN
elpa/polymode-20170307.322/polymode-export.elc Normal file
View File

Binary file not shown.

872
elpa/polymode-20170307.322/polymode-methods.el Normal file
View File

@@ -0,0 +1,872 @@
(require 'polymode-core)
(require 'poly-lock)
;;; Initialization
(defgeneric pm-initialize (config)
"Initialize current buffer with CONFIG.")
(defmethod pm-initialize ((config pm-polymode))
;; fixme: (VS[06-03-2016]: probably not anymore) reinstalation leads to
;; infloop of poly-lock--fontify-region-original and others ... On startup with local
;; auto vars emacs reinstals the mode twice .. waf? Temporary fix: don't
;; install twice
(unless pm/polymode
(let ((chunkmode (clone (symbol-value (oref config :hostmode)))))
(let ((pm-initialization-in-progress t)
;; Set if nil! This allows unspecified host chunkmodes to be used in
;; minor modes.
(host-mode (or (oref chunkmode :mode)
(oset chunkmode :mode major-mode))))
(pm--mode-setup host-mode)
;; maybe: fixme: inconsistencies?
;; 1) Not calling config's :minor-mode (polymode function). But polymode
;; function calls pm-initialize, so it's probably ok.
(oset chunkmode -buffer (current-buffer))
(oset config -hostmode chunkmode)
(setq pm/polymode config
pm/chunkmode chunkmode
pm/type 'host)
(pm--common-setup)
(add-hook 'flyspell-incorrect-hook
'pm--flyspel-dont-highlight-in-chunkmodes nil t))
(pm--run-init-hooks config 'polymode-init-host-hook)
(pm--run-init-hooks chunkmode))))
(defmethod pm-initialize ((config pm-polymode-one))
(let ((pm-initialization-in-progress t))
(call-next-method))
(eval `(oset config -innermodes
(list (clone ,(oref config :innermode)))))
(pm--run-init-hooks config 'polymode-init-host-hook))
(defmethod pm-initialize ((config pm-polymode-multi))
(let ((pm-initialization-in-progress))
(call-next-method))
(oset config -innermodes
(mapcar (lambda (sub-name)
(clone (symbol-value sub-name)))
(oref config :innermodes)))
(pm--run-init-hooks config 'polymode-init-host-hook))
(defmethod pm-initialize ((chunkmode pm-chunkmode) &optional type mode)
;; run in chunkmode indirect buffer
(setq mode (or mode (pm--get-chunkmode-mode chunkmode type)))
(let ((pm-initialization-in-progress t)
(new-name (generate-new-buffer-name
(format "%s[%s]" (buffer-name (pm-base-buffer))
(replace-regexp-in-string "-mode" "" (symbol-name mode))))))
(rename-buffer new-name)
(pm--mode-setup (pm--get-existent-mode mode))
(pm--move-vars '(pm/polymode buffer-file-coding-system) (pm-base-buffer))
(setq pm/chunkmode chunkmode
pm/type type)
(funcall (oref pm/polymode :minor-mode))
(vc-find-file-hook)
(pm--common-setup)
(pm--run-init-hooks chunkmode 'polymode-init-inner-hook)))
(defun pm--mode-setup (mode &optional buffer)
;; General major-mode install. Should work for both indirect and base buffers.
;; PM objects are not yet initialized (pm/polymode, pm/chunkmode, pm/type)
(with-current-buffer (or buffer (current-buffer))
;; don't re-install if already there; polymodes can be used as minor modes.
(unless (eq major-mode mode)
(let ((polymode-mode t) ;major-modes might check this
;; (font-lock-fontified t)
;; Modes often call font-lock functions directly. We prevent that.
(font-lock-function 'ignore)
(font-lock-flush-function 'ignore)
(font-lock-fontify-buffer-function 'ignore)
;; Mode functions can do arbitrary things. We inhibt all PM hooks
;; because PM objects have not been setup yet.
(pm-allow-after-change-hook nil)
(pm-allow-fontification nil))
(condition-case-unless-debug err
(funcall mode)
(error (message "Polymode error (pm--mode-setup '%s): %s" mode (error-message-string err))))))
(setq polymode-mode t)
(current-buffer)))
(defun pm--common-setup (&optional buffer)
;; General buffer setup. Should work for indirect and base buffers. Assumes
;; that the buffer was fully prepared and objects like pm/polymode and
;; pm/chunkmode have been initialised. Return the BUFFER.
(with-current-buffer (or buffer (current-buffer))
;; INDENTATION
(when (and indent-line-function ; not that it should ever be nil...
(oref pm/chunkmode :protect-indent-line))
(setq pm--indent-line-function-original indent-line-function)
(setq-local indent-line-function 'pm-indent-line-dispatcher))
;; FONT LOCK
(setq-local font-lock-function 'poly-lock-mode)
(font-lock-mode t)
;; SYNTAX
;; We are executing `syntax-propertize' narrowed to span as per advice in
;; (polymode-compat.el)
(pm-around-advice syntax-begin-function 'pm-override-output-position) ; obsolete as of 25.1
(pm-around-advice syntax-propertize-extend-region-functions 'pm-override-output-cons)
;; flush ppss in all buffers and hook checks
(add-hook 'before-change-functions 'polymode-before-change-setup t t)
;; REST
(add-hook 'kill-buffer-hook 'pm--kill-indirect-buffer t t)
(add-hook 'post-command-hook 'polymode-post-command-select-buffer nil t)
(object-add-to-list pm/polymode '-buffers (current-buffer))
(current-buffer)))
(defun pm--run-init-hooks (object &optional emacs-hook)
(unless pm-initialization-in-progress
(when emacs-hook
(run-hooks emacs-hook))
(pm--run-hooks object :init-functions)))
(defun pm--run-hooks (object slot &rest args)
"Run hooks from SLOT of OBJECT and its parent instances.
Parents' hooks are run first."
(let ((inst object)
funs)
;; run hooks, parents first
(while inst
(setq funs (append (and (slot-boundp inst slot) ; don't cascade
(eieio-oref inst slot))
funs)
inst (and (slot-boundp inst :parent-instance)
(oref inst :parent-instance))))
(if args
(apply 'run-hook-with-args 'funs args)
(run-hooks 'funs))))
(defvar-local pm--killed-once nil)
(defun pm--kill-indirect-buffer ()
;; find-alternate-file breaks (https://github.com/vspinu/polymode/issues/79)
(let ((base (buffer-base-buffer)))
(when (and base (buffer-live-p base))
;; 'base' is non-nil in indirect buffers only
(set-buffer-modified-p nil)
(unless (buffer-local-value 'pm--killed-once base)
(with-current-buffer base
(setq pm--killed-once t))
(kill-buffer base)))))
(defgeneric pm-get-buffer-create (chunkmode &optional type)
"Get the indirect buffer associated with SUBMODE and
SPAN-TYPE. Should return nil if buffer has not yet been
installed. Also see `pm-get-span'.")
(defmethod pm-get-buffer-create ((chunkmode pm-chunkmode) &optional type)
(let ((buff (oref chunkmode -buffer)))
(or (and (buffer-live-p buff) buff)
(oset chunkmode -buffer
(pm--get-chunkmode-buffer-create chunkmode type)))))
(defmethod pm-get-buffer-create ((chunkmode pm-hbtchunkmode) &optional type)
(let ((buff (cond ((eq 'body type) (oref chunkmode -buffer))
((eq 'head type) (oref chunkmode -head-buffer))
((eq 'tail type) (oref chunkmode -tail-buffer))
(t (error "Don't know how to select buffer of type '%s' for chunkmode '%s' of class '%s'"
type (eieio-object-name chunkmode) (class-of chunkmode))))))
(if (buffer-live-p buff)
buff
(pm--set-chunkmode-buffer chunkmode type
(pm--get-chunkmode-buffer-create chunkmode type)))))
(defun pm--get-chunkmode-buffer-create (chunkmode type)
(let ((mode (pm--get-existent-mode
(pm--get-chunkmode-mode chunkmode type))))
(or
;; 1. look through existent buffer list
(loop for bf in (oref pm/polymode -buffers)
when (and (buffer-live-p bf)
(eq mode (buffer-local-value 'major-mode bf)))
return bf)
;; 2. create new
(with-current-buffer (pm-base-buffer)
(let* ((new-name (generate-new-buffer-name (buffer-name)))
(new-buffer (make-indirect-buffer (current-buffer) new-name)))
(with-current-buffer new-buffer
(pm-initialize chunkmode type mode))
new-buffer)))))
(defun pm--get-chunkmode-mode (obj type)
(with-slots (mode head-mode tail-mode) obj
(cond ((or (eq type 'body)
(and (eq type 'head)
(eq head-mode 'body))
(and (eq type 'tail)
(or (eq tail-mode 'body)
(and (or (null tail-mode)
(eq tail-mode 'head))
(eq head-mode 'body)))))
(oref obj :mode))
((or (and (eq type 'head)
(eq head-mode 'host))
(and (eq type 'tail)
(or (eq tail-mode 'host)
(and (or (null tail-mode)
(eq tail-mode 'head))
(eq head-mode 'host)))))
(oref (oref pm/polymode -hostmode) :mode))
((eq type 'head)
(oref obj :head-mode))
((eq type 'tail)
(if (or (null tail-mode)
(eq tail-mode 'head))
(oref obj :head-mode)
(oref obj :tail-mode)))
(t (error "type must be one of 'head 'tail 'body")))))
(defun pm--set-chunkmode-buffer (obj type buff)
"Assign BUFF to OBJ's slot(s) corresponding to TYPE."
(with-slots (-buffer head-mode -head-buffer tail-mode -tail-buffer) obj
(pcase (list type head-mode tail-mode)
(`(body body ,(or `nil `body))
(setq -buffer buff
-head-buffer buff
-tail-buffer buff))
(`(body ,_ body)
(setq -buffer buff
-tail-buffer buff))
(`(body ,_ ,_ )
(setq -buffer buff))
(`(head ,_ ,(or `nil `head))
(setq -head-buffer buff
-tail-buffer buff))
(`(head ,_ ,_)
(setq -head-buffer buff))
(`(tail ,_ ,(or `nil `head))
(setq -tail-buffer buff
-head-buffer buff))
(`(tail ,_ ,_)
(setq -tail-buffer buff))
(_ (error "type must be one of 'body, 'head or 'tail")))))
(defvar pm-move-vars-from-base '(buffer-file-name)
"Variables transferred from base buffer on buffer switch.")
(defvar pm-move-vars-from-old-buffer
'(buffer-invisibility-spec
selective-display overwrite-mode
;; truncation and word-wrap
truncate-lines word-wrap
line-move-visual truncate-partial-width-windows)
"Variables transferred from old buffer on buffer switch.")
(defgeneric pm-select-buffer (chunkmode span)
"Ask SUBMODE to select (make current) its indirect buffer
corresponding to the type of the SPAN returned by
`pm-get-span'.")
(defmethod pm-select-buffer ((chunkmode pm-chunkmode) span)
"Select the buffer associated with CHUNKMODE.
Install a new indirect buffer if it is not already installed. For
this method to work correctly, SUBMODE's class should define
`pm-get-buffer-create' methods."
(let* ((type (car span))
(buff (pm-get-buffer-create chunkmode type)))
(pm--select-existent-buffer buff)))
;; extracted for debugging purpose
(defun pm--select-existent-buffer (buffer)
(when (and (not (eq buffer (current-buffer)))
(buffer-live-p buffer))
(pm--move-vars pm-move-vars-from-base (pm-base-buffer) buffer)
(if pm--select-buffer-visibly
;; slow, visual selection
(pm--select-existent-buffer-visibly buffer)
;; fast set-buffer
(set-buffer buffer))))
;; extracted for debugging purpose
(defun pm--select-existent-buffer-visibly (new-buffer)
(let ((old-buffer (current-buffer))
(point (point))
(window-start (window-start))
(visible (pos-visible-in-window-p))
(vlm visual-line-mode)
(ractive (region-active-p))
;; text-scale-mode
(scale (and (boundp 'text-scale-mode) text-scale-mode))
(scale-amount (and (boundp 'text-scale-mode-amount) text-scale-mode-amount))
(hl-line (and (boundp 'hl-line-mode) hl-line-mode))
(mkt (mark t))
(bro buffer-read-only))
(when hl-line
(hl-line-mode -1))
(pm--move-vars pm-move-vars-from-old-buffer old-buffer new-buffer)
(pm--move-overlays old-buffer new-buffer)
(switch-to-buffer new-buffer)
(bury-buffer-internal old-buffer)
(unless (eq bro buffer-read-only)
(read-only-mode (if bro 1 -1)))
(pm--adjust-visual-line-mode vlm)
(when (and (boundp 'text-scale-mode-amount)
(not (and (eq scale text-scale-mode)
(= scale-amount text-scale-mode-amount))))
(if scale
(text-scale-set scale-amount)
(text-scale-set 0)))
;; fixme: what is the right way to do this ... activate-mark-hook?
(if (not ractive)
(deactivate-mark)
(set-mark mkt)
(activate-mark))
;; avoid display jumps
(goto-char point)
(when visible
(set-window-start (get-buffer-window buffer t) window-start))
(when hl-line
(hl-line-mode 1))
(run-hook-with-args 'polymode-switch-buffer-hook old-buffer new-buffer)
(pm--run-hooks pm/polymode :switch-buffer-functions old-buffer new-buffer)
(pm--run-hooks pm/chunkmode :switch-buffer-functions old-buffer new-buffer)))
(defun pm--move-overlays (from-buffer to-buffer)
(with-current-buffer from-buffer
(mapc (lambda (o)
(unless (eq 'linum-str (car (overlay-properties o)))
(move-overlay o (overlay-start o) (overlay-end o) to-buffer)))
(overlays-in 1 (1+ (buffer-size))))))
(defun pm--move-vars (vars from-buffer &optional to-buffer)
(let ((to-buffer (or to-buffer (current-buffer))))
(unless (eq to-buffer from-buffer)
(with-current-buffer to-buffer
(dolist (var vars)
(and (boundp var)
(set var (buffer-local-value var from-buffer))))))))
(defun pm--adjust-visual-line-mode (vlm)
(unless (eq visual-line-mode vlm)
(if (null vlm)
(visual-line-mode -1)
(visual-line-mode 1))))
(defmethod pm-select-buffer ((config pm-polymode-multi-auto) &optional span)
;; :fixme: pm-get-span on multi configs returns config as last object of
;; span. This unnatural and confusing. Same problem with pm-indent-line
(pm-select-buffer (pm--get-multi-chunk config span) span))
(defun pm--get-multi-chunk (config span)
;; fixme: cache somehow?
(if (null (car span))
(oref config -hostmode)
(let ((type (car span))
(proto (symbol-value (oref config :auto-innermode))))
(save-excursion
(goto-char (cadr span))
(unless (eq type 'head)
(let ((matcher (oref proto :head-reg)))
(if (functionp matcher)
(goto-char (car (funcall matcher -1)))
(re-search-backward matcher nil 'noerr))))
(let* ((str (or
;; a. try regexp matcher
(and (oref proto :retriever-regexp)
(re-search-forward (oref proto :retriever-regexp) nil t)
(match-string-no-properties (oref proto :retriever-num)))
;; b. otherwise function (fixme: these should be merged)
(and (oref proto :retriever-function)
(funcall (oref proto :retriever-function)))))
(mode (pm--get-mode-symbol-from-name str 'no-fallback)))
(if mode
;; Inferred body MODE serves as ID; this not need be the
;; case in the future and a generic id getter might replace
;; it. Currently head/tail/body indirect buffers are shared
;; across chunkmodes. This currently works ok. A more
;; general approach would be to track head/tails/body with
;; associated chunks. Then for example r hbt-chunk and elisp
;; hbt-chunk will not share head/tail buffers. There could
;; be even two r hbt-chunks with providing different
;; functionality and thus not even sharing body buffer.
(let ((name (concat (object-name-string proto) ":" (symbol-name mode))))
(or
;; a. loop through installed inner modes
(loop for obj in (oref config -auto-innermodes)
when (equal name (object-name-string obj))
return obj)
;; b. create new
(let ((innermode (clone proto name :mode mode)))
(object-add-to-list config '-auto-innermodes innermode)
innermode)))
;; else, use hostmode
(oref pm/polymode -hostmode)))))))
;;; SPAN MANIPULATION
(defgeneric pm-get-span (chunkmode &optional pos)
"Ask the CHUNKMODE for the span at point.
Return a list of three elements (TYPE BEG END OBJECT) where TYPE
is a symbol representing the type of the span surrounding
POS (head, tail, body). BEG and END are the coordinates of the
span. OBJECT is a sutable object which is 'responsable' for this
span. This is an object that could be dispached upon with
`pm-select-buffer', .. (fixme: complete this list).
Should return nil if there is no SUBMODE specific span around POS.")
(defmethod pm-get-span (chunkmode &optional pos)
"Return nil.
Base mode usually do not compute the span."
(unless chunkmode
(error "Dispatching `pm-get-span' on a nil object"))
nil)
(defmethod pm-get-span ((config pm-polymode) &optional pos)
"Apply pm-get-span on every element of chunkmodes slot of config object.
Return a cons (chunkmode . span), for which START is closest to
POS (and before it); i.e. the innermost span. POS defaults to
point."
(save-restriction
(widen)
;; fixme: host should be last, to take advantage of the chunkmodes computation
(let* ((smodes (cons (oref config -hostmode)
(oref config -innermodes)))
(start (point-min))
(end (point-max))
(pos (or pos (point)))
(span (list nil start end nil))
val)
(dolist (sm smodes)
(setq val (pm-get-span sm pos))
(when (and val
(or (> (nth 1 val) start)
(< (nth 2 val) end)))
(if (or (car val)
(null span))
(setq span val
start (nth 1 val)
end (nth 2 val))
;; nil car means outer chunkmode (usually host). And it can be an
;; intersection of spans returned by 2 different neighbour inner
;; chunkmodes. See rapport mode for an example
(setq start (max (nth 1 val)
(nth 1 span))
end (min (nth 2 val)
(nth 2 span)))
(setcar (cdr span) start)
(setcar (cddr span) end))))
(unless (and (<= start end) (<= pos end) (>= pos start))
(error "Bad polymode selection: span:%s pos:%s"
(list start end) pos))
(when (null (car span)) ; chunkmodes can compute the host span by returning nil
(setcar (last span) (oref config -hostmode)))
span)))
;; No need for this one so far. Basic method iterates through -innermodes
;; anyhow.
;; (defmethod pm-get-span ((config pm-polymode-multi) &optional pos))
(defmethod pm-get-span ((config pm-polymode-multi-auto) &optional pos)
(let ((span-other (call-next-method))
(proto (symbol-value (oref config :auto-innermode))))
(if (oref proto :head-reg)
(let ((span (pm--span-at-point (oref proto :head-reg)
(oref proto :tail-reg)
pos)))
(if (and span-other
(or (> (nth 1 span-other) (nth 1 span))
(< (nth 2 span-other) (nth 2 span))))
;; treat intersections with the host mode
(if (car span-other)
span-other ;not host
;; here, car span should better be nil; no explicit check
(setcar (cdr span-other) (max (nth 1 span-other) (nth 1 span)))
(setcar (cddr span-other) (min (nth 2 span-other) (nth 2 span)))
span-other)
(append span (list config)))) ;fixme: this returns config as last object
span-other)))
(defmethod pm-get-span ((chunkmode pm-hbtchunkmode) &optional pos)
"Return a list of the form (TYPE POS-START POS-END SELF).
TYPE can be 'body, 'head or 'tail. SELF is just a chunkmode object
in this case."
(with-slots (head-reg tail-reg head-mode tail-mode) chunkmode
(let* ((span (pm--span-at-point head-reg tail-reg pos))
(type (car span)))
(when (or (and (eq type 'head) (eq head-mode 'host))
(and (eq type 'tail) (or (eq tail-mode 'host)
(and (null tail-mode)
(eq head-mode 'host)))))
(setcar span nil))
(append span (list chunkmode)))))
(defmacro pm-create-indented-block-matchers (name regex)
"Defines 2 functions, each return a list of the start and end points of the
HEAD and TAIL portions of an indented block of interest, via some regex.
You can then use these functions in the defcustom pm-inner modes.
e.g.
(pm-create-indented-block-matchers 'slim-coffee' \"^[^ ]*\\(.*:? *coffee: *\\)$\")
creates the functions
pm-slim-coffee-head-matcher
pm-slim-coffee-tail-matcher
In the example below,
The head matcher will match against 'coffee:', returning the positions of the
start and end of 'coffee:'
The tail matcher will return a list (n, n) of the final characters is the block.
|<----- Uses this indentation to define the left edge of the 'block'
|
|<--->| This region is higlighted by the :head-mode in the block-matchers
| |
| |<----- the head matcher uses this column as the end of the head
| |
----:-----:-------------- example file -----------------------------------------
1| : :
2| coffee:
3| myCoffeeCode()
4| moreCode ->
5| do things
6| :
7| This is no longer in the block
8| :
----------------:---------------------------------------------------------------
--->|<----- this region of 0 width is highlighted by the :tail-mode
the 'block' ends after this column on line 5
All the stuff after the -end- of the head and before the start of the tail is
sent to the new mode for syntax highlighting."
(let* ((head-name (intern (format "pm-%s-head-matcher" name)))
(tail-name (intern (format "pm-%s-tail-matcher" name))))
`(progn
(defun ,head-name (ahead)
(when (re-search-forward ,regex nil t ahead)
(cons (match-beginning 1) (match-end 1))))
(defun ,tail-name (ahead)
(save-excursion
;; (cons (point-max) (point-max)))))))
(goto-char (car (,head-name 1)))
(let* ((block-col (current-indentation))
(posn (catch 'break
(while (not (eobp))
(forward-line 1)
(when (and (<= (current-indentation) block-col)
(not (progn
(beginning-of-line)
(looking-at "^[[:space:]]*$"))))
(throw 'break (point-at-bol))))
(throw 'break (point-max)))))
(cons posn posn)))))))
(defun pm--default-matcher (reg ahead)
(if (< ahead 0)
(if (re-search-backward reg nil t)
(cons (match-beginning 0) (match-end 0)))
(if (re-search-forward reg nil t)
(cons (match-beginning 0) (match-end 0)))))
;; fixme: there should be a simpler way... check the code and document
(defun pm--span-at-point-fun-fun (hd-matcher tl-matcher)
(save-excursion
(let ((pos (point))
(posh (funcall hd-matcher -1)))
(if (null posh)
;; special first chunk
(let ((posh1 (progn (goto-char (point-min))
(funcall hd-matcher 1))))
(if (and posh1
(<= (car posh1) pos)
(< pos (cdr posh1)))
(list 'head (car posh1) (cdr posh1))
(list nil (point-min) (or (car posh1)
(point-max)))))
(let ((post (progn (goto-char (car posh))
(or (funcall tl-matcher 1)
(cons (point-max) (point-max))))))
(if (and (<= (cdr posh) pos)
(< pos (car post)))
(list 'body (cdr posh) (car post))
(if (and (<= (car post) pos)
(< pos (cdr post)))
(list 'tail (car post) (cdr post))
(if (< pos (cdr post))
;; might be in the head
(progn
(goto-char (car post))
(let ((posh1 (funcall hd-matcher -1)))
(if (and (<= (car posh1) pos)
(< pos (cdr posh1)))
(list 'head (car posh1) (cdr posh1))
(list nil (cdr posh) (car posh1))))) ;; posh is point min, fixme: not true anymore?
(goto-char (cdr post))
(let ((posh1 (or (funcall hd-matcher 1)
(cons (point-max) (point-max)))))
(if (and posh
(<= (car posh1) pos )
(< pos (cdr posh1)))
(list 'head (car posh1) (cdr posh1))
(list nil (cdr post) (car posh1))))))))))))
(defun pm--span-at-point-reg-reg (head-matcher tail-matcher)
;; Guaranteed to produce non-0 length spans. If no span has been found
;; (head-matcher didn't match) return (nil (point-min) (point-max)).
;; xxx1 relate to the first ascending search
;; xxx2 relate to the second descending search
(save-excursion
(let* ((pos (point))
(head1-beg (and (re-search-backward head-matcher nil t)
(match-beginning 0)))
(head1-end (and head1-beg (match-end 0))))
(if head1-end
;; we know that (>= pos head1-end)
;; -----------------------
;; host](head)[body](tail)[host](head)
(let* ((tail1-beg (and (goto-char head1-end)
(re-search-forward tail-matcher nil t)
(match-beginning 0)))
(tail1-end (and tail1-beg (match-end 0)))
(tail1-beg (or tail1-beg (point-max)))
(tail1-end (or tail1-end (point-max))))
(if (or (< pos tail1-end)
(= tail1-end (point-max)))
(if (<= pos tail1-beg)
;; ------
;; host](head)[body](tail)[host](head))
(list 'body head1-end tail1-beg)
;; -----
;; host](head](body](tail)[host](head)
(list 'tail tail1-beg tail1-end))
;; ------------
;; host](head](body](tail)[host](head)
(let* ((head2-beg (or (and (re-search-forward head-matcher nil t)
(match-beginning 0))
(point-max))))
(if (<= pos head2-beg)
;; ------
;; host](head](body](tail)[host](head)
(list nil tail1-end head2-beg)
;; ------
;; host](head](body](tail)[host](head)
(list 'head head2-beg (match-end 0))))))
;; -----------
;; host](head)[body](tail)[host
(let ((head2-beg (and (goto-char (point-min))
(re-search-forward head-matcher nil t)
(match-beginning 0))))
(if (null head2-beg)
;; no span found
(list nil (point-min) (point-max))
(if (<= pos head2-beg)
;; -----
;; host](head)[body](tail)[host
(list nil (point-min) head2-beg)
;; ------
;; host](head)[body](tail)[host
(list 'head head2-beg (match-end 0)))))))))
(defun pm--span-at-point (head-matcher tail-matcher &optional pos)
"Basic span detector with head/tail.
Either of HEAD-MATCHER and TAIL-MATCHER can be a regexp or a
function. When a function the matcher must accept one argument
that can take either values 1 (forwards search) or -1 (backward
search). This function must return either nil (no match) or
a (cons BEG END) representing the span of the head or tail
respectively. See `pm--default-matcher' for an example.
Return (type span-start span-end) where type is one of the
follwoing symbols:
nil - pos is between point-min and head-reg, or between tail-reg and point-max
body - pos is between head-reg and tail-reg (exclusively)
head - head span
tail - tail span"
;; ! start of the span is part of the span !
(save-restriction
(widen)
(goto-char (or pos (point)))
(cond ((and (stringp head-matcher)
(stringp tail-matcher))
(pm--span-at-point-reg-reg head-matcher tail-matcher))
((and (stringp head-matcher)
(functionp tail-matcher))
(pm--span-at-point-fun-fun
(lambda (ahead) (pm--default-matcher head-matcher ahead))
tail-matcher))
((and (functionp head-matcher)
(stringp tail-matcher))
(pm--span-at-point-fun-fun
head-matcher
(lambda (ahead) (pm--default-matcher tail-matcher ahead))))
((and (functionp head-matcher)
(functionp tail-matcher))
(pm--span-at-point-fun-fun head-matcher tail-matcher))
(t (error "head and tail matchers should be either regexp strings or functions")))))
;;; INDENT
(defun pm-indent-line-dispatcher ()
"Dispatch methods indent methods on current span."
(let ((span (pm-get-innermost-span))
(inhibit-read-only t))
(pm-indent-line (car (last span)) span)))
(defgeneric pm-indent-line (&optional chunkmode span)
"Indent current line.
Protect and call original indentation function associated with
the chunkmode.")
(defun pm--indent-line (span)
(let (point)
(save-current-buffer
(pm-set-buffer span)
(pm-with-narrowed-to-span span
(funcall pm--indent-line-function-original)
(setq point (point))))
(goto-char point)))
(defmethod pm-indent-line ((chunkmode pm-chunkmode) &optional span)
(pm--indent-line span))
(defmethod pm-indent-line ((chunkmode pm-hbtchunkmode) &optional span)
"Indent line in inner chunkmodes.
When point is at the beginning of head or tail, use parent chunk
to indent."
(let ((pos (point))
(span (or span (pm-get-innermost-span)))
delta)
(unwind-protect
(cond
;; 1. in head or tail (we assume head or tail fit in one line for now)
((or (eq 'head (car span))
(eq 'tail (car span)))
(goto-char (nth 1 span))
(setq delta (- pos (point)))
(when (not (bobp))
(let ((prev-span (pm-get-innermost-span (1- pos))))
(if (and (eq 'tail (car span))
(eq (point) (save-excursion (back-to-indentation) (point))))
;; if tail is first on the line, indent as head
(indent-to (pm--head-indent prev-span))
(pm--indent-line prev-span)))))
;; 2. body
(t
(back-to-indentation)
(if (> (nth 1 span) (point))
;; first body line in the same line with header (re-indent at indentation)
(pm-indent-line-dispatcher)
(setq delta (- pos (point)))
(pm--indent-line span)
(let ((fl-indent (pm--first-line-indent span)))
(if fl-indent
(when (bolp)
;; Not first line. Indent only when original indent is at
;; 0. Otherwise it's a continuation indentation and we assume
;; the original function did it correctly with respect to
;; previous lines.
(indent-to fl-indent))
;; First line. Indent with respect to header line.
(indent-to
(+ (- (point) (point-at-bol)) ;; non-0 if code in header line
(pm--head-indent span) ;; indent with respect to header line
(oref chunkmode :indent-offset))))))))
;; keep point on same characters
(when (and delta (> delta 0))
(goto-char (+ (point) delta))))))
(defun pm--first-line-indent (&optional span)
(save-excursion
(let ((pos (point)))
(goto-char (nth 1 (or span (pm-get-innermost-span))))
(goto-char (point-at-eol))
(skip-chars-forward " \t\n")
(let ((indent (- (point) (point-at-bol))))
(when (< (point-at-eol) pos)
indent)))))
(defun pm--head-indent (&optional span)
(save-excursion
(goto-char (nth 1 (or span (pm-get-innermost-span))))
(back-to-indentation)
(- (point) (point-at-bol))))
(defmethod pm-indent-line ((config pm-polymode-multi-auto) &optional span)
;; fixme: pm-polymode-multi-auto is not a chunk, pm-get-innermost-span should
;; not return it in the first place
;; (pm-set-buffer span)
;; (pm-indent-line pm/chunkmode span))
(pm-indent-line (pm--get-multi-chunk config span) span))
;;; FACES
(defgeneric pm-get-adjust-face (chunkmode &optional type))
(defmethod pm-get-adjust-face ((chunkmode pm-chunkmode) &optional type)
(oref chunkmode :adjust-face))
(defmethod pm-get-adjust-face ((chunkmode pm-hbtchunkmode) &optional type)
(setq type (or type pm/type))
(cond ((eq type 'head)
(oref chunkmode :head-adjust-face))
((eq type 'tail)
(if (eq 'head (oref pm/chunkmode :tail-adjust-face))
(oref pm/chunkmode :head-adjust-face)
(oref pm/chunkmode :tail-adjust-face)))
(t (oref pm/chunkmode :adjust-face))))
(defun pm--get-adjusted-background (prop)
;; if > lighten on dark backgroun. Oposite on light.
(color-lighten-name (face-background 'default)
(if (eq (frame-parameter nil 'background-mode) 'light)
(- prop) ;; darken
prop)))
(defun pm--adjust-chunk-face (beg end face)
;; propertize 'face of the region by adding chunk specific configuration
(interactive "r")
(when face
(with-current-buffer (current-buffer)
(let ((face (or (and (numberp face)
(list (cons 'background-color
(pm--get-adjusted-background face))))
face))
(pchange nil))
;; (while (not (eq pchange end))
;; (setq pchange (next-single-property-change beg 'face nil end))
;; (put-text-property beg pchange 'face
;; `(,face ,@(get-text-property beg 'face)))
;; (setq beg pchange))
(font-lock-prepend-text-property beg end 'face face)))))
(provide 'polymode-methods)

BIN
elpa/polymode-20170307.322/polymode-methods.elc Normal file
View File

Binary file not shown.

6
elpa/polymode-20170307.322/polymode-pkg.el Normal file
View File

@@ -0,0 +1,6 @@
(define-package "polymode" "20170307.322" "Versatile multiple modes with extensive literate programming support"
'((emacs "24"))
:url "https://github.com/vitoshka/polymode")
;; Local Variables:
;; no-byte-compile: t
;; End:

3
elpa/polymode-20170307.322/polymode-tangle.el Normal file
View File

@@ -0,0 +1,3 @@
(defgroup polymode-tangle nil
"Polymode Tanglers"
:group 'polymode)

BIN
elpa/polymode-20170307.322/polymode-tangle.elc Normal file
View File

Binary file not shown.

252
elpa/polymode-20170307.322/polymode-weave.el Normal file
View File

@@ -0,0 +1,252 @@
;; -*- lexical-binding: t -*-
(require 'polymode-core)
(require 'polymode-classes)
(defgroup polymode-weave nil
"Polymode Weavers"
:group 'polymode)
(defcustom polymode-weave-output-file-format "%s[woven]"
"Format of the weaved files.
%s is substituted with the current file name sans extension."
:group 'polymode-weave
:type 'string)
(defclass pm-weaver (pm-root)
((from-to
:initarg :from-to
:initform '()
:type list
:custom list
:documentation
"Input-output specifications. An alist with elements of the
form (id reg-from ext-to doc command) or (id . selector).
In both cases ID is the unique identifier of the spec. In
the former case REG-FROM is a regexp used to identify if
current file can be weaved with the spec. EXT-TO is the
extension of the output file. DOC is a short help string
used for interactive completion and messages. COMMAND is a
weaver specific specific command. It can contain the
following format specs:
%i - input file (no dir)
%I - input file (full path)
%o - output file (no dir)
%O - output file (full path)
%b - output file (base name only)
%t - 4th element of the :to spec
When specification is of the form (id . selector), SELECTOR
is a function of variable arguments that accepts at least
one argument ACTION. This function is called in a buffer
visiting input file. ACTION is a symbol and can one of the
following:
match - must return non-nil if this specification
applies to the file that current buffer is visiting,
or :nomatch if specification does not apply.
regexp - return a string which is used to match input
file name. If nil, `match' selector must return
non-nil value. This selector is ignored if `match'
returned non-nil.
output-file - return an output file name or a list of
file names. Receives input-file as argument. If this
command returns nil, the output is built from the
input file name and value of 'output-ext command.
This selector can also return a function. This
function will be called in the callback or sentinel of
the weaving process after the weaving was
completed. This function should sniff the output of
the process for errors or file names. It must return a
file name, a list of file names or nil if no such
files have been detected.
ext - extension of output file. If nil and
`output' also returned nil, the exporter won't be able
to identify the output file and no automatic display
or preview will be available.
doc - return documentation string
command - return a string to be used instead of
the :from command. If nil, :from spec command is used.")
(function
:initarg :function
:initform (lambda (command id)
(error "No weaving function declared for this weaver"))
:type (or symbol function)
:documentation
"Function to perform the weaving. Must take 2 arguments
COMMAND and ID. COMMAND is the 5th argument of :from-to spec
with all the formats substituted. ID is the id the
corresponding element in :from-to spec.
If this function returns a filename that file will be
displayed to the user."))
"Root weaver class.")
(defclass pm-callback-weaver (pm-weaver)
((callback
:initarg :callback
:initform (lambda (&optional rest)
(error "No callback defined for this weaver."))
:type (or symbol function)
:documentation
"Callback function to be called by :function. There is no
default callback. Callbacks must return the output file."))
"Class to represent weavers that call processes spanned by
Emacs.")
(defclass pm-shell-weaver (pm-weaver)
((function
:initform 'pm-default-shell-weave-function)
(sentinel
:initarg :sentinel
:initform 'pm-default-shell-weave-sentinel
:type (or symbol function)
:documentation
"Sentinel function to be called by :function when a shell
call is involved. Sentinel must return the output file
name.")
(quote
:initarg :quote
:initform nil
:type boolean
:documentation "Non-nil when file arguments must be quoted
with `shell-quote-argument'."))
"Class for weavers that call external processes.")
(defun pm-default-shell-weave-function (command sentinel from-to-id &rest args)
"Run weaving command interactively.
Run command in a buffer (in comint-shell-mode) so that it accepts
user interaction. This is a default function in all weavers
that call a shell command"
(pm--run-shell-command command sentinel "*polymode weave*"
(concat "weaving " from-to-id " with command:\n\n "
command "\n\n")))
;;; METHODS
(declare-function pm-export "polymode-export")
(defgeneric pm-weave (weaver from-to-id &optional ifile)
"Weave current FILE with WEAVER.
WEAVER is an object of class `pm-weaver'. EXPORT is a list of the
form (FROM TO) suitable to be passed to `polymode-export'. If
EXPORT is provided, corresponding exporter's (from to)
specification will be called.")
(defmethod pm-weave ((weaver pm-weaver) from-to-id &optional ifile)
(pm--weave-internal weaver from-to-id ifile))
(defmethod pm-weave ((weaver pm-callback-weaver) fromto-id &optional ifile)
(let ((cb (pm--wrap-callback weaver :callback ifile))
;; with transitory output, callback might not run
(pm--export-spec (and pm--output-not-real pm--export-spec)))
(pm--process-internal weaver fromto-id nil ifile cb)))
(defmethod pm-weave ((weaver pm-shell-weaver) fromto-id &optional ifile)
(let ((cb (pm--wrap-callback weaver :sentinel ifile))
;; with transitory output, callback might not run
(pm--export-spec (and pm--output-not-real pm--export-spec)))
(pm--process-internal weaver fromto-id nil ifile cb (oref weaver :quote))))
;; UI
(defvar pm--weaver-hist nil)
(defvar pm--weave:fromto-hist nil)
(defvar pm--weave:fromto-last nil)
(defun polymode-weave (&optional from-to)
"Weave current file.
First time this command is called in a buffer the user is asked
for the weaver to use from a list of known weavers.
FROM-TO is the id of the specification declared in :from-to slot
of the current weaver. If the weaver hasn't been set yet, set the
weaver with `polymode-set-weaver'. You can always change the
weaver manually by invoking `polymode-set-weaver'.
If `from-to' dismissing detect automatically based on current
weaver :from-to specifications. If this detection is ambiguous
ask the user.
When `from-to' is universal argument ask user for specification
for the specification. See also `pm-weaveer' for the complete
specification."
(interactive "P")
(cl-flet ((name.id (el) (cons (funcall (cdr el) 'doc) (car el))))
(let* ((weaver (symbol-value (or (oref pm/polymode :weaver)
(polymode-set-weaver))))
(fname (file-name-nondirectory buffer-file-name))
(case-fold-search t)
(opts (mapcar #'name.id (pm--selectors weaver :from-to)))
(ft-id
(cond
;; A. guess from-to spec
((null from-to)
(or
;; 1. repeated weaving; don't ask
pm--weave:fromto-last
;; 2. select :from entries which match to current file
(let ((matched (cl-loop for el in (pm--selectors weaver :from-to)
when (pm--selector-match (cdr el))
collect (name.id el))))
(when matched
(if (> (length matched) 1)
(cdr (pm--completing-read "Multiple `from-to' specs matched. Choose one: " matched))
(cdar matched))))
;; 3. nothing matched, ask
(let* ((prompt (format "No `from-to' specs matched. Choose one: "
(file-name-extension fname) (eieio-object-name weaver)))
(sel (pm--completing-read prompt opts nil t nil 'pm--weave:fromto-hist)))
(cdr sel))))
;; B. C-u, force a :from-to spec
((equal from-to '(4))
(cdr (if (> (length opts) 1)
(pm--completing-read "Weaver type: " opts nil t nil 'pm--weave:fromto-hist)
(car opts))))
;; C. string
((stringp from-to)
(if (assoc from-to (oref weaver :from-to))
from-to
(error "Cannot find `from-to' spec '%s' in %s weaver"
from-to (eieio-object-name weaver))))
(t (error "'from-to' argument must be nil, universal argument or a string")))))
(setq-local pm--weave:fromto-last ft-id)
(pm-weave weaver ft-id))))
(defmacro polymode-register-weaver (weaver defaultp &rest configs)
"Add WEAVER to :weavers slot of all config objects in CONFIGS.
When DEFAULT? is non-nil, also make weaver the default WEAVER for
each polymode in CONFIGS."
`(dolist (pm ',configs)
(object-add-to-list (symbol-value pm) :weavers ',weaver)
(when ,defaultp (oset (symbol-value pm) :weaver ',weaver))))
(defun polymode-set-weaver ()
(interactive)
(unless pm/polymode
(error "No pm/polymode object found. Not in polymode buffer?"))
(let* ((weavers (pm--abrev-names
(delete-dups (pm--oref-with-parents pm/polymode :weavers))
"pm-weaver/"))
(sel (pm--completing-read "Choose weaver: " weavers nil t nil 'pm--weaver-hist))
(out (intern (cdr sel))))
(setq-local pm--weaver:from-last nil)
(setq-local pm--weaver:to-last nil)
(oset pm/polymode :weaver out)
out))
(provide 'polymode-weave)

BIN
elpa/polymode-20170307.322/polymode-weave.elc Normal file
View File

Binary file not shown.

449
elpa/polymode-20170307.322/polymode.el Normal file
View File

@@ -0,0 +1,449 @@
;;; polymode.el --- Versatile multiple modes with extensive literate programming support
;;
;; Filename: polymode.el
;; Author: Spinu Vitalie
;; Maintainer: Spinu Vitalie
;; Copyright (C) 2013-2014, Spinu Vitalie, all rights reserved.
;; Version: 1.0
;; Package-Requires: ((emacs "24"))
;; URL: https://github.com/vitoshka/polymode
;; Keywords: emacs
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Extensible, fast, objected-oriented multimode specifically designed for
;; literate programming. Extensible support for weaving, tangling and export.
;;
;; Usage: https://github.com/vspinu/polymode
;;
;; Design new polymodes: https://github.com/vspinu/polymode/tree/master/modes
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(require 'polymode-core)
(require 'polymode-classes)
(require 'polymode-methods)
(require 'polymode-compat)
(require 'polymode-debug)
(require 'polymode-export)
(require 'polymode-weave)
(require 'poly-lock)
(require 'poly-base)
(defcustom polymode-prefix-key "\M-n"
"Prefix key for the polymode mode keymap.
Not effective after loading the polymode library."
:group 'polymode
:type '(choice string vector))
(defvar polymode-mode-map
(let ((map (make-sparse-keymap)))
(define-key map polymode-prefix-key
(let ((map (make-sparse-keymap)))
;; navigation
(define-key map "\C-n" 'polymode-next-chunk)
(define-key map "\C-p" 'polymode-previous-chunk)
(define-key map "\C-\M-n" 'polymode-next-chunk-same-type)
(define-key map "\C-\M-p" 'polymode-previous-chunk-same-type)
;; chunk manipulation
(define-key map "\M-k" 'polymode-kill-chunk)
(define-key map "\M-m" 'polymode-mark-or-extend-chunk)
(define-key map "\C-t" 'polymode-toggle-chunk-narrowing)
(define-key map "\M-i" 'polymode-insert-new-chunk)
;; backends
(define-key map "e" 'polymode-export)
(define-key map "E" 'polymode-set-exporter)
(define-key map "w" 'polymode-weave)
(define-key map "W" 'polymode-set-weaver)
(define-key map "t" 'polymode-tangle)
(define-key map "T" 'polymode-set-tangler)
(define-key map "$" 'polymode-show-process-buffer)
;; todo: add polymode-goto-process-buffer
map))
(define-key map [menu-bar Polymode]
(cons "Polymode"
(let ((map (make-sparse-keymap "Polymode")))
(define-key-after map [next]
'(menu-item "Next chunk" polymode-next-chunk))
(define-key-after map [previous]
'(menu-item "Previous chunk" polymode-previous-chunk))
(define-key-after map [next-same]
'(menu-item "Next chunk same type" polymode-next-chunk-same-type))
(define-key-after map [previous-same]
'(menu-item "Previous chunk same type" polymode-previous-chunk-same-type))
(define-key-after map [mark]
'(menu-item "Mark or extend chunk" polymode-mark-or-extend-chunk))
(define-key-after map [kill]
'(menu-item "Kill chunk" polymode-kill-chunk))
(define-key-after map [insert]
'(menu-item "Insert new chunk" polymode-insert-new-chunk))
map)))
map)
"The default minor mode keymap that is active in all polymode
modes.")
;;; COMMANDS
(defvar *span*)
(defun polymode-next-chunk (&optional N)
"Go COUNT chunks forwards.
Return, how many chucks actually jumped over."
(interactive "p")
(let* ((sofar 0)
(back (< N 0))
(beg (if back (point-min) (point)))
(end (if back (point) (point-max)))
(N (if back (- N) N)))
(condition-case nil
(pm-map-over-spans
(lambda ()
(unless (memq (car *span*) '(head tail))
(when (>= sofar N)
(signal 'quit nil))
(setq sofar (1+ sofar))))
beg end nil back)
(quit (when (looking-at "\\s *$")
(forward-line)))
(pm-switch-to-buffer))
sofar))
;;fixme: problme with long chunks .. point is recentered
;;todo: merge into next-chunk
(defun polymode-previous-chunk (&optional N)
"Go COUNT chunks backwards .
Return, how many chucks actually jumped over."
(interactive "p")
(polymode-next-chunk (- N)))
(defun polymode-next-chunk-same-type (&optional N)
"Go to next COUNT chunk.
Return, how many chucks actually jumped over."
(interactive "p")
(let* ((sofar 0)
(back (< N 0))
(beg (if back (point-min) (point)))
(end (if back (point) (point-max)))
(N (if back (- N) N))
this-type this-class)
(condition-case nil
(pm-map-over-spans
(lambda ()
(unless (memq (car *span*) '(head tail))
(when (and (equal this-class
(eieio-object-name (car (last *span*))))
(eq this-type (car *span*)))
(setq sofar (1+ sofar)))
(unless this-class
(setq this-class (eieio-object-name (car (last *span*)))
this-type (car *span*)))
(when (>= sofar N)
(signal 'quit nil))))
beg end nil back)
(quit (when (looking-at "\\s *$")
(forward-line)))
(pm-switch-to-buffer))
sofar))
(defun polymode-previous-chunk-same-type (&optional N)
"Go to previus COUNT chunk.
Return, how many chucks actually jumped over."
(interactive "p")
(polymode-next-chunk-same-type (- N)))
(defun pm--kill-span (types)
(let ((span (pm-get-innermost-span)))
(when (memq (car span) types)
(delete-region (nth 1 span) (nth 2 span)))))
(defun polymode-kill-chunk ()
"Kill current chunk"
(interactive)
(pcase (pm-get-innermost-span)
(`(,(or `nil `host) ,beg ,end ,_) (delete-region beg end))
(`(body ,beg ,end ,_)
(goto-char beg)
(pm--kill-span '(body))
(pm--kill-span '(head tail))
(pm--kill-span '(head tail)))
(`(tail ,beg ,end ,_)
(if (eq beg (point-min))
(delete-region beg end)
(goto-char (1- beg))
(polymode-kill-chunk)))
(`(head ,_ ,end ,_)
(goto-char end)
(polymode-kill-chunk))
(_ (error "canoot find chunk to kill"))))
(defun polymode-toggle-chunk-narrowing ()
"Toggle narrowing of the current chunk."
(interactive)
(if (buffer-narrowed-p)
(progn (widen) (recenter))
(pcase (pm-get-innermost-span)
(`(head ,_ ,end ,_)
(goto-char end)
(pm-narrow-to-span))
(`(tail ,beg ,end ,_)
(if (eq beg (point-min))
(error "Invalid chunk")
(goto-char (1- beg))
(pm-narrow-to-span)))
(_ (pm-narrow-to-span)))))
(defun polymode-mark-or-extend-chunk ()
(interactive)
(error "Not implemented yet"))
(defun polymode-insert-new-chunk ()
(interactive)
(error "Not implemented yet"))
(defun polymode-show-process-buffer ()
(interactive)
(let ((buf (cl-loop for b being the buffers
if (buffer-local-value 'pm--process-buffer b)
return b)))
(if buf
(pop-to-buffer buf `(nil . ((inhibit-same-window . ,pop-up-windows))))
(message "No polymode process buffers found."))))
;;; HOOKS
;; In addition to these hooks there is poly-lock-after-change which is placed in
;; after-change-functions. See poly-lock.el
(defun polymode-post-command-select-buffer ()
"Select the appropriate (indirect) buffer corresponding to point's context.
This funciton is placed in local `post-command-hook'."
(when (and pm-allow-post-command-hook
polymode-mode
pm/chunkmode)
(condition-case err
(pm-switch-to-buffer)
(error (message "(pm-switch-to-buffer %s): %s"
(point) (error-message-string err))))))
(defun polymode-before-change-setup (beg end)
"Run `syntax-ppss-flush-cache' in all polymode buffers.
This function is placed in `before-change-functions' hook."
;; Modification hooks are run only in current buffer and not in other (base or
;; indirect) buffers. Thus some actions like flush of ppss cache must be taken
;; care explicitly. We run some safety hooks checks here as well.
(dolist (buff (oref pm/polymode -buffers))
;; The following two checks are unnecessary by poly-lock design, but we are
;; checking them here, just in case.
;; VS[06-03-2016]: `fontification-functions' probably should be checked as well.
(when (memq 'font-lock-after-change-function after-change-functions)
(remove-hook 'after-change-functions 'font-lock-after-change-function t))
(when (memq 'jit-lock-after-change after-change-functions)
(remove-hook 'after-change-functions 'jit-lock-after-change t))
(with-current-buffer buff
;; now `syntax-ppss-flush-cache is harmless, but who knows in the future.
(when (memq 'syntax-ppss-flush-cache before-change-functions)
(remove-hook 'before-change-functions 'syntax-ppss-flush-cache t))
(syntax-ppss-flush-cache beg end))))
;;; DEFINE
;;;###autoload
(defmacro define-polymode (mode config &optional keymap &rest body)
"Define a new polymode MODE.
This macro defines command MODE and an indicator variable MODE
which becomes t when MODE is active and nil otherwise.
MODE command is similar to standard emacs major modes and it can
be used in `auto-mode-alist'. Standard hook MODE-hook is run at
the end of the initialization of each polymode buffer (both
indirect and base buffers). Additionally MODE-map is created
based on the CONFIG's :map slot and the value of the :keymap
argument; see below.
CONFIG is a name of a config object representing the mode.
MODE command can also be use as a minor mode. Current major mode
is not reinitialized if it coincides with the :mode slot of
CONFIG object or if the :mode slot is nil.
BODY contains code to be executed after the complete
initialization of the polymode (`pm-initialize') and before
running MODE-hook. Before the BODY code, you can write keyword
arguments, i.e. alternating keywords and values. The following
special keywords are supported:
:lighter SPEC Optional LIGHTER is displayed in the mode line when
the mode is on. If omitted, it defaults to
the :lighter slot of CONFIG object.
:keymap MAP Same as the KEYMAP argument.
If nil, a new MODE-map keymap is created what
directly inherits from the keymap defined by
the :map slot of CONFIG object. In most cases it
is a simple map inheriting form
`polymode-mode-map'. If t or an alist (of
bindings suitable to be passed to
`easy-mmode-define-keymap') a keymap MODE-MAP is
build by mergin this alist with the :map
specification of the CONFIG object. If a symbol,
it should be a variable whose value is a
keymap. No MODE-MAP is automatically created in
the latter case and :map slot of the CONFIG
object is ignored.
:after-hook A single lisp form which is evaluated after the mode hooks
have been run. It should not be quoted."
(declare
(debug (&define name name
[&optional [&not keywordp] sexp]
[&rest [keywordp sexp]]
def-body)))
(when (keywordp keymap)
(push keymap body)
(setq keymap nil))
(let* ((last-message (make-symbol "last-message"))
(mode-name (symbol-name mode))
(pretty-name (concat
(replace-regexp-in-string "poly-\\|-mode" "" mode-name)
" polymode"))
(keymap-sym (intern (concat mode-name "-map")))
(hook (intern (concat mode-name "-hook")))
(extra-keywords nil)
(after-hook nil)
keyw lighter)
;; Check keys.
(while (keywordp (setq keyw (car body)))
(setq body (cdr body))
(pcase keyw
(`:lighter (setq lighter (purecopy (pop body))))
(`:keymap (setq keymap (pop body)))
(`:after-hook (setq after-hook (pop body)))
(_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
`(progn
:autoload-end
;; Define the variable to enable or disable the mode.
(defvar ,mode nil ,(format "Non-nil if %s mode is enabled." pretty-name))
(make-variable-buffer-local ',mode)
(let* ((keymap ,keymap)
(config ',config)
(lighter (or ,lighter
(oref (symbol-value config) :lighter)))
key-alist)
(unless (keymapp keymap)
;; keymap is either nil or list. Iterate through parents' :map slot
;; and gather keys.
(setq key-alist keymap)
(let* ((pi (symbol-value config))
map mm-name)
(while pi
(setq map (and (slot-boundp pi :map)
(oref pi :map)))
(if (and (symbolp map)
(keymapp (symbol-value map)))
;; If one of the parent's :map is a keymap, use it as our
;; keymap and stop further descent.
(setq keymap (symbol-value map)
pi nil)
;; Descend to next parent and append the key list to key-alist
(setq pi (and (slot-boundp pi :parent-instance)
(oref pi :parent-instance))
key-alist (append key-alist map))))))
(unless keymap
;; If we couldn't figure out the original keymap:
(setq keymap polymode-mode-map))
;; Define the minor-mode keymap:
(defvar ,keymap-sym
(easy-mmode-define-keymap key-alist nil nil `(:inherit ,keymap))
,(format "Keymap for %s." pretty-name))
;; The actual mode function:
(defun ,mode (&optional arg) ,(format "%s.\n\n\\{%s}" pretty-name keymap-sym)
(interactive)
(unless ,mode
(let ((,last-message (current-message)))
(unless pm/polymode ;; don't reinstall for time being
(let ((config (clone ,config)))
(oset config :minor-mode ',mode)
(pm-initialize config)))
;; set our "minor" mode
(setq ,mode t)
,@body
(run-hooks ',hook)
;; Avoid overwriting a message shown by the body,
;; but do overwrite previous messages.
(when (and (called-interactively-p 'any)
(or (null (current-message))
(not (equal ,last-message
(current-message)))))
(message ,(format "%s enabled" pretty-name)))
,@(when after-hook `(,after-hook))
(force-mode-line-update)))
;; Return the new setting.
,mode)
(add-minor-mode ',mode lighter ,keymap-sym)))))
(define-minor-mode polymode-minor-mode
"Polymode minor mode, used to make everything work."
nil " PM" polymode-mode-map)
(define-derived-mode poly-head-tail-mode prog-mode "HeadTail"
"Default major mode for polymode head and tail spans.")
(define-derived-mode poly-fallback-mode prog-mode "FallBack"
;; fixme:
;; 1. doesn't work as fallback for hostmode
;; 2. highlighting is lost (Rnw with inner fallback)
"Default major mode for modes which were not found.
This is better than fundamental-mode because it allows running
globalized minor modes and can run user hooks.")
;;; FONT-LOCK
;; indulge elisp font-lock :)
(dolist (mode '(emacs-lisp-mode lisp-interaction-mode))
(font-lock-add-keywords
mode
'(("(\\(define-polymode\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"
(1 font-lock-keyword-face)
(2 font-lock-variable-name-face)))))
(provide 'polymode)
;;; polymode.el ends here

BIN
elpa/polymode-20170307.322/polymode.elc Normal file
View File

Binary file not shown.