move emacs related

This commit is contained in:
Rongsong Shen 2018-04-07 10:54:04 +08:00
parent 8b3288ab04
commit 577b5827cd
185 changed files with 34354 additions and 0 deletions

View File

@ -0,0 +1,28 @@
#+TITLE: Emacs Configuration
#+AUTHOR: Rongsong Shen
#+EMAIL: rshen@shenrs.eu
#+OPTIONS: ^:{} H:2
#+STARTUP: showall
* Initialize Emacs Package System
** Using Emacs package mirror in China
#+BEGIN_SRC emacs-lisp
(package-initialize)
(setq package-archives '(("gnu_cn" . "http://mirrors.tuna.tsinghua.edu.cn/elpa/gnu/")
("melpa_cn" . "http://mirrors.tuna.tsinghua.edu.cn/elpa/melpa/")))
#+END_SRC
** Using use-package as basic
#+BEGIN_SRC emacs-lisp
(unless (package-installed-p 'use-package)
(package-refresh-contents)
(package-install 'use-package))
(require 'use-package)
(setq use-package-always-ensure t)
#+END_SRC
# Local Variables:
# End:

16
emacs.config.org/init.el Normal file
View File

@ -0,0 +1,16 @@
;; Using org as the configuration file of Emacs
;;
(defun load-config (name)
(let ((config-org (concat name ".org"))
(config-el (concat name ".el")))
(when (file-exists-p config-org)
(if (or (not (file-exists-p config-el))
(file-newer-than-file-p config-org
config-el))
(org-babel-load-file config-org)
(load-file config-el)))))
(require 'org)
(load-config "~/.emacs.d/emacs")

BIN
jars/ditaa.jar Normal file

Binary file not shown.

BIN
jars/eclim_2.3.2.jar Normal file

Binary file not shown.

BIN
jars/mathtoweb.jar Normal file

Binary file not shown.

BIN
jars/plantuml.jar Normal file

Binary file not shown.

View File

@ -0,0 +1,29 @@
#+TITLE: customized layer
#+HTML_HEAD_EXTRA: <link rel="stylesheet" type="text/css" href="../css/readtheorg.css" />
#+CAPTION: logo
# The maximum height of the logo should be 200 pixels.
[[img/customized.png]]
* Table of Contents :TOC_4_org:noexport:
- [[Description][Description]]
- [[Install][Install]]
- [[Key bindings][Key bindings]]
* Description
This layer does wonderful things:
- thing01
* Install
To use this contribution add it to your =~/.spacemacs=
#+begin_src emacs-lisp
(setq-default dotspacemacs-configuration-layers '(customized))
#+end_src
* Key bindings
| Key Binding | Description |
|-----------------+----------------|
| ~<SPC> x x x~ | Does thing01 |

View File

@ -0,0 +1,2 @@
(defvar my-default-c-style nil
"Choose the default style of c mode")

View File

@ -0,0 +1,85 @@
;;;###autoload
(defun add-my-c-styles ()
(c-add-style "Personal"
'("gnu"
(c-basic-offset . 4) ; Guessed value
(c-offsets-alist
(block-close . 0) ; Guessed value
(defun-block-intro . +) ; Guessed value
(defun-close . 0) ; Guessed value
(defun-open . 0) ; Guessed value
(statement . 0) ; Guessed value
(statement-block-intro . +) ; Guessed value
(topmost-intro . 0) ; Guessed value
(topmost-intro-cont . 0) ; Guessed value
(access-label . -)
(annotation-top-cont . 0)
(annotation-var-cont . +)
(arglist-close . c-lineup-close-paren)
(arglist-cont c-lineup-gcc-asm-reg 0)
(arglist-cont-nonempty . c-lineup-arglist)
(arglist-intro . +)
(block-open . 0)
(brace-entry-open . 0)
(brace-list-close . 0)
(brace-list-entry . 0)
(brace-list-intro . +)
(brace-list-open . 0)
(c . c-lineup-C-comments)
(case-label . 0)
(catch-clause . 0)
(class-close . 0)
(class-open . 0)
(comment-intro . c-lineup-comment)
(composition-close . 0)
(composition-open . 0)
(cpp-define-intro c-lineup-cpp-define +)
(cpp-macro . -1000)
(cpp-macro-cont . +)
(do-while-closure . 0)
(else-clause . 0)
(extern-lang-close . 0)
(extern-lang-open . 0)
(friend . 0)
(func-decl-cont . +)
(inclass . +)
(incomposition . +)
(inexpr-class . +)
(inexpr-statement . +)
(inextern-lang . +)
(inher-cont . c-lineup-multi-inher)
(inher-intro . +)
(inlambda . c-lineup-inexpr-block)
(inline-close . 0)
(inline-open . +)
(inmodule . +)
(innamespace . +)
(knr-argdecl . 0)
(knr-argdecl-intro . +)
(label . 2)
(lambda-intro-cont . +)
(member-init-cont . c-lineup-multi-inher)
(member-init-intro . +)
(module-close . 0)
(module-open . 0)
(namespace-close . 0)
(namespace-open . 0)
(objc-method-args-cont . c-lineup-ObjC-method-args)
(objc-method-call-cont c-lineup-ObjC-method-call-colons c-lineup-ObjC-method-call +)
(objc-method-intro .
[0])
(statement-case-intro . +)
(statement-case-open . 0)
(statement-cont . +)
(stream-op . c-lineup-streamop)
(string . -1000)
(substatement . +)
(substatement-label . 2)
(substatement-open . +)
(template-args-cont c-lineup-template-args +)))))
;;;###autoload
(defun use-my-c-style ()
(c-set-style "Personal"))
(provide 'my-c-styles)

View File

@ -0,0 +1,85 @@
;;; packages.el --- customized layer packages file for Spacemacs.
;;
;; Copyright (c) 2012-2016 Sylvain Benner & Contributors
;;
;; Author: Rongsong Shen <rshen@pc13x.cn.ibm.com>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;;; Commentary:
;; See the Spacemacs documentation and FAQs for instructions on how to implement
;; a new layer:
;;
;; SPC h SPC layers RET
;;
;;
;; Briefly, each package to be installed or configured by this layer should be
;; added to `customized-packages'. Then, for each package PACKAGE:
;;
;; - If PACKAGE is not referenced by any other Spacemacs layer, define a
;; function `customized/init-PACKAGE' to load and initialize the package.
;; - Otherwise, PACKAGE is already referenced by another Spacemacs layer, so
;; define the functions `customized/pre-init-PACKAGE' and/or
;; `customized/post-init-PACKAGE' to customize the package as it is loaded.
;;; Code:
(defconst customized-packages
'(
(my-c-styles :location local)
google-c-style
cc-mode)
"The list of Lisp packages required by the customized layer.
Each entry is either:
1. A symbol, which is interpreted as a package to be installed, or
2. A list of the form (PACKAGE KEYS...), where PACKAGE is the
name of the package to be installed or loaded, and KEYS are
any number of keyword-value-pairs.
The following keys are accepted:
- :excluded (t or nil): Prevent the package from being loaded
if value is non-nil
- :location: Specify a custom installation location.
The following values are legal:
- The symbol `elpa' (default) means PACKAGE will be
installed using the Emacs package manager.
- The symbol `local' directs Spacemacs to load the file at
`./local/PACKAGE/PACKAGE.el'
- A list beginning with the symbol `recipe' is a melpa
recipe. See: https://github.com/milkypostman/melpa#recipe-format")
(defun customized/init-my-c-styles ()
(use-package my-c-styles
:defer t
:commands (add-my-c-styles use-my-c-style)
:config (progn
(add-my-c-styles))))
(defun customized/post-init-cc-mode ()
(spacemacs/add-to-hooks #'(lambda ()
(when my-default-c-style
(cond
((eq my-default-c-style "google") (google-set-c-style))
(t (use-my-c-style)))))
'(c-mode-hook c++-mode-hook)))
(defun customized/init-google-c-style ()
(use-package google-c-style
:defer t
:commands google-set-c-style))
;;; packages.el ends here

View File

@ -0,0 +1,30 @@
#+TITLE: my-polymode layer
# The maximum height of the logo should be 200 pixels.
[[img/my-polymode.png]]
# TOC links should be GitHub style anchors.
* Table of Contents :TOC_4_gh:noexport:
- [[#description][Description]]
- [[#install][Install]]
- [[#key-bindings][Key bindings]]
* Description
This layer does wonderful things:
- thing01
* Install
To use this configuration layer, add it to your =~/.spacemacs=. You will need to
add =my-polymode= to the existing =dotspacemacs-configuration-layers= list in this
file.
* Key bindings
| Key Binding | Description |
|-------------+----------------|
| ~SPC x x x~ | Does thing01 |
# Use GitHub URLs if you wish to link a Spacemacs documentation file or its heading.
# Examples:
# [[https://github.com/syl20bnr/spacemacs/blob/master/doc/VIMUSERS.org#sessions]]
# [[https://github.com/syl20bnr/spacemacs/blob/master/layers/%2Bfun/emoji/README.org][Link to Emoji layer README.org]]
# If space-doc-mode is enabled, Spacemacs will open a local copy of the linked 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))))

View File

@ -0,0 +1,10 @@
*~
*#
#*
auto/
*\[weaved\]*
tmp/
*woven*
*exported*
.tmd
tmp*

Binary file not shown.

After

Width:  |  Height:  |  Size: 31 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 35 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 22 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 26 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 59 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 26 KiB

View File

@ -0,0 +1,466 @@
;;; 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',encoding='UTF-8')\""))
: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")
("tufte handout pdf" "pdf" "pdf with tufte handout" "tufte::tufte_handout")
("tufte book pdf" "pdf" "tufte book in PDF" "tufte::tufte_book")
("tufte handout html" "html" "html with tufte handout" "tufte::tufte_html")))
"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', encoding='UTF-8')\"")
(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")
("tufte handout pdf" "pdf" "pdf with tufte handout" "tufte::tufte_handout")
("tufte book pdf" "pdf" "tufte book in PDF" "tufte::tufte_book")
("tufte handout html" "html" "html with tufte handout" "tufte::tufte_html"))
: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',encoding='UTF-8')\"")
("html" "\\.x?html?\\'" "html" "HTML" "Rscript -e \"knitr::knit('%i', output='%o',encoding='UTF-8')\"")
("markdown" "\\.[rR]?md]\\'" "md" "Markdown" "Rscript -e \"knitr::knit('%i', output='%o')\"")
("rst" "\\.rst" "rst" "ReStructuredText" "Rscript -e \"knitr::knit('%i', output='%o', encoding='UTF-8')\"")
("brew" "\\.[rR]?brew\\'" "brew" "Brew" "Rscript -e \"knitr::knit('%i', output='%o', encoding='UTF-8')\"")
("asciidoc" "\\.asciidoc\\'" "txt" "AsciiDoc" "Rscript -e \"knitr::knit('%i', output='%o', encoding='UTF-8')\"")
("textile" "\\.textile\\'" "textile" "Textile" "Rscript -e \"knitr::knit('%i', output='%o', encoding='UTF-8')\"")))
"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', encoding='UTF-8')")
("html" "\\.x?html?\\'" "html" "HTML" "knitr::knit('%I', output='%O', encoding='UTF-8')")
("markdown" "\\.r?md\\'" "md" "Markdown" "knitr::knit('%I', output='%O', encoding='UTF-8')")
("rst" "\\.rst\\'" "rst" "ReStructuredText" "knitr::knit('%I', output='%O', encoding='UTF-8')")
("brew" "\\.r?brew\\'" "brew" "Brew" "knitr::knit('%I', output='%O', encoding='UTF-8')")
("asciidoc" "\\.asciidoc\\'" "txt" "AsciiDoc" "knitr::knit('%I', output='%O',encoding='UTF-8')")
("textile" "\\.textile\\'" "textile" "Textile" "knitr::knit('%I', output='%O',encoding='UTF-8')"))
: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
(message string)
(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)

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)

View File

@ -0,0 +1,51 @@
;;; 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")

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)

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)

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)

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)

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)

View File

