move emacs related
28
emacs.config.org/emacs.org
Normal 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
@ -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
BIN
jars/eclim_2.3.2.jar
Normal file
BIN
jars/mathtoweb.jar
Normal file
BIN
jars/plantuml.jar
Normal file
29
layers.personal/customized/README.org
Normal 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 |
|
||||
2
layers.personal/customized/config.el
Normal file
@ -0,0 +1,2 @@
|
||||
(defvar my-default-c-style nil
|
||||
"Choose the default style of c mode")
|
||||
85
layers.personal/customized/local/my-c-styles/my-c-styles.el
Normal 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)
|
||||
85
layers.personal/customized/packages.el
Normal 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
|
||||
30
layers.personal/misctools/my-polymode/README.org
Normal 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.
|
||||
@ -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))))
|
||||
10
layers.personal/misctools/my-polymode/local/polymode/.gitignore
vendored
Normal file
@ -0,0 +1,10 @@
|
||||
*~
|
||||
*#
|
||||
#*
|
||||
auto/
|
||||
*\[weaved\]*
|
||||
tmp/
|
||||
*woven*
|
||||
*exported*
|
||||
.tmd
|
||||
tmp*
|
||||
BIN
layers.personal/misctools/my-polymode/local/polymode/img/Rmd.png
Normal file
|
After Width: | Height: | Size: 31 KiB |
|
After Width: | Height: | Size: 35 KiB |
|
After Width: | Height: | Size: 22 KiB |
|
After Width: | Height: | Size: 26 KiB |
BIN
layers.personal/misctools/my-polymode/local/polymode/img/org.png
Normal file
|
After Width: | Height: | Size: 12 KiB |
|
After Width: | Height: | Size: 59 KiB |
|
After Width: | Height: | Size: 26 KiB |
@ -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)
|
||||
@ -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)
|
||||
@ -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")
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
@ -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.
|
||||
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -0,0 +1,3 @@
|
||||
(defgroup polymode-tangle nil
|
||||
"Polymode Tanglers"
|
||||
:group 'polymode)
|
||||
@ -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)
|
||||
449
layers.personal/misctools/my-polymode/local/polymode/polymode.el
Normal 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 [¬ 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
|
||||
164
layers.personal/misctools/my-polymode/local/polymode/readme.md
Normal file
@ -0,0 +1,164 @@
|
||||
[](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"/>
|
||||
|
||||
@ -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)) %>
|
||||
|
||||
|
||||
|
||||
@ -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}
|
||||
@ -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])
|
||||
%>
|
||||
@ -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 won’t 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 %>.
|
||||
@ -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 won’t 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%>.
|
||||
@ -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 π? Of course it is <!--rinline pi -->.</p>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
@ -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)));')
|
||||
@ -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.
|
||||
*/
|
||||
@ -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**.
|
||||
@ -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}
|
||||
@ -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}
|
||||
@ -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}
|
||||
@ -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
|
||||
```
|
||||
|
||||
|
||||
|
||||
|
||||
3689
layers.personal/misctools/my-polymode/local/polymode/samples/nbib.nw
Normal 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}
|
||||
@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
')
|
||||
|
||||
|
||||
@ -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)
|
||||
@ -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
|
||||
@ -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.
|
||||
*/
|
||||
|
||||
@ -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.
|
||||
@ -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)
|
||||
```
|
||||
@ -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
|
||||
@ -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
|
||||
@ -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}
|
||||
|
||||
```
|
||||
71
layers.personal/misctools/my-polymode/packages.el
Normal 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
|
||||
30
layers.personal/misctools/mytools/README.org
Normal 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.
|
||||
72
layers.personal/misctools/mytools/packages.el
Normal 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
|
||||
31
layers.personal/mylangs/mycquery/config.el
Normal 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")
|
||||
97
layers.personal/mylangs/mycquery/funcs.el
Normal 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))))
|
||||
137
layers.personal/mylangs/mycquery/packages.el
Normal 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
|
||||
29
layers.personal/mylangs/myeiffel/README.org
Normal 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 |
|
||||
|-----------------+----------------|
|
||||
| | |
|
||||
|
||||
3
layers.personal/mylangs/myeiffel/funcs.el
Normal file
@ -0,0 +1,3 @@
|
||||
;; add functions here which can be used in myeiffel layer
|
||||
(defun spacemacs/eiffel-define-keys ()
|
||||
)
|
||||
BIN
layers.personal/mylangs/myeiffel/img/myeiffel.png
Normal file
|
After Width: | Height: | Size: 576 KiB |
2776
layers.personal/mylangs/myeiffel/local/eiffel/eiffel.el
Normal 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)
|
||||
83
layers.personal/mylangs/myeiffel/packages.el
Normal 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
|
||||
29
layers.personal/mylangs/mymermaid/README.org
Normal 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 |
|
||||
@ -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)
|
||||
239
layers.personal/mylangs/mymermaid/local/mermaid/mermaid.el
Normal 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)
|
||||
77
layers.personal/mylangs/mymermaid/packages.el
Normal 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
|
||||
2
layers.personal/mylangs/mypollen/config.el
Normal file
@ -0,0 +1,2 @@
|
||||
(defvar pollen-templates-directory "~/workenv/templates.pollen/"
|
||||
"Default directory for pollen templates")
|
||||
30
layers.personal/mylangs/mypollen/funcs.el
Normal 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)))))
|
||||
@ -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)
|
||||
92
layers.personal/mylangs/mypollen/packages.el
Normal 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
|
||||
1
layers.personal/mylangs/myscribble/funcs.el
Normal file
@ -0,0 +1 @@
|
||||
;; add functions here which can be used in myeiffel layer
|
||||
@ -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)
|
||||
1143
layers.personal/mylangs/myscribble/local/scribble/scribble.el
Normal file
87
layers.personal/mylangs/myscribble/packages.el
Normal 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
|
||||
29
layers.personal/orgtools/README.org
Normal 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 |
|
||||
45
layers.personal/orgtools/funcs.el
Normal 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))))))
|
||||
164
layers.personal/orgtools/local/ob-mermaid/ob-mermaid.el
Normal 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
|
||||
207
layers.personal/orgtools/local/ob-metapost/ob-metapost.el
Normal 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
|
||||
201
layers.personal/orgtools/local/ob-tikz/ob-tikz.el
Normal 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
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
822
layers.personal/orgtools/local/ox-ravel/ox-ravel.el
Normal 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
|
||||
169
layers.personal/orgtools/packages.el
Normal 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
@ -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)))
|
||||
|
||||