├── .gitignore ├── HISTORY.org ├── README.md ├── old ├── .nosearch ├── old-outorg.el ├── old-readme.org └── old-readme.txt ├── outorg-test.el └── outorg.el /.gitignore: -------------------------------------------------------------------------------- 1 | # Dirs 2 | old/* 3 | # Compiled 4 | *.elc 5 | -------------------------------------------------------------------------------- /HISTORY.org: -------------------------------------------------------------------------------- 1 | * TODO Version 2.1 2 | 3 | ** TODO quit byte-compiler 4 | ** TODO improve MELPA-package 5 | ** TODO update README 6 | ** TODO set version number 7 | ** TODO announce in org-mode mailing-list 8 | ** TODO announce in emacs-user mailing-list 9 | 10 | 11 | 12 | * TODO Version 2.0 13 | 14 | ** TODO improve MELPA-package 15 | ** DONE create new ert-buffer-report github repo 16 | - State "DONE" from "TODO" [2014-09-21 So 13:16] 17 | ** DONE add hint to outorg-export repo during loading 18 | - State "DONE" from "TODO" [2014-09-21 So 13:15] 19 | ** TODO clean test file 20 | ** DONE update comment-section 21 | - State "DONE" from "TODO" [2014-09-20 Sa 14:39] 22 | ** DONE port org-mode's marker tracking to outorg 23 | - State "DONE" from "TODO" [2014-09-20 Sa 14:38] 24 | ** DONE test conversion process for side-effects 25 | - State "DONE" from "TODO" [2014-09-20 Sa 14:37] 26 | ** DONE (almost) handle special multi-line comments 27 | - State "DONE" from "TODO" [2014-09-20 Sa 14:36] 28 | ** DONE rewrite conversion functions 29 | - State "DONE" from "TODO" [2014-09-20 Sa 14:35] 30 | ** DONE quite byte-compiler 31 | - State "DONE" from "TODO" [2014-09-21 So 02:07] 32 | ** DONE update README 33 | - State "DONE" from "TODO" [2014-09-20 Sa 14:58] 34 | ** DONE set version number 35 | - State "DONE" from "TODO" [2014-09-20 Sa 14:57] 36 | ** DONE announce in org-mode mailing-list 37 | - State "DONE" from "TODO" [2014-09-21 So 13:16] 38 | ** DONE announce in emacs-user mailing-list 39 | - State "DONE" from "TODO" [2014-09-21 So 13:16] 40 | 41 | 42 | * DONE Version 1.0 43 | CLOSED: [2013-05-03 Fr 19:14] 44 | :LOGBOOK: 45 | - State "DONE" from "NEXT" [2013-05-03 Fr 19:14] 46 | :END: 47 | 48 | ** DONE add menu to outorg-edit-buffer 49 | CLOSED: [2013-05-03 Fr 19:12] 50 | :LOGBOOK: 51 | - State "DONE" from "TODO" [2013-05-03 Fr 19:12] 52 | :END: 53 | [2013-03-19 Di 16:14] 54 | ** DONE check headline not uncommented bug in html 55 | CLOSED: [2013-05-03 Fr 19:13] 56 | :LOGBOOK: 57 | - State "DONE" from "TODO" [2013-05-03 Fr 19:13] 58 | :END: 59 | [2013-02-20 Mi 14:47] 60 | ** CANCELLED check with java :CANCELLED: 61 | CLOSED: [2013-05-03 Fr 19:13] 62 | :LOGBOOK: 63 | - State "CANCELLED" from "TODO" [2013-05-03 Fr 19:13] \\ 64 | later 65 | :END: 66 | [2013-02-16 Sa 23:40] 67 | ** CANCELLED check with C :CANCELLED: 68 | CLOSED: [2013-05-03 Fr 19:13] 69 | :LOGBOOK: 70 | - State "CANCELLED" from "TODO" [2013-05-03 Fr 19:13] \\ 71 | later 72 | :END: 73 | [2013-02-16 Sa 23:40] 74 | ** CANCELLED check with R :CANCELLED: 75 | CLOSED: [2013-05-03 Fr 19:13] 76 | :LOGBOOK: 77 | - State "CANCELLED" from "TODO" [2013-05-03 Fr 19:13] \\ 78 | later 79 | :END: 80 | [2013-02-16 Sa 23:39] 81 | ** CANCELLED check with html :CANCELLED: 82 | CLOSED: [2013-05-03 Fr 19:13] 83 | :LOGBOOK: 84 | - State "CANCELLED" from "TODO" [2013-05-03 Fr 19:13] \\ 85 | later 86 | :END: 87 | [2013-02-16 Sa 23:39] 88 | ** CANCELLED check with latex :CANCELLED: 89 | CLOSED: [2013-05-03 Fr 19:12] 90 | :LOGBOOK: 91 | - State "CANCELLED" from "TODO" [2013-05-03 Fr 19:12] \\ 92 | later 93 | :END: 94 | [2013-02-16 Sa 23:39] 95 | ** DONE keybindings for commands 96 | CLOSED: [2013-03-19 Di 16:13] 97 | :LOGBOOK: 98 | - State "DONE" from "TODO" [2013-03-19 Di 16:13] 99 | :END: 100 | [2013-02-16 Sa 23:25] 101 | ** DONE work out the edit-buffer and tmp-file naming scheme 102 | CLOSED: [2013-02-16 Sa 23:25] 103 | :LOGBOOK: 104 | - State "DONE" from "TODO" [2013-02-16 Sa 23:25] 105 | :END: 106 | [2013-02-16 Sa 02:35] 107 | ** DONE rename outorg2 to outorg and (old) outorg to old-outorg. 108 | CLOSED: [2013-02-16 Sa 02:34] 109 | :LOGBOOK: 110 | - State "DONE" from "TODO" [2013-02-16 Sa 02:34] 111 | :END: 112 | [2013-02-16 Sa 02:29] 113 | ** DONE fix issue with indented comments when 'comment-region' is applied to indented text. 114 | CLOSED: [2013-02-16 Sa 14:09] 115 | :LOGBOOK: 116 | - State "DONE" from "TODO" [2013-02-16 Sa 14:09] 117 | :END: 118 | [2013-02-16 Sa 02:26] 119 | ** DONE fix double insertion bug (when edit-buffer killed without saving??) 120 | CLOSED: [2013-02-20 Mi 17:56] 121 | :LOGBOOK: 122 | - State "DONE" from "TODO" [2013-02-20 Mi 17:56] 123 | - State "TODO" from "DONE" [2013-02-20 Mi 14:48] 124 | - State "DONE" from "TODO" [2013-02-16 Sa 02:28] 125 | :END: 126 | [2013-02-14 Do 17:37] 127 | ** DONE add special marker to narrowed buffers to remember point-position 128 | CLOSED: [2013-02-16 Sa 20:29] 129 | :LOGBOOK: 130 | - State "DONE" from "TODO" [2013-02-16 Sa 20:29] 131 | :END: 132 | [2013-02-14 Do 17:18] 133 | ** DONE add persistent header line to edit-buffer 134 | CLOSED: [2013-02-14 Do 17:18] 135 | :LOGBOOK: 136 | - State "DONE" from "" [2013-02-14 Do 17:18] 137 | :END: 138 | [2013-02-14 Do 17:15] 139 | ** DONE move outxxtra.el to its own github repo 140 | CLOSED: [2013-02-14 Do 17:15] 141 | :LOGBOOK: 142 | - State "DONE" from "TODO" [2013-02-14 Do 17:15] 143 | :END: 144 | [2013-02-14 Do 17:14] 145 | ** DONE special minor-mode for edit-buffer 146 | CLOSED: [2013-02-16 Sa 02:28] 147 | :LOGBOOK: 148 | - State "DONE" from "TODO" [2013-02-16 Sa 02:28] 149 | :END: 150 | [2013-02-13 Mi 01:42] 151 | *** DONE outorg-keybindings in edit-buffer 152 | CLOSED: [2013-02-16 Sa 02:28] 153 | :LOGBOOK: 154 | - State "DONE" from "TODO" [2013-02-16 Sa 02:28] 155 | :END: 156 | [2013-02-13 Mi 01:44] 157 | *** DONE kill-buffer actions 158 | CLOSED: [2013-02-16 Sa 02:28] 159 | :LOGBOOK: 160 | - State "DONE" from "TODO" [2013-02-16 Sa 02:28] 161 | :END: 162 | [2013-02-13 Mi 01:44] 163 | **** DONE reset window-config 164 | CLOSED: [2013-02-16 Sa 02:28] 165 | :LOGBOOK: 166 | - State "DONE" from "TODO" [2013-02-16 Sa 02:28] 167 | :END: 168 | [2013-02-13 Mi 01:45] 169 | **** DONE save dangling edits in tmp-file 170 | CLOSED: [2013-02-16 Sa 02:28] 171 | :LOGBOOK: 172 | - State "DONE" from "TODO" [2013-02-16 Sa 02:28] 173 | :END: 174 | [2013-02-13 Mi 01:44] 175 | **** DONE reset-global-vars 176 | CLOSED: [2013-02-16 Sa 02:28] 177 | :LOGBOOK: 178 | - State "DONE" from "TODO" [2013-02-16 Sa 02:28] 179 | :END: 180 | [2013-02-13 Mi 01:45] 181 | ** DONE fix bug eob when last line was line of code (conversion to org) 182 | CLOSED: [2013-02-14 Do 17:11] 183 | :LOGBOOK: 184 | - State "DONE" from "TODO" [2013-02-14 Do 17:11] 185 | :END: 186 | [2013-02-13 Mi 01:39] 187 | ** DONE refactor outxxtra.el (only extensions to out-xtra.el) 188 | CLOSED: [2013-02-14 Do 17:11] 189 | :LOGBOOK: 190 | - State "DONE" from "TODO" [2013-02-14 Do 17:11] 191 | :END: 192 | [2013-02-13 Mi 01:38] 193 | ** DONE refactor outorg2.el (only Org-style editing) 194 | CLOSED: [2013-02-14 Do 17:11] 195 | :LOGBOOK: 196 | - State "DONE" from "TODO" [2013-02-14 Do 17:11] 197 | :END: 198 | [2013-02-13 Mi 01:37] 199 | ** CANCELLED announce new version in PicoLisp mailing-list :CANCELLED: 200 | CLOSED: [2013-05-03 Fr 19:14] 201 | :LOGBOOK: 202 | - State "CANCELLED" from "TODO" [2013-05-03 Fr 19:14] \\ 203 | enough publicity 204 | :END: 205 | [2013-02-13 Mi 01:37] 206 | ** DONE change version number (comment and const) 207 | CLOSED: [2013-05-03 Fr 19:14] 208 | :LOGBOOK: 209 | - State "DONE" from "TODO" [2013-05-03 Fr 19:14] 210 | :END: 211 | [2013-02-13 Mi 01:37] 212 | ** CANCELLED fix menu :CANCELLED: 213 | CLOSED: [2013-02-14 Do 17:12] 214 | :LOGBOOK: 215 | - State "CANCELLED" from "TODO" [2013-02-14 Do 17:12] \\ 216 | related to outxxtra.el 217 | :END: 218 | [2013-02-13 Mi 01:37] 219 | ** DONE develop README to Worg article 220 | CLOSED: [2013-03-19 Di 16:13] 221 | :LOGBOOK: 222 | - State "DONE" from "TODO" [2013-03-19 Di 16:13] 223 | :END: 224 | [2013-02-13 Mi 01:37] 225 | ** DONE write installation guide (with outline-magic) 226 | CLOSED: [2013-03-19 Di 16:13] 227 | :LOGBOOK: 228 | - State "DONE" from "TODO" [2013-03-19 Di 16:13] 229 | :END: 230 | [2013-02-13 Mi 01:37] 231 | ** CANCELLED check keybindings, compare to org :CANCELLED: 232 | CLOSED: [2013-02-14 Do 17:13] 233 | :LOGBOOK: 234 | - State "CANCELLED" from "TODO" [2013-02-14 Do 17:13] \\ 235 | related to outxxtra.el 236 | :END: 237 | [2013-02-13 Mi 01:36] 238 | ** CANCELLED fix demote and promote subtree :CANCELLED: 239 | CLOSED: [2013-02-14 Do 17:11] 240 | :LOGBOOK: 241 | - State "CANCELLED" from "TODO" [2013-02-14 Do 17:11] \\ 242 | related to outxxtra.el 243 | :END: 244 | [2013-02-13 Mi 01:36] 245 | ** CANCELLED check with different languages (comment-end true, e..g. HTML) :CANCELLED: 246 | CLOSED: [2013-02-14 Do 17:13] 247 | :LOGBOOK: 248 | - State "CANCELLED" from "TODO" [2013-02-14 Do 17:13] \\ 249 | related to outxxtra.el 250 | :END: 251 | [2013-02-13 Mi 01:36] 252 | ** CANCELLED check with different languages (comment-end false, e.g. R, Java) :CANCELLED: 253 | CLOSED: [2013-02-14 Do 17:13] 254 | :LOGBOOK: 255 | - State "CANCELLED" from "TODO" [2013-02-14 Do 17:13] \\ 256 | related to outxxtra.el 257 | :END: 258 | [2013-02-13 Mi 01:36] 259 | 260 | 261 | * Version 0.9 262 | ** DONE announce new version in Org-mode mailing-list 263 | CLOSED: [2013-02-12 Di 00:08] 264 | :LOGBOOK: 265 | - State "DONE" from "TODO" [2013-02-12 Di 00:08] 266 | :END: 267 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Outorg 2 | 3 | I no longer maintain this package, but @alphapapa has graciously agreed to take over maintainership. His fork should be considered authoritative and can be found here: 4 | 5 | https://github.com/alphapapa/outorg 6 | -------------------------------------------------------------------------------- /old/.nosearch: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tj64/outorg/76a4072736dd6ca92fc42749dc94c42172b96b8b/old/.nosearch -------------------------------------------------------------------------------- /old/old-outorg.el: -------------------------------------------------------------------------------- 1 | ;; * outorg.el --- Org-style outline navigation and comment editing 2 | 3 | ;; ** Copyright 4 | 5 | ;; Copyright (C) 2013 Thorsten Jolitz 6 | ;; This file is not (yet) part of GNU Emacs 7 | 8 | ;; Author: Thorsten Jolitz (format "tjolitz%sgmail%s" "@" ".com") 9 | 10 | ;; ** Credits 11 | 12 | ;; This library is based on, or rather an extension of, Per Abrahamsen's 13 | ;; 'out-xtra.el' (http://tinyurl.com/aql9p97), and may replace it many cases. 14 | ;; Some new ideas were taken from Fabrice Niessen's '.emacs' 15 | ;; (http://www.mygooglest.com/fni/dot-emacs.html#sec-2), and some inspiration 16 | ;; from Eric Schulte's and Dan Davidson's 'Org-babel' 17 | ;; (http://orgmode.org/worg/org-contrib/babel/). 18 | 19 | ;; ** Commentary 20 | 21 | ;; This file provides (almost) the same nice extra features for outline minor 22 | ;; mode like Per Abrahamsen's 'out-xtra': 23 | 24 | ;; - Change default minor mode key prefix to `C-c'. 25 | ;; - Complete keybindings and menu support. 26 | ;; - Add command to show top level headers. 27 | ;; - Add command to hide all other entries than the one containing point. 28 | 29 | ;; `outorg' follows a different idea than `out-xtra': it consists of generic 30 | ;; functionality that that calculates the adequate outline-regexp and 31 | ;; outline-level for the active major-mode, rather than defining several blocks 32 | ;; of major-mode specific functionality. 33 | 34 | ;; New features of `outorg' are: 35 | 36 | ;; 1. Generic functionality that should work whereever `comment-region' and 37 | ;; `uncomment-region' work. 38 | 39 | ;; 2. Fontification of headlines (copied from Fabrice Niessen's 40 | ;; '.emacs') 41 | 42 | ;; 3. Toggling between editing in Lisp mode and in Org mode, similar to the 43 | ;; editing of source-code blocks in Org-mode. 44 | 45 | ;; It is highly recommended to use `outorg' together with `outline-magic' for 46 | ;; the Org-style `outline-cycle' command. 47 | 48 | ;; ** Emacs Version 49 | 50 | ;; `outorg.el' works with [GNU Emacs 24.2.1 (x86_64-unknown-linux-gnu, GTK+ 51 | ;; Version 3.6.4) of 2013-01-20 on eric]. No attempts of testing with older 52 | ;; versions or other types of Emacs have be made (yet). 53 | 54 | ;; ** Installation 55 | 56 | ;; Insert 57 | ;; (require 'outorg) 58 | ;; in your .emacs file to install. If you want a different prefix 59 | ;; key, insert first 60 | ;; (defvar outline-minor-mode-prefix "\C-c") 61 | ;; or whatever. The prefix can only be changed before outline (minor) 62 | ;; mode is loaded. 63 | 64 | ;; ** ChangeLog 65 | 66 | ;; | date | author(s) | version | 67 | ;; |-----------------+-----------------+---------| 68 | ;; | <2013-02-11 Mo> | Thorsten Jolitz | 0.9 | 69 | 70 | ;; ** Bugs 71 | 72 | ;; `outorg' is line-based, it only works with 'one-line' comments, i.e. with 73 | ;; comment-sections like those produced by `comment-region' (a command that 74 | ;; comments or uncomments each line in the region). Those special multi-line 75 | ;; comments found in many programming languages are not recognized and lead to 76 | ;; undefined behaviour. 77 | 78 | ;; * Requires 79 | 80 | (require 'outline) 81 | (require 'org) 82 | 83 | ;; * Variables 84 | 85 | ;; ** Consts 86 | 87 | (defconst outorg-version "0.9" 88 | "outorg version number.") 89 | 90 | ;; ** Vars 91 | 92 | (defvar outline-minor-mode-prefix "\C-c" 93 | "New outline-minor-mode prefix.") 94 | 95 | (defvar outorg-edit-whole-buffer-p nil 96 | "Non-nil if the whole code-buffer is edited.") 97 | 98 | (defvar outorg-initial-window-config nil 99 | "Initial window-configuration when editing as Org.") 100 | 101 | ;; ** Hooks 102 | 103 | (defvar outorg-hook nil 104 | "Functions to run after `outorg' is loaded.") 105 | 106 | ;; ** Customs 107 | 108 | ;; *** Custom Groups 109 | 110 | ;; (defgroup outorg nil 111 | ;; "Library for outline navigation and Org-mode editing in Lisp buffers." 112 | ;; :prefix "outorg-" 113 | ;; :group 'lisp 'outlines 114 | ;; :link '(url-link "http://emacswiki.org/emacs/OutlineMinorMode")) 115 | 116 | 117 | ;; *** Custom Vars 118 | 119 | ;; * Functions 120 | 121 | ;; ** Non-interactive Functions 122 | 123 | ;; *** Get buffer major mode 124 | 125 | (defun outorg-get-buffer-mode (buffer-or-string) 126 | "Return major mode of BUFFER-OR-STRING." 127 | (with-current-buffer buffer-or-string 128 | major-mode)) 129 | 130 | 131 | ;; *** Calculate the outline-regexp 132 | 133 | (defun outorg-calc-outline-regexp () 134 | "Calculate the outline regexp for the current mode." 135 | (let* ((comment-start-no-space 136 | (replace-regexp-in-string 137 | "[[:space:]]+" "" comment-start)) 138 | (comment-start-region 139 | (if (and 140 | comment-end 141 | (not (string-equal "" comment-end))) 142 | comment-start-no-space 143 | (concat 144 | comment-start-no-space comment-start-no-space)))) 145 | ;; the "^" not needed by outline, but by outorg (?) 146 | (concat "^" comment-start-region " [*]+ "))) 147 | 148 | ;; *** Calculate the outline-level 149 | 150 | (defun outorg-calc-outline-level () 151 | "Calculate the right outline level for the outorg-outline-regexp" 152 | (save-excursion 153 | (save-match-data 154 | (let ((len (- (match-end 0) (match-beginning 0)))) 155 | (- len (+ 2 (* 2 (length (format "%s" comment-start))))))))) 156 | 157 | 158 | ;; *** Fontify the headlines 159 | 160 | ;; Org-style highlighting of the headings 161 | (defun outorg-fontify-headlines (outline-regexp) 162 | ;; (interactive) 163 | ;; (setq outline-regexp (tj/outline-regexp)) 164 | 165 | ;; highlight the headings 166 | ;; see http://www.gnu.org/software/emacs/manual/html_node/emacs/Font-Lock.html 167 | ;; use `M-x customize-apropos-faces' to customize faces 168 | ;; to find the corresponding face for each outline level, see 169 | ;; `org-faces.el' 170 | 171 | ;; Added `\n?', after having read the following chunk of code (from org.el): 172 | ;; `(,(if org-fontify-whole-heading-line 173 | ;; "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)" 174 | ;; "^\\(\\**\\)\\(\\* \\)\\(.*\\)") 175 | 176 | (let ((org-fontify-whole-heading-line "") ; "\n?") 177 | (heading-1-regexp 178 | (concat (substring outline-regexp 0 -1) 179 | "\\{1\\} \\(.*" org-fontify-whole-heading-line "\\)")) 180 | (heading-2-regexp 181 | (concat (substring outline-regexp 0 -1) 182 | "\\{2\\} \\(.*" org-fontify-whole-heading-line "\\)")) 183 | (heading-3-regexp 184 | (concat (substring outline-regexp 0 -1) 185 | "\\{3\\} \\(.*" org-fontify-whole-heading-line "\\)")) 186 | (heading-4-regexp 187 | (concat (substring outline-regexp 0 -1) 188 | "\\{4,\\} \\(.*" org-fontify-whole-heading-line "\\)")) 189 | (heading-5-regexp 190 | (concat (substring outline-regexp 0 -1) 191 | "\\{5\\} \\(.*" org-fontify-whole-heading-line "\\)"))) 192 | (font-lock-add-keywords 193 | nil 194 | `((,heading-1-regexp 1 'org-level-1 t) 195 | (,heading-2-regexp 1 'org-level-2 t) 196 | (,heading-3-regexp 1 'org-level-3 t) 197 | (,heading-4-regexp 1 'org-level-4 t) 198 | (,heading-5-regexp 1 'org-level-5 t))))) 199 | 200 | ;; *** Set outline-regexp und outline-level 201 | 202 | (defun outorg-set-local-outline-regexp-and-level (regexp &optional fun) 203 | "Set `outline-regexp' locally to REGEXP and `outline-level' to FUN." 204 | (make-local-variable 'outline-regexp) 205 | (setq outline-regexp regexp) 206 | (and fun 207 | (make-local-variable 'outline-level) 208 | (setq outline-level fun))) 209 | 210 | ;; *** Outorg hook-functions 211 | 212 | (defun outorg-hook-function () 213 | "Add this function to outline-minor-mode-hook" 214 | (let ((out-regexp (outorg-calc-outline-regexp))) 215 | (outorg-set-local-outline-regexp-and-level 216 | out-regexp 'outorg-calc-outline-level) 217 | (outorg-fontify-headlines out-regexp))) 218 | 219 | (add-hook 'outline-minor-mode-hook 'outorg-hook-function) 220 | 221 | ;; ** Commands 222 | 223 | ;; *** Edit as Org 224 | 225 | (defun outorg-edit-as-org (arg) 226 | "Convert and copy to temporary Org buffer 227 | With ARG, edit the whole buffer, otherwise the current subtree." 228 | (interactive "P") 229 | (setq outorg-code-buffer-marker (point-marker)) 230 | (and arg (setq outorg-edit-whole-buffer-p t)) 231 | (setq outorg-initial-window-config 232 | (current-window-configuration)) 233 | (outorg-copy-and-convert)) 234 | 235 | (defun outorg-save-edits () 236 | "Replace code-buffer content with (converted) edit-buffer content and 237 | kill edit-buffer" 238 | (interactive) 239 | (widen) 240 | (funcall 241 | (outorg-get-buffer-mode 242 | (marker-buffer outorg-code-buffer-marker))) 243 | (outorg-convert-back-to-code) 244 | (outorg-replace-code-with-edits) 245 | (kill-buffer 246 | (marker-buffer outorg-edit-buffer-marker)) 247 | (set-window-configuration 248 | outorg-initial-window-config) 249 | ;; (switch-to-buffer 250 | ;; (marker-buffer outorg-code-buffer-marker)) 251 | ;; (goto-char 252 | ;; (marker-position outorg-code-buffer-marker)) 253 | (outorg-reset-global-vars)) 254 | 255 | ;; *** Additional outline commands (from `out-xtra'). 256 | 257 | (defun outline-hide-sublevels (keep-levels) 258 | "Hide everything except the first KEEP-LEVEL headers." 259 | (interactive "p") 260 | (if (< keep-levels 1) 261 | (error "Must keep at least one level of headers")) 262 | (setq keep-levels (1- keep-levels)) 263 | (save-excursion 264 | (goto-char (point-min)) 265 | (hide-subtree) 266 | (show-children keep-levels) 267 | (condition-case err 268 | (while (outline-get-next-sibling) 269 | (hide-subtree) 270 | (show-children keep-levels)) 271 | (error nil)))) 272 | 273 | (defun outline-hide-other () 274 | "Hide everything except for the current body and the parent headings." 275 | (interactive) 276 | (outline-hide-sublevels 1) 277 | (let ((last (point)) 278 | (pos (point))) 279 | (while (save-excursion 280 | (and (re-search-backward "[\n\r]" nil t) 281 | (eq (following-char) ?\r))) 282 | (save-excursion 283 | (beginning-of-line) 284 | (if (eq last (point)) 285 | (progn 286 | (outline-next-heading) 287 | (outline-flag-region last (point) ?\n)) 288 | (show-children) 289 | (setq last (point))))))) 290 | 291 | 292 | ;; *** Edit as Org-file 293 | 294 | (defun outorg-copy-and-convert () 295 | "Copy code buffer content to tmp-buffer and convert it to Org syntax. 296 | If WHOLE-BUFFER-P is non-nil, copy the whole buffer, otherwise 297 | the current subtree." 298 | (let* ((edit-buffer 299 | (get-buffer-create "*outorg-edit-buffer*"))) 300 | (save-restriction 301 | (with-current-buffer edit-buffer (erase-buffer)) 302 | (widen) 303 | ;; copy code buffer content 304 | (copy-to-buffer 305 | edit-buffer 306 | (if outorg-edit-whole-buffer-p 307 | (point-min) 308 | (save-excursion 309 | (outline-back-to-heading 'INVISIBLE-OK) 310 | (point))) 311 | (if outorg-edit-whole-buffer-p 312 | (point-max) 313 | (save-excursion 314 | (outline-end-of-subtree) 315 | (point))))) 316 | ;; switch to edit buffer 317 | (if (one-window-p) (split-window-sensibly (get-buffer-window))) 318 | (switch-to-buffer-other-window edit-buffer) 319 | (and outorg-edit-whole-buffer-p 320 | (goto-char 321 | (marker-position outorg-code-buffer-marker))) 322 | (setq outorg-edit-buffer-marker (point-marker))) 323 | ;; activate programming language major mode and convert to org 324 | (funcall (outorg-get-buffer-mode 325 | (marker-buffer outorg-code-buffer-marker))) 326 | (outorg-convert-to-org) 327 | ;; change major mode to org-mode 328 | (org-mode) 329 | (if outorg-edit-whole-buffer-p 330 | (progn 331 | (org-first-headline-recenter) 332 | (hide-sublevels 3) 333 | (goto-char 334 | (marker-position outorg-edit-buffer-marker)) 335 | (show-subtree)) 336 | (goto-char 337 | (marker-position outorg-edit-buffer-marker)) 338 | (show-all))) 339 | 340 | (defun outorg-convert-to-org () 341 | "Convert file content to Org Syntax" 342 | (let* ((last-line-comment-p nil) 343 | (mode-name 344 | (format 345 | "%S" (with-current-buffer 346 | (marker-buffer outorg-code-buffer-marker) 347 | major-mode))) 348 | (splitted-mode-name 349 | (split-string mode-name "-mode")) 350 | (language-name 351 | (if (> (length splitted-mode-name) 1) 352 | (car splitted-mode-name) 353 | (car (split-string mode-name "\\.")))) 354 | (in-org-babel-load-languages-p 355 | (assq 356 | (intern language-name) 357 | org-babel-load-languages))) 358 | (goto-char (point-min)) 359 | (while (not (eobp)) 360 | (cond 361 | ;; empty line (do nothing) 362 | ((looking-at "^[[:space:]]*$")) 363 | ;; comment line after comment line or at 364 | ;; beginning of buffer 365 | ((and 366 | (save-excursion 367 | (eq (comment-on-line-p) (point-at-bol))) 368 | (or (bobp) last-line-comment-p)) 369 | (uncomment-region (point-at-bol) (point-at-eol)) 370 | (setq last-line-comment-p t)) 371 | ;; line of code after comment line 372 | ((and 373 | (save-excursion 374 | (not (eq (comment-on-line-p) (point-at-bol)))) 375 | last-line-comment-p) 376 | (newline) 377 | (forward-line -1) 378 | (insert 379 | (if in-org-babel-load-languages-p 380 | (concat "#+begin_src " language-name) 381 | "#+begin_example")) 382 | (forward-line) 383 | (setq last-line-comment-p nil)) 384 | ;; comment line after line of code 385 | ((and 386 | (save-excursion 387 | (eq (comment-on-line-p) (point-at-bol))) 388 | (not last-line-comment-p)) 389 | (uncomment-region (point-at-bol) (point-at-eol)) 390 | (save-excursion 391 | (forward-line -1) 392 | (unless (looking-at "^[[:space:]]*$") 393 | (newline)) 394 | (if in-org-babel-load-languages-p 395 | (insert "#+end_src") 396 | (insert "#+end_example")) 397 | (newline)) 398 | (setq last-line-comment-p t)) 399 | ;; last line after line of code 400 | ((and 401 | (eq (line-number-at-pos) 402 | (1- (count-lines (point-min) (point-max)))) 403 | (not last-line-comment-p)) 404 | ;; (unless (looking-at "^[[:space:]]*$") 405 | (forward-line) 406 | (newline) 407 | (if in-org-babel-load-languages-p 408 | (insert "#+end_src") 409 | (insert "#+end_example")) 410 | (newline)) 411 | ;; line of code after line of code 412 | (t (setq last-line-comment-p nil))) 413 | (forward-line)))) 414 | 415 | (defun outorg-convert-back-to-code () 416 | "Convert edit-buffer content back to programming language syntax. 417 | Assume that edit-buffer major-mode has been set back to the 418 | programming-language major-mode of the associated code-buffer 419 | before this function is called." 420 | (let* ((inside-code-or-example-block-p nil)) 421 | (goto-char (point-min)) 422 | (while (not (eobp)) 423 | (cond 424 | ;; empty line (do nothing) 425 | ((looking-at "^[[:space:]]*$")) 426 | ;; begin code/example block 427 | ((looking-at "^[ \t]*#\\+begin_?") 428 | (kill-whole-line) 429 | (forward-line -1) 430 | (setq inside-code-or-example-block-p t)) 431 | ;; end code/example block 432 | ((looking-at "^[ \t]*#\\+end_?") 433 | (kill-whole-line) 434 | (forward-line -1) 435 | (setq inside-code-or-example-block-p nil)) 436 | ;; line inside code/example block (do nothing) 437 | (inside-code-or-example-block-p) 438 | ;; not-empty line outside code/example block 439 | (t (comment-region (point-at-bol) (point-at-eol)))) 440 | (forward-line)))) 441 | 442 | (defun outorg-replace-code-with-edits () 443 | "Replace code-buffer contents with edits." 444 | (let* ((edit-buf (marker-buffer outorg-edit-buffer-marker)) 445 | (code-buf (marker-buffer outorg-code-buffer-marker)) 446 | (edit-buf-point-min 447 | (with-current-buffer edit-buf 448 | (point-min))) 449 | (edit-buf-point-max 450 | (with-current-buffer edit-buf 451 | (goto-char (point-max)) 452 | (unless (and (bolp) (looking-at "^$")) 453 | (newline)) 454 | (point)))) 455 | (with-current-buffer code-buf 456 | (if outorg-edit-whole-buffer-p 457 | (progn 458 | (erase-buffer) 459 | (insert-buffer-substring-no-properties 460 | edit-buf edit-buf-point-min edit-buf-point-max) 461 | ;; (goto-char (marker-position outorg-edit-buffer-marker)) 462 | ) 463 | (save-restriction 464 | (narrow-to-region 465 | (save-excursion 466 | (outline-back-to-heading 'INVISIBLE-OK) 467 | (point)) 468 | (save-excursion 469 | (outline-end-of-subtree) 470 | (point))) 471 | (delete-region (point-min) (point-max)) 472 | (insert-buffer-substring-no-properties 473 | edit-buf edit-buf-point-min edit-buf-point-max))) 474 | ;; (save-buffer) 475 | ))) 476 | 477 | (defun outorg-reset-global-vars () 478 | "Reset some global vars defined by outorg to initial values." 479 | (set-marker outorg-code-buffer-marker nil) 480 | (set-marker outorg-edit-buffer-marker nil) 481 | (setq outorg-edit-whole-buffer-p nil) 482 | (setq outorg-initial-window-config nil)) 483 | 484 | ;; * Keybindings. 485 | 486 | ;; We provide bindings for all keys. 487 | ;; FIXME: very old stuff from `out-xtra' - still necesary? 488 | 489 | (if (fboundp 'eval-after-load) 490 | ;; FSF Emacs 19. 491 | (eval-after-load "outline" 492 | '(let ((map (lookup-key outline-minor-mode-map 493 | outline-minor-mode-prefix))) 494 | (define-key map "\C-t" 'hide-body) 495 | (define-key map "\C-a" 'show-all) 496 | (define-key map "\C-c" 'hide-entry) 497 | (define-key map "\C-e" 'show-entry) 498 | (define-key map "\C-l" 'hide-leaves) 499 | (define-key map "\C-k" 'show-branches) 500 | (define-key map "\C-q" 'outline-hide-sublevels) 501 | (define-key map "\C-o" 'outline-hide-other) 502 | ;; TODO differentiate between called in code or edit buffer 503 | (define-key map "'" 'outorg-edit-as-org) 504 | ;; TODO add these keybindings to org-mode keymap (all?) 505 | ;; (define-key map "\C-s" 'outorg-save-edits) 506 | ;; (define-key map "\C-c" 'outorg-save-edits) 507 | ;; (define-key map "'" 'outorg-save-edits) 508 | 509 | (define-key outline-minor-mode-map [menu-bar hide hide-sublevels] 510 | '("Hide Sublevels" . outline-hide-sublevels)) 511 | (define-key outline-minor-mode-map [menu-bar hide hide-other] 512 | '("Hide Other" . outline-hide-other)) 513 | (if (fboundp 'update-power-keys) 514 | (update-power-keys outline-minor-mode-map)))) 515 | 516 | (if (string-match "Lucid" emacs-version) 517 | (progn ;; Lucid Emacs 19 518 | (defconst outline-menu 519 | '(["Up" outline-up-heading t] 520 | ["Next" outline-next-visible-heading t] 521 | ["Previous" outline-previous-visible-heading t] 522 | ["Next Same Level" outline-forward-same-level t] 523 | ["Previous Same Level" outline-backward-same-level t] 524 | "---" 525 | ["Show All" show-all t] 526 | ["Show Entry" show-entry t] 527 | ["Show Branches" show-branches t] 528 | ["Show Children" show-children t] 529 | ["Show Subtree" show-subtree t] 530 | "---" 531 | ["Hide Leaves" hide-leaves t] 532 | ["Hide Body" hide-body t] 533 | ["Hide Entry" hide-entry t] 534 | ["Hide Subtree" hide-subtree t] 535 | ["Hide Other" outline-hide-other t] 536 | ["Hide Sublevels" outline-hide-sublevels t])) 537 | 538 | (defun outline-add-menu () 539 | (set-buffer-menubar (copy-sequence current-menubar)) 540 | (add-menu nil "Outline" outline-menu)) 541 | 542 | (add-hook 'outline-minor-mode-hook 'outline-add-menu) 543 | (add-hook 'outline-mode-hook 'outline-add-menu) 544 | (add-hook 'outline-minor-mode-off-hook 545 | (function (lambda () (delete-menu-item '("Outline"))))))) 546 | 547 | ;; Lucid Emacs or Emacs 18. 548 | (require 'outln-18) 549 | (let ((map (lookup-key outline-minor-mode-map outline-minor-mode-prefix))) 550 | ;; Should add a menu here. 551 | (define-key map "\C-t" 'hide-body) 552 | (define-key map "\C-a" 'show-all) 553 | (define-key map "\C-c" 'hide-entry) 554 | (define-key map "\C-e" 'show-entry) 555 | (define-key map "\C-l" 'hide-leaves) 556 | (define-key map "\C-k" 'show-branches) 557 | (define-key map "\C-q" 'outline-hide-sublevels) 558 | (define-key map "\C-o" 'outline-hide-other))) 559 | 560 | 561 | ;; * Run hooks and provide 562 | 563 | (run-hooks 'outorg-hook) 564 | 565 | (provide 'outorg) 566 | 567 | ;; Local Variables: 568 | ;; coding: utf-8 569 | ;; ispell-local-dictionary: "en_US" 570 | ;; End: 571 | 572 | ;; outorg.el ends here 573 | -------------------------------------------------------------------------------- /old/old-readme.org: -------------------------------------------------------------------------------- 1 | #+TITLE: outorg.el -- reverse org-babel 2 | #+AUTHOR: Thorsten Jolitz 3 | #+EMAIL: tjolitz gmail com 4 | #+DATE: 2013-02-11 Mo 5 | #+DESCRIPTION: 6 | #+KEYWORDS: 7 | #+LANGUAGE: en 8 | #+OPTIONS: H:3 num:nil toc:t \n:nil @:t ::t |:t ^:nil -:t f:t *:t <:nil 9 | #+OPTIONS: TeX:t LaTeX:t skip:nil d:nil todo:t pri:nil tags:not-in-toc 10 | #+INFOJS_OPT: view:nil toc:nil ltoc:t mouse:underline buttons:0 path:http://orgmode.org/org-info.js 11 | #+EXPORT_SELECT_TAGS: export 12 | #+EXPORT_EXCLUDE_TAGS: noexport 13 | #+LINK_UP: 14 | #+LINK_HOME: 15 | #+XSLT: 16 | 17 | 18 | * outorg.el - Org-style comment editing 19 | ** Copyright 20 | 21 | Copyright (C) 2013 Thorsten Jolitz 22 | This file is not (yet) part of GNU Emacs 23 | 24 | Author: Thorsten Jolitz (format "tjolitz%sgmail%s" "@" ".com") 25 | 26 | ** Credits 27 | 28 | This library is inspired by the way source-blocks can be edited in temporary 29 | edit files in Org-mode (http://orgmode.org/worg/org-contrib/babel/). 30 | 31 | ** Commentary 32 | 33 | `outorg' is like "reverse Org-babel": editing of comment-sections from source 34 | code files in temporary Org-mode buffers instead of editing of Org-mode 35 | source-blocks in temporary source-code buffers. 36 | 37 | ** Emacs Version 38 | 39 | `outorg.el' works with [GNU Emacs 24.2.1 (x86_64-unknown-linux-gnu, GTK+ 40 | Version 3.6.4) of 2013-01-20 on eric]. No attempts of testing with older 41 | versions or other types of Emacs have be made (yet). 42 | 43 | ** Installation 44 | 45 | Insert 46 | (require 'outorg) 47 | in your .emacs file to install. If you want a different prefix 48 | key, insert first 49 | (defvar outline-minor-mode-prefix "\C-c") 50 | or whatever. The prefix can only be changed before outline (minor) 51 | mode is loaded. 52 | 53 | ** ChangeLog 54 | 55 | | date | author(s) | version | 56 | |-----------------+-----------------+---------| 57 | | <2013-02-11 Mo> | Thorsten Jolitz | 0.9 | 58 | 59 | ** Bugs 60 | 61 | `outorg' is line-based, it only works with 'one-line' comments, i.e. with 62 | comment-sections like those produced by `comment-region' (a command that 63 | comments or uncomments each line in the region). Those special multi-line 64 | comments found in many programming languages are not recognized and lead to 65 | undefined behaviour. 66 | 67 | -------------------------------------------------------------------------------- /old/old-readme.txt: -------------------------------------------------------------------------------- 1 | Thorsten Jolitz 2 | 3 | 4 | Table of Contents 5 | _________________ 6 | 7 | 1 outorg.el --- Org-style comment editing 8 | .. 1.1 Copyright 9 | .. 1.2 Licence 10 | .. 1.3 Credits 11 | .. 1.4 Commentary 12 | ..... 1.4.1 About outorg 13 | ..... 1.4.2 Installation 14 | ..... 1.4.3 Bugs and Shortcomings 15 | ..... 1.4.4 Emacs Version 16 | .. 1.5 ChangeLog 17 | 18 | 19 | 1 outorg.el --- Org-style comment editing 20 | ========================================= 21 | 22 | 1.1 Copyright 23 | ~~~~~~~~~~~~~ 24 | 25 | Copyright (C) 2013 Thorsten Jolitz 26 | 27 | Author: Thorsten Jolitz 28 | Maintainer: Thorsten Jolitz 29 | Version: 1.0 30 | Created: 11th February 2013 31 | Keywords: outlines, org-mode, editing 32 | 33 | 34 | 1.2 Licence 35 | ~~~~~~~~~~~ 36 | 37 | This file is NOT (yet) part of GNU Emacs. 38 | 39 | This program is free software; you can redistribute it and/or modify 40 | it under the terms of the GNU General Public License as published by 41 | the Free Software Foundation, either version 3 of the License, or (at 42 | your option) any later version. 43 | 44 | This program is distributed in the hope that it will be useful, but 45 | WITHOUT ANY WARRANTY; without even the implied warranty of 46 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 47 | General Public License for more details. 48 | 49 | You should have received a copy of the GNU General Public License 50 | along with this program. If not, see [http://www.gnu.org/licenses/]. 51 | 52 | 53 | 1.3 Credits 54 | ~~~~~~~~~~~ 55 | 56 | This library is inspired by the way source-blocks can be edited in 57 | temporary edit files in Org-mode (see 58 | [http://orgmode.org/worg/org-contrib/babel/]). 59 | 60 | 61 | 1.4 Commentary 62 | ~~~~~~~~~~~~~~ 63 | 64 | 1.4.1 About outorg 65 | ------------------ 66 | 67 | `outorg' is like "reverse Org-Babel": editing of comment-sections from 68 | source code files in temporary Org-mode buffers instead of editing of 69 | Org-mode source-blocks in temporary source-code buffers. 70 | 71 | It should be used together with `outline-minor-mode' and 72 | `outshine.el'. Keep in mind, that `outorg' only works with 73 | outshine-style headlines like those produced by calling 74 | `comment-region' on Org-mode style headlines in a source-code buffer. 75 | Take this file as an example for suitable outline headlines in an 76 | Emacs Lisp buffer. In other major-modes, the `comment-start' character 77 | ';' of Emacs Lisp would be replaced by that of the respective 78 | major-mode, e.g. '#' in PicoLisp mode or '%' in LaTeX mode. 79 | 80 | `outorgs' main command is 81 | 82 | ,--------------------------- 83 | C-c ' (outorg-edit-as-org) 84 | `--------------------------- 85 | 86 | or, depending on the outline-mode prefix 87 | 88 | ,--------------------------- 89 | M-# M-# (outorg-edit-as-org) 90 | `--------------------------- 91 | 92 | used in source-code buffers where `outline-minor-mode' is activated 93 | with `outshine' extensions. The Org-mode edit-buffer popped up by this 94 | command has `outorg-edit-mode' activated, a minor-mode with only 2 95 | commands: 96 | 97 | ,---------------------------------------- 98 | M-# (outorg-copy-edits-and-exit) 99 | C-x C-s (outorg-save-edits-to-tmp-file) 100 | `---------------------------------------- 101 | 102 | If you want to insert Org-mode source-code or example blocks in 103 | comment-sections, simply outcomment them in the outorg-edit buffer 104 | before calling `outorg-copy-edits-and-exit'. 105 | 106 | 107 | 1.4.2 Installation 108 | ------------------ 109 | 110 | Insert 111 | 112 | #+begin_src emacs-lisp 113 | (require 'outorg) 114 | #+end_src 115 | 116 | in your .emacs. 117 | 118 | 1.4.3 Bugs and Shortcomings 119 | --------------------------- 120 | 121 | `outorg' is line-based, it only works with 'one-line' comments, i.e. 122 | with comment-sections like those produced by `comment-region' (a 123 | command that comments or uncomments each line in the region). Those 124 | special multi-line comments found in many programming languages are 125 | not recognized and lead to undefined behaviour. 126 | 127 | 128 | 1.4.4 Emacs Version 129 | ------------------- 130 | 131 | `outorg.el' works with [GNU Emacs 24.2.1 (x86_64-unknown-linux-gnu, 132 | GTK+ Version 3.6.4) of 2013-01-20 on eric]. No attempts of testing 133 | with older versions or other types of Emacs have been made (yet). 134 | 135 | 136 | 1.5 ChangeLog 137 | ~~~~~~~~~~~~~ 138 | 139 | date author(s) version 140 | ---------------------------------------------- 141 | 2013-05-03 Fr Thorsten Jolitz 1.0 142 | 2013-02-11 Mo Thorsten Jolitz 0.9 143 | -------------------------------------------------------------------------------- /outorg-test.el: -------------------------------------------------------------------------------- 1 | ;;; outorg-test.el --- ERT suite for outorg.el 2 | 3 | ;; Author: Thorsten Jolitz 4 | ;; Version: 2.0 5 | ;; URL: https://github.com/tj64/outorg 6 | 7 | ;;;; MetaData 8 | ;; :PROPERTIES: 9 | ;; :copyright: Thorsten Jolitz 10 | ;; :copyright-years: 2014+ 11 | ;; :version: 2.0 12 | ;; :licence: GPL 2 or later (free software) 13 | ;; :licence-url: http://www.gnu.org/licenses/ 14 | ;; :part-of-emacs: no 15 | ;; :author: Thorsten Jolitz 16 | ;; :author_email: tjolitz AT gmail DOT com 17 | ;; :inspiration: test-org-element.el 18 | ;; :keywords: emacs org-mode ert buffer 19 | ;; :git-repo: https://github.com/tj64/outorg 20 | ;; :git-clone: git://github.com/tj64/outorg.git 21 | ;; :END: 22 | 23 | 24 | ;;; Requires 25 | 26 | (require 'ert-buffer) 27 | 28 | ;;; Dependencies 29 | 30 | (unless (featurep 'outorg) 31 | (signal 'missing-test-dependency "outorg")) 32 | (unless (featurep 'ert-buffer) 33 | (signal 'missing-test-dependency "ert-buffer")) 34 | 35 | ;;; Variables 36 | 37 | (defvar outorg-test-saved-org-cmd () 38 | "Org command to be used in ERT test.") 39 | 40 | (defvar outorg-test-saved-major-mode nil 41 | "Major mode to be used in ERT test.") 42 | 43 | (defvar outorg-test-saved-prefix-arg nil 44 | "Prefix arg to be used in ERT test.") 45 | 46 | ;; (defvar outorg-test-with-return-p nil 47 | ;; "Test return values too.") 48 | 49 | ;; (defvar outorg-test-with-explain-p nil 50 | ;; "Explain test results.") 51 | 52 | 53 | ;;; Functions 54 | 55 | ;; (defun outorg-test-toggle-with-return () 56 | ;; "Toggles the value of boolean var. 57 | ;; If `outorg-test-with-return-p' is non-nil, a test that includes 58 | ;; expected and actual return values is called." 59 | ;; (interactive) 60 | ;; (if outorg-test-with-return-p 61 | ;; (setq outorg-test-with-return-p nil) 62 | ;; (setq outorg-test-with-return-p t)) 63 | ;; (message "Outorg-test: include return values is %s" 64 | ;; outorg-test-with-return-p)) 65 | 66 | ;; (defun outorg-test-toggle-with-explain () 67 | ;; "Toggles the value of boolean var. 68 | ;; If `outorg-test-with-explain-p' is non-nil, a test that explains 69 | ;; results is called." 70 | ;; (interactive) 71 | ;; (if outorg-test-with-explain-p 72 | ;; (setq outorg-test-with-explain-p nil) 73 | ;; (setq outorg-test-with-explain-p t)) 74 | ;; (message "Outorg-test: explain results is %s" 75 | ;; outorg-test-with-explain-p)) 76 | 77 | (defun outorg-test-cmd () 78 | "Command to be used inside `ert-deftest'" 79 | (interactive) 80 | (let ((pref-arg '(4)) 81 | saved-undo-tree) 82 | ;; set major mode in buffer copy 83 | (if (eq outorg-test-saved-major-mode 'ess-mode) 84 | ;; special case R-mode 85 | (funcall 'R-mode) 86 | (funcall outorg-test-saved-major-mode)) 87 | ;; (funcall outorg-test-saved-major-mode) 88 | ;; 1ST ROUND: convert buffer from source to org 89 | (outorg-edit-as-org 90 | outorg-test-saved-prefix-arg) 91 | ;; activate undo-tree-mode 92 | (undo-tree-mode t) 93 | ;; avoid failing tests due to moving point 94 | (save-excursion 95 | ;; call org cmd (and modify buffer) 96 | (call-interactively 97 | outorg-test-saved-org-cmd)) 98 | ;; necessary (?) HACK to fill buffer-undo-tree 99 | (undo-tree-visualize) 100 | (undo-tree-visualizer-quit) 101 | ;; store buffer-undo-tree 102 | (setq saved-undo-tree buffer-undo-tree) 103 | ;; reconvert buffer from org to source 104 | (outorg-copy-edits-and-exit) 105 | ;; 2ND ROUND: convert buffer from source to org (again) 106 | (outorg-edit-as-org 107 | outorg-test-saved-prefix-arg) 108 | ;; activate undo-tree-mode 109 | (undo-tree-mode t) 110 | ;; undo changes by org cmd 111 | (org-set-local 'buffer-undo-tree saved-undo-tree) 112 | (undo-tree-undo (undo-tree-count buffer-undo-tree)) 113 | ;; reconvert buffer from org to source 114 | (outorg-copy-edits-and-exit))) 115 | 116 | 117 | (defun outorg-test-run-ert (org-cmd &optional USE-PREFIX-ARG-P RETURN-P EXPLAIN-P) 118 | "Prepare and run ERT test. 119 | 120 | This command records the major-mode of current-buffer in global 121 | variable `outorg-test-saved-major-mode', the given 122 | prefix-argument in `outorg-test-saved-prefix-arg' (if 123 | USE-PREFIX-ARG-P is non-nil) and the given ORG-CMD in 124 | `outorg-test-saved-org-cmd', and it copies the content of current 125 | buffer into a temporary *outorg-test-buffer* and sets its 126 | major-mode. 127 | 128 | After this preparation it calls either 129 | 130 | - `outorg-test-conversion-with-equal' :: RETURN-P and EXPLAIN-P 131 | are both nil 132 | 133 | - `outorg-test-conversion-with-equal-explain' :: RETURN-P is 134 | nil, EXPLAIN-P is non-nil 135 | 136 | - `outorg-test-conversion-with-equal-return' :: RETURN-P is 137 | non-nil, EXPLAIN-P is nil 138 | 139 | - `outorg-test-conversion-with-equal-return-explain' :: RETURN-P 140 | and EXPLAIN-P are both non-nil 141 | 142 | depending on the values of optional function arguments RETURN-P 143 | and EXPLAIN-P or on `outorg-test-with-return-p' and 144 | `outorg-test-with-explain-p'. All of these tests make use of the 145 | *outorg-test-buffer* and the three global variables mentioned 146 | above." 147 | (interactive 148 | (if current-prefix-arg 149 | (list 150 | (read-command "Org Command: ") 151 | (y-or-n-p "Use prefix-arg for calling outorg ") 152 | (y-or-n-p "Test return values ") 153 | (y-or-n-p "Explain test results ")) 154 | (list (read-command "Org Command: ")))) 155 | (let ((old-buf (current-buffer)) 156 | (maj-mode (outorg-get-buffer-mode))) 157 | ;; (ret-p (or RETURN-P outorg-test-with-return-p)) 158 | ;; (exp-p (or EXPLAIN-P outorg-test-with-explain-p) 159 | ;; (use-pref-arg-p (or USE-PREFIX-ARG-P 160 | ;; outorg-test-with-return-p)))) 161 | ;; necessary (?) HACK 162 | (setq outorg-test-saved-org-cmd org-cmd) 163 | (setq outorg-test-saved-major-mode maj-mode) 164 | (when USE-PREFIX-ARG-P 165 | (setq outorg-test-saved-prefix-arg current-prefix-arg)) 166 | (save-restriction 167 | (widen) 168 | (with-current-buffer 169 | (get-buffer-create "*outorg-test-buffer*") 170 | (erase-buffer) 171 | (insert-buffer-substring old-buf) 172 | (if (eq maj-mode 'ess-mode) 173 | ;; special case R-mode 174 | (funcall 'R-mode) 175 | (funcall outorg-test-saved-major-mode)) 176 | ;; (funcall maj-mode) 177 | ;; (call-interactively 'ert-run-tests-interactively) 178 | (cond 179 | ((and (org-string-nw-p RETURN-P) 180 | (org-string-nw-p EXPLAIN-P)) 181 | (funcall 182 | 'ert-run-test ;s-interactively 183 | "outorg-test-conversion-with-equal-return-explain")) 184 | ((org-string-nw-p RETURN-P) 185 | (funcall 186 | 'ert-run-test ;s-interactively 187 | "outorg-test-conversion-with-equal-return")) 188 | ((org-string-nw-p EXPLAIN-P) 189 | (funcall 190 | 'ert-run-test ;s-interactively 191 | "outorg-test-conversion-with-equal-explain")) 192 | (t 193 | (funcall 194 | 'ert-run-tests-interactively 195 | "outorg-test-conversion-with-equal"))))))) 196 | 197 | 198 | ;;; Tests 199 | 200 | (ert-deftest outorg-test-conversion-with-equal () 201 | "Test outorg conversion to and from Org. 202 | 203 | This test assumes that it is called via user command 204 | `outorg-test-run-ert' with point in the original programming 205 | language buffer to be converted to Org-mode, and with the prefix 206 | argument that should be used for `outorg-edit-as-org'. It further 207 | relies on the `ert-buffer' library for doing its work. 208 | 209 | Since outorg is about editing (and thus modifying) a buffer in 210 | Org-mode, defining the expected outcome manually would be bit 211 | cumbersome. Therefore so called 'do/undo' tests (invented and 212 | named by the author) are introduced: 213 | 214 | - do :: convert to org, save original state before editing, edit 215 | in org, produce and save the diffs between original and 216 | final state, convert back from org 217 | 218 | - undo :: convert to org again, undo the saved diffs, convert 219 | back from org 220 | 221 | After such an do/undo cyle the test buffer should be in exactly 222 | the same state as before the test, i.e. 223 | 224 | - buffer content after the test should be string-equal to buffer 225 | content before 226 | 227 | - point should be in the same position 228 | 229 | - the mark should be in the same position (or nil) 230 | 231 | These are actually the three criteria checked by the 'ert-buffer' 232 | library, and when one or more of the checks returns nil, the ert 233 | test fails. 234 | 235 | This test is a one-size-fits-all test for outorg, since it 236 | allows, when called via command `outorg-test-run-ert', to execute 237 | arbitrary Org-mode commands in the *outorg-edit-buffer* and undo 238 | the changes later on, checking for any undesired permanent side 239 | effects of the conversion process per se." 240 | (let ((curr-buf-initial-state 241 | (with-current-buffer "*outorg-test-buffer*" 242 | (ert-Buf-from-buffer)))) 243 | (should 244 | (ert-equal-buffer 245 | (outorg-test-cmd) 246 | curr-buf-initial-state 247 | t)))) 248 | 249 | ;; (ert-deftest outorg-test-conversion-with-equal-return () 250 | ;; "Test outorg conversion to and from Org. 251 | 252 | ;; This test takes return values into account. See docstring of 253 | ;; `outorg-test-conversion-with-equal' for more info." 254 | ;; (let ((curr-buf-initial-state 255 | ;; (with-current-buffer "*outorg-test-buffer*" 256 | ;; (ert-Buf-from-buffer)))) 257 | ;; (should 258 | ;; (ert-equal-buffer-return 259 | ;; (outorg-test-cmd) 260 | ;; curr-buf-initial-state 261 | ;; t nil)))) 262 | 263 | ;; (ert-deftest outorg-test-conversion-with-equal-explain () 264 | ;; "Test outorg conversion to and from Org. 265 | 266 | ;; This test explains results. See docstring of 267 | ;; `outorg-test-conversion-with-equal' for more info." 268 | ;; (let ((curr-buf-initial-state 269 | ;; (with-current-buffer "*outorg-test-buffer*" 270 | ;; (ert-Buf-from-buffer)))) 271 | ;; (should 272 | ;; (ert-equal-buffer-explain 273 | ;; (outorg-test-cmd) 274 | ;; curr-buf-initial-state 275 | ;; t)))) 276 | 277 | ;; (ert-deftest outorg-test-conversion-with-equal-return-explain () 278 | ;; "Test outorg conversion to and from Org. 279 | 280 | ;; This test takes return values into account and explains 281 | ;; results. See docstring of `outorg-test-conversion-with-equal' for 282 | ;; more info." 283 | ;; (let ((curr-buf-initial-state 284 | ;; (with-current-buffer "*outorg-test-buffer*" 285 | ;; (ert-Buf-from-buffer)))) 286 | ;; (should 287 | ;; (ert-equal-buffer-return-explain 288 | ;; (outorg-test-cmd) 289 | ;; curr-buf-initial-state 290 | ;; t nil)))) 291 | 292 | 293 | ;;; Run hooks and provide 294 | 295 | (provide 'outorg-test) 296 | 297 | ;;; outorg-test.el ends here 298 | -------------------------------------------------------------------------------- /outorg.el: -------------------------------------------------------------------------------- 1 | ;;; outorg.el --- Org-style comment editing 2 | 3 | ;; Author: Thorsten Jolitz 4 | ;; Version: 2.0 5 | ;; URL: https://github.com/tj64/outorg 6 | 7 | ;;;; MetaData 8 | ;; :PROPERTIES: 9 | ;; :copyright: Thorsten Jolitz 10 | ;; :copyright-years: 2013+ 11 | ;; :version: 2.0 12 | ;; :licence: GPL 2 or later (free software) 13 | ;; :licence-url: http://www.gnu.org/licenses/ 14 | ;; :part-of-emacs: no 15 | ;; :author: Thorsten Jolitz 16 | ;; :author_email: tjolitz AT gmail DOT com 17 | ;; :inspiration: org-src 18 | ;; :keywords: emacs org-mode comment-editing 19 | ;; :git-repo: https://github.com/tj64/outorg 20 | ;; :git-clone: git://github.com/tj64/outorg.git 21 | ;; :END: 22 | 23 | ;;;; Commentary 24 | ;;;;; About outorg 25 | 26 | ;; Outorg is for editing comment-sections of source-code files in 27 | ;; temporary Org-mode buffers. It turns conventional 28 | ;; literate-programming upside-down in that the default mode is the 29 | ;; programming-mode, and special action has to be taken to switch to the 30 | ;; text-mode (i.e. Org-mode). 31 | 32 | ;; Outorg depends on Outshine, i.e. outline-minor-mode with outshine 33 | ;; extensions activated. An outshine buffer is structured like an 34 | ;; org-mode buffer, only with outcommented headlines. While in 35 | ;; Org-mode text is text and source-code is 'hidden' inside of special 36 | ;; src-blocks, in an outshine buffer source-code is source-code and 37 | ;; text is 'hidden' as comments. 38 | 39 | ;; Thus org-mode and programming-mode are just two different views on 40 | ;; the outshine-style structured source-file, and outorg is the tool 41 | ;; to switch between these two views. When switching from a 42 | ;; programming-mode to org-mode, the comments are converted to text 43 | ;; and the source-code is put into src-blocks. When switching back 44 | ;; from org-mode to the programming-mode, the process is reversed - 45 | ;; the text is outcommented again and the src-blocks that enclose the 46 | ;; source-code are removed. 47 | 48 | ;; When the code is more important than the text, i.e. when the task 49 | ;; is rather 'literate PROGRAMMING' than 'LITERATE programming', it is 50 | ;; often more convenient to work in a programming-mode and switch to 51 | ;; org-mode once in a while than vice-versa. Outorg is really fast, 52 | ;; even big files with 10k lines are converted in a second or so, and 53 | ;; the user decides if he wants to convert just the current subtree 54 | ;; (done instantly) or the whole buffer. Since text needs no session 55 | ;; handling or variable passing or other special treatment, the outorg 56 | ;; approach is much simpler than the Org-Babel approach. However, the 57 | ;; full power of Org-Babel is available once the *outorg-edit-buffer* 58 | ;; has popped up. 59 | 60 | ;;;;; Usage 61 | 62 | ;; Outorg (like outshine) assumes that you set 63 | ;; `outline-minor-mode-prefix' in your init-file to 'M-#': 64 | 65 | ;; #+BEGIN_EXAMPLE 66 | ;; ;; must be set before outline is loaded 67 | ;; (defvar outline-minor-mode-prefix "\M-#") 68 | ;; #+END_EXAMPLE 69 | 70 | ;; Outorg's main command is 71 | 72 | ;; #+begin_example 73 | ;; M-# # (or M-x outorg-edit-as-org) 74 | ;; #+end_example 75 | 76 | ;; to be used in source-code buffers where `outline-minor-mode' is 77 | ;; activated with `outshine' extensions. The Org-mode edit-buffer popped 78 | ;; up by this command is called *outorg-edit-buffer* and has 79 | ;; `outorg-edit-minor-mode' activated, a minor-mode with only 2 commands: 80 | 81 | ;; #+begin_example 82 | ;; M-# (outorg-copy-edits-and-exit) 83 | ;; C-x C-s (outorg-save-edits-to-tmp-file) 84 | ;; #+end_example 85 | 86 | ;; If you want to insert Org-mode source-code or example blocks in 87 | ;; comment-sections, i.e. you don't want outorg to remove the 88 | ;; enclosing blocks, simply outcomment them in the outorg-edit buffer 89 | ;; before calling `outorg-copy-edits-and-exit'. 90 | 91 | ;; Note that outorg only treats 'active' src-blocks in a special way - 92 | ;; the blocks whose Babel language is equal to the major-mode of the 93 | ;; associated programming-mode buffer. All other (src-) blocks are 94 | ;; treated like normal text. 95 | 96 | ;; Note further that outorg uses example-blocks as 'fallback' when it 97 | ;; cannot find the major-mode of the programming-mode buffer in the 98 | ;; `org-babel-load-languages'. In this case you should not use 99 | ;; example-blocks for other tasks, since they will be removed when 100 | ;; exiting the *outorg-edit-buffer*, use e.g. quote-blocks or 101 | ;; verse-blocks instead. 102 | 103 | ;;;;; Installation 104 | 105 | ;; You can get outorg.el either from Github (see section MetaData) or 106 | ;; via MELPA. It depends on outshine.el, so you have to install and 107 | ;; configure outshine first to make outorg work. 108 | 109 | ;; Installation is easy, simply insert 110 | 111 | ;; #+begin_example 112 | ;; (require 'outorg) 113 | ;; #+end_example 114 | 115 | ;; in your init file. When you use navi-mode.el too, the third Outshine 116 | ;; library, it suffices to (require 'navi), since it requires the other 117 | ;; two libraries. 118 | 119 | ;;;;; Bugs and Shortcomings 120 | 121 | ;; Outorg started out purely line-based, it only worked with 122 | ;; 'one-line' comments, i.e. with comment-sections like those produced 123 | ;; by `comment-region' (a command that comments or uncomments each 124 | ;; line in the region). It was enhanced later on to recognize comment 125 | ;; regions too, i.e. those special multi-line comments found in many 126 | ;; programming languages. But using outorg on such multi-line comments 127 | ;; will probably change their syntax back to 'single-line', whenever 128 | ;; `comment-region' uses this style. 129 | 130 | ;;;;; Tests 131 | 132 | ;; A special kind of test has been developed for outorg using the 133 | ;; `ert-buffer' library, the so called 'conversion test'. It has the 134 | ;; following steps: 135 | 136 | ;; 1. programming-mode -> org-mode 137 | 138 | ;; 2. edit in org-mode, store undo-information 139 | 140 | ;; 3. org-mode -> programming-mode 141 | 142 | ;; 4. programming-mode -> org-mode (again) 143 | 144 | ;; 5. undo edits 145 | 146 | ;; 6. org-mode -> programming-mode (again) 147 | 148 | ;; After these 4 conversions, the original programming-mode buffer 149 | ;; must be unchanged when the conversion process is perfect, i.e. does 150 | ;; not introduce any changes itself. See `outorg-test.el' for details. 151 | 152 | ;;;;; Emacs Version 153 | 154 | ;; Outorg works with GNU Emacs 24.2.1 or later. No attempts of testing 155 | ;; with older versions or other types of Emacs have been made (yet). 156 | 157 | ;;;; ChangeLog 158 | 159 | ;; | date | author(s) | version | 160 | ;; |-----------------+-----------------+---------| 161 | ;; | <2014-09-20 Sa> | Thorsten Jolitz | 2.0 | 162 | ;; | <2013-05-03 Fr> | Thorsten Jolitz | 1.0 | 163 | ;; | <2013-02-11 Mo> | Thorsten Jolitz | 0.9 | 164 | 165 | ;;; Requires 166 | 167 | (require 'outline) 168 | (require 'org) 169 | (require 'org-watchdoc nil t) 170 | ;; (unless (require 'outorg-export nil t) 171 | ;; (message 172 | ;; "Try library `outorg-export' for automated export to all Org 173 | ;; backends:\n%s" 174 | ;; "https://github.com/jleechpe/outorg-export")) 175 | 176 | (declare-function R-mode "ess-r-d") 177 | (declare-function org-watchdoc-propagate-changes "org-watchdoc") 178 | (declare-function org-watchdoc-set-md5 "org-watchdoc") 179 | 180 | ;;; Mode and Exporter Definitions 181 | ;;;; Outorg Edit minor-mode 182 | 183 | (define-minor-mode outorg-edit-minor-mode 184 | "Minor mode for Org-mode buffers generated by outorg. 185 | There is a mode hook, and two commands: 186 | \\[outorg-copy-edits-and-exit] outorg-copy-edits-and-exit 187 | \\[outorg-save-edits-to-tmp-file] outorg-save-edits-to-tmp-file" 188 | :lighter " Outorg") 189 | 190 | ;;; Variables 191 | ;;;; Consts 192 | 193 | (defconst outorg-version "2.0" 194 | "outorg version number.") 195 | 196 | (defconst outorg-edit-buffer-name "*outorg-edit-buffer*" 197 | "Name of the temporary outorg edit buffer.") 198 | 199 | ;; FIXME org-babel names should be correct, but major-mode names need 200 | ;; to be cross-checked! 201 | (defconst outorg-language-name-assocs 202 | '((abc-mode . abc) 203 | (asymptote-mode . asymptote) 204 | (awk-mode . awk) 205 | (c-mode . C) ; 206 | (c++-mode . cpp) ; 207 | (calc-mode . calc) ; 208 | (clojure-mode . clojure) 209 | (css-mode . css) 210 | (d-mode . D) ; 211 | (ditaa-mode . ditaa) 212 | (dot-mode . dot) 213 | (emacs-lisp-mode . emacs-lisp) ; 214 | (eukleides-mode . eukleides) 215 | (fomus-mode . fomus) 216 | (fortran-mode . F90) 217 | (gnuplot-mode . gnuplot) 218 | (groovy-mode . groovy) 219 | (haskell-mode . haskell) 220 | (j-mode . J) 221 | (java-mode . java) 222 | (javascript-mode . js) 223 | (julia-mode . julia) 224 | (latex-mode . latex) ; 225 | (ledger-mode . ledger) 226 | (lilypond-mode . ly) 227 | (lisp-mode . lisp) 228 | (make-mode . makefile) 229 | (mathomatic-mode . mathomatic) 230 | (matlab-mode . matlab) 231 | (maxima-mode . max) 232 | (mscgen-mode . mscgen) 233 | (tuareg-mode . ocaml) ; 234 | (octave-mode . octave) 235 | (org-mode . org) ; 236 | (oz-mode . oz) 237 | (perl-mode . perl) 238 | (picolisp-mode . picolisp) ; 239 | (plantuml-mode . plantuml) 240 | (python-mode . python) 241 | (ess-mode . R) ; 242 | (ruby-mode . ruby) 243 | (sass-mode . sass) 244 | (scala-mode . scala) 245 | (scheme-mode . scheme) 246 | (shen-mode . shen) 247 | (sh-mode . sh) ; 248 | (sql-mode . sql) 249 | (sqlite-mode . sqlite) 250 | (tcl-mode . tcl)) 251 | "Associations between major-mode-name and org-babel language 252 | names.") 253 | 254 | (defconst outorg-tracked-markers '(point-marker 255 | beg-of-subtree-marker mark-marker) 256 | "Outorg markers to be tracked. The actual marker names are constructed by adding a prefix, either 'outorg-code-buffer-' or 'outorg-edit-buffer-'.") 257 | 258 | (defconst outorg-tracked-org-markers '(org-clock-marker 259 | org-clock-hd-marker org-clock-default-task 260 | org-clock-interrupted-task selected-task org-open-link-marker 261 | org-log-note-marker org-log-note-return-to 262 | org-entry-property-inherited-from) 263 | "Org markers to be tracked by outorg.") 264 | 265 | ;;;; Vars 266 | 267 | (defvar outline-minor-mode-prefix "\C-c" 268 | "New outline-minor-mode prefix.") 269 | 270 | (defvar outorg-edit-whole-buffer-p nil 271 | "Non-nil if the whole code-buffer is edited.") 272 | 273 | (defvar outorg-initial-window-config nil 274 | "Initial window-configuration when editing as Org.") 275 | 276 | (defvar outorg-code-buffer-read-only-p nil 277 | "Remember if code-buffer was read only before editing") 278 | 279 | ;; copied and adapted from ob-core.el 280 | (defvar outorg-temporary-directory) ; FIXME why this duplication? 281 | (unless (or noninteractive (boundp 'outorg-temporary-directory)) 282 | (defvar outorg-temporary-directory 283 | (or (and (boundp 'outorg-temporary-directory) 284 | (file-exists-p outorg-temporary-directory) 285 | outorg-temporary-directory) 286 | (make-temp-file "outorg-" t)) 287 | "Directory to hold outorg's temporary files. 288 | This directory will be removed on Emacs shutdown.")) 289 | 290 | (defvar outorg-last-temp-file nil 291 | "Storage for absolute file name of last saved temp-file.") 292 | 293 | (defvar outorg-called-via-outshine-use-outorg-p nil 294 | "Non-nil if outorg was called via `outshine-use-outorg' command") 295 | 296 | (defvar outorg-oldschool-elisp-headers-p nil 297 | "Non-nil if an Emacs Lisp file uses oldschool headers ';;;+'") 298 | 299 | (defvar outorg-insert-default-export-template-p nil 300 | "Non-nil means either the file specified in 301 | `outorg-export-template-for-org-mode' or a file given by the user 302 | will be inserted at the top of the *outorg-edit-buffer* when it 303 | is opened, and will be removed when it is closed, thus enabling 304 | the user to e.g. define default export options in a file and use 305 | them on-demand in the *outorg-edit-buffer*. The value of this variable is 306 | toggled with command `outorg-toggle-export-template-insertion'.") 307 | ;; (make-variable-buffer-local 'outorg-insert-default-export-template-p) 308 | 309 | (defvar outorg-ask-user-for-export-template-file-p nil 310 | "Non-nil means user is prompted for export-template-file.") 311 | ;; (make-variable-buffer-local 'outorg-ask-user-for-export-template-file-p) 312 | 313 | (defvar outorg-keep-export-template-p nil 314 | "Non-nil means inserted export template is permanent.") 315 | ;; (make-variable-buffer-local 'outorg-keep-export-template-p) 316 | 317 | (defvar outorg-export-template-regexp 318 | (concat 319 | "[[:space:]\n]*" 320 | "# <<<\\*\\*\\* BEGIN EXPORT TEMPLATE [[:ascii:]]+" 321 | "# <<<\\*\\*\\* END EXPORT TEMPLATE \\*\\*\\*>>>[^*]*") 322 | "Regexp used to identify (and delete) export templates.") 323 | 324 | (defvar outorg-propagate-changes-p nil 325 | "Non-nil means propagate changes to associated doc files.") 326 | ;; (make-variable-buffer-local 'outorg-propagate-changes-p) 327 | 328 | (defvar outorg-code-buffer-point-marker (make-marker) 329 | "Marker to store position in code-buffer.") 330 | 331 | (defvar outorg-edit-buffer-point-marker (make-marker) 332 | "Marker to store position in edit-buffer.") 333 | 334 | (defvar outorg-code-buffer-beg-of-subtree-marker (make-marker) 335 | "Marker to store begin of current subtree in 336 | code-buffer.") 337 | 338 | (defvar outorg-edit-buffer-beg-of-subtree-marker (make-marker) 339 | "Marker to store begin of current subtree in 340 | edit-buffer.") 341 | 342 | (defvar outorg-markers-to-move nil 343 | "Markers that should be moved with a cut-and-paste operation. 344 | Those markers are stored together with their positions relative to 345 | the start of the region.") 346 | 347 | (defvar outorg-org-finish-function-called-p nil 348 | "Non-nil if `org-finish-function' was called, nil otherwise.") 349 | 350 | (defvar outorg-pt-A-marker (make-marker) 351 | "Outorg marker for tracking begin of comment. 352 | If pt-A < pt-B, the region between A and B is out- or 353 | uncommented.") 354 | 355 | (defvar outorg-pt-B-marker (make-marker) 356 | "Outorg marker for tracking beginning of source-code. 357 | If pt-B < pt-C, the region between B and C is wrapped/unwrapped 358 | as source-block.") 359 | 360 | (defvar outorg-pt-C-marker (make-marker) 361 | "Outorg marker for tracking end of source-code. 362 | If pt-B < pt-C, the region between B and C is wrapped/unwrapped 363 | as source-block.") 364 | 365 | ;; ;; pt-A 366 | ;; (defvar outorg-beg-comment-marker (make-marker) 367 | ;; "Outorg marker for tracking begin of comment.") 368 | 369 | ;; ;; pt-B 370 | ;; (defvar outorg-beg-src-marker (make-marker) 371 | ;; "Outorg marker for tracking beginning of source-code.") 372 | 373 | ;; ;; pt-C 374 | ;; (defvar outorg-end-src-marker (make-marker) 375 | ;; "Outorg marker for tracking end of source-code.") 376 | 377 | 378 | ;;;; Hooks 379 | 380 | (defvar outorg-hook nil 381 | "Functions to run after `outorg' is loaded.") 382 | 383 | (defvar outorg-edit-minor-mode-hook nil 384 | "Hook run after `outorg' switched a source code file or subtree to 385 | Org-mode.") 386 | 387 | ;;;; Customs 388 | 389 | ;;;;; Custom Groups 390 | 391 | (defgroup outorg nil 392 | "Library for outline navigation and Org-mode editing in Lisp buffers." 393 | :prefix "outorg-" 394 | :group 'lisp 395 | :link '(url-link 396 | "http://orgmode.org/worg/org-tutorials/org-outside-org.html")) 397 | 398 | ;;;;; Custom Vars 399 | 400 | ;; inspired by 'org-src.el' 401 | (defcustom outorg-edit-buffer-persistent-message t 402 | "Non-nil means show persistent exit help message while in edit-buffer. 403 | The message is shown in the header-line, which will be created in the 404 | first line of the window showing the editing buffer." 405 | :group 'outorg 406 | :type 'boolean) 407 | 408 | (defcustom outorg-unindent-active-source-blocks-p t 409 | "Non-nil means common indentation (e.g. 2 spaces) in the active 410 | source-blocks of the *outorg-edit-buffer* (i.e. those in the 411 | language of the associated source-code buffer, and only in those) 412 | is removed before converting back from Org to source-code." 413 | :group 'outorg 414 | :type 'boolean) 415 | 416 | ;;; Functions 417 | ;;;; Non-interactive Functions 418 | ;;;;; Get Buffer Mode and Language Name 419 | 420 | (defun outorg-comment-on-line () 421 | "Look forward from point for a comment at the start of this 422 | line. If found, move point to the beginning of the text after 423 | `comment-start' syntax, and return the location of the 424 | beginning of the line. If the line does not start with 425 | `comment-start', returns `nil'." 426 | (and (search-forward-regexp (concat "\\(" 427 | (regexp-quote comment-start) 428 | "[[:space:]]*\\)") 429 | (line-end-position) 430 | 1) 431 | (eq (match-beginning 0) (point-at-bol)) 432 | (point-at-bol))) 433 | 434 | (defun outorg-comment-on-line-p () 435 | "Determine if point is on a line that begins with a comment." 436 | (save-excursion 437 | (beginning-of-line) 438 | (outorg-comment-on-line))) 439 | 440 | (defun outorg-comment-search-forward () 441 | "Like `comment-search-forward', but looks only for comments 442 | beginning with `comment-start' syntax at the start of a 443 | line. Point is left at the beginning of the text after the line 444 | comment syntax, while the returned point is at the beginning of 445 | the line." 446 | (while (not (or (eobp) (outorg-comment-on-line))) (forward-line)) 447 | (point-at-bol)) 448 | 449 | ;; copied from http://www.emacswiki.org/emacs/basic-edit-toolkit.el 450 | (defun outorg-region-or-buffer-limits () 451 | "Return the start and end of the region as a list, smallest first. 452 | If the region is not active or empty, then bob and eob are used." 453 | (if (or 454 | (not mark-active) 455 | (null (mark)) 456 | (= (point) (mark))) 457 | (list (point-min) (point-max)) 458 | (if (< (point) (mark)) 459 | (list (point) (mark)) 460 | (list (mark) (point))))) 461 | 462 | (defun outorg-get-buffer-mode (&optional buf-or-strg as-strg-p) 463 | "Return major-mode of BUF-OR-STRG or current-buffer. 464 | 465 | If AS-STRG-P is non-nil, a string is returned instead instead 466 | of a symbol." 467 | (let ((buf (if buf-or-strg 468 | (get-buffer buf-or-strg) 469 | (current-buffer)))) 470 | (with-current-buffer buf 471 | (if as-strg-p (symbol-name major-mode) major-mode)))) 472 | 473 | (defun outorg-get-babel-name (&optional mode-name as-strg-p) 474 | "Return the symbol associated in Org-Babel with MODE-NAME. 475 | 476 | Uses `outorg-language-name-assocs' as association list between 477 | the string returned by `major-mode' in the associated source-code 478 | buffer and the symbol used for that language in 479 | `org-babel-load-languages'. If AS-STRG-P is non-nil, a string 480 | is returned." 481 | (let* ((mmode (or 482 | (and mode-name 483 | (cond 484 | ((stringp mode-name) (intern mode-name)) 485 | ((symbolp mode-name) mode-name) 486 | (t (error 487 | "Mode-Name neither String nor Symbol")))) 488 | major-mode)) 489 | (bname (cdr (assoc mmode outorg-language-name-assocs)))) 490 | (if as-strg-p (symbol-name bname) bname))) 491 | 492 | (defun outorg-get-mode-name (babel-name &optional as-strg-p) 493 | "Return the major-mode name associated with BABEL-NAME. 494 | 495 | Uses `outorg-language-name-assocs' as association list between 496 | the symbol returned by `major-mode' in the associated source-code 497 | buffer and the symbol used for that language in 498 | `org-babel-load-languages'. If AS-STRG-P is non-nil, a string 499 | is returned." 500 | (let* ((bname 501 | (cond 502 | ((stringp babel-name) (intern babel-name)) 503 | ((symbolp babel-name) babel-name) 504 | (t (error "Babel-Name neither String nor Symbol")))) 505 | (mmode 506 | (car 507 | (rassoc bname outorg-language-name-assocs)))) 508 | (if as-strg-p (symbol-name mmode) mmode))) 509 | 510 | (defun outorg-get-language-name (&optional mode-name as-sym-p) 511 | "Extract car of splitted and normalized MODE-NAME. 512 | 513 | If AS-SYM-P is non-nil, a symbol instead of a string is 514 | returned." 515 | (let* ((mmode (or 516 | (and mode-name 517 | (cond 518 | ((stringp mode-name) mode-name) 519 | ((symbolp mode-name) (symbol-name mode-name)) 520 | (t (error 521 | "Mode-Name neither String nor Symbol")))) 522 | (symbol-name major-mode))) 523 | (splitted-mmode 524 | (split-string mmode "-mode")) 525 | (language-name 526 | (if (> (length splitted-mmode) 1) 527 | (car splitted-mmode) 528 | (car (split-string mmode "\\."))))) 529 | (if as-sym-p (intern language-name) language-name))) 530 | 531 | (defun outorg-in-babel-load-languages-p (&optional mode-name) 532 | "Non-nil if MODE-NAME is in Org-Babel load languages. 533 | 534 | If MODE-NAME is nil, check if Org-Babel identifier of major-mode of current buffer is in Org-Babel load languages." 535 | (let* ((mmode (or 536 | (and mode-name 537 | (cond 538 | ((stringp mode-name) (intern mode-name)) 539 | ((symbolp mode-name) mode-name) 540 | (t (error 541 | "Mode-Name neither String nor Symbol")))) 542 | major-mode))) 543 | (assoc 544 | ;; Note that babel's cpp (for C++) is packaged in ob-C with the C 545 | ;; language 546 | (let ((bname (outorg-get-babel-name mmode))) 547 | (if (eq bname (intern "cpp")) (intern "C") bname)) 548 | org-babel-load-languages))) 549 | 550 | 551 | ;;;;; Configure Edit Buffer 552 | 553 | ;; copied and adapted from org-src.el 554 | (defun outorg-edit-configure-buffer () 555 | "Configure edit buffer" 556 | (let ((msg 557 | (concat "[ " 558 | (buffer-name 559 | (marker-buffer outorg-code-buffer-point-marker)) 560 | " ] " 561 | "Exit with M-# (Meta-Key and #)"))) 562 | 563 | ;; Only run the kill-buffer-hooks when the outorg edit buffer is 564 | ;; being killed. This is because temporary buffers may be created 565 | ;; by various org commands, and when those buffers are killed, we 566 | ;; do not want the outorg kill hooks to run. 567 | (org-add-hook 'kill-buffer-hook 568 | (lambda () 569 | (when (string= (buffer-name) outorg-edit-buffer-name) 570 | (outorg-save-edits-to-tmp-file))) 571 | nil 'local) 572 | 573 | (org-add-hook 'kill-buffer-hook 574 | (lambda () 575 | (when (string= (buffer-name) outorg-edit-buffer-name) 576 | (outorg-reset-global-vars)) nil 'local)) 577 | 578 | 579 | ;; (setq buffer-offer-save t) 580 | (and outorg-edit-buffer-persistent-message 581 | (org-set-local 'header-line-format msg)) 582 | ;; (setq buffer-file-name 583 | ;; (concat (buffer-file-name 584 | ;; (marker-buffer outorg-code-buffer-point-marker)) 585 | ;; "[" (buffer-name) "]")) 586 | (if (featurep 'xemacs) 587 | (progn 588 | (make-variable-buffer-local 589 | 'write-contents-hooks) ; needed only for 21.4 590 | (setq write-contents-hooks 591 | '(outorg-save-edits-to-tmp-file))) 592 | (setq write-contents-functions 593 | '(outorg-save-edits-to-tmp-file))) 594 | ;; (setq buffer-read-only t) ; why? 595 | )) 596 | 597 | 598 | ;; (org-add-hook 'outorg-edit-minor-mode-hook 'outorg-edit-minor-mode) 599 | (org-add-hook 'outorg-edit-minor-mode-hook 600 | 'outorg-edit-configure-buffer) 601 | 602 | ;;;;; Backup Edit Buffer 603 | 604 | ;; copied and adapted from ob-core.el 605 | (defun outorg-temp-file (prefix &optional suffix) 606 | "Create a temporary file in the `outorg-temporary-directory'. 607 | Passes PREFIX and SUFFIX directly to `make-temp-file' with the 608 | value of `temporary-file-directory' temporarily set to the value 609 | of `outorg-temporary-directory'." 610 | (let ((temporary-file-directory 611 | (if (file-remote-p default-directory) 612 | (concat (file-remote-p default-directory) "/tmp") 613 | (or (and (boundp 'outorg-temporary-directory) 614 | (file-exists-p outorg-temporary-directory) 615 | outorg-temporary-directory) 616 | temporary-file-directory)))) 617 | (make-temp-file prefix nil suffix))) 618 | 619 | (defun outorg-save-edits-to-tmp-file () 620 | "Save edit-buffer in temporary file" 621 | (interactive) 622 | (let* ((code-file (file-name-sans-extension 623 | (file-name-nondirectory 624 | (buffer-name 625 | (marker-buffer 626 | outorg-code-buffer-point-marker))))) 627 | (tmp-file (outorg-temp-file code-file)) 628 | (tmp-dir (file-name-directory tmp-file))) 629 | (setq outorg-last-temp-file tmp-file) 630 | (setq buffer-file-name (concat tmp-dir "outorg-edit-" code-file)) 631 | (write-region nil nil tmp-file nil 'VISIT))) 632 | 633 | ;; copied and adapted from ob-core.el 634 | (defun outorg-remove-temporary-directory () 635 | "Remove `outorg-temporary-directory' on Emacs shutdown." 636 | (when (and (boundp 'outorg-temporary-directory) 637 | (file-exists-p outorg-temporary-directory)) 638 | ;; taken from `delete-directory' in files.el 639 | (condition-case nil 640 | (progn 641 | (mapc (lambda (file) 642 | ;; This test is equivalent to 643 | ;; (and (file-directory-p fn) (not (file-symlink-p fn))) 644 | ;; but more efficient 645 | (if (eq t (car (file-attributes file))) 646 | (delete-directory file) 647 | (delete-file file))) 648 | ;; We do not want to delete "." and "..". 649 | (directory-files outorg-temporary-directory 'full 650 | "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) 651 | (delete-directory outorg-temporary-directory)) 652 | (error 653 | (message "Failed to remove temporary outorg directory %s" 654 | (if (boundp 'outorg-temporary-directory) 655 | outorg-temporary-directory 656 | "[directory not defined]")))))) 657 | 658 | (add-hook 'kill-emacs-hook 'outorg-remove-temporary-directory) 659 | 660 | ;;;;; Reset Global Vars 661 | 662 | ;; TODO better use buffer-local variables instead? 663 | (defun outorg-reset-global-vars () 664 | "Reset some global vars defined by outorg to initial values." 665 | (ignore-errors 666 | (set-marker outorg-code-buffer-point-marker nil) 667 | (set-marker outorg-code-buffer-beg-of-subtree-marker nil) 668 | (set-marker outorg-edit-buffer-point-marker nil) 669 | (set-marker outorg-edit-buffer-beg-of-subtree-marker nil) 670 | (setq outorg-edit-whole-buffer-p nil) 671 | (setq outorg-initial-window-config nil) 672 | (setq outorg-code-buffer-read-only-p nil) 673 | (setq outorg-oldschool-elisp-headers-p nil) 674 | (setq outorg-insert-default-export-template-p nil) 675 | (setq outorg-ask-user-for-export-template-file-p nil) 676 | (setq outorg-keep-export-template-p nil) 677 | (setq outorg-propagate-changes-p nil) 678 | (setq outorg-called-via-outshine-use-outorg-p nil) 679 | (when outorg-markers-to-move 680 | (mapc (lambda (m) 681 | (when (markerp m) 682 | (move-marker m nil))) 683 | outorg-markers-to-move) 684 | (setq outorg-markers-to-move nil)) 685 | (setq outorg-org-finish-function-called-p nil))) 686 | 687 | ;;;;; Remove Trailing Blank Lines 688 | 689 | ;; inspired by `article-remove-trailing-blank-lines' in `gnus-art.el' 690 | (defun outorg-remove-trailing-blank-lines () 691 | "Remove all trailing blank lines from buffer. 692 | Finally add one newline." 693 | (save-excursion 694 | (let ((inhibit-read-only t)) 695 | (goto-char (point-max)) 696 | (delete-region 697 | (point) 698 | (progn 699 | (while (and (not (bobp)) 700 | (looking-at "^[ \t]*$")) 701 | (forward-line -1)) 702 | (forward-line 1) 703 | (point)))))) 704 | 705 | ;;;;; Save and Restore Markers 706 | 707 | ;; 1. Deal with position markers in code and edit buffer, to get the 708 | ;; least possible surprise about point position after switching 709 | ;; buffers 710 | 711 | ;; 2. Deal with org markers set in the edit buffer and needed in 712 | ;; after command hooks when edit buffer is already closed 713 | 714 | (defun outorg-save-markers (marker-lst) 715 | "Save markers from MARKER-LST in `outorg-markers-to-move'." 716 | (save-restriction 717 | (widen) 718 | (let* ((beg (if (or outorg-edit-whole-buffer-p 719 | (equal (buffer-name) 720 | outorg-edit-buffer-name)) 721 | (point-min) 722 | (if (outline-on-heading-p) 723 | (point) 724 | (save-excursion 725 | (outline-previous-heading) 726 | (point))))) 727 | (end (if (or outorg-edit-whole-buffer-p 728 | (equal (buffer-name) 729 | outorg-edit-buffer-name)) 730 | (point-max) 731 | (save-excursion 732 | (outline-end-of-subtree) 733 | (point)))) 734 | (prefix (cond 735 | ((eq (current-buffer) 736 | (marker-buffer 737 | outorg-code-buffer-point-marker)) 738 | "outorg-code-buffer-") 739 | ((eq (current-buffer) 740 | (marker-buffer 741 | outorg-edit-buffer-point-marker)) 742 | "outorg-edit-buffer-") 743 | (t (error "This should not happen")))) 744 | (markers (mapcar 745 | (lambda (--marker) 746 | (intern 747 | (format 748 | "%s%s" 749 | (if (string-match 750 | "\\(org\\|mark\\)" 751 | (car (split-string 752 | (symbol-name --marker) 753 | "-" t))) 754 | "" 755 | prefix) 756 | --marker))) 757 | marker-lst))) 758 | (mapc 759 | (lambda (--marker) 760 | (outorg-check-and-save-marker --marker beg end)) 761 | markers)))) 762 | 763 | ;; adapted from org.el 764 | (defun outorg-check-and-save-marker (marker-or-var beg end) 765 | "Check if MARKER-OR-VAR is between BEG and END. 766 | If yes, remember the marker and the distance to BEG." 767 | (let ((marker (cond 768 | ((markerp marker-or-var) marker-or-var) 769 | ((boundp marker-or-var) (eval marker-or-var)) 770 | (t nil)))) 771 | (when (and (markerp marker) 772 | (marker-buffer marker) 773 | (equal (marker-buffer marker) (current-buffer))) 774 | (when (and (>= marker beg) (< marker end)) 775 | (let* ((splitted-marker-name 776 | (split-string 777 | (symbol-name marker-or-var) 778 | "\\(outorg-\\|-buffer-\\)" t)) 779 | (split-gt-1-p (> (length splitted-marker-name) 1)) 780 | (marker-buf 781 | (ignore-errors 782 | (when split-gt-1-p 783 | (intern (car splitted-marker-name))))) 784 | (marker-typ 785 | (ignore-errors 786 | (if split-gt-1-p 787 | (intern (cadr splitted-marker-name)) 788 | (intern (car splitted-marker-name)))))) 789 | (push (list marker-buf marker-typ (- marker beg)) 790 | outorg-markers-to-move)))))) 791 | 792 | (defun outorg-reinstall-markers-in-region (beg) 793 | "Move all remembered markers to their position relative to BEG." 794 | (mapc (lambda (--marker-lst) 795 | (move-marker 796 | (eval 797 | (intern 798 | (format "%s%s" 799 | (cond 800 | ((eq (car --marker-lst) 'code) 801 | "outorg-edit-buffer-") 802 | ((eq (car --marker-lst) 'edit) 803 | "outorg-code-buffer-") 804 | ((and (booleanp (car --marker-lst)) 805 | (null (car --marker-lst))) 806 | "") 807 | (t (error "This should not happen."))) 808 | (cadr --marker-lst)))) 809 | (+ beg (caddr --marker-lst)))) 810 | outorg-markers-to-move) 811 | (setq outorg-markers-to-move nil)) 812 | 813 | ;;;;; Copy and Convert 814 | 815 | (defun outorg-convert-org-to-outshine 816 | (&optional mode infile outfile BATCH) 817 | "Convert an existing Org-mode file into an Outshine buffer. 818 | 819 | If MODE is non-nil, the Outshine buffer will be put in this 820 | major-mode, otherwise the major-mode of the language of the first 821 | source-code block in the Org-mode buffer will be used. 822 | 823 | If INFILE is non-nil, the specified Org-mode file will be 824 | visited, otherwise the current buffer will be used (i.e. the 825 | buffer content will be copied to a temporary *outorg-edit-buffer* 826 | for further processing). 827 | 828 | If OUTFILE is non-nil, the converted Outshine buffer will be 829 | saved in this file. Its the user's responsability to make sure 830 | that OUTFILE's file-extension is suited for the major-mode of the 831 | Outshine buffer to be saved. When in doubt, consult variable 832 | `auto-mode-alist' for associations between file-extensions and 833 | major-modes. 834 | 835 | If BATCH is non-nil (and OUTFILE is non-nil, otherwise it makes 836 | no sense), the new Outshine file is saved and its buffer 837 | deleted." 838 | (let* ((org-buffer (if infile 839 | (if (and (file-exists-p infile) 840 | (string-equal 841 | (file-name-extension infile) "org")) 842 | (find-file (expand-file-name infile)) 843 | (error 844 | "Infile doesn't exist or is not an Org file")) 845 | (current-buffer))) 846 | (maj-mode (or mode 847 | (with-current-buffer org-buffer 848 | (save-excursion 849 | (goto-char (point-min)) 850 | (or 851 | ;; major-mode of first src-block 852 | (ignore-errors 853 | (org-next-block 854 | nil nil org-babel-src-block-regexp) 855 | (format 856 | "%s-mode" 857 | (car (org-babel-get-src-block-info 'LIGHT)))) 858 | ;; default case emacs-lisp-mode 859 | "emacs-lisp-mode")))))) 860 | (with-current-buffer (get-buffer-create 861 | (generate-new-buffer-name "tmp")) 862 | (setq outorg-code-buffer-point-marker (point-marker)) 863 | (funcall (intern maj-mode)) 864 | (and outfile 865 | ;; ;; FIXME does not really avoid confirmation prompts 866 | ;; (add-to-list 'revert-without-query (expand-file-name outfile)) 867 | (if BATCH 868 | (write-file (expand-file-name outfile)) 869 | (write-file (expand-file-name outfile) 'CONFIRM)))) 870 | (setq outorg-edit-whole-buffer-p t) 871 | (setq outorg-initial-window-config 872 | (current-window-configuration)) 873 | (with-current-buffer (get-buffer-create outorg-edit-buffer-name) 874 | (erase-buffer) 875 | (insert-buffer-substring org-buffer) 876 | (org-mode) 877 | (outorg-transform-active-source-block-headers) 878 | (outorg-copy-edits-and-exit)) 879 | ;; ;; FIXME ugly hack 880 | ;; (funcall major-mode) 881 | ;; (funcall major-mode) 882 | ;; (fontify-keywords) 883 | (when outfile 884 | (save-buffer) 885 | ;; (revert-buffer t t) 886 | ;; (remove 887 | ;; (expand-file-name outfile) 888 | ;; revert-without-query) 889 | (and BATCH (kill-buffer))))) 890 | 891 | (defun outorg-transform-active-source-block-headers () 892 | "Move switches and arguments on top of block. 893 | 894 | This functions transforms all active source-blocks, i.e. those 895 | with the associated source-code buffer's major-mode as 896 | language. If there are switches and header arguments after the 897 | language specification on the #+BEGIN_SRC line, they are moved on 898 | top of the block. 899 | 900 | The idea behind this function is that it should be possible to 901 | specify permanent switches and arguments even for source-code 902 | blocks that are transformed back to code after 903 | `outorg-copy-and-switch' is called. They will remain as comment 904 | lines directly over their code section in the source-code buffer, 905 | and thus be transformed to text - and thereby activated - 906 | everytime `outorg-edit-as-org' is called." 907 | (save-excursion 908 | (let* ((mode (outorg-get-buffer-mode 909 | (marker-buffer outorg-code-buffer-point-marker))) 910 | (active-lang 911 | (outorg-get-babel-name mode 'as-strg-p))) 912 | (org-babel-map-src-blocks nil 913 | (when (string-equal active-lang lang) 914 | (let ((sw switches) 915 | (args header-args)) 916 | (goto-char end-lang) 917 | (delete-region (point) (line-end-position)) 918 | (goto-char beg-block) 919 | (forward-line -1) 920 | (when (org-string-nw-p sw) 921 | (newline) 922 | (insert (format "#+header: %s" sw))) 923 | (when (org-string-nw-p args) 924 | (let ((params 925 | (ignore-errors 926 | (org-split-string args))) 927 | headers) 928 | (while params 929 | (setq headers 930 | (cons 931 | (format "#+header: %s %s" 932 | (org-no-properties (pop params)) 933 | (org-no-properties (pop params))) 934 | headers))) 935 | (newline) 936 | (insert (mapconcat 'identity headers "\n")))))))))) 937 | ;; (insert (format "#+header: %s" args))))))))) 938 | 939 | ;; Thx to Eric Abrahamsen for the tip about `mail-header-separator' 940 | (defun outorg-prepare-message-mode-buffer-for-editing () 941 | "Prepare an unsent-mail in a message-mode buffer for outorg. 942 | 943 | This function assumes that '--text follows this line--' (or 944 | whatever is found inside variable `mail-header-separator') is the 945 | first line below the message header, is always present, and never 946 | modified by the user. It turns this line into an `outshine' 947 | headline and out-comments all text below this line - if any." 948 | (goto-char (point-min)) 949 | ;; (re-search-forward "--text follows this line--" nil 'NOERROR) 950 | (re-search-forward mail-header-separator nil 'NOERROR) 951 | (let ((inhibit-read-only t)) 952 | (replace-match "* \\&")) 953 | ;; (replace-match "* \\&") 954 | (beginning-of-line) 955 | (let ((start-body (point))) 956 | (comment-region start-body (point-max)) 957 | (narrow-to-region start-body (point-max)) 958 | (forward-line))) 959 | 960 | (defun outorg-prepare-message-mode-buffer-for-sending () 961 | "Prepare an unsent-mail edited via `outorg-edit' for sending. 962 | 963 | This function assumes that '* --text follows this line--' is the 964 | first line below the message header and is, like all lines below 965 | it, out-commented with `comment-region'. It deletes the leading 966 | star and uncomments the line and all text below it - if any." 967 | (save-excursion 968 | (goto-char (point-min)) 969 | (re-search-forward 970 | (concat 971 | "\\(" (regexp-quote "* ") "\\)" 972 | "--text follows this line--") 973 | nil 'NOERROR) 974 | (replace-match "" nil nil nil 1) 975 | (beginning-of-line) 976 | (let ((start-body (point))) 977 | (uncomment-region start-body (point-max)) 978 | (widen)))) 979 | 980 | (defun outorg-prepare-iorg-edit-buffer-for-editing () 981 | "Prepare a buffer opened with `edit' from iorg-scrape for outorg. 982 | 983 | This function assumes that a PicoLisp symbol that contains the 984 | text of an Org-mode file (fetched from an iOrg application) has 985 | been loaded into a PicoLisp `edit' buffer. It transforms the 986 | buffer content to a `outshine' compatible format, such that 987 | `outorg-edit-as-org' can be applied on it. 988 | 989 | In particular, this function assumes that the original `edit' 990 | buffer has the following format 991 | 992 | ;; #+begin_quote 993 | txt \"\" 994 | 995 | \(********\) 996 | ;; #+end_quote 997 | 998 | and that the text must be transformed to a format that looks 999 | somehow like this 1000 | 1001 | ;; #+begin_quote 1002 | ## #+DESCRIPTION txt 1003 | 1004 | \[## #+\] 1005 | 1006 | ## * Org-file 1007 | ## Content 1008 | 1009 | \(********\) 1010 | ;; #+end_quote 1011 | 1012 | i.e. the symbol-name 'txt' is converted to a #+DESCRIPTION keyword 1013 | and is followed by the (expanded and unquoted) content of the Org 1014 | file. This whole section of the buffer is outcommented with 1015 | picolisp-mode comment syntax. Finally, at the end of the buffer 1016 | the '\(********\)' line is left as-is." 1017 | (goto-char (point-min)) 1018 | (insert "#+DESCRIPTION: ") 1019 | (re-search-forward "\\(\"\\|NIL\\)" nil 'NOERROR) 1020 | (if (string-equal (match-string-no-properties 0) "NIL") 1021 | (progn 1022 | (backward-word) 1023 | (newline 2) 1024 | (looking-at "NIL") 1025 | (replace-match "*
" 'FIXEDCASE 'LITERAL)) 1026 | (replace-match "") 1027 | (newline 2)) 1028 | (goto-char (point-max)) 1029 | (re-search-backward "[^*)(\n\t\s]" nil 'NOERROR) 1030 | (if (string-equal (match-string-no-properties 0) "\"") 1031 | (replace-match "") 1032 | (forward-char)) 1033 | (newline) 1034 | (let ((end-body (point)) 1035 | (start-body (point-min))) 1036 | (save-excursion 1037 | (goto-char start-body) 1038 | (while (search-forward "^J" end-body t) 1039 | (replace-match "\n" nil t))) 1040 | ;; (replace-string "^J" "\n" nil start-body end-body) 1041 | (goto-char (point-min)) 1042 | (re-search-forward 1043 | (concat "(" (regexp-quote "********") ")") nil 'NOERROR) 1044 | (forward-line -1) 1045 | (setq end-body (point)) 1046 | (comment-region start-body end-body))) 1047 | 1048 | (defun outorg-prepare-iorg-edit-buffer-for-posting () 1049 | "Prepare an `edit' buffer for posting via iorg-scrape. 1050 | 1051 | This function assumes that a PicoLisp symbol that contains the 1052 | text of an Org-mode file (fetched from an iOrg application) has 1053 | been edited with outorg and converted back to PicoLisp. It 1054 | transforms the `edit' buffer content back to its original format, 1055 | such that it can be posted back to the PicoLisp system by closing 1056 | the emacsclient (via the protocol defined in `eedit.l'). 1057 | 1058 | In particular, this function assumes that the original `edit' 1059 | buffer had the following format 1060 | 1061 | ;; #+begin_quote 1062 | txt \"\" 1063 | 1064 | \(********\) 1065 | ;; #+end_quote 1066 | 1067 | and that the actual text that has to be transformed back to this 1068 | format looks somehow like this 1069 | 1070 | ;; #+begin_quote 1071 | ## #+DESCRIPTION txt 1072 | 1073 | \[## #+\] 1074 | 1075 | ## * Org-file 1076 | ## Content 1077 | 1078 | \(********\) 1079 | ;; #+end_quote 1080 | 1081 | i.e. the symbol-name 'txt' has been converted to a #+DESCRIPTION 1082 | keyword and is followed by the (expanded and unquoted) content of 1083 | the Org file. This whole section of the buffer is outcommented 1084 | with picolisp-mode comment syntax. Finally, at the end of the 1085 | buffer the '\(********\)' line is found again." 1086 | (let ((final-line 1087 | (concat "(" (regexp-quote "********") ")"))) 1088 | (uncomment-region (point-min) (point-max)) 1089 | (goto-char (point-min)) 1090 | (re-search-forward (regexp-quote "#+DESCRIPTION: ") nil 'NOERROR) 1091 | (replace-match "") 1092 | (end-of-line) 1093 | (let ((show-trailing-whitespace nil)) 1094 | (kill-line 2)) 1095 | (insert "\"") 1096 | (re-search-forward final-line nil 'NOERROR) 1097 | (beginning-of-line) 1098 | (re-search-backward "[[:alnum:][:punct:]]" nil 'NOERROR) 1099 | (forward-char) 1100 | (insert "\"") 1101 | (kill-line) 1102 | (save-excursion 1103 | (let ((pt (point))) 1104 | (goto-char (point-min)) 1105 | (while (search-forward "^J" pt t) 1106 | (replace-match "\n" nil t)))) 1107 | ;; (replace-string "\n" "^J" nil (point-min) (point)) 1108 | (goto-char (point-min)) 1109 | (when (looking-at 1110 | (concat "\\(^.*\\)" 1111 | "\\(\"\\*
\"\\)" 1112 | "\\([\s\t\n]+" final-line "\\)")) 1113 | (replace-match (format "%s" "NIL") nil nil nil 2) 1114 | ;; (kill-line) 1115 | ))) 1116 | 1117 | (defun outorg-convert-oldschool-elisp-buffer-to-outshine () 1118 | "Transform oldschool elisp buffer to outshine. 1119 | In `emacs-lisp-mode', transform an oldschool buffer (only 1120 | semicolons as outline-regexp) into an outshine buffer (with 1121 | outcommented org-mode headers)." 1122 | (save-excursion 1123 | (goto-char (point-min)) 1124 | (when (outline-on-heading-p) 1125 | (outorg-convert-oldschool-elisp-headline-to-outshine)) 1126 | (while (not (eobp)) 1127 | (outline-next-heading) 1128 | (outorg-convert-oldschool-elisp-headline-to-outshine))) 1129 | (funcall 'outshine-hook-function)) 1130 | 1131 | (defun outorg-convert-oldschool-elisp-headline-to-outshine () 1132 | "Transform oldschool headline to outshine. 1133 | In `emacs-lisp-mode', transform one oldschool header (only semicolons) into an outshine header (outcommented org-mode header)." 1134 | (unless (bolp) (beginning-of-line)) 1135 | (when (looking-at "^;;[;]+ ") 1136 | (let* ((header-level 1137 | (- (length (match-string-no-properties 0)) 3)) 1138 | (replacement-string 1139 | (concat 1140 | ";; " 1141 | (let ((strg "*")) 1142 | (dotimes (i (1- header-level) strg) 1143 | (setq strg (concat strg "*")))) 1144 | " "))) 1145 | (replace-match replacement-string)))) 1146 | 1147 | (defun outorg-copy-and-convert () 1148 | "Copy code buffer content to tmp-buffer and convert it to Org syntax. 1149 | If `outorg-edit-whole-buffer' is non-nil, copy the whole buffer, otherwise 1150 | the current subtree." 1151 | (when (buffer-live-p (get-buffer outorg-edit-buffer-name)) 1152 | (if (y-or-n-p 1153 | (format "%s exists - save and overwrite contents " 1154 | outorg-edit-buffer-name)) 1155 | (with-current-buffer outorg-edit-buffer-name 1156 | (outorg-save-edits-to-tmp-file)) 1157 | (user-error "Edit as Org cancelled."))) 1158 | (let* ((edit-buffer 1159 | (get-buffer-create outorg-edit-buffer-name))) 1160 | (save-restriction 1161 | (with-current-buffer edit-buffer 1162 | (erase-buffer)) 1163 | ;; copy code buffer content 1164 | (copy-to-buffer 1165 | edit-buffer 1166 | (if outorg-edit-whole-buffer-p 1167 | (point-min) 1168 | (save-excursion 1169 | (outline-back-to-heading 'INVISIBLE-OK) 1170 | (point))) 1171 | (if outorg-edit-whole-buffer-p 1172 | (point-max) 1173 | (save-excursion 1174 | (outline-end-of-subtree) 1175 | (point))))) 1176 | ;; switch to edit buffer 1177 | (if (one-window-p) (split-window-sensibly (get-buffer-window))) 1178 | (switch-to-buffer-other-window edit-buffer) 1179 | ;; reinstall outorg-markers 1180 | (outorg-reinstall-markers-in-region (point-min)) 1181 | ;; set point 1182 | (goto-char outorg-edit-buffer-point-marker) 1183 | ;; activate programming language major mode and convert to org 1184 | (let ((mode (outorg-get-buffer-mode 1185 | (marker-buffer outorg-code-buffer-point-marker)))) 1186 | ;; special case R-mode 1187 | (if (eq mode 'ess-mode) 1188 | (funcall 'R-mode) 1189 | (funcall mode))) 1190 | ;; convert oldschool elisp headers to outshine headers 1191 | (when outorg-oldschool-elisp-headers-p 1192 | (outorg-convert-oldschool-elisp-buffer-to-outshine) 1193 | ;; reset var to original state after conversion 1194 | (setq outorg-oldschool-elisp-headers-p t)) 1195 | ;; call conversion function 1196 | (outorg-convert-to-org) 1197 | ;; change major mode to org-mode 1198 | (org-mode) 1199 | ;; activate minor mode outorg-edit-minor-mode 1200 | (outorg-edit-minor-mode) 1201 | ;; set outline visibility 1202 | (if (not outorg-edit-whole-buffer-p) 1203 | (show-all) 1204 | (hide-sublevels 3) 1205 | (ignore-errors (show-subtree)) 1206 | ;; insert export template 1207 | (cond 1208 | (outorg-ask-user-for-export-template-file-p 1209 | (call-interactively 1210 | 'outorg-insert-export-template-file)) 1211 | (outorg-insert-default-export-template-p 1212 | (outorg-insert-default-export-template)))) 1213 | ;; update md5 for watchdoc 1214 | (when (and outorg-propagate-changes-p 1215 | (require 'org-watchdoc nil t)) 1216 | (org-watchdoc-set-md5)) 1217 | ;; reset buffer-undo-list 1218 | (setq buffer-undo-list nil))) 1219 | 1220 | (defun outorg-wrap-source-in-block (lang &optional EXAMPLE-BLOCK-P) 1221 | "Wrap code between in src-block of LANG. 1222 | If EXAMPLE-BLOCK-P is non-nil, use an example-block instead of a 1223 | source-block. Use `outorg-pt-B-marker' and 1224 | `outorg-pt-C-marker' to find start and end position of 1225 | block." 1226 | (save-excursion 1227 | ;; begin of block 1228 | (goto-char outorg-pt-B-marker) 1229 | (newline) 1230 | (forward-line -1) 1231 | (insert 1232 | (if EXAMPLE-BLOCK-P 1233 | "#+begin_example" 1234 | (format "#+begin_src %s" lang))) 1235 | (move-marker outorg-pt-B-marker (point-at-bol)) 1236 | ;; end of block 1237 | (goto-char outorg-pt-C-marker) 1238 | (newline) 1239 | ;; (forward-line -1) 1240 | (insert 1241 | (if EXAMPLE-BLOCK-P 1242 | "#+end_example" 1243 | "#+end_src")))) 1244 | 1245 | ;; We treat nestable comments as code. This is the fourth field of the 1246 | ;; parser state vector: it is `t' if in a non-nestable comment, or the 1247 | ;; comment nesting level if inside a comment that can be nested. 1248 | 1249 | (defun skip-line-comment-or-ws () 1250 | "If the current line is a comment or whitespace, move to the 1251 | next line and return `t'. Otherwise, leaves point alone and 1252 | returns `nil'." 1253 | (cond 1254 | ((looking-at "[[:space:]]*$") (forward-line)) 1255 | ((outorg-comment-on-line-p) (forward-line)) 1256 | (t nil))) 1257 | 1258 | ;; Note: this behavior is slightly different than `forward-comment': 1259 | ;; it leaves point at the beginning of the line that is not a line 1260 | ;; comment or white space, not at the actual first character of code 1261 | ;; on the line. 1262 | (defun forward-line-comments () 1263 | "Move forward across comments. Stop scanning if we find 1264 | something other than a comment or white space. Set point to where 1265 | scanning stops." 1266 | (while (and (not (eobp)) (skip-line-comment-or-ws)))) 1267 | 1268 | (defun backward-line-comments () 1269 | "Move backward across comments. Stop scanning if we find 1270 | something other than a comment or white space. Point is left at 1271 | the end of the first line found to not be a line comment or white 1272 | space." 1273 | (while (and (not (bobp)) (save-excursion (skip-line-comment-or-ws)) (forward-line -1))) 1274 | (end-of-line)) 1275 | 1276 | (defun outorg-convert-to-org () 1277 | "Convert buffer content to Org Syntax" 1278 | (let* ((buffer-mode 1279 | (outorg-get-buffer-mode 1280 | (marker-buffer outorg-code-buffer-point-marker))) 1281 | (babel-lang (outorg-get-babel-name buffer-mode)) 1282 | (example-block-p 1283 | (not 1284 | (outorg-in-babel-load-languages-p buffer-mode)))) 1285 | 1286 | (outorg-remove-trailing-blank-lines) 1287 | ;; reset (left-over) markers 1288 | (move-marker outorg-pt-A-marker nil) 1289 | (move-marker outorg-pt-B-marker nil) 1290 | (move-marker outorg-pt-C-marker nil) 1291 | ;; special case beginning of buffer 1292 | (save-excursion 1293 | (goto-char (point-min)) 1294 | ;; buffer begins with code 1295 | (unless (outorg-comment-on-line-p) 1296 | ;; mark beginning of code 1297 | (move-marker outorg-pt-B-marker 1298 | (progn 1299 | (forward-line-comments) 1300 | (point)))) 1301 | ;; loop over rest of buffer 1302 | (while (and (< (point) (point-max)) 1303 | ;; mark beginning of comment 1304 | (marker-position 1305 | (move-marker outorg-pt-A-marker 1306 | (outorg-comment-search-forward)))) 1307 | (goto-char outorg-pt-A-marker) 1308 | ;; comment does not start at BOL -> skip 1309 | ;; looking at src-block delimiter -> skip 1310 | (if (or (not (eq (marker-position outorg-pt-A-marker) 1311 | (point-at-bol))) 1312 | (looking-at "^#\\+begin_") 1313 | (looking-at "^#\\+end_")) 1314 | (forward-line) 1315 | ;; comments starts at BOL -> convert 1316 | (if (marker-position outorg-pt-B-marker) 1317 | ;; special case buffer begins with code 1318 | (move-marker outorg-pt-C-marker 1319 | (progn 1320 | (beginning-of-line) 1321 | (backward-line-comments) 1322 | (point))) 1323 | ;; default case buffer begins with comments 1324 | ;; mark beginning of code 1325 | (move-marker outorg-pt-B-marker 1326 | ;; skip forward comments and whitespace 1327 | (progn 1328 | (forward-line-comments) 1329 | (point))) 1330 | ;; mark end of code 1331 | (move-marker outorg-pt-C-marker 1332 | ;; search next comment (starting at bol) 1333 | (progn 1334 | (forward-line) 1335 | (outorg-comment-search-forward) 1336 | ;; move point to beg of comment 1337 | (beginning-of-line) 1338 | (unless (bobp) 1339 | ;; skip backward comments and whitespace 1340 | (backward-line-comments) 1341 | ;; deal with trailing comment on line 1342 | (unless (bobp) 1343 | (end-of-line))) 1344 | (point))))) 1345 | ;; wrap code between B and C in block 1346 | (when (< outorg-pt-B-marker outorg-pt-C-marker) 1347 | (outorg-wrap-source-in-block 1348 | babel-lang example-block-p)) 1349 | ;; remember marker positions 1350 | (let ((pt-A-pos ; beg-of-comment 1351 | (marker-position outorg-pt-A-marker)) 1352 | (pt-B-pos ; beg-of-code 1353 | (marker-position outorg-pt-B-marker)) 1354 | (pt-C-pos ; end-of-code 1355 | (marker-position outorg-pt-C-marker))) 1356 | ;; special case only comments and whitespace in buffer 1357 | (when (and (eq pt-A-pos 1) 1358 | (eq pt-B-pos 1)) 1359 | ;; mark whole buffer 1360 | (move-marker outorg-pt-B-marker (point-max))) 1361 | ;; uncomment region between A and B 1362 | (when (< outorg-pt-A-marker 1363 | outorg-pt-B-marker) 1364 | (uncomment-region 1365 | outorg-pt-A-marker outorg-pt-B-marker) 1366 | ;; move point to end of src 1367 | (and pt-B-pos pt-C-pos 1368 | (cond 1369 | ;; special case only comments and whitespace in 1370 | ;; buffer -> finish loop 1371 | ((eq (marker-position outorg-pt-B-marker) 1372 | (point-max)) 1373 | (goto-char outorg-pt-B-marker)) 1374 | ;; loop until C is at EOB 1375 | ((< pt-B-pos pt-C-pos) 1376 | (goto-char outorg-pt-C-marker)) 1377 | (t "This should not happen")))) 1378 | (when (< pt-C-pos pt-B-pos) (goto-char (point-max)))) 1379 | ;; reset markers 1380 | (move-marker outorg-pt-B-marker nil) 1381 | (move-marker outorg-pt-C-marker nil) 1382 | (move-marker outorg-pt-A-marker nil))))) 1383 | 1384 | (defun outorg-indent-active-source-blocks (mode-name) 1385 | "Indent active source-blocks after conversion to Org. 1386 | 1387 | This function calls `org-indent-block' on source-blocks in the 1388 | major-mode language of the associated source-file." 1389 | (let ((language (outorg-get-babel-name mode-name))) 1390 | (save-excursion 1391 | (org-babel-map-src-blocks nil 1392 | ;; language given as argument equal to lang of processed 1393 | ;; block? 1394 | (and (string-equal language lang) 1395 | (org-babel-mark-block) 1396 | (org-indent-region 1397 | (car (outorg-region-or-buffer-limits)) 1398 | (cadr (outorg-region-or-buffer-limits)))))))) 1399 | 1400 | (defun outorg-unindent-active-source-blocks (mode-name) 1401 | "Remove common indentation from active source-blocks. 1402 | 1403 | While editing in the *outorg-edit-buffer*, the source-code of the 1404 | source-blocks with language LANG (which should be the major-mode 1405 | language of the associated source-code buffer) might be indented 1406 | consciously or by accident. The latter happens e.g. when the 1407 | source-blocks are edited with `org-edit-special' (C-c '), and 1408 | variable `org-edit-src-content-indentation' has a value > 0. 1409 | 1410 | This function removes the introduced common indentation (e.g. 2 1411 | spaces) in these source-blocks (and only in them) before 1412 | converting back from Org to source-code if customizable variable 1413 | `outorg-unindent-active-source-blocks-p' is non-nil." 1414 | (let ((language (outorg-get-babel-name mode-name))) 1415 | (save-excursion 1416 | (org-babel-map-src-blocks nil 1417 | ;; language given as argument equal to lang of processed 1418 | ;; block? 1419 | (and (string-equal language lang) 1420 | (org-babel-mark-block) 1421 | (save-restriction 1422 | (narrow-to-region 1423 | (car (outorg-region-or-buffer-limits)) 1424 | (cadr (outorg-region-or-buffer-limits))) 1425 | (org-do-remove-indentation))))))) 1426 | 1427 | 1428 | (defun outorg-convert-back-to-code () 1429 | "Convert edit-buffer content back to programming language syntax. 1430 | Assume that edit-buffer major-mode has been set back to the 1431 | programming-language major-mode of the associated code-buffer 1432 | before this function is called." 1433 | (let* ((comment-style "plain") ; "multi-line"? 1434 | (buffer-mode (outorg-get-buffer-mode)) 1435 | (in-org-babel-load-languages-p 1436 | (outorg-in-babel-load-languages-p buffer-mode)) 1437 | (rgxp 1438 | (if in-org-babel-load-languages-p 1439 | (format "%s%s%s" 1440 | "\\(?:^#\\+begin_src[[:space:]]+" 1441 | (regexp-quote 1442 | (outorg-get-babel-name 1443 | buffer-mode 'AS-STRG-P)) 1444 | "[^\000]*?\n#\\+end_src\\)") ; NUL char 1445 | (concat 1446 | "\\(?:#\\+begin_example" 1447 | "[^\000]*?\n#\\+end_example\\)"))) 1448 | (first-block-p t)) 1449 | ;; 1st run: outcomment text, delete (active) block delimiters 1450 | ;; reset (left-over) marker 1451 | (move-marker outorg-pt-B-marker nil) 1452 | (move-marker outorg-pt-C-marker nil) 1453 | ;; 1st run: outcomment text 1454 | (goto-char (point-min)) 1455 | (while (re-search-forward rgxp nil 'NOERROR) 1456 | ;; special case 1st block 1457 | (if first-block-p 1458 | (progn 1459 | ;; Handle first block 1460 | (move-marker outorg-pt-B-marker (match-beginning 0)) 1461 | (move-marker outorg-pt-C-marker (match-end 0)) 1462 | (if (eq (point-min) (match-beginning 0)) 1463 | (goto-char (match-end 0)) 1464 | (save-match-data 1465 | (ignore-errors 1466 | (comment-region (point-min) (match-beginning 0))))) 1467 | (setq first-block-p nil)) 1468 | ;; default case 1469 | (let ((previous-beg-src 1470 | (marker-position outorg-pt-B-marker)) 1471 | (previous-end-src 1472 | (marker-position outorg-pt-C-marker))) 1473 | (move-marker outorg-pt-B-marker (match-beginning 0)) 1474 | (move-marker outorg-pt-C-marker (match-end 0)) 1475 | (save-match-data 1476 | (ignore-errors 1477 | (comment-region previous-end-src 1478 | (match-beginning 0)))) 1479 | (save-excursion 1480 | (goto-char previous-end-src) 1481 | (delete-region (1- (point-at-bol)) (point-at-eol)) 1482 | (goto-char previous-beg-src) 1483 | (if (eq (point-at-bol) (point-min)) 1484 | (delete-region 1 (1+ (point-at-eol))) 1485 | (delete-region (1- (point-at-bol)) (point-at-eol))))))) 1486 | ;; special case last block 1487 | (ignore-errors 1488 | (comment-region 1489 | (if first-block-p (point-min) outorg-pt-C-marker) 1490 | (point-max))) 1491 | (unless first-block-p ; no src-block so far 1492 | (save-excursion 1493 | (goto-char outorg-pt-C-marker) 1494 | (delete-region (1- (point-at-bol)) (point-at-eol)) 1495 | (goto-char outorg-pt-B-marker) 1496 | (delete-region (1- (point-at-bol)) (point-at-eol))))) 1497 | (move-marker outorg-pt-B-marker nil) 1498 | (move-marker outorg-pt-C-marker nil) 1499 | ;; 2nd (optional) run: convert elisp headers to oldschool 1500 | (when outorg-oldschool-elisp-headers-p 1501 | (save-excursion 1502 | (goto-char (point-min)) 1503 | (while (re-search-forward 1504 | "\\(^;;\\)\\( [*]+\\)\\( \\)" 1505 | nil 'NOERROR) 1506 | (let* ((org-header-level 1507 | (- (length (match-string-no-properties 0)) 4)) 1508 | (replacement-string 1509 | (let ((strg ";")) 1510 | (dotimes (i (1- org-header-level) strg) 1511 | (setq strg (concat strg ";")))))) 1512 | (replace-match replacement-string nil nil nil 2)))))) 1513 | ;; ;; finally remove trailing empty lines REALLY? 1514 | ;; (outorg-remove-trailing-blank-lines)) 1515 | 1516 | (defun outorg-replace-code-with-edits () 1517 | "Replace code-buffer contents with edits." 1518 | (let* ((edit-buf (marker-buffer outorg-edit-buffer-point-marker)) 1519 | (code-buf (marker-buffer outorg-code-buffer-point-marker)) 1520 | (edit-buf-point-min 1521 | (with-current-buffer edit-buf 1522 | (point-min))) 1523 | (edit-buf-point-max 1524 | (with-current-buffer edit-buf 1525 | (save-excursion 1526 | (goto-char (point-max)) 1527 | (unless (and (bolp) (looking-at "^[ \t]*$")) 1528 | (newline)) 1529 | (point))))) 1530 | (with-current-buffer code-buf 1531 | (if outorg-edit-whole-buffer-p 1532 | (progn 1533 | (if (buffer-narrowed-p) 1534 | (delete-region (point-min) (point-max)) 1535 | (erase-buffer)) 1536 | (insert-buffer-substring-no-properties 1537 | edit-buf edit-buf-point-min edit-buf-point-max) 1538 | (outorg-reinstall-markers-in-region (point-min))) 1539 | (goto-char 1540 | (marker-position outorg-code-buffer-point-marker)) 1541 | (save-restriction 1542 | (narrow-to-region 1543 | (save-excursion 1544 | (outline-back-to-heading 'INVISIBLE-OK) 1545 | (point)) 1546 | (save-excursion 1547 | (outline-end-of-subtree) 1548 | (point))) 1549 | (delete-region (point-min) (point-max)) 1550 | (insert-buffer-substring-no-properties 1551 | edit-buf edit-buf-point-min edit-buf-point-max) 1552 | (outorg-reinstall-markers-in-region (point-min))) 1553 | ;; (save-buffer) 1554 | )))) 1555 | 1556 | ;;;; Commands 1557 | ;;;;; Edit and Exit 1558 | 1559 | ;;;###autoload 1560 | (defun outorg-edit-as-org (&optional arg) 1561 | "Convert and copy to temporary Org buffer 1562 | 1563 | With ARG, act conditional on the raw value of ARG: 1564 | 1565 | | prefix | raw | action 1 | action 2 | 1566 | |--------+-----+-------------------+--------------------------------| 1567 | | C-u | (4) | edit-whole-buffer | --- | 1568 | | C-1 | 1 | edit-whole-buffer | insert default export-template | 1569 | | C-2 | 2 | edit-whole-buffer | prompt user for template-file | 1570 | | C-3 | 3 | edit-whole-buffer | insert & keep default template | 1571 | | C-4 | 4 | edit-whole-buffer | insert & keep template-file | 1572 | | C-5 | 5 | propagate changes | --- | 1573 | 1574 | " 1575 | (interactive "P") 1576 | (ignore-errors 1577 | (outorg-reset-global-vars)) 1578 | (and buffer-file-read-only 1579 | (error "Cannot edit read-only buffer-file")) 1580 | (and buffer-read-only 1581 | (if (not (y-or-n-p "Buffer is read-only - make writable ")) 1582 | (error "Cannot edit read-only buffer") 1583 | (setq inhibit-read-only t) 1584 | (setq outorg-code-buffer-read-only-p t))) 1585 | (and (derived-mode-p 'message-mode) 1586 | (outorg-prepare-message-mode-buffer-for-editing)) 1587 | (and (eq major-mode 'picolisp-mode) 1588 | (save-excursion 1589 | (save-match-data 1590 | (goto-char (point-max)) 1591 | (re-search-backward 1592 | (concat "(" (regexp-quote "********") ")") 1593 | nil 'NOERROR))) 1594 | (outorg-prepare-iorg-edit-buffer-for-editing)) 1595 | (move-marker outorg-code-buffer-point-marker (point)) 1596 | (save-excursion 1597 | (or 1598 | (outline-on-heading-p 'INVISIBLE-OK) 1599 | (ignore-errors 1600 | (outline-back-to-heading 'INVISIBLE-OK)) 1601 | (ignore-errors 1602 | (outline-next-heading))) 1603 | (move-marker 1604 | outorg-code-buffer-beg-of-subtree-marker (point))) 1605 | (and arg 1606 | (cond 1607 | ((equal arg '(4)) 1608 | (setq outorg-edit-whole-buffer-p t)) 1609 | ((equal arg 1) 1610 | (setq outorg-edit-whole-buffer-p t) 1611 | (setq outorg-insert-default-export-template-p t)) 1612 | ((equal arg 2) 1613 | (setq outorg-edit-whole-buffer-p t) 1614 | (setq outorg-ask-user-for-export-template-file-p t)) 1615 | ((equal arg 3) 1616 | (setq outorg-edit-whole-buffer-p t) 1617 | (setq outorg-insert-default-export-template-p t) 1618 | (setq outorg-keep-export-template-p t)) 1619 | ((equal arg 4) 1620 | (setq outorg-edit-whole-buffer-p t) 1621 | (setq outorg-ask-user-for-export-template-file-p t) 1622 | (setq outorg-keep-export-template-p t)) 1623 | ((equal arg 5) 1624 | (setq outorg-propagate-changes-p t)))) 1625 | (and (bound-and-true-p outshine-enforce-no-comment-padding-p) 1626 | (setq outorg-oldschool-elisp-headers-p t)) 1627 | (setq outorg-initial-window-config 1628 | (current-window-configuration)) 1629 | (outorg-save-markers (append outorg-tracked-markers 1630 | outorg-tracked-org-markers)) 1631 | (outorg-copy-and-convert)) 1632 | 1633 | ;; (defun outorg-gather-src-block-data () 1634 | ;; "Gather beg/end data of active src-blocks in curr-buf. 1635 | ;; Store the data as alist with form 1636 | 1637 | ;; #+begin_src emacs-lisp 1638 | ;; ((beg-block end-block) ... (beg-block end-block)) 1639 | ;; #+end_src 1640 | 1641 | ;; in global variable `outorg-src-block-data'." 1642 | 1643 | (defun outorg-copy-edits-and-exit () 1644 | "Replace code-buffer content with (converted) edit-buffer content and 1645 | kill edit-buffer" 1646 | (interactive) 1647 | (if (not buffer-undo-list) 1648 | ;; edit-buffer not modified at all 1649 | (progn 1650 | (move-marker outorg-edit-buffer-point-marker (point)) 1651 | ;; restore window configuration 1652 | (set-window-configuration 1653 | outorg-initial-window-config) 1654 | ;; avoid confirmation prompt when killing the edit buffer 1655 | (with-current-buffer 1656 | (marker-buffer outorg-edit-buffer-point-marker) 1657 | (set-buffer-modified-p nil)) 1658 | (kill-buffer 1659 | (marker-buffer outorg-edit-buffer-point-marker)) 1660 | (and outorg-code-buffer-read-only-p 1661 | (setq inhibit-read-only nil)) 1662 | ;; (and (eq major-mode 'message-mode) 1663 | (and (derived-mode-p 'message-mode) 1664 | (outorg-prepare-message-mode-buffer-for-sending)) 1665 | (and (eq major-mode 'picolisp-mode) 1666 | (save-excursion 1667 | (save-match-data 1668 | (goto-char (point-max)) 1669 | (re-search-backward 1670 | (concat "(" (regexp-quote "********") ")") 1671 | nil 'NOERROR)))) 1672 | ;; clean up global vars 1673 | (outorg-reset-global-vars)) 1674 | ;; edit-buffer modified 1675 | (widen) 1676 | ;; propagate changes to associated doc files 1677 | (when (and outorg-propagate-changes-p 1678 | (require 'org-watchdoc nil t)) 1679 | (save-excursion 1680 | (goto-char (point-min)) 1681 | (org-watchdoc-propagate-changes))) 1682 | (let ((mode (outorg-get-buffer-mode 1683 | (marker-buffer outorg-code-buffer-point-marker)))) 1684 | (and outorg-unindent-active-source-blocks-p 1685 | (outorg-unindent-active-source-blocks mode)) 1686 | (move-marker outorg-edit-buffer-point-marker (point)) 1687 | (move-marker outorg-edit-buffer-beg-of-subtree-marker 1688 | (or (ignore-errors 1689 | (save-excursion 1690 | (outline-previous-heading) 1691 | (point))) 1692 | 1)) 1693 | ;; special case R-mode 1694 | (if (eq mode 'ess-mode) 1695 | (funcall 'R-mode) 1696 | (funcall mode))) 1697 | (outorg-convert-back-to-code) 1698 | (outorg-save-markers (append outorg-tracked-markers 1699 | outorg-tracked-org-markers)) 1700 | (outorg-replace-code-with-edits) 1701 | (set-window-configuration 1702 | outorg-initial-window-config) 1703 | (goto-char outorg-code-buffer-point-marker) 1704 | ;; avoid confirmation prompt when killing the edit buffer 1705 | (with-current-buffer 1706 | (marker-buffer outorg-edit-buffer-point-marker) 1707 | (set-buffer-modified-p nil)) 1708 | (kill-buffer 1709 | (marker-buffer outorg-edit-buffer-point-marker)) 1710 | (and outorg-code-buffer-read-only-p 1711 | (setq inhibit-read-only nil)) 1712 | (and (derived-mode-p 'message-mode) 1713 | (outorg-prepare-message-mode-buffer-for-sending)) 1714 | (and (eq major-mode 'picolisp-mode) 1715 | (save-excursion 1716 | (save-match-data 1717 | (goto-char (point-max)) 1718 | (re-search-backward 1719 | (concat "(" (regexp-quote "********") ")") 1720 | nil 'NOERROR))) 1721 | (outorg-prepare-iorg-edit-buffer-for-posting)) 1722 | (outorg-reset-global-vars))) 1723 | 1724 | ;;;;; Insert Export Template 1725 | 1726 | ;; (defun outorg-toggle-export-template-insertion (&optional arg) 1727 | ;; "Toggles automatic insertion of export template into *outorg-edit-buffer* 1728 | 1729 | ;; With prefix arg, unconditionally deactivates insertion if numeric 1730 | ;; alue of ARG is negative, otherwise unconditionally activates it, except value 1731 | ;; is 16 (C-u C-u) - then `outorg-ask-user-for-export-template-file-p' will be 1732 | ;; set to t and the user asked for a file to insert. 1733 | 1734 | ;; Toggles the value without prefix arg." 1735 | ;; (interactive "P") 1736 | ;; (let ((num (prefix-numeric-value arg))) 1737 | ;; (cond 1738 | ;; ((= num 1) (if outorg-insert-default-export-template-p 1739 | ;; (prog 1740 | ;; (setq outorg-insert-default-export-template-p nil) 1741 | ;; (setq outorg-ask-user-for-export-template-file-p nil)) 1742 | ;; (setq outorg-insert-default-export-template-p t) 1743 | ;; (setq outorg-ask-user-for-export-template-file-p nil))) 1744 | ;; ((= num 16) (setq outorg-ask-user-for-export-template-file-p t)) 1745 | ;; ((< num 0) (setq outorg-insert-default-export-template-p nil) 1746 | ;; (setq outorg-ask-user-for-export-template-file-p nil)) 1747 | ;; ((> num 1) (setq outorg-insert-default-export-template-p t)) 1748 | ;; (setq outorg-ask-user-for-export-template-file-p nil)))) 1749 | 1750 | 1751 | (defun outorg-insert-default-export-template (&optional arg) 1752 | "Insert a default export template in the *outorg-edit-buffer*" 1753 | (interactive "P") 1754 | (and arg 1755 | (cond 1756 | ((equal arg '(4)) 1757 | (setq outorg-keep-export-template-p t)))) 1758 | (save-excursion 1759 | (goto-char (point-min)) 1760 | (insert 1761 | (concat 1762 | (unless outorg-keep-export-template-p 1763 | (concat 1764 | "# <<<*** BEGIN EXPORT TEMPLATE " 1765 | "[edits will be lost at exit] ***>>>\n\n")) 1766 | (format "#+TITLE: %s\n" 1767 | (ignore-errors 1768 | (file-name-sans-extension 1769 | (file-name-nondirectory 1770 | (buffer-file-name 1771 | (marker-buffer 1772 | (or outorg-code-buffer-point-marker 1773 | outorg-code-buffer-beg-of-subtree-marker))))))) 1774 | (format "#+LANGUAGE: %s\n" "en") 1775 | ;; ;; many people write in English, although locale is different 1776 | ;; (ignore-errors 1777 | ;; (car (split-string (getenv "LANG") "_" 'OMIT-NULLS)))) 1778 | (format "#+AUTHOR: %s\n" 1779 | (ignore-errors 1780 | (user-full-name))) 1781 | (format "#+EMAIL: %s\n" (ignore-errors 1782 | (or user-mail-address 1783 | (getenv "MAIL")))) 1784 | (concat "#+OPTIONS: H:3 num:t toc:3 \\n:nil @:t ::t " 1785 | "|:t ^:nil -:t f:t *:t <:nil prop:t\n") 1786 | (concat "#+OPTIONS: TeX:t LaTeX:nil skip:nil d:nil " 1787 | "todo:t pri:nil tags:not-in-toc\n") 1788 | "#+OPTIONS: author:t creator:t timestamp:t email:t\n" 1789 | "# #+DESCRIPTION: <>\n" 1790 | "# #+KEYWORDS: <>\n" 1791 | "# #+SEQ_TODO: <>\n" 1792 | (concat "#+INFOJS_OPT: view:nil toc:t ltoc:t mouse:underline " 1793 | "buttons:0 path:http://orgmode.org/org-info.js\n") 1794 | "#+EXPORT_SELECT_TAGS: export\n" 1795 | "#+EXPORT_EXCLUDE_TAGS: noexport\n\n" 1796 | (unless outorg-keep-export-template-p 1797 | "# <<<*** END EXPORT TEMPLATE ***>>>\n\n"))))) 1798 | 1799 | (defun outorg-insert-export-template-file (arg template-file ) 1800 | "Insert a user export-template-file in the *outorg-edit-buffer*" 1801 | (interactive "P\nfTemplate File: ") 1802 | (and arg 1803 | (cond 1804 | ((equal arg '(4)) 1805 | (setq outorg-keep-export-template-p t)))) 1806 | (save-excursion 1807 | (goto-char (point-min)) 1808 | (unless outorg-keep-export-template-p 1809 | (insert 1810 | (concat 1811 | "# <<<*** BEGIN EXPORT TEMPLATE " 1812 | "[edits will be lost at exit] ***>>>\n\n"))) 1813 | (forward-char 1814 | (cadr (insert-file-contents template-file))) 1815 | (newline) 1816 | (unless outorg-keep-export-template-p 1817 | (insert "# <<<*** END EXPORT TEMPLATE ***>>>\n") 1818 | (newline)))) 1819 | 1820 | 1821 | ;;;;; Misc 1822 | 1823 | ;; courtesy to Trey Jackson (http://tinyurl.com/cbnlemg) 1824 | (defun outorg-edit-comments-and-propagate-changes () 1825 | "Edit first buffer tree and propagate changes. 1826 | Used to keep exported comment-sections in sync with their 1827 | source-files." 1828 | (interactive) 1829 | (goto-char (point-min)) 1830 | (unless (outline-on-heading-p 'INVISIBLE-OK) 1831 | (ignore-errors 1832 | (outline-next-heading))) 1833 | (outorg-edit-as-org 5)) 1834 | 1835 | (defun outorg-replace-source-blocks-with-results 1836 | (&optional arg &rest languages) 1837 | "Replace source-blocks with their results. 1838 | 1839 | Only source-blocks with ':export results' in their header 1840 | arguments will be mapped. 1841 | 1842 | If LANGUAGES is non-nil, only those source-blocks with a 1843 | language found in the list are mapped. 1844 | 1845 | If LANGUAGES is nil but a prefix-argument ARG is given, only the 1846 | languages read from the mini-buffer (separated by blanks) are mapped. 1847 | 1848 | Otherwise, all languages found in `org-babel-load-languages' are mapped." 1849 | (interactive "P\n") 1850 | (let ((langs (or languages 1851 | (and arg 1852 | (split-string 1853 | (read-string 1854 | (concat "Org Babel languages separated by blanks: ")) 1855 | " " 'OMIT-NULLS)) 1856 | (mapcar 1857 | (lambda (X) (symbol-name (car X))) 1858 | org-babel-load-languages)))) 1859 | (org-babel-map-src-blocks nil 1860 | (and 1861 | (string-equal 1862 | (cdr 1863 | (assoc 1864 | :exports 1865 | (org-babel-parse-header-arguments header-args))) 1866 | "results") 1867 | (member lang langs) 1868 | (org-babel-execute-src-block) 1869 | (let* ((block-start (org-babel-where-is-src-block-head)) 1870 | (results-head (org-babel-where-is-src-block-result)) 1871 | (results-body 1872 | (save-excursion 1873 | (goto-char results-head) 1874 | (forward-line) 1875 | (point)))) 1876 | (delete-region block-start results-body)))))) 1877 | 1878 | (defun outorg-which-active-modes () 1879 | "Give a message of which minor modes are enabled in the current buffer." 1880 | (interactive) 1881 | (let ((active-modes)) 1882 | (mapc 1883 | (lambda (mode) 1884 | (condition-case nil 1885 | (if (and (symbolp mode) (symbol-value mode)) 1886 | (add-to-list 'active-modes mode)) 1887 | (error nil) )) 1888 | minor-mode-list) 1889 | active-modes)) 1890 | 1891 | 1892 | ;;; Menus and Keys 1893 | ;;;; Menus 1894 | 1895 | (defvar outorg-edit-menu-map 1896 | (let ((map (make-sparse-keymap))) 1897 | (define-key map [outorg-copy-edits-and-exit] 1898 | '(menu-item "Copy and Exit" outorg-copy-edits-and-exit 1899 | :help "Copy edits to original-buffer 1900 | and exit outorg")) 1901 | (define-key map [outorg-save-edits-to-tmp-file] 1902 | '(menu-item "Save" outorg-save-edits-to-tmp-file 1903 | :help "Save edit buffer to temporary 1904 | file in the OS tmp directory")) 1905 | map)) 1906 | 1907 | ;;;; Keys 1908 | 1909 | ;;;;; Mode Keys 1910 | 1911 | (defvar outorg-edit-minor-mode-map 1912 | (let ((map (make-sparse-keymap))) 1913 | (define-key map "\M-#" 1914 | 'outorg-copy-edits-and-exit) 1915 | (define-key map "\C-x\C-s" 1916 | 'outorg-save-edits-to-tmp-file) 1917 | (define-key map [menu-bar outorg-edit] 1918 | (cons (purecopy "Outorg") outorg-edit-menu-map)) 1919 | map)) 1920 | 1921 | (add-to-list 'minor-mode-map-alist 1922 | (cons 'outorg-edit-minor-mode 1923 | outorg-edit-minor-mode-map)) 1924 | 1925 | ;;; Run hooks and provide 1926 | 1927 | (run-hooks 'outorg-hook) 1928 | 1929 | (provide 'outorg) 1930 | 1931 | ;; Local Variables: 1932 | ;; coding: utf-8 1933 | ;; ispell-local-dictionary: "en_US" 1934 | ;; End: 1935 | 1936 | ;;; outorg.el ends here 1937 | --------------------------------------------------------------------------------