@ -0,0 +1,402 @@
# Developing with Polymode
Polymode doesn't keep its modes in a single emacs buffer but in several indirect
buffers, as many as different modes are there in a file. Consequently, polymode
is as fast as switching emacs buffers because it never re-installs major modes
like other multi-modes do. Dave Love's
[multi-mode.el](http://www.loveshack.ukfsn.org/emacs/multi-mode.el) gets full
credit for this idea.
- [Glossary of Terms](#glossary-of-terms)
- [Class Hierarchy](#class-hierarchy)
- [Polymodes](#polymodes)
- [Chunkmodes](#chunkmodes)
- [Defining New Polymodes](#defining-new-polymodes)
- [One Predefined Innermode](#one-predefined-innermode)
- [Multiple Predefined Innermodes](#multiple-predefined-innermodes)
- [Multiple Automatically Detected Innermodes](#multiple-automatically-detected-innermodes)
- [Visually debugging polymodes](#visually-debugging-polymodes)
- [Defining Literate Programming Backends](#defining-backends)
- [Weavers](#weavers)
- [Exporters](#exporters)
- [Tanglers](#tanglers)
- [Internals](#internals)
- [API](#api)
- [Initialization of polymodes](#initialization-of-polymodes)
## Glossary of Terms
Assume the following `org-mode` file:
```org
* emacs lisp code block
#+begin_src emacs-lisp :var tbl='()
(defun all-to-string (tbl)
(if (listp tbl)
(mapcar #'all-to-string tbl)
(if (stringp tbl)
tbl
(format "%s" tbl))))
(all-to-string tbl)
#+end_src
```
- **span** - a syntactically homogeneous fragment of text. In the `org-mode`
example the org span starts at the beginning of the file ends with (but does
not include) `#+begin_src`. Header span is `#+begin_src emacs-lisp :var
tbl='()`. The emacs lisp code span follows next. `#+end_src` is the tail
span.
- **sub-mode** - an emacs mode from inside a span.
- **chunk** is a well delimited fragment of text that consists of one or more
spans. Most common types of chunks are `bchunk` (= *b*ody chunk) and hbtchunk
(= *h*ead + *b*ody + *t*ail spans). In the above example, org-mode emacs-lisp
chunk starts with `#+begin_src` and ends with `#+end_src` (inclusively).
- **polymode** is overloaded with three concurrent meanings which we will
disambiguate from the context:
1. Like emacs plain modes, polymodes represent an _abstract idea_ of a
collection of related functionality that is available in emacs buffers.
2. Like emacs modes, polymodes are _functions_ that install a bunch of
functionality into emacs buffer. You can use polymodes just as any other
emacs major or minor mode.
3. Polymodes are _objects_ of `pm-polymode` class. The functionality of each
polymode is completely characterized by this object and the methods that
act on it. During initialization this object is cloned and its copy is
stored in a buffer-local variable `pm/polymode`. There are several types
of polymode objects. See [hierarchy](#class-hierarchy) below.
- **chunkmode** refers to one of the following:
1. An abstract idea of the functionality available in chunks of the same type
(e.g. `org-mode chunk`, `emacs-lisp chunk`).
2. Emacs mode function (e.g. `org-mode`), or a set of such functions (e.g.
`pm-head-tail-mode` for header/tail + `emacs-lisp-mode` for the chunk's
body) what instantiate all of the required functionality of the plain
emacs modes embodies by that chunk.
3. Object of `pm-chunkmode` class. This object represents the behavior of the
chunkmode and is stored in a buffer-local variable `pm/chunkmode`. There
are several types of chunkmode objects. See [hierarchy](#class-hierarchy)
below.
- **hostmodes** and **innermodes** Chunkmodes could be classified into host and
inner chunkmodes (hostmodes and innermodes in short). In the above example
org chunkmode is a hostmode and emacs-lisp chunkmode is an innermode.
It is easy to think of the chunkmodes as inter-weaved threads. Host chunkmode is
a stretched canvas. Each inner chunkmode is a thread weaved into the
hostmode. Visible fragments of the each thread are chunks.
In light of the above metaphor, it is worth emphasizing the distinctions between
`chunks` and `chunkmodes`. Chunks are fragments of text and there might be
multiple chunks of the same type in the buffer. In contrast, there is only one
chunkmode of some specific type and multiple chunks of this type "share" this
chunkmode.
## Class Hierarchy
Polymode package uses `eieio` to represent its objects. The root class for all
polymode classes is `eieio-instance-inheritor` which provides prototype based
inheritance (in addition to class based). This means that objects instantiated
from polymode classes can be cloned in order to dynamically create a hierarchy
of customizable objects. There are a bunch of such objects already defined, you
can investigate those in `polymodes`, `hostmodes`, `innermodes` customization
groups.
As polymode uses indirect buffers to implement the multi-mode, storing mode
functionality in objects (in contrast to buffer local variables) is very
convenient strategy for moving stuff around.
Current polymode class hierarchy:
```
+--eieio-instance-inheritor
| +--pm-root
| +--pm-polymode
| | +--pm-polymode-multi
| | | +--pm-polymode-multi-auto
| | +--pm-polymode-one
| |
| +--pm-chunkmode
| | +--pm-hbtchunkmode
| | | +--pm-hbtchunkmode-auto
| | +--pm-bchunkmode
| |
| +--pm-weaver
| | +--pm-shell-weaver
| | +--pm-callback-weaver
| +--pm-exporter
| +--pm-shell-exporter
| +--pm-callback-exporter
```
*Using Help with EIEIO:* Each `eieio` class has a corresponding constructor
whose docstring contains a complete description of the class. In emacs 24.4 or
higher you can use `C-h f pm-foo RET` to inspect the documentation of the
class. Alternatively either use `M-x describe-class pm-foo` or lookup the class
definition directly in [polymode-classes.el](polymode-classes.el).
### Polymodes
As noted earlier, each polymode is a function that walks and quacks like
standard emacs major mode. Hence, things like `poly-XXX-mode-map` and
`poly-XXX-mode-hook` work just as expected. Plymode functions are defined with
`define-polymode` and can be used in place of emacs standard major or minor
modes.
Each polymode is represented by a customizable `pm-polymode` object which fully
characterizes its behavior. During the initialization this config object is
cloned and installed in every new buffer.
The most important slot of root config class `pm-polymode` is:
- `:hostmode` - name of the chunkmode object (typicaly of class `pm-bchunkmode`,
see [Chunkmodes](#chunkmodes)).
Currently there are three subclasses of `pm-polymode`:
- `pm-polymode-one` - used for polymdoes with only one predefined innermode. It
extends `pm-polymode` with one slot - `:innermode` - which is a name of the
inner chunkmode (typically objects of class `pm-hbtchunkmode`).
- `pm-polymode-multi` - used for polymodes with multiple predefined inner
modes. It extends `pm-polymode` with `:innermodes` list that contains names of
predefined `pm-hbtchunkmode` objects.
- `pm-polymode-multi-auto` - used for polymodes with multiple dynamically
discoverable chunkmodes. It extends `pm-polymode-multi` with `:auto-innermode`
slot (typically an object of class `pm-hbtchunkmode-auto`).
### Chunkmodes
Most important user visible slots of the root class `pm-chunkmode` are:
- `:mode` - symbol of corresponding emacs plain mode (e.g. `html-mode`,
`latex-mode` etc)
- `:indent-offset`, `:font-lock-narrow`, `:adjust-face`etc - configuration options.
Currently, there are three sub classes of `pm-chunkmode`:
1. `pm-bchunkmode` - represents the mode of plain body chunks
(bchunks). These objects are commonly used to represent functionality in
host chunks and are instances of `pm-bchunkmode`. Currently it doesn't
add any new slots to its parent class `pm-chunkmode`.
2. `hbtchunkmode` - represents the mode of composite head-body-tail
chunks. These objects are commonly used to represent the functionality of
the innermost chunks of the buffer. `pm-hbtchunkmode` extends
`pm-chunkmode` with additional slots, most importantly:
* `head-mode` and `tail-mode`: names of emacs-modes for header/tail of the
chunk
* `head-reg` and `tail-reg`: regular expressions or functions to detect the
header/tail
3. `pm-hbtchunkmode-auto` - represents chunkmodes for which the mode type is not
predefined and must be computed at runtime. This class extends
`pm-hbtchunkmode` with `retriver-regexp`, `retriver-num` and
`retriver-function` which can be used to retrive the mode name from the
header of the inner chunk.
## Defining New Polymodes
In order to define a new polymode `poly-cool-mode` you first have to define or
clone a chunkmode object to represent the hostmode, and one or more chunkmodes
to represent innermodes. Then define the polymode object `pm-poly/cool` pointing
to previously defined host and inner chunkmodes.
There are a lot of polymodes, hostmodes and innermodes already defined. Please
reuse those whenever possible.
### One Predefined Innermode
This is a simplified version of `poly-noweb-mode` from
[poly-noweb.el](poly-noweb.el). First define the latex hostmode:
```lisp
(defcustom pm-host/latex
(pm-bchunkmode "latex" :mode 'latex-mode)
"Latex host chunkmode"
:group 'hostmodes
:type 'object)
```
Then define the noweb innermode:
```lisp
(defcustom pm-inner/noweb
(pm-hbtchunkmode "noweb"
:head-reg "<<\\(.*\\)>>="
:tail-reg "\\(@ +%def .*\\)$\\|\\(@[ \n]\\)")
"Noweb typical chunk."
:group 'innermodes
:type 'object)
```
Finally, define the `pm-polymode` object and the coresponding polymode function:
```lisp
(defcustom pm-poly/noweb
(pm-polymode-one "noweb"
:hostmode 'pm-host/latex
:innermode 'pm-inner/noweb)
"Noweb typical polymode."
:group 'polymodes
:type 'object)
(define-polymode poly-noweb-mode pm-poly/noweb)
```
The hostmode `pm-host/latex` from above is already defined in
[poly-base.el](poly-base.el), so you need not have declared it.
Now, let's assume you want a more specialized noweb mode, say `noweb` with `R`
chunks. Instead of declaring root hostmodes and innermodes again you should
clone existing noweb root object. This is how it is done (from
[poly-R.el](poly-R.el)):
```lisp
(defcustom pm-inner/noweb+R
(clone pm-inner/noweb :mode 'R-mode)
"Noweb innermode for R"
:group 'innermodes
:type 'object)
(defcustom pm-poly/noweb+R
(clone pm-poly/noweb :innermode 'pm-inner/noweb+R)
"Noweb polymode for R"
:group 'polymodes
:type 'object)
(define-polymode poly-noweb+r-mode pm-poly/noweb+R :lighter " PM-Rnw")
```
That's it. You simply had to define new innermode and polymode by cloning from
previously defined objects and adjusting `:mode` and `:innermode` slots
respectively.
### Multiple Predefined Innermodes
No examples yet. Web-mode would probably qualify.
### Multiple Automatically Detected Innermodes
This is an example of markdown polymode (from [poly-markdown.el](poly-markdown.el)).
```lisp
;; 1. Define hostmode object
(defcustom pm-host/markdown
(pm-bchunkmode "Markdown" :mode 'markdown-mode)
"Markdown host chunkmode"
:group 'hostmodes
:type 'object)
;; 2. Define innermode object
(defcustom pm-inner/markdown
(pm-hbtchunkmode-auto "markdown"
:head-reg "^[ \t]*```[{ \t]*\\w.*$"
:tail-reg "^[ \t]*```[ \t]*$"
:retriever-regexp "```[ \t]*{?\\(\\(\\w\\|\\s_\\)*\\)"
:font-lock-narrow t)
"Markdown typical chunk."
:group 'innermodes
:type 'object)
;; 3. Define polymode object
(defcustom pm-poly/markdown
(pm-polymode-multi-auto "markdown"
:hostmode 'pm-host/markdown
:auto-innermode 'pm-inner/markdown
:init-functions '(poly-markdown-remove-markdown-hooks))
"Markdown typical configuration"
:group 'polymodes
:type 'object)
;; 4. Define polymode function
(define-polymode poly-markdown-mode pm-poly/markdown)
```
## Visually Debugging Polymodes
After defining polymodes you can visually inspect if the polymode does what you
intended by activating globalized minor pm-debug minor mode with `M-x
pm-debug-mode`. When `pm-debug-mode` is active the current span will be
highlighted and brief info displayed in the minibuffer.
Currently defined commands are:
- `M-n M-f` Toggle font-locking (`pm-debug-toggle-fontification`)
- `M-n M-h` Map through all spans and briefly blink each span (`pm-debug-map-over-spans-and-highlight`)
- `M-n M-i` Highlight current span and display more info (`pm-debug-info-on-span`)
<img src="../img/debug.png"/>
## Defining Backends
### Weavers
todo
### Exporters
todo
### Tanglers
todo
## Internals
Warning: Following description is subject to change and might not be up-to-date.
### API
All API classes and methods are named with `pm-` prefix. <!-- Actual instances have -->
<!-- "/" in their name -->
Buffer local objects:
- `pm/type`
- `pm/chunkmode`
- `pm/polymode`
Generics:
- `pm-initialize`
- `pm-get-buffer-create`
- `pm-select-buffer`
- `pm-get-span`
- `pm-indent-line`
- `pm-get-adjust-face`
Utilities:
- `pm-get-innermost-span`
- `pm-map-over-spans`
- `pm-narrow-to-span`
### Initialization of polymodes
Note: This description is obsolete. Internals have changed.
When called, `poly-XXX-mode` (created with `define-polymode`) clones
`pm-poly/XXX` object and calls `pm-initialize` generic on it. The actual
initialization depends on concrete type of the `pm-polymode` object but these
are the common steps:
1. assign the config object into local `pm/polymode` variable
2. clone the `pm-chunkmode` object specified by `:hostmode` slot of
`pm-polymode`
3. initialize hostmode by running the actual function in `:mode` slot of the
hostmode object.
4. store hostmode object into local `pm/chunkmode` variable
5. set local variable `pm/type` to `'host`
6. run `pm-polymode`'s `:init-functions` as normal hooks
7. run `pm--setup-buffer` which is common setup function used internally to
set `font-lock` and a range of other stuff
8. run `poly-XXX-mode-hook`.
Discovery of the spans is done by `pm-select-buffer` generic which is commonly
called first by `jit-lock`. `pm-select-buffer` fist checks if the corresponding
`pm-chunkmode` object (and associated indirect buffer) has been already
created. If so, `pm-select-buffer` simply selects that buffer. Otherwise, it
calls `pm-get-buffer-create` generic which, in turn, creates `pm-chunkmode`
object and the associated indirect buffer.

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)

View File

@ -0,0 +1,374 @@
(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.")
;; 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)

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)

View File

@ -0,0 +1,65 @@
;; Examples of polymode configuration. Choose what suits your needs and place
;; into your .emacs file.
(let ((mydir (file-name-directory (or load-file-name buffer-file-name))))
(let ((modes-dir (concat mydir "modes")))
(add-to-list 'load-path modes-dir)))
;;; MARKDOWN
(use-package poly-markdown
:defer t
:commands (poly-markdown-mode)
:init (progn
(add-to-list 'auto-mode-alist '("\\.md$" . poly-markdown-mode))))
;; ;;; ORG
;; ;; org is not working presently
(use-package poly-org
:defer t
:commands (poly-org-mode)
:init (progn
(add-to-list 'auto-mode-alist '("\\.org$" . poly-org-mode))))
;; ;;; R related modes
(use-package poly-R
:defer t
:commands (poly-noweb+r-mode poly-markdown+r-mode
poly-rapport-mode
poly-html+r-mode
poly-brew+r-mode
poly-r+c++-mode
poly-c++r-mode)
:init (progn
(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
(use-package poly-erb
:defer t
:commands (poly-javascript+erb-mode poly-coffee+erb-mode poly-html+erb-mode)
:init (progn
(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
(use-package poly-slim
:defer t
:commands (poly-slim-mode)
:init (progn
(add-to-list 'auto-mode-alist '("\\.slim$" . poly-slim-mode))))
(defalias 'dot-mode 'graphviz-dot-mode)
(defalias 'r-mode 'ess-r-mode)
(use-package ob-tikz
:defer t
:commands (tikz-mode))
(provide 'polymode-configuration)

View File

@ -0,0 +1,661 @@
;; -*- 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)
(message message)
(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)

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)

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"
"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)

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)

View File

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

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)

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

View File

@ -0,0 +1,164 @@
[![unstable](http://badges.github.io/stability-badges/dist/unstable.svg)](http://github.com/badges/stability-badges)
## Overview
Polymode is an emacs package that offers generic support for multiple major
modes inside a single emacs buffer. It is lightweight, object oriented and
highly extensible. Creating new polymodes typically takes a
[few](modes#multiple-automatically-detected-innermodes) lines of code.
Polymode also provides extensible facilities for external literate programming
tools for exporting, weaving and tangling.
- [Installation](#installation)
- [Polymodes Activation](#activation-of-polymodes)
- [Basic Usage](#basic-usage)
- [Warnings](#warnings)
- [Development](modes)
- [Screenshots](#screenshots)
## Installation
*Note: Oldest supported Emacs version is 24.4*
### From [MELPA](https://github.com/milkypostman/melpa)
<kbd>M-x</kbd> `package-install` `polymode`.
### Manually
```sh
git clone https://github.com/vitoshka/polymode.git
```
Add "polymode" directory and "polymode/modes" to your emacs path:
```lisp
(setq load-path
(append '("path/to/polymode/" "path/to/polymode/modes")
load-path))
```
Require any polymode bundles that you are interested in. For example:
```lisp
(require 'poly-R)
(require 'poly-markdown)
```
## Activation of Polymodes
Polymodes are functions, just like ordinary emacs modes. The can be used in
place of emacs major or minor modes alike. There are two main ways to
automatically activate emacs (poly)modes:
1. _By registering a file extension by adding modes to `auto-mode-alist`_:
```lisp
;;; MARKDOWN
(add-to-list 'auto-mode-alist '("\\.md" . poly-markdown-mode))
;;; R 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))
```
See [polymode-configuration.el](polymode-configuration.el) for more
examples.
2. _By setting local mode variable in you file_:
```c++
// -*- mode: poly-C++R -*-
```
or
```sh
## -*- mode: poly-brew+R; -*-
```
## Basic Usage
All polymode keys start with the prefix defined by `polymode-prefix-key`,
default is <kbd>M-n</kbd>. The `polymode-mode-map` is the parent of all
polymodes' maps:
* BACKENDS
<kbd>e</kbd> `polymode-export`
<kbd>E</kbd> `polymode-set-exporter`
<kbd>w</kbd> `polymode-weave`
<kbd>W</kbd> `polymode-set-weaver`
<kbd>t</kbd> `polymode-tangle` ;; not implemented yet
<kbd>T</kbd> `polymode-set-tangler` ;; not implemented yet
<kbd>$</kbd> `polymode-show-process-buffer`
* NAVIGATION
<kbd>C-n</kbd> `polymode-next-chunk`
<kbd>C-p</kbd> `polymode-previous-chunk`
<kbd>C-M-n</kbd> `polymode-next-chunk-same-type`
<kbd>C-M-p</kbd> `polymode-previous-chunk-same-type`
* MANIPULATION
<kbd>M-k</kbd> `polymode-kill-chunk`
<kbd>M-m</kbd> `polymode-mark-or-extend-chunk`
<kbd>C-t</kbd> `polymode-toggle-chunk-narrowing`
<kbd>M-i</kbd> `polymode-insert-new-chunk`
## Warnings
* Tested with Emacs 24.3.1 and 24.4.5.
Some things still don't work as expected. For example:
* To kill a polymode buffer you will have position the cursor in the host
mode buffer.
* Customization interface is not working as expected (an eieio bug) and is
not even tested.
* Indentation and font-lock is not always right and requires some more
tweaking. This is especially true for complex modes like `c-mode`.
## Developing with Polymode
For the relevant terminology and development info see these [docs](modes).
## Screenshots
### slim
<img src="img/slim.png" width="400px"/>
### markdown+R
<img src="img/Rmd.png" width="400px"/>
### markdown+R+YAML
<img src="img/rapport.png" width="400px"/>
### org mode
<img src="img/org.png" width="400px"/>
### Ess-help buffer
<img src="img/ess-help.png" width="400px"/>
### C++R
<img src="img/cppR.png" width="400px"/>

View File

@ -0,0 +1,243 @@
<!--head
meta:
title: ANOVA Template
author: Aleksandar Blagotić, Dániel Nagy
description: An ANOVA report with table of descriptives, diagnostic tests and ANOVA-specific
statistics.
email: ~
packages: example
nortest:
- 'rapport("ANOVA", ius2008, resp = "leisure", fac = "gender") # one-way'
- 'rapport("ANOVA", ius2008, resp = "leisure", fac = c("gender", "partner")) # two-way'
inputs:
- name: resp
label: Response variable
description: Dependent (response) variable
class: numeric
length:
min: 1.0
max: 1.0
value: ~
required: yes
standalone: no
- name: fac
label: Factor variables
description: Independent variables (factors)
class: factor
length:
min: 1.0
max: 2.0
value: ~
required: yes
standalone: no
- name: fac.intr
label: Factor interaction
description: Include factor interaction
class: logical
length:
min: 1.0
max: 1.0
value: yes
required: no
standalone: yes
head-->
<%=
panderOptions('table.split.table', Inf)
d <- dfsf(data.frame(resp, fac), .Names = c(resp.iname, fac.name))
f(.int <- fml(resp.iname, fac.name, join.right = "*")
sml <- fml(123, sfd <- sum(sfs)) c()
f.nonint <- fml(resp.iname, fac.name, join.right = "+")
fit <- lm(ifelse(isTRUE(fac.intr), f.int, f.nonint), data = d)
fac.plu <- switch(fac.ilen, '', 's')%>
# Introduction
**Analysis of Variance** or **ANOVA** is a statistical procedure that tests equality of means for several samples. It was first introduced in 1921 by famous English statistician Sir Ronald Aylmer Fisher.
```r
ff()
test <- markdown(chunk)
```
```r
sdf <- 343
ddplot(sfd <- ddd())
sfsdfds
```
# Model Overview
<%= switch(fac.ilen, 'One', 'Two') %>-Way ANOVA was carried out, with <%= p(fac.label) %> as independent variable<%= fac.plu %>, and <%= p(resp.label) %> as a response variable. Factor interaction was<%= ifelse(fac.intr, "", "n't")%> taken into account.
# Descriptives
I n order to get more insight on the model data, a table of frequencies for ANOVA factors is displayed, as well as a table of descriptives.
## Frequency Table
Below lies a frequency table for factors in ANOVA model. Note that the missing values are removed from the summary.
<%=
(freq <- rp.freq(fac.name, rp.data))
%>
## Descriptive Statistics
he following table displays the descriptive statistics of ANOVA model. Factor levels <%=ifelse(ncol(fac) > 1, "and their combinations", "")%> lie on the left-hand side, while the corresponding statistics for response variable are given on the right-hand side.
<%=
(desc <- rp.desc(resp, fac, c(Min = min, Max = max, Mean = mean, Std.Dev. = sd, Median = median, IQR, Skewness = skewness, Kurtosis = kurtosis)))
%>
# Diagnostics
Before we carry out ANOVA, we'd like to check some basic assumptions. For those purposes, normality and homoscedascity tests are carried out alongside several graphs that may help you with your decision on model's main assumptions.
## Diagnostics
### Univariate Normality
<% if (length(resp) < 5000) { %>
<%= ntest <- htest(resp, lillie.test, ad.test, shapiro.test)
k <- 0
l <- 0
m <- 0
n <- 0
p <- 0.05
if (ntest$p[1] < 0.05) {l <- k + 1}
if (ntest$p[2] < 0.05) {m <- l + 1}
if (ntest$p[3] < 0.05) {n <- m + 1}
ntest
%>
So, the conclusions we can draw with the help of test statistics:
- based on _Lilliefors test_, distribution of _<%= resp.label %>_ is <%= ifelse(ntest[1, 3] < p, "not normal", "normal") %>
- _Anderson-Darling test_ confirms<%= ifelse(ntest[2, 3] < p, " violation of", "") %> normality assumption
- according to _Shapiro-Wilk test_, the distribution of _<%= resp.label %>_ is<%= ifelse(ntest[3, 3] < p, " not", "") %> normal
<% } else { %>
<%= ntest <- htest(resp, lillie.test, ad.test)
k <- 0
l <- 0
m <- 0
n <- 0
p <- 0.05
if (ntest$p[1] < 0.05) {l <- k + 1}
if (ntest$p[2] < 0.05) {n <- l + 1}
ntest
%>
So, the conclusions we can draw with the help of test statistics:
- based on _Lilliefors test_, distribution of _<%= resp.label %>_ is <%= ifelse(ntest[1, 3] < p, "not normal", "normal") %>
- _Anderson-Darling test_ confirms<%= ifelse(ntest[2, 3] < p, " violation of", "") %> normality assumption
<% } %>
<%= if (n > 0) {
sprintf("As you can see, the applied tests %s of the %s.", ifelse(n > 1, "confirm departures from normality", "yield different results on hypotheses of normality, so you may want to stick with one you find most appropriate or you trust the most in the case"), resp.label)
} else {
sprintf("reject departures from normality")
}
%>
### Homoscedascity
In order to test homoscedascity, _Bartlett_ and _Fligner-Kileen_ tests are applied.
<%=
hsced <- with(d, htest(as.formula(f.nonint), fligner.test, bartlett.test))
hp <- hsced$p ls()
hcons <- all(hp < .05) | all(hp > .05)
hp.all <- all(hp < .05)
hsced
%>
When it comes to equality of variances, applied tests yield <%= ifelse(hcons, "consistent", "inconsistent") %> results. <%= if (hcons) { sprintf("Homoscedascity assumption is %s.", ifelse(hp.all, "rejected", "confirmed")) } else { sprintf("While _Fligner-Kileen test_ %s the hypotheses of homoscedascity, _Bartlett's test_ %s it.", ifelse(hp[1] < .05, "rejected", "confirmed"), ifelse(hp[2] < .05, "rejected", "confirmed")) } %>
## Diagnostic Plots
Here you can see several diagnostic plots for ANOVA model:
- residuals against fitted values
- scale-location plot of square root of residuals against fitted values
- normal Q-Q plot
- residuals against leverages
<%=
par(mfrow = c(2, 2))
+plot(fit)
%>
# ANOVA Summary
## ANOVA Table
<%=
a <- anova(fit)
a.f <- a$F
a.p <- a$Pr
a.fp <- a.p < .05
data.frame(a)
%>
_F-test_ for <%= p(fac.label[1]) %> is <%= ifelse(a.fp[1], "", "not") %> statistically significant, which implies that there is <%= ifelse(a.fp[1], "an", "no") %> <%= fac.label[1] %> effect on response variable. <%= if (fac.ilen == 2) { sprintf("Effect of %s on response variable is %s significant. ", p(fac.label[2]), ifelse(a.fp[2], "", "not")) } else { "" } %><%= if (fac.ilen == 2 & fac.intr) { sprintf("Interaction between levels of %s %s found significant (p = %.3f).", p(fac.label), ifelse(a.fp[3], "was", "wasn't"), a.p[3]) } else { "" } %>
## Post Hoc test
### Results
After getting the results of the ANOVA, usually it is advisable to run a [post hoc test](http://en.wikipedia.org/wiki/Post-hoc_analysis) to explore patterns that were not specified a priori. Now we are presenting [Tukey's HSD test](http://en.wikipedia.org/wiki/Tukey%27s_range_test).
<%=
aovfit <- aov(fit)
Tukey <- TukeyHSD(aovfit)
%>
<% for (v in names(Tukey)) { %>
#### <%= v %>
<%= posthoc <- round(Tukey[[v]],3)
colnames(posthoc) <- c("Difference", "Lower Bound", "Upper Bound", "P value")
is.signif <- length(posthoc[,4][which(abs(posthoc[,4]) < 0.05)]) > 0
length.signif <- length(posthoc[,4][which(abs(posthoc[,4]) < 0.05)])
if (is.signif) {
post.signif <- paste(pander.return(lapply(1:length.signif, function(i) paste0(p(c(rownames(posthoc)[which(abs(posthoc[,4]) < 0.05)][i])), ' (', round(posthoc[,4][which(abs(posthoc[,4]) < 0.05)][i], 3), ')'))), collapse = '\n')
} else {
post.signif <- NULL
}
posthoc[,4] <- add.significance.stars(posthoc[,4])
posthoc
%>
<% if (is.signif) { %>
The following categories differ significantly (in the brackets you can see the p-value):
<% } else { %>
There are no categories which differ significantly here.
<% } %>
<%=
post.signif
%>
<% } %>
### Plot
Below you can see the result of the post hoc test on a plot.
<%= Tukey_plot <- plot(TukeyHSD(aovfit)) %>

View File

@ -0,0 +1,87 @@
% Usage: knitr an
\documentclass{article}
\usepackage{relsize,setspace} % used by latex(describe( ))
\usepackage{needspace}
\usepackage{longtable,epic} % used by print(..., latex=TRUE)
\usepackage{url} % used in bibliography
\usepackage[superscript,nomove]{cite} % use if \cite is used and superscripts wanted
% Remove nomove if you want superscripts after punctuation in citations
\usepackage{lscape} % for landscape mode tables
\textwidth 6.75in % set dimensions before fancyhdr
\textheight 9.25in
\topmargin -.875in
\oddsidemargin -.125in
\evensidemargin -.125in
\usepackage{fancyhdr} % this and next line are for fancy headers/footers
\pagestyle{fancy}
\newcommand{\bc}{\begin{center}} % abbreviate
\newcommand{\ec}{\end{center}}
\newcommand{\code}[1]{{\smaller\texttt{#1}}}
\newcommand{\R}{{\normalfont\textsf{R}}{}}
\newcommand{\vr}[1]{\texttt{#1}}
\newcommand{\mc}[2]{\multicolumn{#1}{c}{#2}}
\title{Analysis of Race and Severe Aortic Stenosis}
\author{Frank Harrell\\\smaller Department of Biostatistics\\\smaller Vanderbilt University School of Medicine}
\begin{document}
\maketitle
\tableofcontents
<<echo=FALSE>>=
require(rms)
@
\section{Univariable Descriptive Statistics}
<<describe,results='asis'>>=
Load(ras)
ras <-
within(ras, {
label(age) <- 'Age'
diabetes <- ifelse(diabetes.after.review=='No', 0,
ifelse(diabetes.after.review=='Yes', 1,
ifelse(diabetes.search=='No', 0,
ifelse(diabetes.search=='Yes', 1,
NA))))
htn <- ifelse(htn.after.review=='No', 0,
ifelse(htn.after.review=='Yes', 1,
ifelse(htn.search=='No', 0,
ifelse(htn.search=='Yes', 1,
NA))))
dialysis <- ifelse(dialysis.after.review=='No', 0,
ifelse(dialysis.after.review=='Yes', 1,
ifelse(dialysis.search=='No', 0,
NA)))
cad <- ifelse(cad.after.review=='No', 0,
ifelse(cad.after.review=='Yes', 1,
ifelse(cad.search=='No', 0,
ifelse(cad.search=='Yes', 1,
NA))))
gender <- factor(ifelse(gender=='Female', 'Female',
ifelse(gender=='Male', 'Male',
NA)))
})
latex(describe(ras), file='')
@
\section{Missing Data}
Let's look at patterns of missing values, especially which variables
are missing on the same patients.
<<naclus,top=2>>=
r <- subset(ras, select=c(gender,race,age,bmi,ldl,diabetes,htn,dialysis,
cad,statin,sasr,sas.etiology,creatinine))
dd <- datadist(r)
n <- naclus(subset(r, select=-sas.etiology))
naplot(n, which='na per obs')
@
<<naplot,top=2,rt=1,ps=8>>=
options(datadist='dd')
naplot(n, which='mean na')
@
<<naplot2>>=
plot(n)
@
\end{document}

View File

@ -0,0 +1,74 @@
<!--head
meta:
title: Minimal template
author: Gergely Daróczi
description: This template demonstrates the basic features of rapport. We all hope
you will like it!
packages:
- ggplot2
- xtable
example:
- rapport("Minimal", data = ius2008, var='leisure')
- rapport("Minimal", data = ius2008, var='leisure', desc=FALSE)
- rapport("Minimal", data = ius2008, var='leisure', desc=FALSE, histogram=T)
inputs:
- name: var
label: Variable
description: A variable
class: numeric
length: 1
value: ~
required: TRUE
standalone: FALSE
- name: desc
label: Descriptives
description: Table of the descriptive statistics
class: logical
value: TRUE
required: FALSE
standalone: TRUE
- name: histogram
label: Histogram
description: Histogram
class: logical
value: FALSE
required: FALSE
standalone: TRUE
head-->
# Début
Hello, world!
I have just specified a *Variable* in this template named to **<%=rp.name(var)%>**. The label of this *variable* is "<%=var.label%>".
And wow, the mean of *<%=var.name%>* is <%=mean(na.omit(var))%>!
<%=
if (!desc) '**For more detailed statistics, you should have set `desc=TRUE`!**'
%>
<% if (desc) { %>
## 'Descriptive statistics'
<% } %>
<%=
if (desc) summary(var)
%>
<%=
if (desc) sprintf('The 5 highest value are: %s.', p(sort(var, decreasing = TRUE)[1:5]))
%>
<% if (histogram) { %>
## 'Histogram'
<% } %>
<%=
if (histogram)
if (require(lattice)) {
histogram(rp.data[, var.name])
} else
hist(rp.data[, var.name])
%>

View File

@ -0,0 +1,20 @@
We know the value of pi is <% pi + 34 %>, and 2 times pi is <% 2*pi %>.
The brew syntax in knitr is similar to the brew package, but all kinds of
syntax in the brew package will be treated in the same way in knitr: they are
nothing but inline R code.
<% x<-1.234; NULL %>
You can write a number as <% x %>, or <%= x %>, or <% x -%>.
You wont see this R output, but it will run. <% foo <- bar %>
Now foo is <%=foo%> and today is <%=format(Sys.time(),%B %d, %Y)%>.
<%# Comment -- ignored -- useful in testing.
#Also notice the dash-percent-gt.
It chops off the trailing newline.
You can add it to any percent-gt. -%>
How about generating a template from a template?
<%% foo <- "fee fi fo fum" %%>
foo is still <%= foo %>.

View File

@ -0,0 +1,20 @@
-*- mode: poly-brew+R; -*-
We know the value of pi is <% pi %>, and 2 times pi is <% 2*pi %>.
The brew syntax in knitr is similar to the brew package, but all kinds of
syntax in the brew package will be treated in the same way in knitr: they are
nothing but inline R code.
<% x<-1.234; NULL %>
You can write a number as <% x %>, or <%= x %>, or <% x -%>.
You wont see this R output, but it will run. <% foo <- bar %>
Now foo is <%=foo%> and today is <%=format(Sys.time(),%B %d, %Y)%>.
<%# Comment -- ignored -- useful in testing. Also notice the dash-percent-gt. It
chops off the trailing newline. You can add it to any percent-gt. -%>
How about generating a template from a template? <%% foo <- fee fi fo fum %%>
foo is still <%=foo%>.

View File

@ -0,0 +1,65 @@
<!DOCTYPE html>
<html>
<head>
<title>A minimal knitr example in HTML</title>
</head>
<body>
<!--begin.rcode
opts_chunk$set(fig.width=5, fig.height=5)
end.rcode-->
<p>This is a minimal example which shows <strong>knitr</strong>
working with HTML
pages. See <a href="https://bitbucket.org/stat/knitr/downloads/003-minimal.html">here</a>
for the output and
<a href="https://github.com/yihui/knitr-examples/blob/master/003-minimal.Rhtml">here</a>
for the source.</p>
<p>Boring stuff as usual:</p>
<!--begin.rcode
## a simple calculator
1+1
## boring random numbers
set.seed(123)
rnorm(5) end.rcode-->
<p>We can also produce plots (centered by the
option <code>fig.align='center'</code>):</p>
<!--begin.rcode html-cars-scatter, message=FALSE, fig.align='center'
library(ggplot2)
plot(mpg~hp, mtcars)
qplot(hp, mpg, data=mtcars)+geom_smooth()
end.rcode-->
<p>Errors, messages and warnings can be put into <code>div</code>'s
with different <code>class</code>es:</p>
<!--begin.rcode
sqrt(-1) # warning
message('knitr says hello to HTML!')
1+'a' # mission impossible
end.rcode-->
<p>In the end, let's show off a 3D plot from
the <strong>rgl</strong> package.</p>
<!--begin.rcode
knit_hooks$set(rgl = hook_rgl) # set up the hook first
end.rcode-->
<!--begin.rcode fancy-rgl, rgl=TRUE, fig.align='center', fig.width=4, fig.height=4
if (require('rgl')) {
demo('bivar', package='rgl', echo=FALSE)
par3d(zoom=.7)
}
end.rcode-->
<p>Well, everything seems to be working. Let's ask R what is the
value of &pi;? Of course it is <!--rinline pi -->.</p>
</body>
</html>

View File

@ -0,0 +1,14 @@
## inline functions are not working as yet, use cppFunction instead
require(inline)
require(RcppEigen)
runifXd <- cxxfunction(signature(arg1="integer"), plugin='RcppEigen',
includes='
RNGScope scope;
using namespace Eigen;
inline VectorXd runifXd(int size, double a=0., double b=1.) {
return as<VectorXd>(runif(size, a, b));
}',
body='return wrap(runifXd(as<int>(arg1)));')

View File

@ -0,0 +1,89 @@
// -*- mode: poly-C++R; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
/**
* @title Sparse matrix in Armadillo
* @author Dirk Eddelbuettel
* @license GPL (>= 2)
* @tags armadillo matrix featured
* @summary This example shows how to create a sparse matrix in Armadillo
*
* The Matrix package in R supports sparse matrices, and we can use
* the S4 class in Rcpp to attach the different component row indices,
* column pointers and value which can then be used to initialize an
* Armadillo sparse matrix.
*
* Let's start with creating a sparse matrix.
*
*/
/*** R
suppressMessages(library(Matrix))
i <- c(1,3:8)
j <- c(2,9,6:10) a
x <- 7 * (1:7)
A <- sparseMatrix(i, j, x = x)
print(A)
*/
/**
* The following C++ function access the corresponding slots of the
* `sparseMatrix` object, and creates a `sp_mat` Armadillo object.
*/
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
using namespace Rcpp ;
// [[Rcpp::export]]
void convertSparse(S4 mat) { // slight improvement with two non-nested loops
IntegerVector dims = mat.slot("Dim");
IntegerVector i = mat.slot("i");
IntegerVector p = mat.slot("p");
NumericVector x = mat.slot("x");
int nrow = dims[0], ncol = dims[1];
arma::sp_mat res(nrow, ncol);
// create space for values, and copy
arma::access::rw(res.values) =
arma::memory::acquire_chunked<double>(x.size() + 1);
arma::arrayops::copy(arma::access::rwp(res.values),
x.begin(), x.size() + 1);
// create space for row_indices, and copy -- so far in a lame loop
arma::access::rw(res.row_indices) =
arma::memory::acquire_chunked<arma::uword>(x.size() + 1);
for (int j=0; j<i.size(); j++)
arma::access::rwp(res.row_indices)[j] = i[j];
// create space for col_ptrs, and copy -- so far in a lame loop
arma::access::rw(res.col_ptrs) =
arma::memory::acquire<arma::uword>(p.size() + 2);
for (int j=0; j<p.size(); j++)
arma::access::rwp(res.col_ptrs)[j] = p[j];
// important: set the sentinel as well
arma::access::rwp(res.col_ptrs)[p.size()+1] =
std::numeric_limits<arma::uword>::max();
// set the number of non-zero elements
arma::access::rw(res.n_nonzero) = x.size();
Rcout << "SpMat res:\n" << res << std::endl;
}
/**
* Running this example shows the same matrix printed to `stdout` by
* Armadillo.
*/
/***R
convertSparse(A)
*/
/**
* Support for sparse matrix is currently still limited in Armadillo,
* but expected to grow. Likewise, RcppArmadillo does not yet have
* `as<>()` and `wrap()` converters but we expect to add these
* eventually --- at which point this example will be much simpler.
*/

View File

@ -0,0 +1,26 @@
-*- mode: poly-markdown+r -*-
^^^^^^^^^^^^^^^------- local variable activates apropriate polymode
This demo shows you how to merge the source and output blocks in markdown
output. Note **knitr** puts R source and output in separate blocks by default.
```r
# first ``` are the end of previous source block; second ``` are the
of next output block
knit_hooks$set(chunk = function(x, options) {
gsub("```\n+```", "", x)
})
```
See if it works:
```r
a = 1
a
## [1] 1
```
Source and output lived together happily ever in **knitr**.

View File

@ -0,0 +1,51 @@
%% mode: poly-noweb+C;-*-
\documentclass{article}
\begin{document}
Here is a code chunk.
<<foo, fig.height=4>>=
# include <sdf>
# include <stdio.h>
# include <stdlib.h>
{
char ch, file_name[25];
FILE *fp;
printf("E nter the name of file you wish to see\n");
gets(filkce_name);
fp = fopen(file_name,"r"); // read mode
if(){
ifffff
}
if( fp == NULL )
{
perror("Error while opening the file.\n");
exit(EXIT_FAILURE);
}
printf("The contents of %s file are :\n", file_name);
while(){
}
while( ( ch = fgetc(fp) ) != EOF )
printf("%c",ch);
fclose(fp);
return 0;
}
@
You can also write inline expressions, e.g. $\pi=\Sexpr{pi}$, and \Sexpr{1.598673e8} is a big number.
\end{document}

View File

@ -0,0 +1,20 @@
\documentclass{article}
\begin{document}
\begin{definitions}
Here is a code chunk.
\begin{definition}
<<foo, fig.height=4>>=
aa <- "sdfdsf"
plot(rnorm(100))
@
\end{definition}
\end{definitions}
You can also write inline expressions, e.g. $\pi=\Sexpr{pi}$, and
\Sexpr{1.598673e8} is a big number.
\end{document}

View File

@ -0,0 +1,16 @@
\documentclass{article}
\begin{document}
Here is a code chunk.
<<foo, fig.height=4>>=
1+1
chartr('xie', 'XIE', c('xie yihui', 'Yihui Xie'))
par(mar=c(4, 4, .2, .2)); plot(rnorm(100))
@
You can also write inline expressions, e.g. $\pi=\Sexpr{pi}$, and \Sexpr{1.598673e8} is a big number.
\end{document}

View File

@ -0,0 +1,39 @@
If `poly-markdown.el` is loaded. This should work by default. Otherwise `M-x
poly-markdown+r-mode RET` should do the job.
```r
1 + 1
```
```r
## [1] 2
```
```r
0.4 - 0.7 + 0.3 # what? it is not zero!
```
```r
## [1] 5.551e-17
```
```emacs-lisp
(message "it works")
```
```javascript
{
}
```
```python
if len($declaration) > 0 and $declaration::isTypedef:
$Symbols::types.add($IDENTIFIER.text)
print "define type "+$IDENTIFIER.text # line 19
```

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,102 @@
% File src/library/graphics/man/pairs.Rd
% Part of the R package, http://www.R-project.org
% Copyright 1995-2007 R Core Team
% Distributed under GPL 2 or later
\name{pairs}
\alias{pairs}
\alias{pairs.default}
\alias{pairs.formula}
\title{Scatterplot Matrices}
\description{
A matrix of scatterplots is produced.
}
\usage{
pairs(x, \dots)
\method{pairs}{formula}(formula, data = NULL, \dots, subset,
na.action = stats::na.pass)
\method{pairs}{default}(x, labels, panel = points, \dots,
lower.panel = panel, upper.panel = panel,
diag.panel = NULL, text.panel = textPanel,
label.pos = 0.5 + has.diag/3,
cex.labels = NULL, font.labels = 1,
row1attop = TRUE, gap = 1)
}
\arguments{
\item{x}{the coordinates of points given as numeric columns of a
matrix or dataframe. Logical and factor columns are converted to
numeric in the same way that \code{\link{data.matrix}} does.
}
\item{formula}{a formula, such as \code{~ x + y + z}. Each term will
give a separate variable in the pairs plot, so terms should be
numeric vectors. (A response will be interpreted as another
variable, but not treated specially, so it is confusing to use one.)}
\item{data}{a data.frame (or list) from which the variables in
\code{formula} should be taken.}
\item{subset}{an optional vector specifying a subset of observations
to be used for plotting.}
.....
}
\details{
The \eqn{ij}th scatterplot contains \code{x[,i]} plotted against
\code{x[,j]}. The scatterplot can be customised by setting panel
functions to appear as something completely different. The
off-diagonal panel functions are passed the appropriate columns of
\code{x} as \code{x} and \code{y}: the diagonal panel function (if
any) is passed a single column, and the \code{text.panel} function is
passed a single \code{(x, y)} location and the column name.
.....
}
\author{
Enhancements for \R 1.0.0 contributed by Dr. Jens
Oehlschlaegel-Akiyoshi and R-core members.
}
\references{
Becker, R. A., Chambers, J. M. and Wilks, A. R. (1988)
\emph{The New S Language}.
Wadsworth & Brooks/Cole.
}
\examples{
pairs(iris[1:4], main = "Anderson's Iris Data -- 3 species",
pch = 21, bg = c("red", "green3", "blue")[unclass(iris$Species)])
## formula method
pairs(~ Fertility + Education + Catholic, data = swiss,
subset = Education < 20, main = "Swiss data, Education < 20")
pairs(USJudgeRatings)
## put histograms on the diagonal
panel.hist <- function(x, ...)
{
usr <- par("usr"); on.exit(par(usr))
par(usr = c(usr[1:2], 0, 1.5) )
h <- hist(x, plot = FALSE)
breaks <- h$breaks; nB <- length(breaks)
y <- h$counts; y <- y/max(y)
rect(breaks[-nB], 0, breaks[-1], y, col = "cyan", ...)
}
pairs(USJudgeRatings[1:5], panel = panel.smooth,
cex = 1.5, pch = 24, bg = "light blue",
diag.panel = panel.hist, cex.labels = 2, font.labels = 2)
## put (absolute) correlations on the upper panels,
## with size proportional to the correlations.
panel.cor <- function(x, y, digits = 2, prefix = "", cex.cor, ...)
{
usr <- par("usr"); on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
r <- abs(cor(x, y))
txt <- format(c(r, 0.123456789), digits = digits)[1]
txt <- paste(prefix, txt, sep = "")
if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt)
text(0.5, 0.5, txt, cex = cex.cor * r)
}
pairs(USJudgeRatings, lower.panel = panel.smooth, upper.panel = panel.cor)
}
\keyword{hplot}

View File

@ -0,0 +1,52 @@
## C ++ R is not working properly.
signR <- function(x) {
if (x > 0) {
1
} else if (x == 0) {
0
} else{
-1,
}
}
"sdfd" 'sdfd'
<sdfds > < sdfds >
cppFunction('
int signnC(int x) {
if (x > 0) {
n return 1;
} else if (x == 0) {
return 0;
} else {
return -1;
}
}
')
sdf <- sfds
sfdds <- 343
sdfd
cppFunction('
int signnC(int x) {
if (x > 0) {
n return 1;
} else if (x == 0) {
return 0;
} else {
return -1;
}
}
')

View File

@ -0,0 +1,6 @@
Most of these examples are collected from elsewhere:
* [knitr-examples](https://github.com/yihui/knitr-examples)
* [rcpp-gallery](https://github.com/jjallaire/rcpp-gallery)
* [nXhtml tests](http://bazaar.launchpad.net/~nxhtml/nxhtml/main/files/835/tests)

View File

@ -0,0 +1,20 @@
doctype html
html
head
| Head stuff
body
.body: markdown:
# An awesome header
## Subheading one
Awesome Text
[stuff](Other Stuff)
button#clicky
coffee:
$('#clicky').click ->
elem = $(this)
this.text "Something Fantastic
ruby:
SomethingUnwise.call_at :the_wrong_place

View File

@ -0,0 +1,124 @@
/**
* @title Sorting Numeric Vectors in C++ and R
* @author Ross Bennett
* @license GPL (>= 2)
* @tags stl benchmark
* @summary Illustrates the comparison of different sorting algorithms with R
* and the C++ STL.
*/
/**
* Consider the problem to sort all elements of the given vector in ascending
* order. We can simply use the function `std::sort` from the C++ STL.
*/
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
NumericVector stl_sort(NumericVector x) {
NumericVector y = clone(x);
std::sort(y.begin(), y.end());
return y;
}
/*** R
library(rbenchmark)
set.seed(123)
z <- rnorm(100000)
x <- rnorm(100)
## check that stl_sort is the same as sort
stopifnot(all.equal(stl_sort(x), sort(x)))
## benchmark stl_sort and sort
benchmark(stl_sort(z), sort(z), order="relative")[,1:4]
*/
/**
* Consider the problem of sorting the first `n` elements of a given vector.
* The function `std::partial_sort` from the C++ STL does just this.
*/
// [[Rcpp::export]]
NumericVector stl_partial_sort(NumericVector x, int n) {
NumericVector y = clone(x);
std::partial_sort(y.begin(), y.begin()+n, y.end());
return y;
}
/**
* An alternate implementation of a partial sort algorithm is to use
* `std::nth_element` to partition the given vector at the nth sorted
* element and then use `std::sort`, both from the STL, to sort the vector
* from the beginning to the nth element.
*
* For an equivalent implementation in R, we can use the `sort` function by
* specifying a vector of `1:n` for the partial argument (i.e. `partial=1:n`).
*/
// [[Rcpp::export]]
NumericVector nth_partial_sort(NumericVector x, int nth) {
NumericVector y = clone(x);
std::nth_element(y.begin(), y.begin()+nth, y.end());
std::sort(y.begin(), y.begin()+nth);
return y;
}
/*** R
n <- 25000
# check that stl_partial_sort is equal to nth_partial_sort
stopifnot(all.equal(stl_partial_sort(x, 50)[1:50],
nth_partial_sort(x, 50)[1:50]))
# benchmark stl_partial_sort, nth_element_sort, and sort
benchmark(stl_partial_sort(z, n),
nth_partial_sort(z, n),
sort(z, partial=1:n),
order="relative")[,1:4]
*/
/**
* An interesting result to note is the gain in speed of
* `nth_partial_sort` over `stl_partial_sort`. In this case, for the given
* data, it is faster to use the combination of`std::nth_element` and
* `std::sort` rather than `std::partial_sort` to sort the first `n` elements
* of a vector.
*/
// [[Rcpp::export]]
NumericVector stl_nth_element(NumericVector x, int n) {
NumericVector y = clone(x);
std::nth_element(y.begin(), y.begin()+n, y.end());
return y;
}
/**
* Finally, consider a problem where you only need a single element of a
* sorted vector. The function `std::nth_element` from the C++ STL does just
* this. An example of this type of problem is computing the median of a given
* vector.
*
* For an equivalent implementation in R, we can use the `sort` function by
* specifying a scalar value for the argument partial (i.e. `partial=n`).
*/
/*** R
# check that the nth sorted elements of the vectors are equal
stopifnot(all.equal(stl_nth_element(x, 43)[43], sort(x, partial=43)[43]))
# benchmark nth_element and sort
benchmark(stl_nth_element(z, n),
sort(z, partial=n),
order="relative")[,1:4]
*/
/**
* While these are not huge speed improvements over the base R sort function,
* this post demonstrates how to easily access sorting functions in the C++
* STL and is a good exercise to better understand the differences and
* performance of the sorting algorithms available in C++ and R.
*/

View File

@ -0,0 +1,94 @@
% Title
% Author
% March 29, 2013
Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do
eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad
minim veniam, quis nostrud exercitation ullamco laboris nisi ut
aliquip ex ea commodo consequat. Duis aute irure dolor in
reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla
pariatur. Excepteur sint occaecat cupidatat non proident, sunt in
culpa qui officia deserunt mollit anim id est laborum.
```{r test1}
1+1
bla[[i]]
```
Sed ut perspiciatis unde omnis iste natus error sit voluptatem
accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae
ab illo inventore veritatis et quasi architecto beatae vitae dicta
sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit
aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos
qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui
dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed
quia non numquam eius modi tempora incidunt ut labore et dolore magnam
aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum
exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex
ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in
ea voluptate velit esse quam nihil molestiae consequatur, vel illum
qui dolorem eum fugiat quo voluptas nulla pariatur?
```{r test2, include = FALSE}
2+2
```
Non eram nescius, Brute, cum, quae summis ingeniis exquisitaque
doctrina philosophi Graeco sermone tractavissent, ea Latinis litteris
mandaremus, fore ut hic noster labor in varias reprehensiones
incurreret. nam quibusdam, et iis quidem non admodum indoctis, totum
hoc displicet philosophari. quidam autem non tam id reprehendunt, si
remissius agatur, sed tantum studium tamque multam operam ponendam in
eo non arbitrantur. erunt etiam, et ii quidem eruditi Graecis
litteris, contemnentes Latinas, qui se dicant in Graecis legendis
operam malle consumere. postremo aliquos futuros suspicor, qui me ad
alias litteras vocent, genus hoc scribendi, etsi sit elegans, personae
tamen et dignitatis esse negent.
At vero eos et accusamus et iusto odio dignissimos ducimus qui
blanditiis praesentium voluptatum deleniti atque corrupti quos dolores
et quas molestias excepturi sint occaecati cupiditate non provident,
similique sunt in culpa qui officia deserunt mollitia animi, id est
laborum et dolorum fuga. Et harum quidem rerum facilis est et expedita
distinctio. Nam libero tempore, cum soluta nobis est eligendi optio
cumque nihil impedit quo minus id quod maxime placeat facere possimus,
omnis voluptas assumenda est, omnis dolor repellendus. Temporibus
autem quibusdam et aut officiis debitis aut rerum necessitatibus saepe
eveniet ut et voluptates repudiandae sint et molestiae non
recusandae. Itaque earum rerum hic tenetur a sapiente delectus, ut aut
creiciendis voluptatibus maiores alias consequatur aut perferendis
doloribus asperiores repellat.
Contra quos omnis dicendum breviter existimo. Quamquam philosophiae
quidem vituperatoribus satis responsum est eo libro, quo a nobis
philosophia defensa et collaudata est, cum esset accusata et
vituperata ab Hortensio. qui liber cum et tibi probatus videretur et
iis, quos ego posse iudicare arbitrarer, plura suscepi veritus ne
movere hominum studia viderer, retinere non posse. Qui autem, si
maxime hoc placeat, moderatius tamen id volunt fieri, difficilem
quandam temperantiam postulant in eo, quod semel admissum coerceri
reprimique non potest, ut propemodum iustioribus utamur illis, qui
omnino avocent a philosophia, quam his, qui rebus infinitis modum
constituant reque eo, quo sit , mediocritatem
desiderent.
```R
aa <- function(x){
x + 3
}
aa(2)
```
```{r test3}
bb <- 3+3
bb[[1]]
```
Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do
eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad
minim veniam, quis nostrud exercitation ullamco laboris nisi ut
aliquip ex ea commodo consequat. Duis aute irure dolor in
reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla
pariatur. Excepteur sint occaecat cupidatat non proident, sunt in
culpa qui officia deserunt mollit anim id est laborum.

View File

@ -0,0 +1,42 @@
# Evaluate and echo different lines
For demonstration purposes, we may want to show some source code in the output,
but really evaluate different code in the background.
```{r}
hook_source <- knit_hooks$get('source')
knit_hooks$set(source = function(x, options) {
res <- hook_source(x, options)
gsub("(^|\n)#'#' ", '\\1', res)
})
```
The trick is to mask the source code in special comments (e.g. `#'#'`), and
remove the comment markers later. Of course, you have to guarantee these markers
are unique.
```{r test, echo=-3}
x <- 2
## 1/sqrt(2 * pi) * exp(-x^2/2)
dnorm(x)
```
```{r sdf}
dfdfd
```
We used `echo=-3` to remove the 3rd expression from the source code, and
`gsub()` to strip `#'#'` off.
This is completely hack. Use with care.
Example code:
```{r}
## Example code:
paggregate(argent[, 2:5], by = list(Transect = argent$Transect, Season = argent$Season), FUN = sum)
```

View File

@ -0,0 +1,34 @@
* emacs lisp code block
#+begin_src emacs-lisp :var tbl='()
(defun all-to-string (tbl)
(if (listp tbl)
(mapcar #'all-to-string tbl)
(if (stringp tbl)
tbl
(format "%s" tbl))))
(all-to-string tbl)
#+end_src
* java code block
#+begin_src java :classname myfirstjavaprog
class myfirstjavaprog
{
public static void main(String args[])
{
System.out.println("Hello World!");
}
}
#+end_src
#+begin_src C++
class myfirstjavaprog
{
public static void main(String args[])
{
System.out.println("Hello World!");
}
}
#+end_src

View File

@ -0,0 +1,37 @@
`ifndef WHATEVER_PKG_SV
`define WHATEVER_PKG_SV
`cinclude "randoccm_filename.svh"
//<pl> my $string = 'hat'; # comment test
package whatever;
logic www_w<$string> [<% ($random % 10) + 10 %> : <% $random % 10 %>];
//<pl> if ($define_s) {
function bit s(int x, int y);
return (x < 0 && y > 0) ? 1 : 0;
endfunction: s
//<pl> }
task fin();
#100ns;
$finish;
endtask: fin
<perl>
use strict;
use warnings;
our $str1 = "//Some random string...\n";
my $a1 = "str1"; # a "symbolic reference" -- contains the name of the variable to reference
if ($a1 ne "") {
no strict 'refs'; # since we have "use strict"
print $$a1;
}
</perl>
endpackage: whatever
`endif // WHATEVER_PKG_SV

View File

@ -0,0 +1,56 @@
---
title: "Some very clever title here"
author: "Author 1, Author 2"
date: "February, 2016"
output: html_document
comment: Posted by Fernando Mayer in #87
---
```{r setup, include=FALSE, purl=FALSE, eval=TRUE}
opts_chunk$set(
## knitr options
cache = TRUE,
tidy = FALSE,
## comment = NA,
fig.width = 10,
fig.height = 8,
fig.align = "center",
# dpi = 60, ## higher resolution
dev = "png"
# fig.path = "figures/",
)
```
# Packages
```{r, message=FALSE}
library(lattice)
library(car)
library(Matrix)
# library(INLA)
# library(FishMaps)
## extra functions
# source("script_functions.R")
```
# Data
```{r}
## Some data
dat <- data.frame(col1 = rnorm(100),
col2 = runif(100))
str(dat)
summary(dat)
```
Now we must create a simple plot of the two variables.
```{r}
plot(col2 ~ col1, data = dat)
```
And now we can do some transformation
```{r}
```

View File

@ -0,0 +1,71 @@
;;; packages.el --- my-polymode layer packages file for Spacemacs.
;;
;; Copyright (c) 2012-2017 Sylvain Benner & Contributors
;;
;; Author: Rongsong Shen <rshen@pc13z.cn.ibm.com>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;;; Commentary:
;; See the Spacemacs documentation and FAQs for instructions on how to implement
;; a new layer:
;;
;; SPC h SPC layers RET
;;
;;
;; Briefly, each package to be installed or configured by this layer should be
;; added to `my-polymode-packages'. Then, for each package PACKAGE:
;;
;; - If PACKAGE is not referenced by any other Spacemacs layer, define a
;; function `my-polymode/init-PACKAGE' to load and initialize the package.
;; - Otherwise, PACKAGE is already referenced by another Spacemacs layer, so
;; define the functions `my-polymode/pre-init-PACKAGE' and/or
;; `my-polymode/post-init-PACKAGE' to customize the package as it is loaded.
;;; Code:
(defconst my-polymode-packages
'((polymode :location local))
"The list of Lisp packages required by the my-polymode layer.
Each entry is either:
1. A symbol, which is interpreted as a package to be installed, or
2. A list of the form (PACKAGE KEYS...), where PACKAGE is the
name of the package to be installed or loaded, and KEYS are
any number of keyword-value-pairs.
The following keys are accepted:
- :excluded (t or nil): Prevent the package from being loaded
if value is non-nil
- :location: Specify a custom installation location.
The following values are legal:
- The symbol `elpa' (default) means PACKAGE will be
installed using the Emacs package manager.
- The symbol `local' directs Spacemacs to load the file at
`./local/PACKAGE/PACKAGE.el'
- A list beginning with the symbol `recipe' is a melpa
recipe. See: https://github.com/milkypostman/melpa#recipe-format")
(defun my-polymode/init-polymode ()
(use-package polymode
:defer t
:init (progn
(require 'polymode-configuration)))
)
(defun my-polymode/post-init-polymode ()
)
;;; packages.el ends here

View File

@ -0,0 +1,30 @@
#+TITLE: mytools layer
# The maximum height of the logo should be 200 pixels.
[[img/mytools.png]]
# TOC links should be GitHub style anchors.
* Table of Contents :TOC_4_gh:noexport:
- [[#description][Description]]
- [[#install][Install]]
- [[#key-bindings][Key bindings]]
* Description
This layer does wonderful things:
- thing01
* Install
To use this configuration layer, add it to your =~/.spacemacs=. You will need to
add =mytools= to the existing =dotspacemacs-configuration-layers= list in this
file.
* Key bindings
| Key Binding | Description |
|-------------+----------------|
| ~SPC x x x~ | Does thing01 |
# Use GitHub URLs if you wish to link a Spacemacs documentation file or its heading.
# Examples:
# [[https://github.com/syl20bnr/spacemacs/blob/master/doc/VIMUSERS.org#sessions]]
# [[https://github.com/syl20bnr/spacemacs/blob/master/layers/%2Bfun/emoji/README.org][Link to Emoji layer README.org]]
# If space-doc-mode is enabled, Spacemacs will open a local copy of the linked file.

View File

@ -0,0 +1,72 @@
;;; packages.el --- mytools layer packages file for Spacemacs.
;;
;; Copyright (c) 2012-2017 Sylvain Benner & Contributors
;;
;; Author: 沈荣松 <rongsongshen@E3-1275Lv3.shenrs.eu>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;;; Commentary:
;; See the Spacemacs documentation and FAQs for instructions on how to implement
;; a new layer:
;;
;; SPC h SPC layers RET
;;
;;
;; Briefly, each package to be installed or configured by this layer should be
;; added to `mytools-packages'. Then, for each package PACKAGE:
;;
;; - If PACKAGE is not referenced by any other Spacemacs layer, define a
;; function `mytools/init-PACKAGE' to load and initialize the package.
;; - Otherwise, PACKAGE is already referenced by another Spacemacs layer, so
;; define the functions `mytools/pre-init-PACKAGE' and/or
;; `mytools/post-init-PACKAGE' to customize the package as it is loaded.
;;; Code:
(defconst mytools-packages
'((vlfi :location (recipe :fetcher github
:repo "m00natic/vlfi")))
"The list of Lisp packages required by the mytools layer.
Each entry is either:
1. A symbol, which is interpreted as a package to be installed, or
2. A list of the form (PACKAGE KEYS...), where PACKAGE is the
name of the package to be installed or loaded, and KEYS are
any number of keyword-value-pairs.
The following keys are accepted:
- :excluded (t or nil): Prevent the package from being loaded
if value is non-nil
- :location: Specify a custom installation location.
The following values are legal:
- The symbol `elpa' (default) means PACKAGE will be
installed using the Emacs package manager.
- The symbol `local' directs Spacemacs to load the file at
`./local/PACKAGE/PACKAGE.el'
- A list beginning with the symbol `recipe' is a melpa
recipe. See: https://github.com/milkypostman/melpa#recipe-format")
(defun mytools/init-vlfi ()
;; (use-package vlfi
;; :defer t
;; :commands (vlf vlf-mode))
(require 'vlf-setup)
)
(defun mytools/post-init-vlfi ()
t)
;;; packages.el ends here

View File

@ -0,0 +1,31 @@
;; Configuration for cquery
;;; config.el --- lsp Layer config File for Spacemacs
;;
;; Copyright (c) 2012-2018 Sylvain Benner & Contributors
;;
;; Author: Fangrui Song <i@maskray.me>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;; ;; These all have toggles bound under 't' in spacemacs/lsp-define-keys-for-mode
(defvar mycquery-executable "/usr/local/bin/cquery"
"The executable file for cquery tool")
(defvar mycquery-extra-init-params
'(:index (:comments 2)
:cacheFormat "msgpack"
:completion (:detailedLabel t))
"Extra parameters for cquery init")
(defvar lsp-remap-xref-keybindings nil "When non-nil, xref keybindings remapped to lsp-ui-peek-find-*")
(defvar lsp-ui-peek-expand-by-default nil "Expand lsp-ui-peek by default (may have performance implications)")
(defvar lsp-ui-doc-enable t "Enable/disable lsp-ui-doc overlay")
(defvar lsp-ui-doc-include-signature nil "When non-nil, type signature included in the lsp-ui-doc overlay")
(defvar lsp-ui-sideline-enable t "Enable/disable lsp-ui-sideline overlay")
(defvar lsp-ui-sideline-show-symbol nil "When non-nil, sideline includes symbol info (largely redundant for c modes)") ; don't show symbol on the right of info
(defvar lsp-ui-sideline-ignore-duplicate t "Ignore duplicates")

View File

@ -0,0 +1,97 @@
;;; funcs.el --- lsp Layer funcs File for Spacemacs
;;
;; Copyright (c) 2012-2018 Sylvain Benner & Contributors
;;
;; Author: Fangrui Song <i@maskray.me>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
(defun spacemacs//lsp-sync-peek-face ()
"Synchronize the face used in `lsp-ui' peek window according to the theme."
(set-face-attribute 'lsp-ui-peek-list nil
:background (face-attribute 'hl-line :background nil t))
(set-face-attribute 'lsp-ui-peek-peek nil
:background (face-attribute 'hl-line :background nil t))
(set-face-attribute 'lsp-ui-peek-selection nil
:background (face-attribute 'highlight :background nil t)
:foreground (face-attribute 'default :foreground nil t))
(set-face-attribute 'lsp-ui-peek-filename nil
:foreground (face-attribute 'font-lock-constant-face
:foreground nil t))
(set-face-attribute 'lsp-ui-peek-highlight nil
:background (face-attribute 'highlight :background nil t)
:foreground (face-attribute 'highlight :foreground nil t)
:distant-foreground (face-attribute 'highlight
:foreground nil t))
(set-face-attribute 'lsp-ui-peek-header nil
:background (face-attribute 'highlight :background nil t)
:foreground (face-attribute 'default :foreground nil t))
)
(defun spacemacs/lsp-append-jump-handlers (mode)
;;; Override
(let ((handler (intern (format "spacemacs-jump-handlers-%s" mode))))
(add-to-list handler 'lsp-ui-peek-find-definitions))
;; The notion of 'spacemacs-reference-handlers' is the subject of this PR:
;; https://github.com/syl20bnr/spacemacs/pull/9911
;; Disabling for now...
;; (let ((handler (intern (format "spacemacs-reference-handlers-%s" mode))))
;; (add-to-list handler 'lsp-ui-peek-find-references))
)
(defun spacemacs/lsp-bind-keys-for-mode (mode)
"Define key bindings for the specific MODE."
(spacemacs/declare-prefix-for-mode mode "m=" "format")
(spacemacs/declare-prefix-for-mode mode "mg" "goto")
(spacemacs/declare-prefix-for-mode mode "ml" "lsp")
(spacemacs/declare-prefix-for-mode mode "mr" "refactor")
(spacemacs/declare-prefix-for-mode mode "mT" "toggle")
(spacemacs/set-leader-keys-for-major-mode mode
;;Format
"=b" #'spacemacs/lsp-format-buffer
;;goto
"gi" #'lsp-ui-imenu
"gd" #'lsp-ui-peek-find-definitions
"gr" #'lsp-ui-peek-find-references
"gs" #'lsp-ui-peek-find-workspace-symbol
;;refactor
"rr" #'lsp-rename
;;toggles
"Td" #'lsp-ui-doc-mode
"Ts" #'lsp-ui-sideline-mode
"TF" #'spacemacs/lsp-ui-doc-func
"TS" #'spacemacs/lsp-ui-sideline-symb
"TI" #'spacemacs/lsp-ui-sideline-ignore-duplicate
)
)
(defun spacemacs/lsp-ui-doc-func ()
"Toggle the function signature in the lsp-ui-doc overlay"
(interactive)
(setq lsp-ui-doc-include-signature (not lsp-ui-doc-include-signature)))
(defun spacemacs/lsp-ui-sideline-symb ()
"Toggle the symbol in the lsp-ui-sideline overlay.
(generally redundant in C modes)"
(interactive)
(setq lsp-ui-sideline-show-symbol (not lsp-ui-sideline-show-symbol)))
(defun spacemacs/lsp-ui-sideline-ignore-duplicate ()
"Toggle ignore duplicates for lsp-ui-sideline overlay"
(interactive)
(setq lsp-ui-sideline-ignore-duplicate (not lsp-ui-sideline-ignore-duplicate)))
;; Used for lsp-ui-peek-mode, but may be able to use some spacemacs fn. instead?
(defun spacemacs/lsp-define-key (keymap key def &rest bindings)
"Define multiple key bindings with KEYMAP KEY DEF BINDINGS."
(interactive)
(while key
(define-key keymap (kbd key) def)
(setq key (pop bindings)
def (pop bindings))))

View File

@ -0,0 +1,137 @@
;;; packages.el --- mycquery layer packages file for Spacemacs.
;;
;; Copyright (c) 2012-2016 Sylvain Benner & Contributors
;;
;; Author: Rongsong Shen <rshen@E3-1275LV3>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;;; Commentary:
;; See the Spacemacs documentation and FAQs for instructions on how to implement
;; a new layer:
;;
;; SPC h SPC layers RET
;;
;;
;; Briefly, each package to be installed or configured by this layer should be
;; added to `mycquery-packages'. Then, for each package PACKAGE:
;;
;; - If PACKAGE is not referenced by any other Spacemacs layer, define a
;; function `mycquery/init-PACKAGE' to load and initialize the package.
;; - Otherwise, PACKAGE is already referenced by another Spacemacs layer, so
;; define the functions `mycquery/pre-init-PACKAGE' and/or
;; `mycquery/post-init-PACKAGE' to customize the package as it is loaded.
;;; Code:
(defconst mycquery-packages
'((cquery :location (recipe :fetcher github :repo "cquery-project/emacs-cquery"))
(company-lsp :requires company)
(flycheck-lsp :requires flycheck :location built-in)
lsp-mode
lsp-ui
(lsp-imenu :requires imenu :location built-in)
(lsp-ui-imenu :requires lsp-imenu :location built-in)
)
"The list of Lisp packages required by the mycquery layer.
Each entry is either:
1. A symbol, which is interpreted as a package to be installed, or
2. A list of the form (PACKAGE KEYS...), where PACKAGE is the
name of the package to be installed or loaded, and KEYS are
any number of keyword-value-pairs.
The following keys are accepted:
- :excluded (t or nil): Prevent the package from being loaded
if value is non-nil
- :location: Specify a custom installation location.
The following values are legal:
- The symbol `elpa' (default) means PACKAGE will be
installed using the Emacs package manager.
- The symbol `local' directs Spacemacs to load the file at
`./local/PACKAGE/PACKAGE.el'
- A list beginning with the symbol `recipe' is a melpa
recipe. See: https://github.com/milkypostman/melpa#recipe-format")
(defun cquery/enable ()
(condition-case nil
(lsp-cquery-enable)
(lsp-ui-imenu)
(user-error nil)))
(defun mycquery/init-cquery ()
(use-package cquery
:defer t
:commands lsp-cquery-enable
:init (add-hook 'c-mode-common-hook #'cquery/enable)))
(defun mycquery/post-init-cquery ()
t)
(defun mycquery/init-lsp-mode ()
(use-package lsp-mode
:defer t
:commands lsp-mode))
(defun mycquery/post-init-lsp-mode ()
t)
(defun mycquery/init-lsp-ui ()
(use-package lsp-ui
:defer t
:init (add-hook 'lsp-mode-hook 'lsp-ui-mode)
:config (progn
(spacemacs//lsp-sync-peek-face)
(add-hook 'spacemacs-post-theme-change-hook
#'spacemacs//lsp-sync-peek-face)
(if lsp-ui-peek-expand-by-default
(setq lsp-ui-peek-expand-function (lambda (xs) (mapcar #'car xs))))
(if lsp-remap-xref-keybindings
(progn (define-key lsp-ui-mode-map [remap xref-find-definitions] #'lsp-ui-peek-find-definitions)
(define-key lsp-ui-mode-map [remap xref-find-references] #'lsp-ui-peek-find-references)))
(spacemacs/lsp-define-key
lsp-ui-peek-mode-map
"h" #'lsp-ui-peek--select-prev-file
"j" #'lsp-ui-peek--select-next
"k" #'lsp-ui-peek--select-prev
"l" #'lsp-ui-peek--select-next-file
))))
(defun mycquery/post-init-lsp-ui ()
)
(defun mycquery/init-company-lsp ()
(use-package company-lsp
:defer t
:init (setq company-transformers nil
company-lsp-async t
company-lsp-cache-candidates nil)))
(defun mycquery/post-init-company-lsp ())
(defun mycquery/init-flycheck-lsp ()
(setq lsp-enable-flycheck nil))
(defun mycqury/init-lsp-imenu ()
(use-package lsp-imenu :defer t :init (add-hook 'lsp-after-open-hook #'lsp-enable-imenu)))
(defun mycquery/init-lsp-ui-imenu ()
(use-package lsp-ui-imenu :defer t :config (evil-make-overriding-map lsp-ui-imenu-mode-map)))
;;; packages.el ends here

View File

@ -0,0 +1,29 @@
#+TITLE: myeiffel layer
#+HTML_HEAD_EXTRA: <link rel="stylesheet" type="text/css" href="../css/readtheorg.css" />
#+CAPTION: logo
# The maximum height of the logo should be 200 pixels.
[[img/myeiffel.png]]
* Table of Contents :TOC_4_org:noexport:
- [[Description][Description]]
- [[Install][Install]]
- [[Key bindings][Key bindings]]
* Description
This layer add the support of Eiffel to Spacemacs:
* Install
To use this contribution add it to your =~/.spacemacs=
#+begin_src emacs-lisp
(setq-default dotspacemacs-configuration-layers '(myeiffel))
#+end_src
* Key bindings
| Key Binding | Description |
|-----------------+----------------|
| | |

View File

@ -0,0 +1,3 @@
;; add functions here which can be used in myeiffel layer
(defun spacemacs/eiffel-define-keys ()
)

Binary file not shown.

After

Width:  |  Height:  |  Size: 576 KiB

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,24 @@
(require 'evil)
(require 'eiffel)
(define-minor-mode evil-eiffel-mode
"Buffer local minor mode for evil-eiffel"
:init-value nil
:lighter "EvilEiffel"
:keymap (make-sparse-keymap)
:group 'evil-eiffel)
(add-hook 'eiffel-mode-hook 'evil-eiffel-mode)
(mapc #'(lambda (state)
(evil-define-key state evil-eiffel-mode-map
(kbd "M-c") 'eif-compile
(kbd "M-r") 'eif-run
(kbd "M-d") 'eif-debug
(kbd "M-o") 'eif-set-compile-options
(kbd "M-s") 'eif-short
(kbd "M-e") 'eif-next-error
))
'(normal insert))
(provide 'evil-eiffel)

View File

@ -0,0 +1,83 @@
;;; packages.el --- myeiffel layer packages file for Spacemacs.
;;
;; Copyright (c) 2012-2016 Sylvain Benner & Contributors
;;
;; Author: Rongsong Shen <rshen@E3-1275LV3>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;;; Commentary:
;; See the Spacemacs documentation and FAQs for instructions on how to implement
;; a new layer:
;;
;; SPC h SPC layers RET
;;
;;
;; Briefly, each package to be installed or configured by this layer should be
;; added to `myeiffel-packages'. Then, for each package PACKAGE:
;;
;; - If PACKAGE is not referenced by any other Spacemacs layer, define a
;; function `myeiffel/init-PACKAGE' to load and initialize the package.
;; - Otherwise, PACKAGE is already referenced by another Spacemacs layer, so
;; define the functions `myeiffel/pre-init-PACKAGE' and/or
;; `myeiffel/post-init-PACKAGE' to customize the package as it is loaded.
;;; Code:
(defconst myeiffel-packages
'((eiffel :location local)
(evil-eiffel :location local))
"The list of Lisp packages required by the myeiffel layer.
Each entry is either:
1. A symbol, which is interpreted as a package to be installed, or
2. A list of the form (PACKAGE KEYS...), where PACKAGE is the
name of the package to be installed or loaded, and KEYS are
any number of keyword-value-pairs.
The following keys are accepted:
- :excluded (t or nil): Prevent the package from being loaded
if value is non-nil
- :location: Specify a custom installation location.
The following values are legal:
- The symbol `elpa' (default) means PACKAGE will be
installed using the Emacs package manager.
- The symbol `local' directs Spacemacs to load the file at
`./local/PACKAGE/PACKAGE.el'
- A list beginning with the symbol `recipe' is a melpa
recipe. See: https://github.com/milkypostman/melpa#recipe-format")
(defun myeiffel/init-eiffel ()
(use-package eiffel
:defer t
:mode ("\\.e$" . eiffel-mode)))
(defun myeiffel/init-evil-eiffel ()
(use-package evil-eiffel
:commands evil-eiffel-mode
:init (add-hook 'eiffel-mode-hook 'evil-eiffel-mode)
:config (progn
(spacemacs/set-leader-keys-for-major-mode 'eiffel-mode
"c" 'eif-compile
"r" 'eif-run
"o" 'eif-set-compile-options
"d" 'eif-debug
"s" 'eif-short
"e" 'next-error))))
(defun myeiffel/post-init-eiffel ()
)
;;; packages.el ends here

View File

@ -0,0 +1,29 @@
#+TITLE: mymermaid layer
#+HTML_HEAD_EXTRA: <link rel="stylesheet" type="text/css" href="../css/readtheorg.css" />
#+CAPTION: logo
# The maximum height of the logo should be 200 pixels.
[[img/mymermaid.png]]
* Table of Contents :TOC_4_org:noexport:
- [[Description][Description]]
- [[Install][Install]]
- [[Key bindings][Key bindings]]
* Description
This layer does wonderful things:
- thing01
* Install
To use this contribution add it to your =~/.spacemacs=
#+begin_src emacs-lisp
(setq-default dotspacemacs-configuration-layers '(mymermaid))
#+end_src
* Key bindings
| Key Binding | Description |
|-----------------+----------------|
| ~<SPC> x x x~ | Does thing01 |

View File

@ -0,0 +1,20 @@
(require 'evil)
(require 'mermaid-mode)
(define-minor-mode evil-mermaid-mode
"Buffer local minor mode for evil-mermaid"
:init-value nil
:lighter "EvilMermaid"
:keymap (make-sparse-keymap)
:group 'evil-mermaid)
(add-hook 'mermaid-mode-hook 'evil-mermaid-mode)
(mapc #'(lambda (state)
(evil-define-key state evil-mermaid-mode-map
(kbd "M-c") 'mermaid-compile
(kbd "M-v") 'mermaid-view
))
'(normal insert))
(provide 'evil-mermaid)

View File

@ -0,0 +1,239 @@
;; mermaid mode
(defvar mermaid-mode-hook nil
"initial hook for mermaid mode"
)
(defun mermaid-compilation-mode-hook ()
"Hook function to set local value for `compilation-error-screen-columns'."
;; In Emacs > 20.7 compilation-error-screen-columns is buffer local.
(or (assq 'compilation-error-screen-columns (buffer-local-variables))
(make-local-variable 'compilation-error-screen-columns))
(setq compilation-error-screen-columns nil))
(defvar mermaid-output-format 'png
"The format of generated file")
(defvar mermaid-verbose nil
"Show verbose information when run compiler")
(defvar mermaid-compiler "mermaid"
"The compiler used to generate output")
(defvar mermaid-mode-map
(let ((map (make-sparse-keymap)))
;; add key bindings for mermaid mode here
;;
(define-key map "\C-j" 'newline-and-indent)
(define-key map "\C-c\C-c" 'mermaid-compile)
(define-key map "\C-c\C-v" 'mermaid-view)
map)
"Keymap for mermaid mode")
(defconst mermaid-font-lock-keywords-1
'(("^[ \t]*\\(graph\\|subgraph\\|end\\|loop\\|alt\\|gantt\\|title\\|section\\|dateFormat\\|sequenceDiagram\\|opt\\|participant\\|note\\|else\\|gitGraph\\|options\\)" . font-lock-keyword-face)
("^[ \t]*graph[ \t]+\\(TD|\\TB\\|BT\\RL\\|LR\\)" . font-lock-keyword-face)
("%%\\(.*$\\)" . font-lock-comment-face)
("{\\(.*\\)}" . font-lock-string-face)
(":\\([^%\012]*\\)[^%\012]*$" . font-lock-warning-face)
)
"keyword in mermaid mode"
)
(defconst mermaid-new-scope-regexp
"^[ \t]*\\(loop\\|opt\\|subgraph\\|graph\\|sequenceDiagram\\|gantt\\|gitGraph\\|{\\)\\([ \t]*\\|$\\)"
"keyword to start a new scope(indent level)")
(defconst mermaid-end-scope-regexp
"^[ \t]*\\(end\\|}\\)\\([ \t]*\\|$\\)"
"keyword for end a scope(maybe also start a new scope)")
(defconst mermaid-section-regexp
"^[ \t]*\\(section\\)[ \t]+"
"section keyword")
(defconst mermaid-else-regexp
"^[ \t]*\\(else\\)"
"else keyword")
(defconst mermaid-alt-regexp
"^[ \t]*\\(alt\\)"
"alt keyword")
(defun mermaid-output-ext ()
"get the extendsion of generated file"
(if (eq mermaid-output-format 'svg)
".svg"
".png"))
;;;###autoload
(defun mermaid-compile ()
(interactive)
(let ((cmd (concat mermaid-compiler
(if (eq mermaid-output-format 'svg)
" --svg "
" ")
(if mermaid-verbose
" --verbose "
" ")
(buffer-file-name)))
(buf-name "*mermaid compilation")
(compilation-mode-hook (cons 'mermaid-compilation-mode-hook compilation-mode-hook)))
(if (fboundp 'compilation-start)
(compilation-start cmd nil
#'(lambda (mode-name)
buf-name))
(compile-internal cmd "No more errors" buf-name))))
;;;###autoload
(defun mermaid-view ()
(interactive)
(let ((dst-file-name (concat (buffer-file-name)
(mermaid-output-ext))))
(if (file-exists-p dst-file-name)
(find-file-other-window dst-file-name)
(error "Please compile the it first!\n"))))
;; disable debug in default
;;
(defvar mermaid-debug-enabled nil
"enable/disable debug")
(defmacro mermaid-debug (fmt &rest args)
`(when mermaid-debug-enabled
(message ,fmt ,@args)))
(defun mermaid-indent-line ()
"indent current line in mermaid mode"
(interactive)
(mermaid-debug "line no @ %d\n" (line-number-at-pos))
(beginning-of-line)
(if (bobp)
(indent-line-to 0)
(let (cur-indent)
(cond
((looking-at mermaid-end-scope-regexp)
(progn
(mermaid-debug "found end scope\n")
(save-excursion
(forward-line -1)
(if (or (looking-at mermaid-new-scope-regexp)
(looking-at mermaid-alt-regexp))
(setq cur-indent (current-indentation))
(setq cur-indent (- (current-indentation) default-tab-width)))
(if (< cur-indent 0)
(setq cur-indent 0)))))
((looking-at mermaid-section-regexp)
(let ((found-section nil)
(need-search t))
(mermaid-debug "found section\n")
(save-excursion
(while need-search
(forward-line -1)
(cond
((looking-at mermaid-section-regexp)
(progn
(mermaid-debug "found section\n")
(setq found-section t)
(setq cur-indent (current-indentation))
(mermaid-debug "cur-indent %d\n" cur-indent)
(setq need-search nil)))
((or (looking-at mermaid-new-scope-regexp)
(looking-at mermaid-alt-regexp))
(progn
(mermaid-debug "found new scope\n")
(setq cur-indent (+ (current-indentation) default-tab-width))
(mermaid-debug "cur-indent %d\n" cur-indent)
(setq need-search nil)))
((looking-at mermaid-end-scope-regexp)
(progn
(mermaid-debug "found end scope\n")
(setq cur-indent (current-indentation))
(mermaid-debug "cur-indent %d\n" cur-indent)
(setq need-search nil)))
((bobp)
(progn
(setq cur-indent 0)
(setq need-search nil)))
(t t))))
(if (< cur-indent 0)
(setq cur-indent 0))))
((looking-at mermaid-else-regexp)
(let ((need-search t))
(mermaid-debug "else\n")
(save-excursion
(while need-search
(forward-line -1)
(cond
((or (looking-at mermaid-else-regexp)
(looking-at mermaid-alt-regexp))
(progn
(mermaid-debug "found matched alt/else\n")
(setq cur-indent (current-indentation))
(mermaid-debug "cur-indent %d\n" cur-indent)
(setq need-search nil)))
((looking-at mermaid-end-scope-regexp)
(progn
(mermaid-debug "found end\n")
(setq cur-indent (- (current-indentation) default-tab-width))
(setq need-search nil)))
((bobp)
(progn
(setq cur-indent 0)))
(t t))))))
(t
(let ((need-search t)
(start-scope (looking-at mermaid-new-scope-regexp)))
(mermaid-debug "normal indent\n")
(save-excursion
(while need-search
(forward-line -1)
(cond
((looking-at mermaid-end-scope-regexp)
(progn
(mermaid-debug "found end scope\n")
(setq cur-indent (current-indentation))
(mermaid-debug "cur-indent %d\n" cur-indent)
(setq need-search nil)))
((or (looking-at mermaid-new-scope-regexp)
(looking-at mermaid-alt-regexp))
(progn
(mermaid-debug "found begin scope\n")
(setq cur-indent (+ (current-indentation) default-tab-width))
(mermaid-debug "cur-indent %d\n" cur-indent)
(setq need-search nil)))
((looking-at mermaid-section-regexp)
(progn
(mermaid-debug "found section \n")
(if start-scope
(setq cur-indent (current-indentation))
(setq cur-indent (+ (current-indentation) default-tab-width)))
(mermaid-debug "cur-indent %d\n" cur-indent)
(setq need-search nil)))
((bobp)
(progn
(setq cur-indent 0)
(setq need-search nil)))))))))
(if cur-indent
(indent-line-to cur-indent)
(indent-line-to 0)))))
;;;###autoload
(defun mermaid-mode ()
"Major mode for editing mermaid scripts"
(interactive)
(kill-all-local-variables)
(use-local-map mermaid-mode-map)
(set (make-local-variable 'font-lock-defaults)
'(mermaid-font-lock-keywords-1))
(set (make-local-variable 'indent-line-function)
'mermaid-indent-line)
(set (make-local-variable 'comment-start) "%%")
(set (make-local-variable 'comment-end) "\n")
(setq font-lock-keywords-case-fold-search t)
(setq major-mode 'mermaid-mode)
(setq mode-name "mermaid")
(run-hooks 'mermaid-mode-hook)
)
(provide 'mermaid-mode)

View File

@ -0,0 +1,77 @@
;;; packages.el --- mymermaid layer packages file for Spacemacs.
;;
;; Copyright (c) 2012-2016 Sylvain Benner & Contributors
;;
;; Author: Rongsong Shen <rshen@pc13x.cn.ibm.com>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;;; Commentary:
;; See the Spacemacs documentation and FAQs for instructions on how to implement
;; a new layer:
;;
;; SPC h SPC layers RET
;;
;;
;; Briefly, each package to be installed or configured by this layer should be
;; added to `mymermaid-packages'. Then, for each package PACKAGE:
;;
;; - If PACKAGE is not referenced by any other Spacemacs layer, define a
;; function `mymermaid/init-PACKAGE' to load and initialize the package.
;; - Otherwise, PACKAGE is already referenced by another Spacemacs layer, so
;; define the functions `mymermaid/pre-init-PACKAGE' and/or
;; `mymermaid/post-init-PACKAGE' to customize the package as it is loaded.
;;; Code:
(defconst mymermaid-packages
'((mermaid :location local)
(evil-mermaid :location local))
"The list of Lisp packages required by the mymermaid layer.
Each entry is either:
1. A symbol, which is interpreted as a package to be installed, or
2. A list of the form (PACKAGE KEYS...), where PACKAGE is the
name of the package to be installed or loaded, and KEYS are
any number of keyword-value-pairs.
The following keys are accepted:
- :excluded (t or nil): Prevent the package from being loaded
if value is non-nil
- :location: Specify a custom installation location.
The following values are legal:
- The symbol `elpa' (default) means PACKAGE will be
installed using the Emacs package manager.
- The symbol `local' directs Spacemacs to load the file at
`./local/PACKAGE/PACKAGE.el'
- A list beginning with the symbol `recipe' is a melpa
recipe. See: https://github.com/milkypostman/melpa#recipe-format")
(defun mymermaid/init-mermaid ()
(use-package mermaid
:defer t
:mode ("\\.mmd\\'" . mermaid-mode)))
(defun mymermaid/init-evil-mermaid ()
(use-package evil-mermaid
:commands evil-mermaid-mode
:init (add-hook 'mermaid-mode-hook 'evil-mermaid-mode)
:config (progn
(spacemacs/set-leader-keys-for-major-mode 'mermaid-mode
"c" 'mermaid-compile
"v" 'mermaid-view))))
;;; packages.el ends here

View File

@ -0,0 +1,2 @@
(defvar pollen-templates-directory "~/workenv/templates.pollen/"
"Default directory for pollen templates")

View File

@ -0,0 +1,30 @@
;; add functions here which can be used in mypollen layer
(defun generate-pollen-document (name)
(let ((context (concat "#lang pollen\n"
"◊(define-meta title \"Sample Pollen Document\")\n"
"◊(define-meta author \"Rongsong Shen\")\n"
"◊(define-meta publisher \"GNU Publisher\")\n"
"◊(define-meta thanklessauthor \"autherX\")"
"◊(define-meta thankslesspublisher \"GNU Less Publisher\")"
"◊(define-meta doc-publish-date \"2016-10-17\")\n"
"◊;using ◊part{} ◊chapter{} as the top two levels of book\n"
"◊;using ◊section{} and ◊subsection{} in tufte-handout\n"
"\n◊;add document here\n")))
(append-to-file context nil name)))
(defun pollen-use-template (template destdir)
(interactive
(let ((template-used (read-directory-name "Choose template:"
(expand-file-name pollen-templates-directory)
nil nil nil))
(destdir-used (read-string "Destination:")))
(list template-used destdir-used)))
(when (and template destdir)
(let ((tmp-buf (current-buffer)))
(apply 'make-comint "/bin/sh" "/bin/sh" nil
(list "-c" (concat "cp -Rf " template " " destdir)))
(switch-to-buffer tmp-buf)
(switch-to-buffer-other-window "* SHELL *")
(let ((name (concat destdir "/doc.poly.pm")))
(generate-pollen-document name)))))

View File

@ -0,0 +1,81 @@
(require 'evil)
(require 'pollen-mode)
(require 'comint)
(defun insert-lozenge ()
"inserts the lozenge character for use with Pollen"
;; enables function through M-x
(interactive)
;; insert the proper character
(insert (make-char
'mule-unicode-2500-33ff 34 42)))
(defcustom pollen-target-format "pdf"
"Options to build pollen document"
:type 'string
:group 'pollen-mode)
(defun pollen-target-file (source)
(replace-regexp-in-string "\\.poly\\.pm"
(concat "." pollen-target-format)
source))
(defun pollen-build ()
"Build pollen document"
(interactive)
(let* ((tmp-buf (current-buffer))
(file-name (buffer-file-name))
(cmd (concat "raco pollen render "
(pollen-target-file file-name)))
(buf-name "*pollen compilation *"))
(if (fboundp 'compilation-start)
(compilation-start cmd nil #'(lambda (mode-name)
buf-name))
(compile-internal cmd "no more errors" buf-name))))
(defun pollen-set-target-format ()
(interactive)
(let ((fmt (read-string
"Output format:")))
(if (or (string= fmt "pdf")
(string= fmt "html")
(string= fmt "txt")
(string= fmt "ltx"))
(setq pollen-target-format fmt)
(message "Unsupported format %s\n" fmt))))
(defun pollen-view ()
(interactive)
(let* ((file-name (concat (pollen-target-file (buffer-file-name))))
(cmd "open")
(tmp-buf (current-buffer)))
(apply 'make-comint cmd cmd nil (list file-name))
(switch-to-buffer tmp-buf)
(switch-to-buffer-other-window (concat "*" cmd "*"))))
(defun pollen-reset ()
(interactive)
(let ((cmd "raco")
(tmp-buf (current-buffer)))
(apply 'make-comint cmd cmd nil (list "pollen" "reset"))
(switch-to-buffer tmp-buf)
(switch-to-buffer-other-window (concat "*" cmd "*"))))
(define-minor-mode evil-pollen-mode
"Buffer local minor mode for evil-pollen "
:init-value nil
:lighter "EvilPollen"
:keymap (make-sparse-keymap)
:group 'evil-pollen)
(mapc #'(lambda (state)
(evil-define-key state evil-pollen-mode-map
(kbd "M-b") 'pollen-build
(kbd "M-f") 'pollen-set-target-format
(kbd "M-v") 'pollen-view
(kbd "M-c") 'pollen-reset))
'(normal insert))
(global-set-key "\M-\\" 'insert-lozenge)
(provide 'evil-pollen)

View File

@ -0,0 +1,92 @@
;;; packages.el --- pollen layer packages file for Spacemacs.
;;
;; Copyright (c) 2012-2016 Sylvain Benner & Contributors
;;
;; Author: Rongsong Shen <rshen@E3-1275LV3>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;;; Commentary:
;; See the Spacemacs documentation and FAQs for instructions on how to implement
;; a new layer:
;;
;; SPC h SPC layers RET
;;
;;
;; Briefly, each package to be installed or configured by this layer should be
;; added to `pollen-packages'. Then, for each package PACKAGE:
;;
;; - If PACKAGE is not referenced by any other Spacemacs layer, define a
;; function `pollen/init-PACKAGE' to load and initialize the package.
;; - Otherwise, PACKAGE is already referenced by another Spacemacs layer, so
;; define the functions `pollen/pre-init-PACKAGE' and/or
;; `pollen/post-init-PACKAGE' to customize the package as it is loaded.
;;; Code:
(defconst mypollen-packages
'(
(pollen-mode :location (recipe :fetcher github :repo "shen390s/pollen-mode"))
(evil-pollen :location local))
"The list of Lisp packages required by the pollen layer.
Each entry is either:
1. A symbol, which is interpreted as a package to be installed, or
2. A list of the form (PACKAGE KEYS...), where PACKAGE is the
name of the package to be installed or loaded, and KEYS are
any number of keyword-value-pairs.
The following keys are accepted:
- :excluded (t or nil): Prevent the package from being loaded
if value is non-nil
- :location: Specify a custom installation location.
The following values are legal:
- The symbol `elpa' (default) means PACKAGE will be
installed using the Emacs package manager.
- The symbol `local' directs Spacemacs to load the file at
`./local/PACKAGE/PACKAGE.el'
- A list beginning with the symbol `recipe' is a melpa
recipe. See: https://github.com/milkypostman/melpa#recipe-format")
(defun mypollen/init-pollen-mode ()
(use-package pollen-mode
:defer t
:commands pollen-mode
:mode ("\\.poly\\.pm$" . pollen-mode)))
(defun mypollen/post-init-pollen-mode ()
(add-hook 'pollen-mode-hook
#'(lambda ()
(smartparens-mode 1)
(rainbow-delimiters-mode 1)
(auto-fill-mode 1))))
(defun mypollen/init-evil-pollen ()
(use-package evil-pollen
:defer t
:commands evil-pollen-mode
:init (add-hook 'pollen-mode-hook 'evil-pollen-mode)
:config (progn
(spacemacs/set-leader-keys-for-major-mode 'pollen-mode
"b" 'pollen-build
"f" 'pollen-set-target-format
"v" 'pollen-view
"c" 'pollen-reset
"n" 'next-error))))
(defun mypollen/post-init-evil-pollen ()
)
;;; packages.el ends here

View File

@ -0,0 +1 @@
;; add functions here which can be used in myeiffel layer

View File

@ -0,0 +1,71 @@
(require 'evil)
(require 'scribble)
(require 'comint)
(defun insert-lozenge ()
"inserts the lozenge character for use with Pollen"
;; enables function through M-x
(interactive)
;; insert the proper character
(insert (make-char
'mule-unicode-2500-33ff 34 42)))
(defcustom scribble-target-format "pdf"
"Options to build scribble document"
:type 'string
:group 'scribble-mode)
(defun scribble-build ()
"Build scribble document"
(interactive)
(setq scribble-build-options
(if (string= scribble-target-format "pdf")
"--pdf"
"--html"))
(let* ((tmp-buf (current-buffer))
(file-name (buffer-file-name))
(cmd (concat "scribble "
scribble-build-options
" " file-name))
(buf-name "*scribble compilation *"))
(if (fboundp 'compilation-start)
(compilation-start cmd nil #'(lambda (mode-name)
buf-name))
(compile-internal cmd "no more errors" buf-name))))
(defun scribble-set-target-format ()
(interactive)
(let ((fmt (read-string
"Output format:")))
(if (or (string= fmt "pdf")
(string= fmt "html"))
(setq scribble-target-format fmt)
(message "Unsupported format %s\n" fmt))))
(defun scribble-view ()
(interactive)
(let* ((file-name (concat (file-name-base (buffer-file-name))
"." scribble-target-format))
(cmd "open")
(tmp-buf (current-buffer)))
(apply 'make-comint cmd cmd nil (list file-name))
(switch-to-buffer tmp-buf)
(switch-to-buffer-other-window (concat "*" cmd "*"))))
(define-minor-mode evil-scribble-mode
"Buffer local minor mode for evil-scribble "
:init-value nil
:lighter "EvilScribble"
:keymap (make-sparse-keymap)
:group 'evil-scribble)
(mapc #'(lambda (state)
(evil-define-key state evil-scribble-mode-map
(kbd "M-b") 'scribble-build
(kbd "M-f") 'scribble-set-target-format
(kbd "M-v") 'scribble-view))
'(normal insert))
(global-set-key "\M-\\" 'insert-lozenge)
(provide 'evil-scribble)

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,87 @@
;;; packages.el --- scribble layer packages file for Spacemacs.
;;
;; Copyright (c) 2012-2016 Sylvain Benner & Contributors
;;
;; Author: Rongsong Shen <rshen@E3-1275LV3>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;;; Commentary:
;; See the Spacemacs documentation and FAQs for instructions on how to implement
;; a new layer:
;;
;; SPC h SPC layers RET
;;
;;
;; Briefly, each package to be installed or configured by this layer should be
;; added to `scribble-packages'. Then, for each package PACKAGE:
;;
;; - If PACKAGE is not referenced by any other Spacemacs layer, define a
;; function `scribble/init-PACKAGE' to load and initialize the package.
;; - Otherwise, PACKAGE is already referenced by another Spacemacs layer, so
;; define the functions `scribble/pre-init-PACKAGE' and/or
;; `scribble/post-init-PACKAGE' to customize the package as it is loaded.
;;; Code:
(defconst myscribble-packages
'((scribble :location local)
(evil-scribble :location local))
"The list of Lisp packages required by the scribble layer.
Each entry is either:
1. A symbol, which is interpreted as a package to be installed, or
2. A list of the form (PACKAGE KEYS...), where PACKAGE is the
name of the package to be installed or loaded, and KEYS are
any number of keyword-value-pairs.
The following keys are accepted:
- :excluded (t or nil): Prevent the package from being loaded
if value is non-nil
- :location: Specify a custom installation location.
The following values are legal:
- The symbol `elpa' (default) means PACKAGE will be
installed using the Emacs package manager.
- The symbol `local' directs Spacemacs to load the file at
`./local/PACKAGE/PACKAGE.el'
- A list beginning with the symbol `recipe' is a melpa
recipe. See: https://github.com/milkypostman/melpa#recipe-format")
(defun myscribble/init-scribble ()
(use-package scribble
:defer t
:commands scribble-mode
:mode ("\\.scrbl$" . scribble-mode)))
(defun myscribble/post-init-scribble ()
)
(defun myscribble/init-evil-scribble ()
(use-package evil-scribble
:defer t
:commands evil-scribble-mode
:init (add-hook 'scribble-mode-hook 'evil-scribble-mode)
:config (progn
(spacemacs/set-leader-keys-for-major-mode 'scribble-mode
"b" 'scribble-build
"f" 'scribble-set-target-format
"v" 'scribble-view
"n" 'next-error))))
(defun myscribble/post-init-evil-scribble ()
)
;;; packages.el ends here

View File

@ -0,0 +1,29 @@
#+TITLE: orgtools layer
#+HTML_HEAD_EXTRA: <link rel="stylesheet" type="text/css" href="../css/readtheorg.css" />
#+CAPTION: logo
# The maximum height of the logo should be 200 pixels.
[[img/orgtools.png]]
* Table of Contents :TOC_4_org:noexport:
- [[Description][Description]]
- [[Install][Install]]
- [[Key bindings][Key bindings]]
* Description
This layer does wonderful things:
- thing01
* Install
To use this contribution add it to your =~/.spacemacs=
#+begin_src emacs-lisp
(setq-default dotspacemacs-configuration-layers '(orgtools))
#+end_src
* Key bindings
| Key Binding | Description |
|-----------------+----------------|
| ~<SPC> x x x~ | Does thing01 |

View File

@ -0,0 +1,45 @@
(require 'cl-lib)
(defun my-org-get-docinfo (info)
(interactive)
(save-excursion
(progn
(goto-char (point-min))
(let ((docinfo (if (re-search-forward "^[ \t]*\\*[ \t]+DOCUMENT[ \t]+METADATA" (point-max) t)
(org-entry-properties (point) nil)
nil)))
(add-to-list 'docinfo
(cons "AUTHOR"
(org-export-data (plist-get info :author) info)))
(add-to-list 'docinfo
(cons "PROJECT"
(org-export-data (plist-get info :title) info)))
docinfo))))
(defun my-org-get-table-name ()
(save-excursion
(if (re-search-backward "^[ \t]*#\\+NAME:[ \t]*\\([^ \t]*\\).*$")
(match-string 1)
"")))
(defvar orgtools-themes nil
"all themes we supported")
(defun orgtools-register-theme (name func)
"add a theme to our supported theme list"
(unless orgtools-themes
(advice-add 'org-latex-template :around #'orgtools-latex-template))
(unless (assoc name orgtools-themes)
(add-to-list 'orgtools-themes (list name func))))
(defun orgtools-latex-template (orig-fun &rest args)
(let* ((content (car args))
(info (car (cdr args)))
(docinfo (my-org-get-docinfo info)))
(let* ((theme (cdr (assoc "THEME" docinfo)))
(func (let ((vx (assoc theme orgtools-themes)))
(if vx
(car (cdr vx))
#'(lambda (content info docinfo)
(list content info ))))))
(apply orig-fun (apply func (list content info docinfo))))))

View File

@ -0,0 +1,164 @@
;;; ob-mermaid.el --- org-babel functions for mermaid evaluation
;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Rongsong Shen
;; Keywords: literate programming, mermaid
;; Homepage: http://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating mermaid source code.
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in mermaid
;;
;; 2) we are generally only going to return results of type "file"
;;
;; 3) we are adding the "file" and "cmdline" header arguments, if file
;; is omitted then the -V option is passed to the mermaid command for
;; interactive viewing
;;; Requirements:
;;
;; - mermaid-mode :: Major mode for editing mermaid files
;;; Code:
(require 'ob)
(eval-when-compile (require 'cl))
(defvar org-babel-default-header-args:mermaid
'((:results . "file") (:exports . "results"))
"Default arguments when evaluating an Mermaid source block.")
(defcustom org-mermaid-program "mmdc"
"Command of mermaid. The command should use command line `mmc sourcefile'"
:group 'org-babel
:version "24.1"
:type 'string)
(defcustom org-mermaid-convert "convert"
"Command for convert picture format. The command should use format `convert source destintion'"
:group 'org-babel
:version "24.1"
:type 'string)
(defun mermaid-shell-command (dir cmd)
(shell-command (concat "/bin/sh -c \" cd "
dir ";"
cmd "\"")))
(defun org-babel-expand-body:mermaid (body params &optional var-lines)
body)
(defun mermaid-script (body)
body)
(defun mermaid-run (fmt in-file out-file)
(cond ((string= fmt "svg")
(copy-file (concat (file-name-nondirectory in-file) ".svg")
out-file))
(t (mermaid-shell-command org-babel-temporary-directory
(concat org-mermaid-convert " "
(file-name-nondirectory in-file)
".svg" " "
out-file)))))
;;;###autoload
(defun org-babel-execute:mermaid (body params)
"Execute a block of Mermaid code.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (expand-file-name (cdr (assoc :file params))))
(format (or (and out-file
(string-match ".+\\.\\(.+\\)" out-file)
(match-string 1 out-file))
"pdf"))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "mermaid-"))
(cmd (concat org-mermaid-program " -i "
(file-name-nondirectory
(org-babel-process-file-name in-file)))))
(with-temp-file in-file
(insert (mermaid-script
(org-babel-expand-body:mermaid
body params))))
(mermaid-shell-command org-babel-temporary-directory
cmd)
(mermaid-run format in-file out-file)
nil)) ;; signal that output has already been written to file
;;;###autoload
(defun org-babel-prep-session:mermaid (session params)
"Return an error if the :session header argument is set.
Mermaid does not support sessions"
(error "Mermaid does not support sessions"))
;;;###autoload
(defun org-babel-variable-assignments:mermaid (params)
"Return list of mermaid statements assigning the block's variables"
t)
(defconst mermaid-type-prefix "^[^:]*:")
(defun org-babel-mermaid-var-value (val)
(setq mmd-m-end 0)
(setq mmd-m-start (string-match mermaid-type-prefix val))
(if mmd-m-start
(setq mmd-m-end (match-end 0)))
(setq mmd-var-type "")
(setq mmd-var-value val)
(if (> mmd-m-end 0)
(progn (setq mmd-var-type
(substring val mmd-m-start (- mmd-m-end 1)))
(setq mmd-var-value
(substring val mmd-m-end (length val)))))
(cons mmd-var-type (cons mmd-var-value nil)))
(defun org-babel-mermaid-var-to-mermaid (pair)
"Convert an elisp value into an Mermaid variable.
The elisp value PAIR is converted into Mermaid code specifying
a variable of the same value."
)
(defun org-babel-mermaid-define-type (data)
"Determine type of DATA.
DATA is a list. Return type as a symbol.
The type is `string' if any element in DATA is
a string. Otherwise, it is either `numeric', if some elements are
floats, or `numeric'."
(let* ((type 'numeric)
find-type ; for byte-compiler
(find-type
(function
(lambda (row)
(catch 'exit
(mapc (lambda (el)
(cond ((listp el) (funcall find-type el))
((stringp el) (throw 'exit (setq type 'string)))
((floatp el) (setq type 'numeric))))
row))))))
(funcall find-type data) type))
(provide 'ob-mermaid)
;;; ob-mermaid.el ends here

View File

@ -0,0 +1,207 @@
;;; ob-metapost.el --- org-babel functions for metapost evaluation
;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Rongsong Shen
;; Keywords: literate programming, metapost
;; Homepage: http://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating metapost source code.
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in metapost
;;
;; 2) we are generally only going to return results of type "file"
;;
;; 3) we are adding the "file" and "cmdline" header arguments, if file
;; is omitted then the -V option is passed to the metapost command for
;; interactive viewing
;;; Requirements:
;;
;; - metapost-mode :: Major mode for editing metapost files
;;; Code:
(require 'ob)
(eval-when-compile (require 'cl))
(defvar org-babel-default-header-args:metapost
'((:results . "file") (:exports . "results"))
"Default arguments when evaluating an Metapost source block.")
(defcustom org-metapost-program "mpost"
"Command of metapost. The command should use command line `mpost sourcefile'"
:group 'org-babel
:version "24.1"
:type 'string)
(defcustom org-metapost-convert "convert"
"Command for convert picture format. The command should use format `convert source destintion'"
:group 'org-babel
:version "24.1"
:type 'string)
(defvar mp-prologues)
(defvar mp-script)
(defvar mp-m-end)
(defvar mp-m-start)
(defvar mp-var-type)
(defvar mp-var-value)
(defvar mp-vpair)
(defun metapost-shell-command (dir cmd)
(shell-command (concat "/bin/sh -c \" cd "
dir ";"
cmd "\"")))
(defun metapost-fold (acc fun lst)
(if lst
(metapost-fold (funcall fun acc (car lst))
fun (cdr lst))
acc))
(defun metapost-script (fmt mp-libs body)
(setq mp-prologues
(cond ((string= fmt "svg") "outputformat:=\"svg\";\n")
(t "prologues:=3;\n")))
(setq mp-script (concat "beginfig(1);\n"
body
"\nendfig;\n"
"end\n"))
(message "%s" mp-script)
(concat mp-prologues
(if mp-libs
(metapost-fold "" #'(lambda (a b)
(concat a "input " b ";\n"))
(split-string mp-libs ","))
"")
mp-script))
(defun metapost-post-run (fmt in-file out-file)
(cond ((or (string= fmt "svg")
(string= fmt "eps"))
(copy-file (concat (file-name-nondirectory in-file) ".1")
out-file))
(t (metapost-shell-command org-babel-temporary-directory
(concat org-metapost-convert " "
(file-name-nondirectory in-file)
".1" " "
out-file)))))
;;;###autoload
(defun org-babel-execute:metapost (body params)
"Execute a block of Metapost code.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (expand-file-name (cdr (assoc :file params))))
(format (or (and out-file
(string-match ".+\\.\\(.+\\)" out-file)
(match-string 1 out-file))
"pdf"))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "metapost-"))
(cmd (concat org-metapost-program " --debug "
(file-name-nondirectory
(org-babel-process-file-name in-file)))))
(with-temp-file in-file
(insert (metapost-script format
(cdr (assoc :mp-libs params))
(org-babel-expand-body:generic
body params
(org-babel-variable-assignments:metapost params)))))
(metapost-shell-command org-babel-temporary-directory
cmd)
(metapost-post-run format in-file out-file)
nil)) ;; signal that output has already been written to file
;;;###autoload
(defun org-babel-prep-session:metapost (session params)
"Return an error if the :session header argument is set.
Metapost does not support sessions"
(error "Metapost does not support sessions"))
;;;###autoload
(defun org-babel-variable-assignments:metapost (params)
"Return list of metapost statements assigning the block's variables"
(mapcar #'org-babel-metapost-var-to-metapost
(mapcar #'cdr (org-babel-get-header params :var))))
(defconst metapost-type-prefix "^[^:]*:")
(defun org-babel-metapost-var-value (val)
(setq mp-m-end 0)
(setq mp-m-start (string-match metapost-type-prefix val))
(if mp-m-start
(setq mp-m-end (match-end 0)))
(setq mp-var-type "")
(setq mp-var-value val)
(if (> mp-m-end 0)
(progn (setq mp-var-type
(substring val mp-m-start (- mp-m-end 1)))
(setq mp-var-value
(substring val mp-m-end (length val)))))
(cons mp-var-type (cons mp-var-value nil)))
(defun org-babel-metapost-var-to-metapost (pair)
"Convert an elisp value into an Metapost variable.
The elisp value PAIR is converted into Metapost code specifying
a variable of the same value."
(let ((var (car pair))
(val (let ((v (cdr pair)))
(if (symbolp v) (symbol-name v) v))))
(progn
(setq mp-vpair (org-babel-metapost-var-value val))
(setq mp-var-type (nth 0 mp-vpair))
(setq mp-var-value (nth 1 mp-vpair))
(if (string= mp-var-type "string")
(format "%s %s;\n %s :=\"%s\";\n"
mp-var-type var var mp-var-value
)
(format "%s %s;\n %s := %s;\n"
mp-var-type var var mp-var-value
)))))
(defun org-babel-metapost-define-type (data)
"Determine type of DATA.
DATA is a list. Return type as a symbol.
The type is `string' if any element in DATA is
a string. Otherwise, it is either `numeric', if some elements are
floats, or `numeric'."
(let* ((type 'numeric)
find-type ; for byte-compiler
(find-type
(function
(lambda (row)
(catch 'exit
(mapc (lambda (el)
(cond ((listp el) (funcall find-type el))
((stringp el) (throw 'exit (setq type 'string)))
((floatp el) (setq type 'numeric))))
row))))))
(funcall find-type data) type))
(provide 'ob-metapost)
;;; ob-metapost.el ends here

View File

@ -0,0 +1,201 @@
;;; ob-tikz.el --- org-babel functions for tikz evaluation
;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Rongsong Shen
;; Keywords: literate programming, tikz
;; Homepage: http://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating tikz source code.
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in tikz
;;
;; 2) we are generally only going to return results of type "file"
;;
;; 3) we are adding the "file" and "cmdline" header arguments, if file
;; is omitted then the -V option is passed to the tikz command for
;; interactive viewing
;;; Requirements:
;;
;; - tikz-mode :: Major mode for editing tikz files
;;; Code:
(require 'ob)
(eval-when-compile (require 'cl))
(require 'latex)
;;(add-to-list 'org-babel-tangle-lang-exts '("tikz" . "tikz"))
(define-derived-mode tikz-mode
latex-mode "tikz/pgf"
"Major mode for tikz/pgf script"
)
(font-lock-add-keywords
'tikz-mode
'(("\\draw" . font-lock-keyword-face)
("\\filldraw" . font-lock-keyword-face)
("\\clip" . font-lock-keyword-face)
("\\shadowdraw" . font-lock-keyword-face)
("\\path" . font-lock-keyword-face)
("\\foreach" . font-lock-keyword-face)
("\\node" . font-lock-keyword-face)
("\\fill" . font-lock-keyword-face)
))
(defvar org-babel-default-header-args:tikz
'((:results . "file") (:exports . "results"))
"Default arguments when evaluating an Tikz source block.")
(defcustom org-tikz-program "pdflatex"
"Command of tikz. The command should use command line `pdflatex sourcefile'"
:group 'org-babel
:version "24.1"
:type 'string)
(defcustom org-tikz-convert "convert"
"Command for convert picture format. The command should use format `convert source destintion'"
:group 'org-babel
:version "24.1"
:type 'string)
(defvar tikz-prologues)
(defvar tikz-script)
(defvar tikz-m-end)
(defvar tikz-m-start)
(defvar tikz-var-type)
(defvar tikz-var-value)
(defvar tikz-vpair)
(defun tikz-shell-command (dir cmd)
(shell-command (concat "/bin/sh " " -c "
"\" cd " dir ";"
cmd "\"")))
(defun tikz-script (fmt tikz-libs body)
(setq tikz-prologues
(concat "\\documentclass{article}\n"
"\\usepackage{tikz}\n"
"\\usepackage{pgfplots}\n"
(if tikz-libs
(concat "\\usetikzlibrary{"
tikz-libs
"}\n")
"")
"\\begin{document}\n"
"\\begin{tikzpicture}"))
(setq tikz-script-data (concat body
"\n\\end{tikzpicture}\n"
"\\end{document}\n"))
(message "%s" (concat tikz-prologues tikz-script-data))
(concat tikz-prologues tikz-script-data))
(defun tikz-post-run (fmt in-file out-file)
(tikz-shell-command "."
(concat org-tikz-convert " "
(concat org-babel-temporary-directory "/"
(file-name-nondirectory in-file)
".pdf")
" "
out-file)))
;;;###autoload
(defun org-babel-execute:tikz (body params)
"Execute a block of Tikz code.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params)))
(format (or (and out-file
(string-match ".+\\.\\(.+\\)" out-file)
(match-string 1 out-file))
"pdf"))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "tikz-"))
(cmd
(concat (concat org-tikz-program " -shell-escape ")
(org-babel-process-file-name in-file)
)))
(with-temp-file (concat in-file ".tex")
(insert (tikz-script format
(tikz-get-value-by-name 'tikz-libs
(mapcar #'cdr (org-babel-get-header params :var)))
(org-babel-expand-body:generic
body params
(org-babel-variable-assignments:tikz params)))))
(message cmd)
(tikz-shell-command org-babel-temporary-directory cmd)
(tikz-post-run format in-file out-file)
nil)) ;; signal that output has already been written to file
;;;###autoload
(defun org-babel-prep-session:tikz (session params)
"Return an error if the :session header argument is set.
Tikz does not support sessions"
(error "Tikz does not support sessions"))
;;;###autoload
(defun org-babel-variable-assignments:tikz (params)
"Return list of tikz statements assigning the block's variables"
(mapcar #'org-babel-tikz-var-to-tikz
(mapcar #'cdr (org-babel-get-header params :var))))
(defun tikz-get-value-by-name (name vpairs)
(let ((vp (assoc name vpairs)))
(if vp
(cdr vp)
nil)))
(defun org-babel-tikz-var-value (val)
val)
(defun org-babel-tikz-var-to-tikz (pair)
"Convert an elisp value into an Tikz variable.
The elisp value PAIR is converted into Tikz code specifying
a variable of the same value."
nil)
(defun org-babel-tikz-define-type (data)
"Determine type of DATA.
DATA is a list. Return type as a symbol.
The type is `string' if any element in DATA is
a string. Otherwise, it is either `numeric', if some elements are
floats, or `numeric'."
(let* ((type 'numeric)
find-type ; for byte-compiler
(find-type
(function
(lambda (row)
(catch 'exit
(mapc (lambda (el)
(cond ((listp el) (funcall find-type el))
((stringp el) (throw 'exit (setq type 'string)))
((floatp el) (setq type 'numeric))))
row))))))
(funcall find-type data) type))
(provide 'ob-tikz)
;;; ob-tikz.el ends here

View File

@ -0,0 +1,61 @@
(defun org-lsf-gen-header (docinfo)
(let ((my-org-doc-tags '(("THEME" . nil)
("REVIEWERS" . "docreviewers")
("VERSION" . "docversion")
("STATUS" . "docstatus")
("CIRCULATION" . "circulation")
("PROJDESCR" . "docdescription")
("CONTRIBUTORS" . "contributors")
("TYPE" . "doctype")
("PROJID" . "projid")
("PRODVER" . "productversion")
("PRODNAME" . "productname")
("PROJNAME" . "projname")
("PROJECT" . "docname")
("AUTHOR" . "docauthor"))))
(concat "\\usepackage{mythemes}\n"
(apply #'concat
(mapcar #'(lambda (tag)
(let ((tagname (car tag))
(cmd (cdr tag)))
(let ((v (cdr (assoc tagname docinfo))))
(when cmd
(concat "\\newcommand\\" cmd "{"
(if v v "") "}\n")))))
my-org-doc-tags))
"\\newcommand\\docupdate{\\today}\n")))
(defun org-lsf-gen-title (docinfo)
(let ((history ""))
(org-table-map-tables #'(lambda ()
(let ((tblname (my-org-get-table-name)))
(when (string= tblname "document-history")
(let ((table (buffer-substring-no-properties
(org-table-begin)
(org-table-end))))
(setq history
(let ((params (list
:tstart "\\begin{dochistory}"
:tend "\\end{dochistory}"
:lstart "" :lend "\\\\" :sep " & "
:efmt "%s\\,(%s)" :hline "\\hline")))
(orgtbl-to-generic (org-table-to-lisp table)
params)))))))
t)
(concat "\\ibmcoverpage\n\\projectinfo\n"
history "\n\\newpage\n")))
(defun org-lsf-put-info (info docinfo)
(plist-put info :latex-header-extra
(org-lsf-gen-header docinfo))
(plist-put info :latex-title-command
(org-lsf-gen-title docinfo))
info)
;;;###autoload
(defun org-lsf-theme-latex-template (content info docinfo)
(list (concat "\\newpage\n" content)
(org-lsf-put-info info docinfo)))
(provide 'org-lsf-theme)

View File

@ -0,0 +1,19 @@
;;
(defcustom org-templates-directory "~/workenv/templates/"
"The directory which org templates have been put"
:type 'string
:group 'orgtools)
;;;###autoload
(defun org-use-template (template)
(interactive
(let ((templated-used (read-file-name "Choose template:"
(expand-file-name org-templates-directory)
nil nil nil)))
(list templated-used)))
(when template
(insert-file-contents template)
;; enable file local variables defined in template
(hack-local-variables)))
(provide 'org-templates)

View File

@ -0,0 +1,97 @@
(defun org-tufte-get-theme (docinfo)
(let ((theme (cdr (assoc "THEME" docinfo))))
(cond
((string= "tufte-handout" theme) theme)
((string= "tufte-book" theme) theme)
(t ""))))
(defun org-tufte-have-toc (docinfo)
(let ((toc (assoc "TOC" docinfo)))
(if toc
(let ((toc-value (cdr toc)))
(if toc-value
(cond
((string= toc-value "no") nil)
((string= toc-value "NO") nil)
(t t))
t))
t)))
(defun org-tufte-gen-header (docinfo)
(concat "\\usepackage{etex}\n"
"\\reserveinserts{36}\n"
"\\usepackage[maxfloats=48]{morefloats}\n"
"\\usepackage[style=verbose-trad1, backend=bibtex]{biblatex}\n"
"\\addbibresource{local.bib}\n"
"\\usepackage{booktabs,graphicx,microtype,hyphenat,marginfix,amsmath}\n"
"\\geometry{paperheight=10.5in,paperwidth=8.5in,textwidth=4.375in}\n"
"\\titleformat{\\part}[display]{\\relax\\itshape\\huge}{}{0pt}{\\huge\\rmfamily\\itshape}[]\n"
"\\usepackage{xparse}\n"
"\\usepackage{xpatch}\n"
"\\makeatletter\n"
"\\xpatchcmd{\\@footnotetext}%\n"
" {\\color@begingroup}\n"
" {\\colomythemesr@begingroup\\toggletrue{blx@footnote}}\n"
" {}\n"
" {}\n"
"\\makeatother\n"
"\n"
"\\DeclareCiteCommand{\\sidecitehelper}\n"
" {\\usebibmacro{prenote}}\n"
" {\\usebibmacro{citeindex}%\n"
" \\usebibmacro{cite}}\n"
" {\\multicitedelim}\n"
" {\\usebibmacro{cite:postnote}}\n"
"\n"
"\\ExplSyntaxOn\n"
"\\NewDocumentCommand\\sidecite{D<>{}O{}om}{%\n"
" \\iftoggle{blx@footnote}\n"
" {\\cs_set_protected_nopar:Npn \\__sct_wrapper:nn ##1 ##2 {\\mkbibparens{##2}}}\n"
" {\\cs_set_protected_nopar:Npn \\__sct_wrapper:nn ##1 ##2 {\\sidenote[][##1]{##2}}}\n"
" {\\IfNoValueTF{#3}\n"
" {\\__sct_wrapper:nn{#1}{\\sidecitehelper[#2]{#4}}}\n"
" {\\__sct_wrapper:nn{#1}{\\sidecitehelper[#2][#3]{#4}}}}\n"
"}\n"
"\\ExplSyntaxOff\n"
"\n"))
(defun org-tufte-put-info (info docinfo)
(let ((theme (org-tufte-get-theme docinfo))
(toc (org-tufte-have-toc docinfo)))
(unless (string= "theme" "")
(plist-put info :latex-class theme))
(if toc
(plist-put info :latex-toc-command
"\\newpage\\tableofcontents")
(plist-put info :latex-toc-command
"\\relax"))
(plist-put info :latex-header
(concat (org-tufte-gen-header docinfo)
"\n"
(plist-get :latex-header docinfo))))
info)
;;;###autoload
(defun org-tufte-register-classes ()
(unless (assoc "tufte-handout" org-latex-classes)
(add-to-list 'org-latex-classes
'("tufte-handout"
"\\documentclass[nobib]{tufte-handout} "
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")))
(add-to-list 'org-latex-classes
'("tufte-book"
"\\documentclass[twoside,nobib]{tufte-book} "
("\\part{%s}" . "\\part*{%s}")
("\\chapter{%s}" . "\\chapter*{%s}")
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\paragraph{%s}" . "\\paragraph*{%s}")))))
;;;###autoload
(defun org-tufte-theme-latex-template (content info docinfo)
(org-tufte-register-classes)
(list (concat "\\newpage\n" content)
(org-tufte-put-info info docinfo)))
(provide 'org-tufte-theme)

View File

@ -0,0 +1,822 @@
;;; ox-ravel.el --- Sweave/knit/brew document maker for orgmode
;; Copyright (C) 2012---2016 Charles C. Berry
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Several exporters are provided for translating from
;; Org to formats for reproducible research using
;; document generating engines such as Sweave, brew,
;; knitr, rmarkdown, et cetera. Typically, R src blocks
;; are converted to `code chunks' in the desired format
;; and the rest of the Org document is translated to
;; latex, html, markdown, or some other document format.
;;
;; See ox-ravel.org in the orgmode-accessories archive on
;; github for details. Also see demos.org and other
;; *.org files for examples of usage.
;;; Code:
;;
;;; Requisites and Declarations
(eval-when-compile (require 'cl-lib))
(require 'ox)
(declare-function org-babel-expand-body:R "ob-R.el" )
;; defconst-org-babel-header-args:ravel
;; #+NAME: defconst-org-babel-header-args-ravel
(defconst org-babel-header-args:ravel
'(
(ravel . :any)
(ravel-style . :any)
(engine . :any))
"Ravel-specific header arguments.")
;; org-lint org-lint needs these
(eval-after-load 'ob-core
'(mapc (lambda (x)
(add-to-list
'org-babel-common-header-args-w-values x))
org-babel-header-args:ravel))
(eval-after-load 'ob-core
'(mapc (lambda (x)
(add-to-list
'org-babel-header-arg-names (car x)))
org-babel-header-args:ravel))
;; defvar-org-ravel-style
;; #+NAME: defvar-org-ravel-style
(defvar org-ravel-style nil
"The default style to use for constructing chunks.
Can be buffer-local, and is usually set by the export dispatcher.")
(make-variable-buffer-local 'org-ravel-style)
;; defvar-org-ravel-run
;; #+NAME: defvar-org-ravel-run
(defvar-local org-ravel-run nil
"If ravel is to be run on src blocks, this will be a list like
'(\"R\") or '(\"R\" \"python\" \"awk\")
and usually set (by the export dispatcher) to `org-ravel-engines'.
Set this as buffer/file local for demos or debugging.")
;; defcustom-org-ravel-engines
;; #+NAME: defcustom-org-ravel-engines
(defcustom org-ravel-engines '(("R"))
"Use these engines in forming ravel chunks.
Typically, `org-ravel-run' will default to these. It can be
buffer-local. These engines are recognized by `knitr':
`R' `python' `awk' `ruby' `haskell' `bash' `perl' `dot'
`tikz' `sas' `coffeescript', `c', `Rcpp', and `polyglot'.
Each alist CONS cell has the language (as a string) for the CAR and
any cdr is cons-ed to the ravel attributes.
Buffer local values are allowed."
:group 'org-export-ravel
:type '(set :greedy t
(const :tag " R" ("R") )
(const :tag " c" ("c" . "engine='c'"))
(const :tag " rcpp" ("c++" . "engine='Rcpp'"))
(const :tag " C" ("C" . "engine='c'"))
(const :tag " Rcpp" ("C++" . "engine='Rcpp'"))
(const :tag " Python" ("python" . "engine='python'"))
(const :tag " AWK" ("awk" . "engine='awk'"))
(const :tag " Ruby" ("ruby" . "engine='ruby'"))
(const :tag " Haskell" ("haskell" . "engine='haskell'"))
(const :tag " bash" ("bash" . "engine='bash'"))
(const :tag " perl" ("perl" . "engine='perl'"))
(const :tag " dot" ("dot" . "engine='dot'"))
(const :tag " TikZ" ("tikz" . "engine='tikz'"))
(const :tag " SAS" ("sas" . "engine='sas'"))
(const :tag " CoffeeScript"
("coffeescript" . "engine='coffeescript'"))
(const :tag " Polyglot" ("polyglot" . "engine='polyglot'"))
(cons :tag " Other" string string)))
(make-variable-buffer-local 'org-ravel-engines)
;; defvar-org-ravel-style-alist
;; #+NAME: defcustom-org-ravel-style-alist
(defgroup org-export-ravel nil
"Options for exporting Org mode files via Ravel."
:tag "Org Export Ravel"
:group 'org-export)
(defcustom org-ravel-style-alist
'((rnw . (org-ravel-block-rnw org-ravel-inline-rnw ".Rnw"))
(brew . (org-ravel-block-brew org-ravel-inline-brew ".Rbrew"))
(tex . (org-ravel-block-tex org-ravel-inline-tex ".Rtex"))
(html . (org-ravel-block-html org-ravel-inline-html ".Rhtml"))
(md . (org-ravel-block-md org-ravel-inline-md ".Rmd"))
(braces . (org-ravel-block-braces org-ravel-inline-braces ".Rtmpl"))
(rst . (org-ravel-block-rst org-ravel-inline-rst ".Rrst")))
"The Chunk Style Alist to use in formatting Ravel output.
The key of each element is matched by the `:ravel-style' property
of a document, if specified, or by the default `:ravel-style' of
the exporter selected.
The value of each pair is a list of three elements:
- the function that formats src blocks
- the function that formats inline src blocks
- a string giving the file extension. "
:group 'org-export-ravel
:type '(alist
:key-type (symbol :tag "Ravel Style")
:value--type (list :tag "Chunk Defn"
(function :tag "block coder")
(function :tag "inline coder")
(string :tag "File extension"))))
;; defvar-org-ravel-backend-parent
(defvar org-ravel-backend-parent nil
"If ravel is running, this variable will contain the name of the parent.")
;; defun-org-babel-expand-body:ravel
(defun org-babel-expand-body:ravel (body params &optional var-lines)
"Use native `org-babel-expand-body' for src-block engine if
there is one to format BODY as per PARAMS."
(let*
((engine-cdr (cdr (assq :engine params)))
(engine (and engine-cdr
(replace-regexp-in-string
"engine='\\([^']+\\)'" "\\1" engine-cdr)))
(expand-cmd
(intern (concat "org-babel-expand-body:" engine))))
(cond
((and engine (fboundp expand-cmd))
(funcall expand-cmd body params))
(engine (org-babel-expand-body:generic body params))
(t (org-babel-expand-body:R body params)))))
;; defun-org-ravel-rewrap
;; Wrap the results of `org-babel-execute:ravel' in a
;; :#+BEGIN_EXPORT RAVEL ... #+END_EXPORT block.
;; #+NAME: defun-org-ravel-rewrap
(defun org-ravel-rewrap (retval &optional inline engine-cdr)
"(Re)Set `:wrap', `:results', `:exports', amd `:engine'
header args to values ravel uses. INLINE settings
differ. ENGINE-CDR gives the engine string, if any.
Argument RETVAL is the vslue of `org-babel-get-src-block-info'..
The original header args `:exports', `:wrap', `:file', `:file-ext', and
`:results' get suffixed with `-arg'. Block/snippet style
functions can find them in `R-HEADERS-ATTR'. "
(let ((n2r (nth 2 retval)))
(cl-loop
for carname in
'(:exports :results :wrap :file :file-ext) do
(let ((elt (assq carname n2r)))
(if elt
(setcar elt (intern (format "%S-arg" carname))))))
;; end do
(setf (nth 2 retval)
(append
`((:results . "replace")
(:wrap . ,(if inline "ravel" "EXPORT RAVEL"))
(:exports . "results")
(:engine . ,engine-cdr))
n2r))))
;; defvar-org-ravel-no-confirm-for-ravel
;; Confirmation of ravel `execution' is a nuisance --- and no code is
;; actually run --- so disable confirmations for `ravel' src blocks.
;; This can be overridden by `(setq org-ravel-no-confirm-for-ravel t)' if
;; ever needed.
;; Maybe need to add check if (functionp org-confirm-babel-evaluate) is
;; nil in which case, I do not reset it.
;; #+NAME: defvar-org-ravel-no-confirm-for-ravel
(defvar org-ravel-no-confirm-for-ravel
(lambda (language body)
(if (string= language "ravel") nil t))
"Do not confirm if LANGUAGE is `ravel'.")
(defun org-ravel-reset-confirm (value)
"Revert `org-confirm-babel-evaluate' as buffer local VALUE."
(when org-confirm-babel-evaluate
(setf org-confirm-babel-evaluate
value)))
;; defun-org-babel-execute:ravel
;; `org-babel-execute:ravel' calls formatting functions for the code. No
;; actual code is run. Also need to add some kind of alias for edit modes
;; if Rcpp is to be supported. Like `(defalias 'Rcpp-mode 'c++-mode)'
;; #+NAME: defun-org-babel-execute-ravel
(defun org-babel-execute:ravel (body params)
"Format BODY as ravel according to PARAMS."
(save-excursion
(if (string= "none" (cdr (assoc :exports params)))
""
(let*
((oec (org-element-context))
(ravel-attr (org-element-property :attr_ravel oec))
(type (org-element-type oec))
;; Need (org-babel-params-from-properties "ravel") here as
;; parsing was done on "R" or other language.
(headers (apply #'org-babel-merge-params
(append
(org-babel-params-from-properties "ravel")
(list params))))
(ravelarg (cdr (assoc :ravel headers)))
(engine (cdr (assoc :engine headers)))
(ravelstyle (cdr (assoc :ravel-style headers)))
(label (org-element-property :name oec))
(non-ravelargs (assq-delete-all :ravel headers))
(chunk-style
(org-ravel-get-style ravelstyle))
(body (org-remove-indentation body))
(full-body
(org-babel-expand-body:ravel body params)))
(when engine
(setq ravel-attr
(cons engine
ravel-attr)))
(if (memq type '(inline-src-block inline-babel-call))
(org-ravel-snippetize chunk-style ravelarg non-ravelargs full-body)
(org-ravel-blockify chunk-style label ravelarg ravel-attr
non-ravelargs full-body))))))
;; defun-org-ravel-snippetize/blockify
;; Call the chunk-style functions to format the code.
;; #+NAME: defun-org-ravel-snippetize
(defun org-ravel-snippetize (chunk-style ravelarg r-headers-attr body)
"Format an inline src block.
Use CHUNK-STYLE, RAVELARG, and R-HEADERS-ATTR (often ignored) to
format BODY, then wrap it inside an export snippet."
(funcall (nth 1 chunk-style)
ravelarg r-headers-attr body))
(defun org-ravel-blockify
(chunk-style label ravelarg ravel-attr non-ravelargs body)
"Format a src block.
Use CHUNK-STYLE, LABEL, RAVELARG, RAVEL-ATTR and
NON-RAVELARGS (typically ignored) to format BODY and wrap it
inside an export block."
(funcall (nth 0 chunk-style) label ravelarg
ravel-attr non-ravelargs body))
;; defun-org-ravel-get-style
;; #+NAME: defun-org-ravel-get-style
(defun org-ravel-get-style (style-from-header)
"Return the chunk style for STYLE-FROM-HEADER.
Possibly find it in properties or use `org-ravel-style' by
default."
(or
(assoc-default
(or style-from-header
(cdr (assoc
:ravel-style
(org-babel-parse-header-arguments
(org-entry-get (point)
"header-args:ravel"
'inherit))))
org-ravel-style)
org-ravel-style-alist 'string=)
(user-error "Ravel-style: %S not found -- Consult `org-ravel-style-alist'"
style-from-header)))
;; defun-org-ravel-attr-plus-header
;; #+NAME: defun-org-ravel-attr-plus-header
(defun org-ravel-attr-plus-header
(label ravelarg ravel-attr)
"Separate LABEL, RAVELARG, and RAVEL-ATTR by commas."
(mapconcat #'identity
(delete nil
(cons label
(cons ravelarg ravel-attr))) ", "))
;; defmacro-org-ravel-style-x
;; #+NAME: defmacro-org-ravel-style-x
(defmacro org-ravel-style-x (x xblock xinline &optional xcode)
"Make style functions.
The functions are `org-ravel-block-X' and `org-ravel-inline-X'
where X names the style, XBLOCK gives the block format, XINLINE gives the
inline format, and XCODE is an optional line prefix.
`org-ravel-block-X' defines the Chunk code style. It's arguments are
LABEL - the chunk name (which will be sanitized by
substituting `_' for any character not allowed as a
chunk label by Sweave),
RAVEL - header args as a string,
ATTR-RAVEL - attributes to be combined with RAVEL,
R-HEADERS-ATTR - other headers from Babel as a string parseable
by `org-babel-parse-header-arguments',
SRC-CODE is the code from the block.
`org-ravel-inline-X' defines the inline code style. It's arguments
are RAVEL, R-HEADERS-ATTR, SRC-CODE as above. Note that only SRC-CODE is
used in this macro, but other arguments may be used in hand tooled inline
style functions."
(let ((blk-args
'(label ravel attr-ravel r-headers-attr src-code))
(inline-args '(ravel r-headers-attr src-code))
(blk-body
`(let* ((label
(if label
(replace-regexp-in-string "[^[:alnum:]#+-_.]" "_" label)))
(ravel (org-ravel-attr-plus-header label ravel attr-ravel)))
,(if xcode
`(format ,xblock ravel
(replace-regexp-in-string "^" ,xcode src-code))
`(format ,xblock ravel src-code))))
(inline-body `(format ,xinline src-code))
(bname (concat "org-ravel-block-" x))
(iname (concat "org-ravel-inline-" x)))
(defalias (intern bname)
(list 'lambda blk-args blk-body)
(concat "Run this:\n\n" (pp-to-string blk-body)))
(defalias (intern iname)
(list 'lambda inline-args inline-body)
(concat "Run this:\n\n" (pp-to-string inline-body)))
(format "Functions: %s and %s" bname iname)))
;; defun-org-ravel-format-brew-spec
;; #+NAME: defun-org-ravel-format-brew-spec
(defun org-ravel-format-brew-spec (&optional spec)
"Check a brew SPEC, escape % signs, and add a %s spec."
(let
((spec (or spec "<% %>")))
(if (string-match
"<\\(%+\\)\\([=]?\\)\\(.+?\\)\\([{}]?[ ]*-?\\)\\(%+\\)>"
spec)
(let (
(opct (match-string 1 spec))
(eqsign (match-string 2 spec))
(filler (match-string 3 spec))
(enddash (match-string 4 spec))
(clpct (match-string 5 spec)))
(if (string= opct clpct)
(concat "<" opct opct eqsign " %s " enddash clpct clpct ">")
(error "Percent signs do not balance:%s" spec)))
(error "Invalid spec:%s" spec))))
;; defun-org-ravel-block-brew
;; #+NAME: defun-org-ravel-block-brew
(defun org-ravel-block-brew (label ravel attr_ravel r-headers-attr src-code)
"Define the chunk style for brew.
LABEL is the chunk name, RAVEL is the collection of ravel args as
a string, ATTR_RAVEL and R-HEADERS-ATTR are ignored here,
SRC-CODE is the code from the block."
(format (org-ravel-format-brew-spec ravel) src-code))
(defun org-ravel-inline-brew (ravel r-headers-attr src-code)
"Define the inline-src style for brew.
RAVEL is the collection of ravel args as a string, R-HEADERS-ATTR
is the collection of headers from Babel as a string parseable by
`org-babel-parse-header-arguments', SRC-CODE is the code from the
block."
(format (org-ravel-format-brew-spec
(or ravel "<%= code -%>"))
src-code))
;; org-ravel-style-x-rnw
;; #+NAME: org-ravel-style-x-rnw
(org-ravel-style-x "rnw"
"<<%s>>=\n%s\n@ %%def"
"\\Sexpr{ %s }")
;; org-ravel-style-x-tex
;; #+NAME: org-ravel-style-x-tex
(org-ravel-style-x "tex"
"%% begin.rcode( %s )\n%s\n%% end.code"
"\\rinline{ %s }"
"%")
;; org-ravel-style-x-html
;; #+NAME: org-ravel-style-x-html
(org-ravel-style-x "html"
"<!--begin.rcode %s \n%s\nend.rcode-->"
"<!--rinline %s -->")
;; org-ravel-style-x-md
;; #+NAME: org-ravel-style-x-md
(org-ravel-style-x "md"
"```{r %s }\n%s \n```"
"`r %s `")
;; org-ravel-style-x-braces
;; #+NAME: org-ravel-style-x-braces
(org-ravel-style-x "braces"
"{{%0.0s%s}}"
"{{%s}}")
;; org-ravel-style-x-rst
;; #+NAME: org-ravel-style-x-rst
(org-ravel-style-x "rst"
"..{r %s}\n%s\n.. .."
":r:`%s`"
"%")
;; defun-org-ravel-export-block
;; #+NAME: defun-org-ravel-export-block
(defun org-ravel-export-block (export-block contents info)
"Transcode a EXPORT-BLOCK element from Org to ravel.
CONTENTS is nil. INFO is a plist holding contextual information."
(if (equal (org-element-property :type export-block) "RAVEL")
(org-unescape-code-in-string
(org-element-property :value export-block))
(org-export-with-backend
org-ravel-backend-parent export-block contents info)))
;; defun-org-ravel-export-snippet
;; #+NAME: defun-org-ravel-export-snippet
(defun org-ravel-export-snippet (export-snippet contents info)
"Transcode a EXPORT-SNIPPET element from Org to ravel.
CONTENTS is nil. INFO is a plist holding contextual information."
(if (eq (org-export-snippet-backend export-snippet) 'ravel)
(org-element-property :value export-snippet)
(org-export-with-backend org-ravel-backend-parent export-snippet contents info)))
;; defun-org-ravel-create-backend
(defun org-ravel-create-backend (parent &optional style)
"Create a ravel-compliant backend from PARENT using STYLE.
Hence, (org-ravel-create-backend 'ascii \"md\") creates a backend
whose parent is ascii and default style is \"md\"."
(org-export-create-backend
:parent parent
:transcoders '((export-snippet . org-ravel-export-snippet)
(export-block . org-ravel-export-block))
:options `((:ravel-style "RAVEL_STYLE" nil ,style t))
:blocks '("RAVEL")))
;; defmacro-org-ravel-export-wrapper
;; See [[*defun-org-ravel-export-string-as][defun-org-ravel-export-string-as]] as an example of how this
;; macro is used.
(defmacro org-ravel-export-wrapper (&rest body)
"Set up the preliminaries for the BODY of an export function.
`org-ravel-export-to-file' and similar actions need to redefine
`org-babel-get-src-block-info' and restore the
function to its original value on exit, set values for
`org-ravel-run' and for `org-ravel-style', force the `backend'
to be ravel compliant and let-bind its parent as
`org-ravel-backend-parent', and (by default) turn off
confirmation for the evaluation of ravel blocks.
`(org-ravel-export-wrapper BODY)' when used inside a `defun' will
take care of these issues.
Use of this macro outside of ravel export functions is
discouraged as it can corrupt the cache used by the
`org-element-*' functions. In case of these issues,
`org-element-cache-reset' will straighten things out."
(declare (indent 1) (debug (form body)))
`(let* ((org-ravel-get-s-b-info
;; avoid recursive redefinition
(or (bound-and-true-p org-ravel-get-s-b-info)
(symbol-function
'org-babel-get-src-block-info)))
(org-ravel-lob-get-info
;; avoid recursive redefinition
(or (bound-and-true-p org-ravel-lob-get-info)
(symbol-function
'org-babel-lob-get-info)))
;; set ravel variables
(org-ravel-run
(or engines org-ravel-run org-ravel-engines))
(bk-orig
(if (symbolp backend)
(org-export-get-backend backend) backend))
(ravel-style-option
(assq :ravel-style
(org-export-backend-options bk-orig)))
(backend (if ravel-style-option bk-orig
(unless style
(message "Non ravel BACKEND might need STYLE."))
(org-ravel-create-backend
(org-export-backend-name bk-orig) style)))
(org-ravel-backend-parent (org-export-backend-parent backend))
(org-ravel-style
(or style org-ravel-style
(nth 3
(assoc :ravel-style
(org-export-backend-options
backend)))))
(org-confirm-babel-evaluate org-confirm-babel-evaluate))
;; org-babel-get-src-block-info will modify info for ravel blocks
(cl-letf
(((symbol-function 'org-babel-get-src-block-info)
(lambda (&optional light datum)
(let* ((dat (or datum (org-element-context)))
(lang (org-element-property :language dat))
(ravel-it (assoc lang org-ravel-run))
(inline (eq 'inline-src-block (org-element-type datum)))
(engine-cdr (and ravel-it (cdr ravel-it))))
(if ravel-it
(setf (nth 1 dat)
(plist-put (nth 1 dat) :language "ravel")))
(let* ((info (funcall org-ravel-get-s-b-info light dat))
(nth-2-info (nth 2 info)))
(unless (or (not ravel-it)
(member '(:exports . "none") (nth 2 info)))
;; revise headers of RAVEL src-blocks
(org-ravel-rewrap info inline engine-cdr))
;; return info for all src-blocks
info))))
((symbol-function 'org-babel-lob-get-info)
(lambda (&optional datum)
(let*
((datum (or datum (org-element-context)))
(info (funcall org-ravel-lob-get-info datum))
(lang (car info))
(ravel-it (string= lang "ravel"))
(inline (eq 'inline-babel-call (org-element-type datum))))
(unless (or (not ravel-it)
(member '(:exports . "none") (nth 2 info)))
;; revise headers of RAVEL src-blocks
(org-ravel-rewrap info inline))
info))))
,@body)))
;; defun-org-ravel-export-string-as
;; #+NAME: defun-org-ravel-export-string-as
(defun org-ravel-export-string-as
(string backend &optional body-only ext-plist engines style)
"Export STRING as a string.
Use BACKEND with BODY-ONLY and EXT-PLIST, all as per
`org-export-string-as'. If non-nil, ENGINES will set
`org-ravel-run' locally. Otherwise, an attempt will be made to
replace it with `org-ravel-run' or `org-ravel-engines'. STYLE
will set `org-ravel-style' if non-nil, otherwise
`org-ravel-style' or the default for BACKEND will be used.
This function can be run by Babel to produce a string that is
used in a Babel src block.
It can run arbitrary backends if STYLE is supplied or if STRING
supplies valid values for src blocks and inline src blocks in it."
(org-ravel-export-wrapper
(org-ravel-reset-confirm
org-ravel-no-confirm-for-ravel)
(org-export-string-as string backend body-only ext-plist)))
;; defun-org-ravel-export-to-file
;; #+NAME: defun-org-ravel-export-to-file
(defun org-ravel-export-to-file
(backend &optional file async subtreep visible-only
body-only ext-plist post-process engines style)
"Export invoking ravel with BACKEND to FILE.
ASYNC must be nil, but SUBTREEP, VISIBLE-ONLY, BODY-ONLY,
EXT-PLIST, and POST-PROCESS are passed to `org-export-to-file'.
ENGINES supplies a value for `org-ravel-run' and STYLE for
`org-ravel-style'. If a backend is used that is not set up for
ravel, it usually best to use, e.g.
`(org-ravel-export-to-file
(org-ravel-create-backend 'ascii \"md\") ... )'
to create a ravel-compliant backend.
Note that `org-babel-confirm-evaluate' is set locally by `let*'
to `org-ravel-no-confirm-for-ravel', which holds a `lambda'
function. To override this, create a variable with that name."
(org-ravel-export-wrapper
(let ((file (or file
(org-export-output-file-name
(org-ravel-extension org-ravel-style) subtreep))))
(when async (user-error "ASYNC not allow for ravel"))
(org-ravel-reset-confirm org-ravel-no-confirm-for-ravel)
(org-export-to-file backend file async subtreep visible-only
body-only ext-plist post-process))))
;; defun-org-ravel-export-to-buffer
;; #+NAME: defun-org-ravel-export-to-buffer
(defun org-ravel-export-to-buffer
(backend &optional buffer async subtreep visible-only
body-only ext-plist post-process engines style)
"Export invoking ravel using BACKEND to BUFFER.
ASYNC must be nil, but SUBTREEP, VISIBLE-ONLY, BODY-ONLY,
EXT-PLIST, and POST-PROCESS are passed to `org-export-to-buffer'.
ENGINES supplies a value for `org-ravel-run' and STYLE for
`org-ravel-style'. If a backend is used that is not set up for
ravel, it usually best to use, e.g.
`(org-ravel-export-to-buffer
(org-ravel-create-backend 'ascii \"md\") ... )'
to create a ravel-compliant backend.
Note that `org-babel-confirm-evaluate' is set locally by `let*'
to `org-ravel-no-confirm-for-ravel', which holds a `lambda'
function. To override this, create a variable with that name."
(org-ravel-export-wrapper
(let ((buffer (or buffer
(format "* %S Output *"
(org-export-backend-name backend)))))
(when async (user-error "ASYNC not allow for ravel"))
(org-ravel-reset-confirm org-ravel-no-confirm-for-ravel)
(org-export-to-buffer backend buffer async subtreep visible-only
body-only ext-plist post-process))))
;; defun-org-ravel-extension
;; #+NAME: defun-org-ravel-extension
(defun org-ravel-extension (style)
"Get the file extension for STYLE."
(nth 3 (assoc-string style org-ravel-style-alist)))
;; defmacro-ravel-define-exporter
;; #+NAME: defmacro-ravel-define-exporter
(defmacro org-ravel-define-exporter
(ravel-backend parent menu-key menu-label style-default
&optional fileout bufferout post-proc filters)
"Define ravel backends.
The arguments are:
RAVEL-BACKEND is a symbol naming the backend derived from
PARENT is a registered backend,
MENU-KEY should be an integer code for a lower-case
character like `?a' to refer to file dispatch,
MENU-LABEL tells how to label the backend in the
dispatch menu,
STYLE-DEFAULT is the style to use if not specified as a
`:ravel-style' attribute,
FILEOUT is usually nil which allows
`org-ravel-export-to-file' to assign the file name
BUFFEROUT is usually `t' - if non-nil create menu
entry `(upcase MENU-KEY)' that will be used for menu
dispatch) or nil for no buffer dispatcher, and
POST-PROC is a post-export hook function or nil
FILTERS is an alist of filters that will overwrite or
complete filters defined in PARENT back-end. See
`org-export-filters-alist' for a list of allowed filters."
`(org-export-define-derived-backend
,ravel-backend
,parent
:translate-alist '(
(export-snippet . org-ravel-export-snippet)
(export-block . org-ravel-export-block))
:options-alist '((:ravel-style "RAVEL_STYLE"
nil ,style-default t))
:filters-alist ,filters
:menu-entry
'(?r "Ravel"
,(remq nil
`((,menu-key ,(concat menu-label " file")
(lambda (a s v b)
(org-ravel-export-to-file
,ravel-backend ,fileout a s v b nil
nil nil ,style-default)))
,(if bufferout
`(,(upcase menu-key) ,(concat menu-label " buffer")
(lambda (a s v b)
(org-ravel-export-to-buffer
,ravel-backend nil a s v b nil ,post-proc
nil ,style-default)))))))))
;; Create Backends
;; The `(eval-after-load FILE FORM)' forms seems to work. i.e. FORM is
;; executed if the backend specified in FILE (e.g. 'ox-latex) is already loaded.
;; If not, then when FILE is loaded, FORM is run.
;; The variable `org-export-backends' can be customized to (de-)list
;; parent backends. The `ravel' backends that depend on those parents are
;; (de-)activated when the parent is (de-)listed.
;; A ravel backend whose parent is not in `org-export-backends' will need
;; to `require' or `load' that parent.
;; #+NAME: run-org-ravel-define-exporters
(eval-after-load 'ox-latex
'(org-ravel-define-exporter
'ravel-latex
'latex ?l "Ravel-LaTeX" "rnw" nil t (lambda () (LaTeX-mode))))
(eval-after-load 'ox-beamer
'(org-ravel-define-exporter
'ravel-beamer
'beamer ?b "Ravel-beamer" "rnw" nil t (lambda () (LaTeX-mode)))
)
(eval-after-load 'ox-html
'(org-ravel-define-exporter
'ravel-html
'html ?h "Ravel-html" "html" nil t ))
(defun org-ravel-filter-cite-as-pandoc (text back-end info)
"Translate citations in latex format (i.e. \cite{id}) into
citations in pandoc format (i.e. [@id]).
Note, loading `ox-bibtex' transforms all latex/bibtex citations
into html links, so do not load it if this format is desired."
(replace-regexp-in-string ",[\s-]*" "; @"
(replace-regexp-in-string
"\\\\cite{\\(.*\\)}" "[@\\1]" text)))
(eval-after-load 'ox-md
'(org-ravel-define-exporter
'ravel-markdown
'md ?m "Ravel-markdown" "md" nil t nil
'((:filter-latex-fragment . org-ravel-filter-cite-as-pandoc))))
;; provide ravel :noexport:
(provide 'ox-ravel)
;;; ox-ravel.el ends here

View File

@ -0,0 +1,169 @@
;;; packages.el --- orgtools layer packages file for Spacemacs.
;;
;; Copyright (c) 2012-2016 Sylvain Benner & Contributors
;;
;; Author: Rongsong Shen <rshen@pc13x.cn.ibm.com>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;;; Commentary:
;; See the Spacemacs documentation and FAQs for instructions on how to implement
;; a new layer:
;;
;; SPC h SPC layers RET
;;
;;
;; Briefly, each package to be installed or configured by this layer should be
;; added to `orgtools-packages'. Then, for each package PACKAGE:
;;
;; - If PACKAGE is not referenced by any other Spacemacs layer, define a
;; function `orgtools/init-PACKAGE'mythemes to load and initialize the package.
;; - Otherwise, PACKAGE is already referenced by another Spacemacs layer, so
;; define the functions `orgtools/pre-init-PACKAGE' and/or
;; `orgtools/post-init-PACKAGE' to customize the package as it is loaded.
;;; Code:
(defconst orgtools-packages
'((org-templates :location local)
(org-lsf-theme :location local)
(org-tufte-theme :location local)
(ob-tikz :location local)
(ob-metapost :location local)
(ob-mermaid :location local)
(ox-epub :location (recipe :fetcher github :repo "ofosos/org-epub"))
(ox-tufte :location (recipe :fetcher github :repo "dakrone/ox-tufte"))
(ox-ravel :location local)
cdlatex)
"The list of Lisp packages required by the orgtools layer.
Each entry is either:
1. A symbol, which is interpreted as a package to be installed, or
2. A list of the form (PACKAGE KEYS...), where PACKAGE is the
name of the package to be installed or loaded, and KEYS are
any number of keyword-value-pairs.
The following keys are accepted:
- :excluded (t or nil): Prevent the package from being loaded
if value is non-nil
- :location: Specify a custom installation location.
The following values are legal:
- The symbol `elpa' (default) means PACKAGE will be
installed using the Emacs package manager.
- The symbol `local' dilibrary(animation)
rects Spacemacs to load the file at
`./local/PACKAGE/PACKAGE.el'
- A list beginning with the symbol `recipe' is a melpa
recipe. See: https://github.com/milkypostman/melpa#recipe-format")
(defun orgtools/init-org-templates ()
(use-package org-templates
:defer t
:if (configuration-layer/package-usedp 'org)
:commands org-use-template))
(defun orgtools/init-org-lsf-theme ()
(use-package org-lsf-theme
:defer t
:if (configuration-layer/package-usedp 'org)
:commands org-lsf-theme-latex-template
:init (progn
(orgtools-register-theme "mythemes"
#'org-lsf-theme-latex-template))))
(defun orgtools/init-org-tufte-theme ()
(use-package org-tufte-theme
:defer t
:if (configuration-layer/package-usedp 'org)
:commands (org-tufte-theme-latex-template org-tufte-register-classes)
:init (progn
(add-hook 'org-mode-hook #'org-tufte-register-classes)
(orgtools-register-theme "tufte-handout"
#'org-tufte-theme-latex-template)
(orgtools-register-theme "tufte-book"
#'org-tufte-theme-latex-template))))
(defun orgtools/init-ob-tikz ()
(use-package ob-tikz
:defer t
:if (configuration-layer/package-usedp 'org)
:init (progn
(autoload 'org-babel-execute:tikz "ob-tikz.el")
(autoload 'org-babel-prep-session:tikz "ob-tikz.el")
(autoload 'org-babel-variable-assignments:tikz "ob-tikz.el"))
:config (progn
(add-to-list 'org-babel-load-languages
'(tikz . t))
(add-to-list 'org-babel-tangle-lang-exts
'("tikz" . "tikz")))))
(defun orgtools/init-ob-metapost ()
(use-package ob-metapost
:defer t
:if (configuration-layer/package-usedp 'org)
:init (progn
(autoload 'org-babel-execute:metapost "ob-metapost.el")
(autoload 'org-babel-prep-session:metapost "ob-metapost.el")
(autoload 'org-babel-variable-assignments:metapost "ob-metapost.el"))
:config (progn
(add-to-list 'org-babel-load-languages
'(metapost . t))
(add-to-list 'org-babel-tangle-lang-exts
'("metapost" . "mp")))))
(defun orgtools/init-ox-epub ()
(spacemacs|use-package-add-hook org :post-config (require 'ox-epub)))
(defun orgtools/init-ox-tufte ()
(spacemacs|use-package-add-hook org :post-config (require 'ox-tufte)))
(defun orgtools/init-ox-ravel ()
(spacemacs|use-package-add-hook org :post-config (require 'ox-ravel)))
(defun orgtools/init-org-html-themes ()
t)
(defun orgtools/post-init-org-templates ()
t)
(defun orgtools/post-init-org-lsf-theme ()
t)
(defun orgtools/post-init-ob-tikz ()
t)
(defun orgtools/post-init-ob-metapost ()
t)
(defun orgtools/post-init-org-html-themes ()
t)
(defun orgtools/init-cdlatex ()
(use-package cdlatex
:defer t
:commands 'turn-on-cdlatex
:config (progn
(add-hook 'org-mode-hook
'turn-on-cdlatex))))
(defun orgtools/post-init-ox-tufte ()
t)
(defun orgtools/post-init-ox-epub ()
t)
(defun orgtools/init-ob-mermaid ()
t)
;;; packages.el ends here

22
old-config/init.el Normal file
View File

@ -0,0 +1,22 @@
(unless (boundp 'user-emacs-directory)
(setq user-emacs-directory "~/.emacs.d/"))
(defvar *custom-dir* (expand-file-name "~/.emacs.d"))
(defvar *elpa-dir* (concat *custom-dir* "/elpa"))
(defvar *lisp-dir* (concat *custom-dir* "/lisp"))
(defvar *misc-dir* (concat *custom-dir* "/misc"))
(setq backup-directory-alist
'(("." . "~/.emacs.d/backups")))
(setq custom-file (concat *custom-dir* "/custom.el"))
(add-to-list 'load-path *lisp-dir*)
;; load personal package configuration
;;
(let ((mypkgs-loader (concat *lisp-dir*
"/mypkgs.el")))
(when (file-exists-p mypkgs-loader)
(load-file mypkgs-loader)))

Some files were not shown because too many files have changed in this diff Show More