Mercurial > hg > dotemacs
changeset 178:a88105de5f74
fountain: new mode (with olivetti and imenu pseudo-dependencies)
| author | Jordi Gutiérrez Hermoso <jordigh@octave.org> |
|---|---|
| date | Mon, 02 Jul 2018 21:48:57 -0400 |
| parents | f029c55c6221 |
| children | a38b9f1d2d2c |
| files | dotemacs.el elpa/fountain-mode-2.4.2/fountain-mode-autoloads.el elpa/fountain-mode-2.4.2/fountain-mode-pkg.el elpa/fountain-mode-2.4.2/fountain-mode.el elpa/imenu-list-0.8/imenu-list-autoloads.el elpa/imenu-list-0.8/imenu-list-pkg.el elpa/imenu-list-0.8/imenu-list.el elpa/olivetti-1.5.9/olivetti-autoloads.el elpa/olivetti-1.5.9/olivetti-pkg.el elpa/olivetti-1.5.9/olivetti.el |
| diffstat | 10 files changed, 6137 insertions(+), 1 deletions(-) [+] |
line wrap: on
line diff
--- a/dotemacs.el +++ b/dotemacs.el @@ -419,7 +419,7 @@ ("gnu" . "http://elpa.gnu.org/packages/")))) '(package-selected-packages (quote - (markdown-mode magit js2-mode yaml-mode web-mode undo-tree puppet-mode nginx-mode json-mode jade-mode idomenu haml-mode goto-last-change flymake-haml elpy dockerfile-mode))) + (imenu-list olivetti fountain-mode markdown-mode magit js2-mode yaml-mode web-mode undo-tree puppet-mode nginx-mode json-mode jade-mode idomenu haml-mode goto-last-change flymake-haml elpy dockerfile-mode))) '(safe-local-variable-values (quote ((encoding . utf-8)
new file mode 100644 --- /dev/null +++ b/elpa/fountain-mode-2.4.2/fountain-mode-autoloads.el @@ -0,0 +1,24 @@ +;;; fountain-mode-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) + +;;;### (autoloads nil "fountain-mode" "fountain-mode.el" (23186 63957 +;;;;;; 555361 643000)) +;;; Generated autoloads from fountain-mode.el + +(add-to-list 'auto-mode-alist '("\\.fountain\\'" . fountain-mode)) + +(autoload 'fountain-mode "fountain-mode" "\ +Major mode for screenwriting in Fountain markup. + +\(fn)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; fountain-mode-autoloads.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/fountain-mode-2.4.2/fountain-mode-pkg.el @@ -0,0 +1,2 @@ +;;; -*- no-byte-compile: t -*- +(define-package "fountain-mode" "2.4.2" "Major mode for screenwriting in Fountain markup" '((emacs "24.5")) :commit "e2878da13e7b87a824ebd6c842e9f552369b220c" :url "https://github.com/rnkn/fountain-mode" :keywords '("wp"))
new file mode 100644 --- /dev/null +++ b/elpa/fountain-mode-2.4.2/fountain-mode.el @@ -0,0 +1,4963 @@ +;;; fountain-mode.el --- Major mode for screenwriting in Fountain markup -*- lexical-binding: t; -*- + +;; Copyright (c) 2014-2018 Paul Rankin + +;; Author: Paul Rankin <hello@paulwrankin.com> +;; Keywords: wp +;; Package-Version: 2.4.2 +;; Version: 2.4.2 +;; Package-Requires: ((emacs "24.5")) +;; URL: https://github.com/rnkn/fountain-mode + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Fountain Mode +;; ============= + +;; Fountain Mode is a complete screenwriting environment for GNU Emacs +;; using the Fountain markup format. For more information on the Fountain markup +;; format, visit <http://fountain.io>. + +;; Features +;; -------- + +;; - Support for Fountain 1.1 specification +;; - WYSIWYG auto-align elements (display only, does not modify file contents) +;; specific to script format, e.g. screenplay, stageplay or user-defined format +;; - Traditional TAB writing style for auto-upcasing character names +;; (see [Do What I Mean]) +;; - Export to plain text, HTML, LaTeX, Final Draft (FDX), or Fountain +;; - Export to standalone document or snippet +;; - Optionally show approximate page count (current page of total pages) in +;; mode-line +;; - Include external files with `{{ include: FILENAME }}` +;; - Integration with `outline` to fold/cycle visibility of sections and scenes +;; (see [Outlining]) +;; - Integration with `imenu` (sections, scene headings, notes) +;; - Intergration with `auto-insert` for title page metadata +;; - Add/remove automatic continuation string to successively speaking characters +;; - Navigation by section, scene, character name, or page +;; - Optionally display scene numbers in the right margin +;; - Intelligent insertion of a page breaks +;; - 3 levels of element syntax highlighting +;; - Automatic loading for `*.fountain` files +;; - Include or omit a title page +;; - Emphasis (bold, italic, underlined text) +;; - Toggle visibility of emphasis delimiters and syntax characters +;; - Everything is customizable + +;; Check out the Nicholl Fellowship sample script exported from Fountain Mode to: + +;; - [Plain text](https://gist.github.com/rnkn/edd4fd20e0f6ce2ca1f75e37496e38c9/raw/) +;; - [HTML](https://rawgit.com/rnkn/mcqueen/master/sample/sample.html) +;; - [LaTeX](https://www.sharelatex.com/project/54ed9180966959cb7fdbde8e) +;; - [Final Draft](https://gist.github.com/rnkn/f56934ac723d43c5dec63952dd99dcfd/raw/) + +;; Most common features are accessible from the menu. For a full list of functions +;; and key-bindings, type C-h m. + +;; [Do What I Mean]: https://github.com/rnkn/fountain-mode/wiki/Do-What-I-Mean +;; [Outlining]: https://github.com/rnkn/fountain-mode/wiki/Outlining + +;; For more, see the [Wiki](https://github.com/rnkn/fountain-mode/wiki). + +;; Requirements +;; ------------ + +;; - Emacs 24.5 +;; - LaTeX packages for PDF export: `geometry` `fontspec` `titling` `fancyhdr` +;; `marginnote` `ulem` `xstring` `oberdiek` + +;; Installation +;; ------------ + +;; For users on OS X with no experience with Emacs, see the +;; [Absolute Beginner's Guide (macOS)][guide]. + +;; The latest stable release of Fountain Mode is available via +;; [MELPA-stable](http://stable.melpa.org/#/fountain-mode). + +;; Alternately, download the [latest release], move the files into your +;; `load-path` and add the following line to your `.emacs` or `init.el` file: + +;; (require 'fountain-mode) + +;; If you prefer the latest but perhaps unstable version, install via +;; [MELPA], or clone the repository into your `load-path` and require as +;; above: + +;; git clone https://github.com/rnkn/fountain-mode.git + +;; Users of Debian ≥10 or Ubuntu ≥18.04 can install Fountain Mode with the following command: + +;; sudo apt install elpa-fountain-mode + +;; [guide]: https://github.com/rnkn/fountain-mode/wiki/Absolute-Beginner's-Guide-(macOS) "Absolute Beginner's Guide (macOS)" +;; [melpa]: https://melpa.org/#/fountain-mode "MELPA" +;; [melpa-stable]: https://stable.melpa.org/#/fountain-mode "MELPA-stable" +;; [latest release]: https://github.com/rnkn/fountain-mode/releases/latest "Fountain Mode latest release" + +;; Bugs and Feature Requests +;; ------------------------- + +;; Please raise an issue on [Issues](https://github.com/rnkn/fountain-mode/issues). + +;; - Emacs versions prior to 26 have a bug with `visual-line-mode` that produces erratic +;; navigation behavior when displaying very long lines. More information here: +;; <https://debbugs.gnu.org/23879> + +;; Roadmap +;; ------- + +;; See [Milestones](https://github.com/rnkn/fountain-mode/milestones). + +;; History +;; ------- + +;; See [Releases](https://github.com/rnkn/fountain-mode/releases). + +;; Tips +;; ---- + +;; Bitcoin Cash address 19gUvL8YUzDKr5GyiHpYeF31BfQm87xM9L + + +;;; Code: + +(defconst fountain-version + "2.4.2") + +(defun fountain-version () + "Return `fountain-mode' version." + (interactive) + (message "Fountain Mode %s" fountain-version)) + +(defgroup fountain () + "Major mode for screenwriting in Fountain markup." + :prefix "fountain-" + :group 'wp + :link '(url-link "https://github.com/rnkn/fountain-mode")) + + +;;; Obsolete Warnings + +(define-obsolete-variable-alias 'fountain-align-centered + 'fountain-align-center "1.1.0") + +(define-obsolete-variable-alias 'fountain-export-title-page-template + 'fountain-export-title-page-title-template "1.1.0") + +(define-obsolete-variable-alias 'fountain-hide-escapes + 'fountain-hide-syntax-chars "1.3.0") + +(make-obsolete-variable 'fountain-export-inline-style + "use inline style instead." "2.1.0") + +(define-obsolete-variable-alias 'fountain-export-style-template + 'fountain-export-html-stylesheet "2.4.0") + +(define-obsolete-function-alias 'fountain-toggle-hide-escapes + 'fountain-toggle-hide-syntax-chars "1.3.0") + +(define-obsolete-face-alias 'fountain-centered + 'fountain-center "1.1.0") + +(define-obsolete-face-alias 'fountain-scene-heading-highlight + 'fountain-scene-heading "1.2.0") + +(define-obsolete-face-alias 'fountain-note-highlight + 'fountain-note "1.2.0") + +(define-obsolete-face-alias 'fountain-section-highlight + 'fountain-section "1.2.0") + +(define-obsolete-face-alias 'fountain-synopsis-highlight + 'fountain-synopsis "1.2.0") + +(define-obsolete-face-alias 'fountain-center-highlight + 'fountain-center "1.2.0") + +(define-obsolete-face-alias 'fountain-character-highlight + 'fountain-character "1.2.0") + +(define-obsolete-face-alias 'fountain-paren-highlight + 'fountain-paren "1.2.0") + +(define-obsolete-face-alias 'fountain-dialog-highlight + 'fountain-dialog "1.2.0") + +(define-obsolete-face-alias 'fountain-trans-highlight + 'fountain-trans "1.2.0") + +(define-obsolete-face-alias 'fountain-section + 'fountain-section-heading "1.4.1") + +(make-obsolete-variable 'fountain-export-title-page-left-template + "edit individual export templates instead." "2.4.0") + +(make-obsolete-variable 'fountain-export-title-page-right-template + "edit individual export templates instead." "2.4.0") + +(make-obsolete 'fountain-export-buffer-to-pdf-via-html + 'fountain-export-buffer-to-tex "2.4.0") + +(make-obsolete-variable 'fountain-export-pdf-via-html-command + 'fountain-export-shell-command "2.0.0") + +(make-obsolete-variable 'fountain-uuid-func + "use a third-party package instead." "2.0.0") + +(make-obsolete-variable 'fountain-export-bold-scene-headings + 'fountain-export-scene-heading-format "2.0.0") + +(make-obsolete-variable 'fountain-export-underline-scene-headings + 'fountain-export-scene-heading-format "2.0.0") + +(make-obsolete-variable 'fountain-export-double-space-scene-headings + 'fountain-export-scene-heading-format "2.0.0") + +(make-obsolete-variable 'fountain-export-bold-title + "edit individual export templates instead." "2.4.0") + +(make-obsolete-variable 'fountain-export-underline-title + "edit individual export templates instead." "2.4.0") + +(make-obsolete-variable 'fountain-export-upcase-title + "edit individual export templates instead." "2.4.0") + +(make-obsolete-variable 'fountain-export-html-head-template + 'fountain-export-html-template "2.4.0") + +(make-obsolete-variable 'fountain-export-html-use-inline-style + "use inline style instead." "2.1.0") + +(make-obsolete-variable 'fountain-additional-template-replace-functions + "see `fountain-export-formats'." "2.4.0") + +(make-obsolete 'fountain-insert-metadata + 'auto-insert "2.1.2") + +(make-obsolete-variable 'fountain-metadata-template + 'fountain-metadata-skeleton "2.1.2") + +(make-obsolete-variable 'fountain-long-time-format + 'fountain-time-format "2.1.2") + +(define-obsolete-variable-alias 'fountain-short-time-format + 'fountain-time-format "2.1.2") + +(make-obsolete-variable 'fountain-export-templates + "use individual export templates instead." "2.1.4") + +(make-obsolete-variable 'fountain-export-format-replace-alist + "see `fountain-export-formats'." "2.4.0") + +(make-obsolete-variable 'fountain-export-title-format + "edit individual export templates instead." "2.4.0") + +(define-obsolete-variable-alias 'fountain-trans-list + 'fountain-trans-suffix-list "2.2.2") + +(make-obsolete-variable 'fountain-switch-comment-syntax + "use the standard comment syntax instead." "2.4.0") + +(define-obsolete-variable-alias 'fountain-export-standalone + 'fountain-export-make-standalone "2.4.0") + +(define-obsolete-variable-alias 'fountain-export-buffer-name + 'fountain-export-tmp-buffer-name "2.4.0") + + +;;; Customization + +(defcustom fountain-mode-hook + '(turn-on-visual-line-mode) + "Mode hook for `fountain-mode', run after the mode is turned on." + :type 'hook + :group 'fountain) + +(defcustom fountain-add-continued-dialog + t + "\\<fountain-mode-map>If non-nil, \\[fountain-continued-dialog-refresh] will mark continued dialogue. + +When non-nil, append `fountain-continued-dialog-string' to +successively speaking characters with `fountain-continued-dialog-refresh'. + +When nil, remove `fountain-continued-dialog-string' with +`fountain-continued-dialog-refresh'." + :type 'boolean + :group 'fountain) + +(defcustom fountain-continued-dialog-string + "(CONT'D)" + "String to append to character name speaking in succession. +If `fountain-add-continued-dialog' is non-nil, append this string +to character when speaking in succession. + +WARNING: if you change this variable then call +`fountain-continued-dialog-refresh', strings matching the +previous value will not be recognized. Before changing this +variable, first make sure to set `fountain-add-continued-dialog' +to nil and run `fountain-continued-dialog-refresh', then make the +changes desired." + :type 'string + :group 'fountain) + +(defcustom fountain-hide-emphasis-delim + nil + "If non-nil, make emphasis delimiters invisible." + :type 'boolean + :group 'fountain + :set (lambda (symbol value) + (set-default symbol value) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (eq major-mode 'fountain-mode) + (if fountain-hide-emphasis-delim + (add-to-invisibility-spec 'fountain-emphasis-delim) + (remove-from-invisibility-spec 'fountain-emphasis-delim)) + (font-lock-refresh-defaults)))))) + +(defcustom fountain-hide-syntax-chars + nil + "If non-nil, make syntax characters invisible." + :type 'boolean + :group 'fountain + :set (lambda (symbol value) + (set-default symbol value) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (eq major-mode 'fountain-mode) + (if fountain-hide-syntax-chars + (add-to-invisibility-spec 'fountain-syntax-chars) + (remove-from-invisibility-spec 'fountain-syntax-chars)) + (font-lock-refresh-defaults)))))) + +(defcustom fountain-time-format + "%F" + "Format of date and time used when inserting `{{time}}'. +See `format-time-string'." + :type 'string + :group 'fountain) + +(defcustom fountain-note-template + " {{time}} - {{fullname}}: " + "\\<fountain-mode-map>Template for inserting notes with \\[fountain-insert-note]. +To include an item in a template you must use the full {{KEY}} +syntax. + + {{title}} Buffer name without extension + {{time}} Short date format (defined in `fountain-time-format') + {{fullname}} User full name (defined in `user-full-name') + {{nick}} User first name (defined in `user-login-name') + {{email}} User email (defined in `user-mail-address') + +The default {{time}} - {{fullname}}: will insert something like: + + [[ 2017-12-31 - Alan Smithee: ]]" + :type 'string + :group 'fountain) +;; FIXME: +;; {{title}} from metadata +;; {{author}} from metadata +;; {{username}} `user-full-name' +;; {{KEY}} arbitrary metadata + + +;;; Aligning + +(defgroup fountain-align () + "Options for element alignment. + +For each Fountain element this group contains a variable that can +be an integer representing align column for that element for all +formats, or a list where each element takes the form: + + (FORMAT INT) + +Where FORMAT is a string and INT is the align column for that +format. + +To disable element alignment, see `fountain-align-element'." + :prefix "fountain-align-" + :group 'fountain) + +(defcustom fountain-align-elements + t + "If non-nil, elements will be displayed auto-aligned. +This option does not affect file contents." + :type 'boolean + :group 'fountain-align + :set (lambda (symbol value) + (set-default symbol value) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (eq major-mode 'fountain-mode) + (font-lock-refresh-defaults)))))) + +(defcustom fountain-align-section-heading + '(("screenplay" 0) + ("teleplay" 0) + ("stageplay" 30)) + "Column integer to which section headings should be aligned. + +This option does not affect file contents." + :type '(choice integer + (repeat (group (string :tag "Format") integer))) + :group 'fountain-align) + +(defcustom fountain-align-scene-heading + '(("screenplay" 0) + ("teleplay" 0) + ("stageplay" 30)) + "Column integer to which scene headings should be aligned. + +This option does not affect file contents." + :type '(choice integer + (repeat (group (string :tag "Format") integer))) + :group 'fountain-align) + +(defcustom fountain-align-synopsis + '(("screenplay" 0) + ("teleplay" 0) + ("stageplay" 30)) + "Column integer to which synopses should be aligned. + +This option does not affect file contents." + :type '(choice integer + (repeat (group (string :tag "Format") integer))) + :group 'fountain-align) + +(defcustom fountain-align-action + '(("screenplay" 0) + ("teleplay" 0) + ("stageplay" 20)) + "Column integer to which action should be aligned. + +This option does not affect file contents." + :type '(choice integer + (repeat (group (string :tag "Format") integer))) + :group 'fountain-align) + +(defcustom fountain-align-character + '(("screenplay" 20) + ("teleplay" 20) + ("stageplay" 30)) + "Column integer to which characters names should be aligned. + +This option does not affect file contents." + :type '(choice integer + (repeat (group (string :tag "Format") integer))) + :group 'fountain-align) + +(defcustom fountain-align-dialog + '(("screenplay" 10) + ("teleplay" 10) + ("stageplay" 0)) + "Column integer to which dialog should be aligned. + +This option does not affect file contents." + :type '(choice integer + (repeat (group (string :tag "Format") integer))) + :group 'fountain-align) + +(defcustom fountain-align-paren + '(("screenplay" 15) + ("teleplay" 15) + ("stageplay" 20)) + "Column integer to which parentheticals should be aligned. + +This option does not affect file contents." + :type '(choice integer + (repeat (group (string :tag "Format") integer))) + :group 'fountain-align) + +(defcustom fountain-align-trans + '(("screenplay" 45) + ("teleplay" 45) + ("stageplay" 30)) + "Column integer to which transitions should be aligned. + +This option does not affect file contents." + :type '(choice integer + (repeat (group (string :tag "Format") integer))) + :group 'fountain-align) + +(defcustom fountain-align-center + '(("screenplay" 20) + ("teleplay" 20) + ("stageplay" 20)) + "Column integer to which centered text should be aligned. + +This option does not affect file contents." + :type '(choice integer + (repeat (group (string :tag "Format") integer))) + :group 'fountain-align) + +(defcustom fountain-display-scene-numbers-in-margin + nil + "If non-nil, display scene numbers in the right margin. + +If nil, do not change scene number display. + +This option does affect file contents." + :type 'boolean + :group 'fountain-align + :set (lambda (symbol value) + (set-default symbol value) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (eq major-mode 'fountain-mode) + (font-lock-refresh-defaults)))))) + +(define-obsolete-variable-alias 'fountain-align-scene-number + 'fountain-display-scene-numbers-in-margin "2.3.0") + +(defun fountain-get-align (element) + "Return ELEMENT align integer based on buffer format." + (if (integerp element) element + (let ((format (or (plist-get (fountain-read-metadata) + 'format) + "screenplay"))) + (cadr (or (assoc format element) + (car element)))))) + + +;;; Autoinsert + +(require 'autoinsert) + +(defvar fountain-metadata-skeleton + '(nil + "title: " (skeleton-read "Title: " (file-name-base (buffer-name))) | -7 "\n" + "credit: " (skeleton-read "Credit: " "written by") | -9 "\n" + "author: " (skeleton-read "Author: " user-full-name) | -9 "\n" + "format: " (skeleton-read "Script format: " "screenplay") | -9 "\n" + "source: " (skeleton-read "Source: ") | -9 "\n" + "date: " (skeleton-read "Date: " (format-time-string fountain-time-format)) | -7 "\n" + "contact:\n" ("Contact details, %s: " " " str | -4 "\n") | -9)) + +(define-auto-insert '(fountain-mode . "Fountain metadata skeleton") + fountain-metadata-skeleton) + + +;;; Regular Expressions + +(defvar fountain-scene-heading-regexp + nil + "Regular expression for matching scene headings. +Set with `fountain-init-scene-heading-regexp'. + + Group 1: match trimmed whitespace + Group 2: match leading . (for forced element) + Group 3: match scene heading without scene number (export group) + Group 4: match space between heading and scene number + Group 5: match first # delimiter + Group 6: match scene number + Group 7: match last # delimiter + +Requires `fountain-match-scene-heading' for preceding blank line.") + +(defvar fountain-scene-number-regexp + "\\(?4:[\s\t]+\\)\\(?5:#\\)\\(?6:[a-z0-9\\.-]+\\)\\(?7:#\\)" + "Regular expression for matching scene numbers. + + Group 4: match space before scene number + Group 5: match first # delimiter + Group 6: match scene number + Group 7: match last # delimiter") + +(defvar fountain-trans-regexp + nil + "Regular expression for matching transitions. + + Group 1: match trimmed whitespace + Group 2: match forced transition mark + Group 3: match transition (export group) + +Set with `fountain-init-trans-regexp'. Requires +`fountain-match-trans' for preceding and succeeding blank lines.") + +(defconst fountain-blank-regexp + "^\s?$" + "Regular expression for matching an empty line.") + +(defconst fountain-action-regexp + "^\\(!\\)?\\(.*\\)[\s\t]*$" + "Regular expression for forced action. + + Group 1: match forced action mark + Group 2: match trimmed whitespace (export group)") + +(defconst fountain-comment-regexp + (concat "\\(?://[\s\t]*\\(?:.*\\)\\)" + "\\|" + "\\(?:\\(?:/\\*\\)[\s\t]*\\(?:\\(?:.\\|\n\\)*?\\)[\s\t]*\\*/\\)") + "Regular expression for matching comments.") + +(defconst fountain-metadata-regexp + (concat "^\\(?1:\\(?2:[^:\n]+\\):[\s\t]*\\(?3:.+\\)?\\)" + "\\|" + "^[\s\t]+\\(?1:\\(?3:.+\\)\\)") + "Regular expression for matching multi-line metadata values. +Requires `fountain-match-metadata' for `bobp'.") + +(defconst fountain-character-regexp + (concat "^[\s\t]*\\(?1:\\(?:" + "\\(?2:@\\)\\(?3:\\(?4:[^<>\n]+?\\)\\(?:[\s\t]*(.*?)\\)*?\\)" + "\\|" + "\\(?3:\\(?4:[^a-z<>\n]*?[A-Z][^a-z<>\n]*?\\)\\(?:[\s\t]*(.*?)\\)*?\\)" + "\\)[\s\t]*\\(?5:\\^\\)?\\)[\s\t]*$") + "Regular expression for matching character names. + + Group 1: match trimmed whitespace + Group 2: match leading @ (for forced element) + Group 3: match character name and parenthetical (export group) + Group 4: match character name only + Group 5: match trailing ^ (for dual dialog) + +Requires `fountain-match-character' for preceding blank line.") + +(defconst fountain-dialog-regexp + (concat "^\\(\s\s\\)$" + "\\|" + "^[\s\t]*\\(?1:[^<>\n]+?\\)[\s\t]*$") + "Regular expression for matching dialogue. + + Group 1: match trimmed whitespace + +Requires `fountain-match-dialog' for preceding character, +parenthetical or dialogue.") + +(defconst fountain-paren-regexp + (concat "^[\s\t]*\\(([^)\n]*)\\)[\s\t]*$") + "Regular expression for matching parentheticals. + + Group 1: match trimmed whitespace (export group) + +Requires `fountain-match-paren' for preceding character or +dialogue.") + +(defconst fountain-page-break-regexp + "^[\s\t]*\\(=\\{3,\\}\\)[\s\t]*\\([a-z0-9\\.-]+\\)?.*$" + "Regular expression for matching page breaks. + + Group 1: leading === + Group 2: forced page number (export group)") + +(defconst fountain-end-regexp + "^[\s\t]*\\(=\\{3,\\}\\)[\s\t]*\\(end\\)\\>.*$" + "Regular expression for matching script end break. + + Group 1: leading === + Group 2: end") + +(defconst fountain-note-regexp + "\\(\\[\\[[\s\t]*\\(\\(?:.\n?\\)*?\\)[\s\t]*]]\\)" + "Regular expression for matching notes. + + Group 1: note including [[ ]] delimiters + Group 2: note (export group)") + +(defconst fountain-section-heading-regexp + "^\\(?1:\\(?2:#\\{1,5\\}\\)[\s\t]*\\(?3:[^#\n].*?\\)\\)[\s\t]*$" + "Regular expression for matching section headings. + + Group 1: match trimmed whitespace + Group 2: match leading #'s + Group 3: match heading (export group)") + +(defconst fountain-synopsis-regexp + "^\\(\\(=[\s\t]*\\)\\([^=\n].+?\\)\\)[\s\t]*$" + "Regular expression for matching synopses. + + Group 1: match trimmed whitespace + Group 2: leading = + Group 3: synopsis (export group)") + +(defconst fountain-center-regexp + "^[\s\t]*\\(?1:\\(?2:>[\s\t]*\\)\\(?3:.*?\\)\\(?4:[\s\t]*<\\)\\)[\s\t]*$" + "Regular expression for matching centered text. + + Group 1: match trimmed whitespace + Group 2: match leading > and whitespace + Group 3: match center text (export group) + Group 4: match trailing whitespace and <") + +(defconst fountain-underline-regexp + (concat "\\(^\\|[^\\]\\)" + "\\(_\\)" + "\\([^\s\t\n_]+?[^\n_]*?\\)" + "\\(\\2\\)") + "Regular expression for matching underlined text.") + +(defconst fountain-italic-regexp + (concat "\\(^\\|[^\\\\*]\\)" + "\\(\\*\\)" + "\\([^\n\r\s\t\\*]+?[^\n\\*]*?\\)" + "\\(\\2\\)") + "Regular expression for matching italic text.") + +(defconst fountain-bold-regexp + (concat "\\(^\\|[^\\]\\)" + "\\(\\*\\{2\\}\\)" + "\\([^\s\t\n\\*]+?[^\n\\*]*?\\)" + "\\(\\2\\)") + "Regular expression for matching bold text.") + +(defconst fountain-bold-italic-regexp + (concat "\\(^\\|[^\\\\*]\\)" + "\\(\\*\\{3\\}\\)" + "\\([^\s\t\n\\*]+?[^\n\\*]*?\\)" + "\\(\\2\\)") + "Regular expression for matching bold-italic text. +Due to the problematic nature of the syntax, +bold-italic-underlined text must be specified with the +bold-italic delimiters together, e.g. + + This text is _***ridiculously important***_.") + +(defconst fountain-lyrics-regexp + (concat "^\\(?2:~\s*\\)" + "\\(?3:.+\\)") + "Regular expression for matching lyrics.") + +(defconst fountain-template-key-regexp + "{{\\([^{}\n]+?\\)}}" + "Regular expression key for making template replacements.") + + +;;; Faces + +(defgroup fountain-faces () + "Faces used in `fountain-mode'. +There are three levels of `font-lock-mode' decoration: + + 1 (minimum): + Comments + Syntax Characters + + 2 (default): + Comments + Syntax Characters + Metadata + Scene Headings + Section Headings + Synopses + Notes + + 3 (maximum): + Comments + Syntax Characters + Metadata Keys + Metadata Values + Section Headings + Scene Headings + Synopses + Notes + Character Names + Parentheticals + Dialog + Transitions + Center Text + +To switch between these levels, customize the value of +`font-lock-maximum-decoration'. This can be set with +\\[fountain-set-font-lock-decoration]." + :prefix "fountain-" + :link '(info-link "(emacs) Font Lock") + :group 'fountain) + +(defface fountain-action + '((t nil)) + "Default face for action." + :group 'fountain-faces) + +(defface fountain-comment + '((t (:inherit shadow))) + "Default face for comments (boneyard)." + :group 'fountain-faces) + +(defface fountain-non-printing + '((t (:inherit fountain-comment))) + "Default face for emphasis delimiters and syntax characters." + :group 'fountain-faces) + +(defface fountain-metadata-key + '((t (:inherit font-lock-constant-face))) + "Default face for metadata keys." + :group 'fountain-faces) + +(defface fountain-metadata-value + '((t (:inherit font-lock-keyword-face))) + "Default face for metadata values." + :group 'fountain-faces) + +(defface fountain-page-break + '((t (:inherit font-lock-constant-face))) + "Default face for page breaks." + :group 'fountain-faces) + +(defface fountain-page-number + '((t (:inherit font-lock-warning-face))) + "Default face for page numbers." + :group 'fountain-faces) + +(defface fountain-scene-heading + '((t (:inherit font-lock-function-name-face))) + "Default face for scene headings." + :group 'fountain-faces) + +(defface fountain-paren + '((t (:inherit font-lock-builtin-face))) + "Default face for parentheticals." + :group 'fountain-faces) + +(defface fountain-center + '((t nil)) + "Default face for centered text." + :group 'fountain-faces) + +(defface fountain-note + '((t (:inherit font-lock-comment-face))) + "Default face for notes." + :group 'fountain-faces) + +(defface fountain-section-heading + '((t (:inherit font-lock-keyword-face))) + "Default face for section headings." + :group 'fountain-faces) + +(defface fountain-synopsis + '((t (:inherit font-lock-type-face))) + "Default face for synopses." + :group 'fountain-faces) + +(defface fountain-character + '((t (:inherit font-lock-variable-name-face))) + "Default face for characters." + :group 'fountain-faces) + +(defface fountain-dialog + '((t (:inherit font-lock-string-face))) + "Default face for dialog." + :group 'fountain-faces) + +(defface fountain-trans + '((t (:inherit font-lock-builtin-face))) + "Default face for transitions." + :group 'fountain-faces) + +(defface fountain-include + '((t (:inherit font-lock-warning-face))) + "Default face for file inclusions." + :group 'fountain-faces) + +(defface fountain-auto-upcase-highlight + '((t (:inherit hi-yellow))) + "Default face for highlighting line for auto-upcasing." + :group 'fountain-faces) + + +;;; Initializing + +(defun fountain-init-scene-heading-regexp () + "Initialize scene heading regular expression. +Uses `fountain-scene-heading-prefix-list' to create non-forced +scene heading regular expression." + (setq fountain-scene-heading-regexp + (concat + ;; First match forced scene heading. + "^\\(?1:\\(?2:\\.\\)\\(?3:\\<.*?\\)" + "\\(?:" fountain-scene-number-regexp "\\)?" + "\\)[\s\t]*$" + ;; Or match omitted scene. + "\\|" + "^\\(?1:\\(?3:OMIT\\(?:TED\\)?\\)" + "\\(?:" fountain-scene-number-regexp "\\)?" + "\\)[\s\t]*$" + ;; Or match regular scene heading. + "\\|" + "^\\(?1:\\(?3:" + (regexp-opt fountain-scene-heading-prefix-list) + "[.\s\t].*?\\)" + "\\(?:" fountain-scene-number-regexp "\\)?" + "\\)[\s\t]*$"))) + +(defun fountain-init-trans-regexp () + "Initialize transition regular expression. +Uses `fountain-trans-suffix-list' to create non-forced tranistion +regular expression." + (setq fountain-trans-regexp + (concat + ;; First match forced transition. + "^[\s\t]*\\(?1:\\(?2:>[\s\t]*\\)\\(?3:[^<>\n]*?\\)\\)[\s\t]*$" + ;; Or match regular transition. + "\\|" + "^[\s\t]*\\(?1:\\(?3:[[:upper:]\s\t]*" + (upcase (regexp-opt fountain-trans-suffix-list)) + "\\)\\)[\s\t]*$"))) + +(defun fountain-init-outline-regexp () + "Initialize `outline-regexp'." + (setq-local outline-regexp + (concat fountain-end-regexp + "\\|" + fountain-section-heading-regexp + "\\|" + fountain-scene-heading-regexp))) + +(defun fountain-init-imenu-generic-expression () ; FIXME: allow user customize + "Initialize `imenu-generic-expression'." + (setq imenu-generic-expression + (list + (list "Notes" fountain-note-regexp 2) + (list "Scene Headings" fountain-scene-heading-regexp 3) + (list "Sections" fountain-section-heading-regexp 1)))) + +(defun fountain-init-vars () + "Initialize important variables. +Needs to be called for every Fountain buffer because some +variatbles are required for functions to operate with temporary +buffers." + (fountain-init-scene-heading-regexp) + (fountain-init-trans-regexp) + (fountain-init-outline-regexp) + (fountain-init-imenu-generic-expression) + (modify-syntax-entry (string-to-char "/") ". 14" nil) + (modify-syntax-entry (string-to-char "*") ". 23" nil) + (setq-local comment-start "/*") + (setq-local comment-end "*/") + (setq-local comment-use-syntax t) + (setq-local font-lock-comment-face 'fountain-comment) + (setq-local page-delimiter fountain-page-break-regexp) + (setq-local outline-level #'fountain-outline-level) + (setq-local require-final-newline mode-require-final-newline) + (setq-local font-lock-extra-managed-props + '(line-prefix wrap-prefix invisible)) + (setq font-lock-multiline 'undecided) + (setq font-lock-defaults + '(fountain-create-font-lock-keywords nil t)) + (add-to-invisibility-spec (cons 'outline t)) + (if fountain-hide-emphasis-delim + (add-to-invisibility-spec 'fountain-emphasis-delim)) + (if fountain-hide-syntax-chars + (add-to-invisibility-spec 'fountain-syntax-chars))) + +(defcustom fountain-scene-heading-prefix-list + '("INT" "EXT" "INT/EXT" "I/E") + "List of scene heading prefixes (case insensitive). +Any scene heading prefix can be followed by a dot and/or a space, +so the following are equivalent: + + INT HOUSE - DAY + + INT. HOUSE - DAY" + :type '(repeat (string :tag "Prefix")) + :group 'fountain + :set (lambda (symbol value) + (set-default symbol value) + (fountain-init-scene-heading-regexp) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (eq major-mode 'fountain-mode) + (fountain-init-outline-regexp) + (font-lock-refresh-defaults)))))) + +(defcustom fountain-trans-suffix-list + '("TO:" "WITH:" "FADE OUT" "TO BLACK") + "List of transition suffixes (case insensitive). +This list is used to match the endings of transitions, +e.g. `TO:' will match both the following: + + CUT TO: + + DISSOLVE TO:" + :type '(repeat (string :tag "Suffix")) + :group 'fountain + :set (lambda (symbol value) + (set-default symbol value) + (fountain-init-trans-regexp) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (eq major-mode 'fountain-mode) + (font-lock-refresh-defaults)))))) + + +;;; Emacs Bugs + +(defcustom fountain-patch-emacs-bugs + t + "If non-nil, attempt to patch known bugs in Emacs. +See function `fountain-patch-emacs-bugs'." + :type 'boolean + :group 'fountain) + +(defun fountain-patch-emacs-bugs () + "Attempt to patch known bugs in Emacs. + +In Emacs versions prior to 26, adds advice to override +`outline-invisible-p' to return non-nil only if the character +after POS or point has invisible text property eq to 'outline. +See <http://debbugs.gnu.org/24073>." + ;; In Emacs version prior to 26, `outline-invisible-p' returns non-nil for ANY + ;; invisible property of text at point: + ;; + ;; (get-char-property (or pos (point)) 'invisible)) + ;; + ;; We want to only return non-nil if property is 'outline + (unless (or (advice-member-p 'fountain-outline-invisible-p 'outline-invisible-p) + (<= 26 emacs-major-version)) + (advice-add 'outline-invisible-p :override 'fountain-outline-invisible-p) + ;; Because `outline-invisible-p' is an inline function, we need to + ;; reevaluate those functions that called the original bugged version. + ;; This is impossible for users who have installed Emacs without + ;; uncompiled source, so we need to demote errors. + (with-demoted-errors "Error: %S" + (dolist (fun '(outline-back-to-heading + outline-on-heading-p + outline-next-visible-heading)) + (let ((source (find-function-noselect fun))) + (with-current-buffer (car source) + (goto-char (cdr source)) + (eval (read (current-buffer)))))) + (message "fountain-mode: Function `outline-invisible-p' has been patched")))) + + +;;; Element Matching + +(defun fountain-blank-before-p () + "Return non-nil if preceding line is blank or a comment." + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (or (bobp) + (progn (forward-line -1) + (or (and (bolp) (eolp)) + (progn (end-of-line 1) + (forward-comment -1)))))))) + +(defun fountain-blank-after-p () + "Return non-nil if following line is blank or a comment." + (save-excursion + (save-restriction + (widen) + (forward-line 1) + (or (eobp) + (and (bolp) (eolp)) + (forward-comment 1))))) + +(defun fountain-match-metadata () + "Match metadata if point is at metadata, nil otherwise." + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (and (looking-at fountain-metadata-regexp) + (or (bobp) + (save-match-data + (forward-line -1) + (fountain-match-metadata))))))) + +(defun fountain-match-page-break () + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (looking-at fountain-page-break-regexp)))) + +(defun fountain-match-section-heading () + "Match section heading if point is at section heading, nil otherwise." + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (looking-at fountain-section-heading-regexp)))) + +(defun fountain-match-synopsis () + "Match synopsis if point is at synopsis, nil otherwise." + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (looking-at fountain-synopsis-regexp)))) + +(defun fountain-match-note () + "Match note if point is at a note, nil otherwise." + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (or (looking-at fountain-note-regexp) + (let ((x (point))) + (and (re-search-backward "\\[\\[" nil t) + (looking-at fountain-note-regexp) + (< x (match-end 0)))))))) + +(defun fountain-match-scene-heading () + "Match scene heading if point is at a scene heading, nil otherwise." + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (and (looking-at fountain-scene-heading-regexp) + (fountain-blank-before-p))))) + +(defun fountain-match-character () + "Match character if point is at character, nil otherwise." + (unless (fountain-match-scene-heading) + (save-excursion + (forward-line 0) + (and (not (and (looking-at fountain-action-regexp) + (match-string 1))) + (let ((case-fold-search nil)) + (looking-at fountain-character-regexp)) + (save-match-data + (save-restriction + (widen) + (and (fountain-blank-before-p) + (save-excursion + (forward-line 1) + (unless (eobp) + (not (and (bolp) (eolp)))))))))))) + +(defun fountain-match-dialog () + "Match dialog if point is at dialog, nil otherwise." + (unless (or (and (bolp) (eolp)) + (save-excursion (and (forward-comment 1) (eolp))) + (fountain-match-paren) + (fountain-match-note)) + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (and (looking-at fountain-dialog-regexp) + (save-match-data + (unless (bobp) + (forward-line -1) + (or (fountain-match-character) + (fountain-match-paren) + (fountain-match-dialog))))))))) + +(defun fountain-match-paren () + "Match parenthetical if point is at a paranthetical, nil otherwise." + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (and (looking-at fountain-paren-regexp) + (save-match-data + (unless (bobp) + (forward-line -1) + (or (fountain-match-character) + (fountain-match-dialog)))))))) + +(defun fountain-match-trans () + "Match transition if point is at a transition, nil otherwise." + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (and (let (case-fold-search) + (looking-at fountain-trans-regexp)) + (fountain-blank-before-p) + (save-match-data + (fountain-blank-after-p)))))) + +(defun fountain-match-center () + "Match centered text if point is at centered text, nil otherwise." + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (looking-at fountain-center-regexp)))) + +(defun fountain-match-action () + "Match action text if point is at action, nil otherwise. +Assumes that all other element matching has been done." + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (or (and (looking-at fountain-action-regexp) + (match-string 1)) + (and (not (or (and (bolp) (eolp)) + (fountain-match-section-heading) + (fountain-match-scene-heading) + (fountain-match-include) + (fountain-match-page-break) + (fountain-match-character) + (fountain-match-dialog) + (fountain-match-paren) + (fountain-match-trans) + (fountain-match-center) + (fountain-match-synopsis) + (fountain-match-metadata) + (fountain-match-note))) + (looking-at fountain-action-regexp)))))) + +(defun fountain-get-element () + "Return element at point as a symbol." + (cond + ((and (bolp) (eolp)) nil) + ((fountain-match-metadata) 'metadata) + ((fountain-match-section-heading) 'section-heading) + ((fountain-match-scene-heading) 'scene-heading) + ((fountain-match-character) 'character) + ((fountain-match-dialog) 'lines) + ((fountain-match-paren) 'paren) + ((fountain-match-trans) 'trans) + ((fountain-match-center) 'center) + ((fountain-match-synopsis) 'synopsis) + ((fountain-match-note) 'note) + ((fountain-match-page-break) 'page-break) + (t (looking-at fountain-action-regexp) 'action))) + + +;;; Pages + +(defgroup fountain-pages () + "Options for calculating page length." + :group 'fountain + :prefix "fountain-pages-") + +(defcustom fountain-pages-max-lines + '((letter . 55) (a4 . 60)) + "Integer representing maximum number of lines on a page. + +WARNING: if you change this option after locking pages in a +script, you may get incorrect output." + :type '(choice integer + (list (cons (const :tag "US Letter" letter) integer) + (cons (const :tag "A4" a4) integer))) + :group 'fountain-pages) + +;; FIXME: timer can be used for things other than page count, e.g. automatically +;; adding continued dialogue string. +(defvar fountain-page-count-timer + nil) + +(defvar-local fountain-page-count-string + nil) + +(defcustom fountain-pages-count-delay + 2.0 + "Idle time in seconds before calculating page count." + :type 'float + :group 'fountain-pages) + +(defun fountain-goto-page-break-point () + "Move point to appropriate place to break a page. +This is usually before point, but may be after if only skipping +over whitespace." + (skip-chars-forward "\n\r\s\t") + (let ((element (fountain-get-element))) + (cond + ;; If we're are a section heading, scene heading or character, we can + ;; safely break before. + ((memq element '(section-heading scene-heading character)) + (forward-line 0)) + ;; If we're at a parenthetical, check if the previous line is a character. + ;; and if so call recursively on that element. + ((eq element 'paren) + (forward-line 0) + (let ((x (point))) + (forward-char -1) + (if (fountain-match-character) + (progn + (forward-line 0) + (fountain-goto-page-break-point)) + ;; Otherwise parenthetical is mid-dialogue, so get character name + ;; and break at this element. + (goto-char x)))) + ;; If we're at dialogue, skip over spaces then go to the beginning of the + ;; current sentence. + ((eq element 'lines) + (skip-chars-forward "\s\t") + (if (not (looking-back (sentence-end) + (save-excursion + (fountain-forward-character -1) + (point)))) + (forward-sentence -1) + ;; This may move to character element, or back within dialogue. If + ;; previous line is a character or parenthetical, call recursively on + ;; that element. Otherwise, get character name and break page here. + (let ((x (point))) + (forward-char -1) + (if (or (fountain-match-character) + (fountain-match-paren)) + (fountain-goto-page-break-point) + (goto-char x))))) + ;; If we're at a transition or center text, skip backwards to previous + ;; element and call recursively on that element. + ((memq element '(trans center)) + (skip-chars-backward "\n\r\s\t") + (forward-line 0) + (fountain-goto-page-break-point)) + ;; If we're at action, skip over spaces then go to the beginning of the + ;; current sentence. + ((eq element 'action) + (skip-chars-forward "\s\t") + (unless (or (bolp) + (looking-back (sentence-end) nil)) + (forward-sentence -1)) + ;; Then, try to skip back to the previous element. If it is a scene + ;; heading, call recursively on that element. Otherwise, break page here. + (let ((x (point))) + (skip-chars-backward "\n\r\s\t") + (forward-line 0) + (if (fountain-match-scene-heading) + (fountain-goto-page-break-point) + (goto-char x))))))) + +(defun fountain-forward-page (&optional n export-elements) + "Move point forward by an approximate page. + +Moves forward from point, which is unlikely to correspond to +final exported pages and so probably should not be used +interactively. + +To considerably speed up this function, supply EXPORT-ELEMENTS +with `fountain-get-export-elements'." + (unless n (setq n 1)) + (while (< 0 n) + ;; Pages don't begin with blank space, so skip over any at point. + (skip-chars-forward "\n\r\s\t") + (forward-line 0) + ;; If we're at a page break, move to its end and skip over whitespace. + (when (fountain-match-page-break) + (goto-char (match-end 0)) + (skip-chars-forward "\n\r\s\t") + (forward-line 0)) + ;; Start counting lines. + (let ((line-count 0)) + ;; Begin the main loop, which only halts if we reach the end of buffer, a + ;; forced page break, or after the maximum lines in a page. + (while (and (< line-count (cdr (assq fountain-export-page-size + fountain-pages-max-lines))) + (not (or (eobp) + (fountain-match-page-break)))) + (cond + ;; If we're at the end of a line (but not also the beginning, i.e. not a + ;; blank line) then move forward a line and increment line-count. + ((and (eolp) (not (bolp))) + (forward-line 1) + (setq line-count (1+ line-count))) + ;; If we're looking at newline, skip over it and any whitespace and + ;; increment line-count. + ((looking-at "\n*\s*\t*\n") ; FIXME: \r ? + (goto-char (match-end 0)) + (setq line-count (1+ line-count))) + ;; We are at an element. Find what kind of element. If it is not included + ;; in export, skip over without incrementing line-count (implement with + ;; block bounds). Get the line width. + (t + (let ((element (fountain-get-element))) + (if (memq element (or export-elements + (fountain-get-export-elements))) + (progn + (fountain-move-to-fill-width element) + (setq line-count (1+ line-count))) + ;; Element is not exported, so skip it without incrementing + ;; line-count. + (end-of-line) + (skip-chars-forward "\n\r\s\t") + (goto-char (line-beginning-position)))))))) + (skip-chars-forward "\n\r\s\t") + (fountain-goto-page-break-point) + (setq n (1- n)))) + +(defun fountain-move-to-fill-width (element) + "Move point to column of ELEMENT fill limit suitable for breaking line. +Skip over comments." + (let ((fill-width + (cdr (symbol-value + (plist-get (cdr (assq element fountain-elements)) + :fill))))) + (let ((i 0)) + (while (and (< i fill-width) (not (eolp))) + (cond ((= (syntax-class (syntax-after (point))) 0) + (forward-char 1) + (setq i (1+ i))) + ((forward-comment 1)) + (t + (forward-char 1) + (setq i (1+ i)))))) + (skip-chars-forward "\s\t") + (if (eolp) (forward-line 1)) + (fill-move-to-break-point (line-beginning-position)))) + +(defun fountain-insert-page-break (&optional string) + "Insert a page break at appropriate place preceding point. +STRING is an optional page number string to force the page +number." + (interactive "sPage number (RET for none): ") + ;; Save a marker where we are. + (let ((x (point-marker)) + (page-break + (concat "===" (if (< 0 (string-width string)) + (concat "\s" string "\s===")))) + element) + ;; Move point to appropriate place to break page. + (fountain-goto-page-break-point) + (setq element (fountain-get-element)) + ;; At this point, element can only be: section-heading, scene-heading, + ;; character, action, paren or lines. Only paren and lines require special + ;; treatment. + (if (memq element '(lines paren)) + (let ((name (fountain-get-character -1))) + (insert (concat + fountain-export-more-dialog-string "\n\n" + page-break "\n\n" + name "\s" fountain-continued-dialog-string "\n"))) + ;; Otherwise, insert the page break where we are. If the preceding element + ;; is a page break, only replace the page number, otherwise, insert the + ;; page break. + (if (save-excursion + (save-restriction + (widen) + (skip-chars-backward "\n\r\s\t") + (fountain-match-page-break))) + (replace-match page-break t t) + (delete-horizontal-space) + (unless (bolp) (insert "\n\n")) + (insert-before-markers page-break "\n\n"))) + ;; Return to where we were. + (goto-char x))) + +(defun fountain-get-page-count () + (let ((x (point)) + (total 0) + (current 0) + (end (point-max)) + (export-elements (fountain-get-export-elements)) + found) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (if (re-search-forward fountain-end-regexp nil t) + (setq end (match-beginning 0))) + (goto-char (point-min)) + (while (< (point) end) + (fountain-forward-page 1 export-elements) + (setq total (1+ total)) + (if (and (not found) (<= x (point))) (setq current total found t))) + (cons current total))))) + +(defun fountain-count-pages () + "Return the approximate current page of total pages in current buffer. + +If called interactively, print message in echo area. + +If point is beyond script end break, current page number is +returned as 0." + (interactive) + (fountain-pages-update-mode-line) + (redisplay) + (let ((pages (fountain-get-page-count))) + (fountain-pages-update-mode-line (car pages) (cdr pages)) + (if (called-interactively-p) + (message "Page %d of %d" (car pages) (cdr pages))))) + +(defun fountain-pages-update-mode-line (&optional current total) + (setq fountain-page-count-string + (if fountain-pages-show-in-mode-line + (if (and current total) + (format "[%d/%d] " current total) + "[-/-] ") + nil)) + (force-mode-line-update)) + +(defun fountain-count-pages-maybe (&optional force) + (while-no-input + (redisplay) + (if (eq major-mode 'fountain-mode) + (cond (force + (fountain-count-pages)) + ((eq fountain-pages-show-in-mode-line 'timer) + (fountain-count-pages)) + ((and fountain-page-count-string + (not fountain-pages-show-in-mode-line)) + (fountain-pages-update-mode-line)))))) + +(defun fountain-init-mode-line () + (let ((tail (cdr (memq 'mode-line-modes mode-line-format)))) + (setq mode-line-format + (append + (butlast mode-line-format (length tail)) + (cons 'fountain-page-count-string tail))))) + +(defun fountain-cancel-page-count-timer () + (if (timerp fountain-page-count-timer) + (cancel-timer fountain-page-count-timer)) + (setq fountain-page-count-timer nil)) + +(defun fountain-restart-page-count-timer () + (fountain-cancel-page-count-timer) + (setq fountain-page-count-timer + (run-with-idle-timer fountain-pages-count-delay t + #'fountain-count-pages-maybe))) + +(defcustom fountain-pages-show-in-mode-line + nil + "If non-nil show current page of total pages in mode-line." + :type '(choice (const :tag "No page count" nil) + (const :tag "Show with manual update" force) + (const :tag "Show with automatic update" timer)) + :group 'fountain-pages + :set (lambda (symbol value) + (set-default symbol value) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (fountain-count-pages-maybe value))))) + + +;;; Inclusions + +(defvar fountain-include-regexp + "^[\s\t]*{{[\s\t]*\\(?1:[^:\n]+:\\)?[\s\t]*\\(?2:.+?\\)[\s\t]*}}[\s\t]*") + +(defun fountain-match-include () + "Match inclusion if point is at inclusion, nil otherwise." + (save-excursion + (save-restriction + (widen) + (forward-line 0) + (looking-at fountain-include-regexp)))) + +(defun fountain-include-find-file (&optional no-select) + "Find included file at point. + +Optional argument NO-SELECT will find file without selecting +window." + (interactive) + (if (and (fountain-match-include) + (save-match-data + (string-match "include:" (match-string 1)))) + (let ((filename (expand-file-name (match-string 2)))) + (if no-select + (find-file-noselect filename) + (find-file filename))))) + +(defun fountain-include-in-region (start end &optional delete) + "Replace inclusions between START and END with their file contents. + +If optional argument DELETE is non-nil (if prefix with \\[universal-argument] +when called interactively), delete instead." + (interactive "*r\nP") + (save-excursion + (save-restriction + (widen) + (goto-char end) + (setq end (point-marker)) + (goto-char start) + (while (< (point) (min end (point-max))) + (when (fountain-match-include) + (if delete + (delete-region (match-beginning 0) (match-end 0)) + (replace-match + (save-match-data + (with-current-buffer (fountain-include-find-file) + (save-restriction + (widen) + (buffer-substring-no-properties (point-min) (point-max))))) + t t))) + (forward-line 1))))) + + +;;; Parsing + +(require 'subr-x) + +(defun fountain-get-character (&optional n limit) + "Return Nth next character (or Nth previous if N is negative). + +If N is non-nil, return Nth next character or Nth previous +character if N is negative, otherwise return nil. If N is nil or +0, return character at point, otherwise return nil. + +If LIMIT is 'scene, halt at next scene heading. If LIMIT is +'dialog, halt at next non-dialog element." + (let ((n (or n 0))) + (save-excursion + (save-restriction + (widen) + (fountain-forward-character n limit) + (if (fountain-match-character) + (match-string-no-properties 4)))))) + +(defun fountain-read-metadata () + "Read metadata of current buffer and return as a property list. + +Key string is slugified using `fountain-slugify', and interned. +Value string remains a string. e.g. + + Draft date: 2015-12-25 -> (draft-date \"2015-12-25\")" + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let (list) + (while (fountain-match-metadata) + (let ((key (match-string 2)) + (value (match-string-no-properties 3))) + (forward-line 1) + (while (and (fountain-match-metadata) + (null (match-string 2))) + (setq value + (concat value (if value "\n") + (match-string-no-properties 3))) + (forward-line 1)) + (setq list + (append list (list (intern (fountain-slugify key)) + value))))) + list)))) + +(defun fountain-dual-dialog (&optional pos) + "Non-nil if point or POS is within dual dialogue. +Returns \"right\" if within right-side dual dialogue, \"left\" if +within left-side dual dialogue, and nil otherwise." + (save-excursion + (save-match-data + (save-restriction + (widen) + (if pos (goto-char pos)) + (cond ((progn (fountain-forward-character 0 'dialog) + (and (fountain-match-character) + (stringp (match-string 5)))) + 'right) + ((progn (fountain-forward-character 1 'dialog) + (and (fountain-match-character) + (stringp (match-string 5)))) + 'left)))))) + +(defun fountain-starts-new-page (&optional limit) ; FIXME: implement LIMIT + (save-excursion + (save-match-data + (save-restriction + (widen) + (forward-line 0) + (skip-chars-backward "\n\r\s\t") + (fountain-match-page-break))))) + +(defun fountain-parse-section (match-data &optional export-elements job) + "Return an element list for matched section heading." + (set-match-data match-data) + (let* ((beg (match-beginning 0)) + (starts-new-page (fountain-starts-new-page)) + (section-heading + (list 'section-heading + (list 'begin (match-beginning 0) + 'end (match-end 0) + 'level (save-excursion + (goto-char (match-beginning 0)) + (funcall outline-level)) + 'export (if (memq 'section-heading export-elements) t)) + (match-string-no-properties 3))) + (end (save-excursion (outline-end-of-subtree) (point))) + content) + (goto-char (plist-get (nth 1 section-heading) 'end)) + (setq content + (fountain-parse-region (point) end export-elements job)) + (list 'section + (list 'begin beg + 'end end + 'starts-new-page starts-new-page + 'export t) + (cons section-heading content)))) + +(defun fountain-parse-scene (match-data &optional export-elements job) + "Return an element list for matched scene heading at point. +Includes child elements." + (set-match-data match-data) + (let* ((beg (match-beginning 0)) + (starts-new-page (fountain-starts-new-page)) + (scene-number + (save-excursion + (save-match-data + (goto-char (match-beginning 0)) + (fountain-scene-number-to-string + (fountain-get-scene-number 0))))) + (scene-heading + (list 'scene-heading + (list 'begin (match-beginning 0) + 'end (match-end 0) + 'scene-number scene-number + 'forced (stringp (match-string 2)) + 'export (if (memq 'scene-heading export-elements) t) + 'starts-new-page starts-new-page) + (match-string-no-properties 3))) + (end (save-excursion (outline-end-of-subtree) (point))) + content) + (goto-char (plist-get (nth 1 scene-heading) 'end)) + (setq content + (fountain-parse-region (point) end export-elements job)) + (list 'scene + (list 'begin beg + 'end end + 'scene-number scene-number + 'starts-new-page starts-new-page + 'export t) + (cons scene-heading content)))) + +(defun fountain-parse-dialog (match-data &optional export-elements job) + (set-match-data match-data) + (let* ((beg (match-beginning 0)) + (starts-new-page (fountain-starts-new-page)) + (dual (fountain-dual-dialog)) + (character + (list 'character + (list 'begin (match-beginning 0) + 'end (match-end 0) + 'forced (stringp (match-string 2)) + 'export (if (memq 'character export-elements) t) + 'starts-new-page (unless (eq dual 'left) starts-new-page)) + (match-string-no-properties 3))) + (end + (save-excursion + (fountain-forward-character 1 'dialog) + (skip-chars-backward "\n\r\s\t") + (point))) + first-dialog) + (goto-char (plist-get (nth 1 character) 'end)) + ;; Parse the first dialogue tree, which may be the only dialogue tree. + (setq first-dialog + (list 'dialog + (list 'begin beg + 'end end + 'dual dual + 'export (if (or (memq 'character export-elements) + (memq 'lines export-elements) + (memq 'paren export-elements)) + t)) + (cons character + (fountain-parse-region (point) end export-elements job)))) + ;; If at the first (left) character of dual dialogue, parse a dual-dialogue + ;; tree, containing dialogue trees. + (if (eq dual 'left) + ;; Find the end of the dual-dialogue. + (let ((end + (save-excursion + (while (fountain-dual-dialog) + (fountain-forward-character 1 'dialog)) + (skip-chars-backward "\n\r\s\t") + (point)))) + ;; Return the dual-dialogue tree. + (list 'dual-dialog + (list 'begin beg + 'end end + 'starts-new-page starts-new-page + 'export (if (or (memq 'character export-elements) + (memq 'lines export-elements) + (memq 'paren export-elements)) + t)) + ;; Add the first dialogue block to the head of the dual-dialogue + ;; tree. + (cons first-dialog + ;; Parse the containing region. + (fountain-parse-region + (plist-get (nth 1 first-dialog) 'end) + end export-elements job)))) + ;; Otherwise, return the first dialogue tree. + first-dialog))) + +(defun fountain-parse-lines (match-data &optional export-elements job) + "Return an element list for matched dialogue." + (set-match-data match-data) + (let ((beg (match-beginning 0)) + (end (match-end 0))) + (list 'lines + (list 'begin beg + 'end end + 'export (if (memq 'lines export-elements) t)) + (match-string-no-properties 1)))) + +(defun fountain-parse-paren (match-data &optional export-elements job) + "Return an element list for matched parenthetical." + (set-match-data match-data) + (list 'paren + (list 'begin (match-beginning 0) + 'end (match-end 0) + 'export (if (memq 'paren export-elements) t)) + (match-string-no-properties 1))) + +(defun fountain-parse-trans (match-data &optional export-elements job) + "Return an element list for matched transition." + (set-match-data match-data) + (list 'trans + (list 'begin (match-beginning 0) + 'end (match-end 0) + 'forced (stringp (match-string 2)) + 'export (if (memq 'trans export-elements) t) + 'starts-new-page (fountain-starts-new-page)) + (match-string-no-properties 3))) + +(defun fountain-parse-center (match-data &optional export-elements job) + "Return an element list for matched center text." + (list 'center + (list 'begin (match-beginning 0) + 'end (match-end 0) + 'export (if (memq 'center export-elements) t) + 'starts-new-page (fountain-starts-new-page)) + (match-string-no-properties 3))) + +(defun fountain-parse-page-break (match-data &optional export-elements job) + "Return an element list for matched page break." + (set-match-data match-data) + (list 'page-break + (list 'begin (match-beginning 0) + 'end (match-end 0) + 'export (if (memq 'page-break export-elements) t)) + (match-string-no-properties 2))) + +(defun fountain-parse-synopsis (match-data &optional export-elements job) + "Return an element list for matched synopsis." + (set-match-data match-data) + (list 'synopsis + (list 'begin (match-beginning 0) + 'end (match-end 0) + 'export (if (memq 'synopsis export-elements) t) + 'starts-new-page (fountain-starts-new-page)) + (match-string-no-properties 3))) + +(defun fountain-parse-note (match-data &optional export-elements job) + "Return an element list for matched note." + (set-match-data match-data) + (list 'note + (list 'begin (match-beginning 0) + 'end (match-end 0) + 'export (if (memq 'note export-elements) t) + 'starts-new-page (fountain-starts-new-page)) + (match-string-no-properties 2))) + +(defun fountain-parse-action (match-data &optional export-elements job) + "Return an element list for matched action." + (set-match-data match-data) + (let ((beg (match-beginning 0)) + (end + (save-excursion + (save-match-data + (goto-char (match-beginning 0)) + (re-search-forward fountain-blank-regexp nil 'move) + (skip-chars-backward "\n\r\s\t") + (point)))) + string) + (setq string (buffer-substring-no-properties (match-beginning 2) end) + string (replace-regexp-in-string "^!" "" string)) + (list 'action + (list 'begin beg + 'end end + 'forced (stringp (match-string 1)) + 'export (if (memq 'action export-elements) t) + 'starts-new-page (fountain-starts-new-page)) + string))) + +(defun fountain-parse-element (&optional export-elements job) + "Call appropropriate element parsing function for matched element at point." + (let ((parser (plist-get (cdr (assq (fountain-get-element) + fountain-elements)) + :parser))) + (if parser (funcall parser (match-data) export-elements job)))) + +(defun fountain-parse-region (start end export-elements job) + "Return a list of parsed element lists in region between START and END." + (goto-char start) + (setq end (min end (point-max))) + (let (list) + (while (< (point) end) + (skip-chars-forward "\n\r\s\t") + (forward-line 0) + (if (< (point) end) + (let ((element (fountain-parse-element export-elements job))) + (push element list) + ;; FIXME: better to use a forward-block function + (goto-char (plist-get (nth 1 element) 'end)))) + (if job (progress-reporter-update job))) + (reverse list))) + +(defun fountain-prep-and-parse-region (start end) + "Prepare and parse region between START and END." + (let ((buffer (current-buffer)) + (export-elements (fountain-get-export-elements)) + (job (make-progress-reporter "Parsing..."))) + (prog1 + (with-temp-buffer + (fountain-init-vars) + (insert-buffer-substring buffer start end) + (fountain-include-in-region (point-min) (point-max) + (not (memq 'include export-elements))) + (fountain-delete-comments-in-region (point-min) (point-max)) + ;; Delete metadata. + (goto-char (point-min)) + (while (fountain-match-metadata) + (forward-line 1)) + (delete-region (point-min) (point)) + ;; Search for script end point and delete beyond. + (if (re-search-forward fountain-end-regexp nil t) + (delete-region (match-beginning 0) (point-max))) + (fountain-parse-region (point-min) (point-max) export-elements job)) + (progress-reporter-done job)))) + + +;;; Filling + +(defgroup fountain-fill () + "Options for filling elements. + +Filling elements is used in exporting to plaintext and +PostScript, and in calculating page length for page locking." + :prefix "fountain-fill-" + :group 'fountain-export) + +(defcustom fountain-fill-section-heading + (cons 0 61) + "Cons cell of integers for indenting and filling section headings. +The car sets `left-margin' and cdr `fill-column'." + :type '(cons (integer :tag "Indent") + (integer :tag "Width")) + :group 'fountain-fill) + +(defcustom fountain-fill-scene-heading + (cons 0 61) + "Cons cell of integers for indenting and filling scene headings. +The car sets `left-margin' and cdr `fill-column'." + :type '(cons (integer :tag "Indent") + (integer :tag "Width")) + :group 'fountain-fill) + +(defcustom fountain-fill-action + (cons 0 61) + "Cons cell of integers for indenting and filling action. +The car sets `left-margin' and cdr `fill-column'." + :type '(cons (integer :tag "Indent") + (integer :tag "Width")) + :group 'fountain-fill) + +(defcustom fountain-fill-character + (cons 20 38) + "Cons cell of integers for indenting and filling character. +The car sets `left-margin' and cdr `fill-column'." + :type '(cons (integer :tag "Indent") + (integer :tag "Width")) + :group 'fountain-fill) + +(defcustom fountain-fill-paren + (cons 15 26) + "Cons cell of integers for indenting and filling parenthetical. +The car sets `left-margin' and cdr `fill-column'." + :type '(cons (integer :tag "Indent") + (integer :tag "Width")) + :group 'fountain-fill) + +(defcustom fountain-fill-dialog + (cons 10 35) + "Cons cell of integers for indenting and filling dialogue. +The car sets `left-margin' and cdr `fill-column'." + :type '(cons (integer :tag "Indent") + (integer :tag "Width")) + :group 'fountain-fill) + +(defcustom fountain-fill-trans + (cons 42 16) + "Cons cell of integers for indenting and filling transition. +The car sets `left-margin' and cdr `fill-column'." + :type '(cons (integer :tag "Indent") + (integer :tag "Width")) + :group 'fountain-fill) + +(defcustom fountain-fill-synopsis + (cons 0 61) + "Cons cell of integers for indenting and filling synopses. +The car sets `left-margin' and cdr `fill-column'." + :type '(cons (integer :tag "Indent") + (integer :tag "Width")) + :group 'fountain-fill) + +(defcustom fountain-fill-note + (cons 0 61) + "Cons cell of integers for indenting and filling notes. +The car sets `left-margin' and cdr `fill-column'." + :type '(cons (integer :tag "Indent") + (integer :tag "Width")) + :group 'fountain-fill) + + +;;; Exporting + +(defgroup fountain-export () + "Options for exporting Fountain files." + :prefix "fountain-export-" + :group 'fountain) + +(defcustom fountain-export-include-elements + '(("screenplay" scene-heading action character lines paren trans center page-break include) + ("teleplay" section-heading scene-heading action character lines paren trans center page-break include) + ("stageplay" section-heading scene-heading action character lines paren trans center page-break include)) + "Association list of elements to include when exporting. +Note that comments (boneyard) are never included." + :type '(alist :key-type (string :tag "Format") + :value-type (set :tag "Elements" + (const :tag "Section Headings" section-heading) + (const :tag "Scene Headings" scene-heading) + (const :tag "Action" action) + (const :tag "Character Names" character) + (const :tag "Dialogue" lines) + (const :tag "Parentheticals" paren) + (const :tag "Transitions" trans) + (const :tag "Center Text" center) + (const :tag "Page Breaks" page-break) + (const :tag "Synopses" synopsis) + (const :tag "Notes" note) + (const :tag "Included Files" include))) + :group 'fountain-export) + +(define-obsolete-variable-alias 'fountain-export-include-elements-alist + 'fountain-export-include-elements "2.4.0") + +(defcustom fountain-export-make-standalone + t + "If non-nil, export a standalone document. + +A standalone document is formatted with the export format's +document template in `fountain-export-templates'. + +If nil, export snippet, which only formats each element. This is +useful when exporting parts of a script for inclusion in another +document." + :type 'boolean + :group 'fountain-export) + +(defcustom fountain-export-tmp-buffer-name + "*Fountain %s Export*" + "Name of export buffer when source buffer is not visiting a file. +Passed to `format' with export format as single variable." + :type 'string + :group 'fountain-export) + +(defcustom fountain-export-default-command + 'fountain-export-buffer-to-latex + "\\<fountain-mode-map>Default function to call with \\[fountain-export-default]." + :type '(radio (function-item fountain-export-buffer-to-latex) + (function-item fountain-export-buffer-to-html) + (function-item fountain-export-buffer-to-fdx) + (function-item fountain-export-buffer-to-fountain) + (function-item fountain-export-buffer-to-txt) + (function-item fountain-export-shell-command)) + :group 'fountain-export) + +(make-obsolete-variable 'fountain-export-include-title-page + 'fountain-export-include-elements "2.4.0") + +(defcustom fountain-export-page-size + 'letter + "Paper size to use on export." + :type '(radio (const :tag "US Letter" letter) + (const :tag "A4" a4)) + :group 'fountain-export) + +(defcustom fountain-export-font + "Courier" + "Font to use when exporting." + :type '(string :tag "Font") + :group 'fountain-export) + +(defcustom fountain-export-include-title-page + t + "If non-nil, include a title page in export." + :type 'boolean + :group 'fountain-export + :set (lambda (symbol value) + (set-default symbol value) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (eq major-mode 'fountain-mode) + (font-lock-refresh-defaults)))))) + +(defcustom fountain-export-contact-align-right + nil + "If non-nil, align title page contact block on the right." + :type 'boolean + :group 'fountain-export) + +(defcustom fountain-export-number-first-page + nil + "If non-nil, add a page number to the first page. + +Traditionally, screenplays omit a page number on the first page." + :type 'boolean + :group 'fountain-export) + +(defcustom fountain-export-include-scene-numbers + nil + "If non-nil, include scene numbers in export." + :type 'boolean + :group 'fountain-export) + +(defcustom fountain-export-scene-heading-format + '(double-space) + "List of format options applied when exporting scene headings. +Options are: bold, double-space, underline." + :type '(set (const :tag "Bold" bold) + (const :tag "Double-spaced" double-space) + (const :tag "Underlined" underline)) + :group 'fountain-export) + +(defcustom fountain-export-more-dialog-string + "(MORE)" + "String to append to dialog when breaking across pages." + :type 'string + :group 'fountain-export) + +(defcustom fountain-export-shell-command + "afterwriting --source %s --pdf --overwrite" + "Shell command string to convert Fountain source to ouput. +`%s' will be substituted with `buffer-file-name'" + :type 'string + :group 'fountain-export) + +(defcustom fountain-export-use-title-as-filename + nil + "If non-nil, use title metadata as export filename. + +This is useful if you are exporting to Fountain and need to +specify a different filename." + :type 'boolean + :group 'fountain-export) + +(defvar fountain-export-formats + '((html + :tag "HTML" + :ext ".html" + :template fountain-export-html-template + :string-replace (("&" "&") + ("<" "<") + (">" ">") + ("\\\\\\*" "*") + ("\\*\\*\\*\\(.+?\\)\\*\\*\\*" "<strong><em>\\1</em></strong>") + ("\\*\\*\\(.+?\\)\\*\\*" "<strong>\\1</strong>") + ("\\*\\(.+?\\)\\*" "<em>\\1</em>") + ("^~\s*\\(.+?\\)$" "<i>\\1</i>") + ("_\\(.+?\\)_" "<span class=\"underline\">\\1</span>") + ("\n\n+" "<br><br>") + ("\n" "<br>")) + :eval-replace ((stylesheet fountain-export-html-stylesheet) + (font fountain-export-font) + (scene-heading-spacing + (if (memq 'double-space fountain-export-scene-heading-format) + "2em" "1em")) + (title-page + (if fountain-export-include-title-page + fountain-export-html-title-page-template))) + :hook fountain-export-html-hook) + (tex + :tag "LaTeX" + :ext ".tex" + :template fountain-export-tex-template + :string-replace (("%" "\\\\%") + ("&" "\\\\&") + ("\\$" "\\\\$") + ("\\*\\*\\*\\(.+?\\)\\*\\*\\*" "\\\\textbf{\\\\emph{\\1}}") + ("\\*\\*\\(.+?\\)\\*\\*" "\\\\textbf{\\1}") + ("\\*\\(.+?\\)\\*" "\\\\emph{\\1}") + ("^~\s*\\(.+?\\)$\\*\\*" "\\\\textit{\\1}") + ("_\\(.+?\\)_" "\\\\uline{\\1}") + ("\n[\s\t]*\n+" "\\\\par") + ("\n" "\\\\protecting{\\\\\\\\}")) + :eval-replace ((font fountain-export-font) + (scene-heading-spacing + (if (memq 'double-space fountain-export-scene-heading-format) + "true" "false")) + (scene-heading-underline + (if (memq 'underline fountain-export-scene-heading-format) + "true" "false")) + (scene-heading-bold + (if (memq 'bold fountain-export-scene-heading-format) + "true" "false")) + (title-page + (if fountain-export-include-title-page + fountain-export-tex-title-page-template)) + (title-contact-align + (if fountain-export-contact-align-right + "true" "false")) + (number-first-page + (if fountain-export-number-first-page + "true" "false")) + (include-scene-numbers + (if fountain-export-include-scene-numbers + "true" "false"))) + :hook fountain-export-tex-hook) + (fdx + :tag "Final Draft" + :ext ".fdx" + :template fountain-export-fdx-template + :string-replace (("&" "&") + ("<" "<") + (">" ">") + ("\"" """) + ("'" "'") + ("\\\\_" "`") + ("\\\\\\*" "*") + ("_\\*\\*\\*\\(.+?\\)\\*\\*\\*_" "</Text><Text Style=\"Bold+Underline+Italic\">\\1</Text><Text>") + ("\\*\\*\\*\\(.+?\\)\\*\\*\\*" "</Text><Text Style=\"Bold+Italic\">\\1</Text><Text>") + ("_\\*\\*\\(.+?\\)\\*\\*_" "</Text><Text Style=\"Bold+Underline\">\\1</Text><Text>") + ("_\\*\\(.+?\\)\\*_" "</Text><Text Style=\"Underline+Italic\">\\1</Text><Text>") + ("\\*\\*\\(.+?\\)\\*\\*" "</Text><Text Style=\"Bold\">\\1</Text><Text>") + ("\\*\\(.+?\\)\\*" "</Text><Text Style=\"Italic\">\\1</Text><Text>") + ("^~\s*\\(.+?\\)$" "</Text><Text Style=\"Italic\">\\1</Text><Text>") + ("_\\(.+?\\)_" "</Text><Text Style=\"Underline\">\\1</Text><Text>") + ("\n\n+" "\n\n")) + :cond-replace ((t + (starts-new-page + (t "Yes") (nil "No")))) + :eval-replace ((title-page + (if fountain-export-include-title-page + fountain-export-fdx-title-page-template))) + :hook fountain-export-fdx-hook) + (fountain + :tag "Fountain" + :ext ".fountain" + :template fountain-export-fountain-template + :cond-replace ((scene-heading + (forced (t "."))) + (character + (dual (right " ^")) + (forced (t "@"))) + (trans + (forced (t "> "))) + (action + (forced (t "!"))) + (section-heading + (level (1 "#") + (2 "##") + (3 "###") + (4 "####") + (5 "#####")))) + :eval-replace ((title-page + (if fountain-export-include-title-page + fountain-export-fountain-title-page-template)) + (scene-heading-spacing + (if (memq 'double-space fountain-export-scene-heading-format) + "\n"))) + :hook fountain-export-fountain-hook) + (txt + :tag "plaintext" + :ext ".txt" + :fill t + :template fountain-export-txt-template + :eval-replace ((scene-heading-spacing + (if (memq 'double-space fountain-export-scene-heading-format) + "\n")) + (title-page + (if fountain-export-include-title-page + fountain-export-txt-title-page-template))) + :hook fountain-export-txt-hook)) + "Association list of export formats and their properties. +Takes the form: + + ((FORMAT KEYWORD PROPERTY) + ...)") + +(defvar fountain-elements + '((section-heading + :tag "Section Heading" + :matcher fountain-section-heading-regexp + :parser fountain-parse-section + :fill fountain-fill-section-heading) + (scene-heading + :tag "Scene Heading" + :parser fountain-parse-scene + :fill fountain-fill-scene-heading) + (action + :tag "Action" + :parser fountain-parse-action + :fill fountain-fill-action) + (character + :tag "Character Name" + :parser fountain-parse-dialog + :fill fountain-fill-character) + (lines + :tag "Dialogue" + :parser fountain-parse-lines + :fill fountain-fill-dialog) + (paren + :tag "Parenthetical" + :parser fountain-parse-paren + :fill fountain-fill-paren) + (trans + :tag: "Transition" + :parser fountain-parse-trans + :fill fountain-fill-trans) + (center + :tag "Center Text" + :matcher fountain-center-regexp + :parser fountain-parse-center + :fill fountain-fill-action) + (page-break + :tage "Page Break" + :parser fountain-parse-page-break + :matcher fountain-page-break-regexp) + (synopsis + :tag "Synopsis" + :parser fountain-parse-synopsis + :fill fountain-fill-action) + (note + :tag "Note" + :parser fountain-parse-note + :fill fountain-fill-note)) + "Association list of Fountain elements and their properties. +Includes references to various functions and variables. + +Takes the form: + + (ELEMENT KEYWORD PROPERTY)") + +(defun define-fountain-export-template-docstring (format) + (let ((tag (plist-get (cdr (assq format fountain-export-formats)) + :tag))) + (format + "Association list of element templates for exporting to %s. +Takes the form: + + ((ELEMENT TEMPLATE) + ...) + +ELEMENT is the Fountain element, a symbol (see below). TEMPLATE +is the template with which to format the format string. If +TEMPLATE is nil, the format string is discarded. + +Fountain ELEMENTs: + + document wrapper template for all content, see + `fountain-export-make-standalone' + section string of section, including child elements + section-heading string of section heading, excluding syntax chars + scene string of scene, including child elements + scene-heading string of scene heading, excluing syntax chars + dual-dialog string of dual-dialogue block, including child dialog + block elements + dialog string of dialogue block, including child elements + character string of character name, excluding syntax chars + paren string of parenthetical + lines string of dialogue lines, up to end of dialogue block or + next parenthetical + trans string of transition, excluding syntax chars + action string of action block + synopsis string of synopsis, excluding syntax chars + note string of note, excluding syntax chars + center string of center text, excluding syntax chars + +Each TEMPLATE should include the replacement key `{{content}}'. +Templates may use any metadata keys (e.g. `{{title}}', `{{author}}', +etc.) as well as keys defined in `fountain-export-formats'." tag))) + +;; The %s template also uses the following keys: + +;; %s" tag tag +;; (mapconcat #'(lambda (var) +;; (concat " {{" (symbol-name (car var)) "}}")) +;; (plist-get (cdr (assq format fountain-export-formats)) +;; :eval-replace) +;; "\n")))) + +(define-widget 'fountain-element-list-type 'lazy + "Customize widget for Fountain templates." + :offset 4 + :type '(list + (group (const :tag "Document" document) + (choice string (const nil))) + (group (const :tag "Section" section) + (choice string (const nil))) + (group (const :tag "Section Heading" section-heading) + (choice string (const nil))) + (group (const :tag "Scene" scene) + (choice string (const nil))) + (group (const :tag "Scene Heading" scene-heading) + (choice string (const nil))) + (group (const :tag "Dual Dialogue" dual-dialog) + (choice string (const nil))) + (group (const :tag "Dialogue" dialog) + (choice string (const nil))) + (group (const :tag "Character" character) + (choice string (const nil))) + (group (const :tag "Parenthetical" paren) + (choice string (const nil))) + (group (const :tag "Lines" lines) + (choice string (const nil))) + (group (const :tag "Transition" trans) + (choice string (const nil))) + (group (const :tag "Action" action) + (choice string (const nil))) + (group (const :tag "Page Break" page-break) + (choice string (const nil))) + (group (const :tag "Synopsis" synopsis) + (choice string (const nil))) + (group (const :tag "Note" note) + (choice string (const nil))) + (group (const :tag "Center Text" center) + (choice string (const nil))))) + +(defun fountain-get-export-elements (&optional format) + "Returns list of elements exported in current format. +Format defaults to \"screenplay\"." + (cdr (or (assoc-string + (or format + (plist-get (fountain-read-metadata) 'format) + "screenplay") + fountain-export-include-elements) + (car fountain-export-include-elements)))) + +(defun fountain-export-get-filename (format &optional buffer) + "If buffer is visiting a file, concat file name base and FORMAT. +Otherwise return `fountain-export-buffer' formatted with export +format tag." + (let* ((alist (cdr (assq format fountain-export-formats))) + (tag (plist-get alist :tag)) + (ext (plist-get alist :ext))) + (with-current-buffer (or buffer (current-buffer)) + (cond (fountain-export-use-title-as-filename + (concat (plist-get (fountain-read-metadata) 'title) ext)) + ((buffer-file-name) + (concat (file-name-base (buffer-file-name)) ext)) + (t + (format fountain-export-tmp-buffer-name tag)))))) + +(require 'subr-x) + +(defun fountain-slugify (string) + "Convert STRING to one suitable for slugs. + +STRING is downcased, non-alphanumeric characters are removed, and +whitespace is converted to dashes. e.g. + + Hello Wayne's World 2! -> hello-wanyes-world-2" + (save-match-data + (string-join + (split-string + (downcase + (replace-regexp-in-string "[^\n\s\t[:alnum:]]" "" string)) + "[^[:alnum:]]+" t) + "-"))) + +(defun fountain-export-fill-string (string element) + (with-temp-buffer + (insert string) + (let (adaptive-fill-mode + (fill + (symbol-value + (plist-get (cdr (assq element fountain-elements)) :fill)))) + (setq left-margin (car fill) + fill-column (+ left-margin (cdr fill))) + ;; Replace emphasis syntax with face text propoerties (before performing fill). + (dolist (face '((fountain-italic-regexp . italic) + (fountain-bold-regexp . bold) + (fountain-underline-regexp . underline))) + (goto-char (point-min)) + (while (re-search-forward (symbol-value (car face)) nil t) + (put-text-property (match-beginning 3) (match-end 3) 'face (cdr face)) + (delete-region (match-beginning 4) (match-end 4)) + (delete-region (match-beginning 2) (match-end 2)))) + ;; Fill the buffer and return it as a string. + (fill-region (point-min) (point-max))) + (buffer-string))) + +(defun fountain-export-replace-in-string (string format) + (let ((replace-alist + (plist-get (cdr (assq format fountain-export-formats)) + :string-replace))) + (dolist (replacement replace-alist string) + (setq string (replace-regexp-in-string + (car replacement) (cadr replacement) string t nil))))) + +(defun fountain-export-get-cond-replacement (format element key value) + (let ((replace-alist + (plist-get (cdr (assq format fountain-export-formats)) + :cond-replace))) + (car + (cdr (assq value + (cdr (assq key + (or (cdr (assq element replace-alist)) + (cdr (assq t replace-alist)))))))))) + +(defun fountain-export-get-eval-replacement (key format) + (let ((replacement + (car (cdr (assq key + (plist-get (cdr (assq format + fountain-export-formats)) + :eval-replace))))) + string) + (unwind-protect + (setq string (eval replacement)) + (if (stringp string) string)))) + +(defun fountain-export-element (element-list format) + "Return a formatted string from ELEMENT-LIST according to FORMAT. + +Break ELEMENT-LIST into ELEMENT, PLIST and CONTENT. + +If PLIST property \"export\" is non-nil, proceed, otherwise +return an empty string. + +If CONTENT is a string, format with +`fountain-export-replace-in-string' and if format it filled, fill +with `fountain-export-fill-string'. + +If CONTENT is a list, recursively call this function on each +element of the list. + +Check if ELEMENT corresponds to a template in +`fountain-export-templates' and set ELEMENT-TEMPLATE. If so, +replace matches of `fountain-template-key-regexp' in the +following order: + +1. {{content}} is replaced with CONTENT. + +2. If {{KEY}} corresponds to a string property in PLIST, it is + replaced with that string. + +3. If {{KEY}} corresponds to the value of the key of ELEMENT of + FORMAT in `fountain-export-conditional-replacements', it is + replaced with that string. + +4. If {{KEY}} corresponds with a cdr of FORMAT in + `fountain-export-replacements', it is evaluated using `eval' + and replaced with that string. + +5. If none of the above, {{KEY}} is replaced with an empty + string." + ;; Break ELEMENT-LIST into ELEMENT, PLIST and CONTENT. + (let ((element (car element-list)) + (plist (nth 1 element-list)) + (content (nth 2 element-list))) + ;; First, element must be included for export. Check if export property is + ;; non-nil. + (if (plist-get plist 'export) + ;; Set the ELEMENT-FORMAT-PLIST. STRING will return the final exported + ;; string. + (let ((export-format-plist (cdr (assq format fountain-export-formats))) + format-template element-template string) + (cond + ;; If CONTENT is nil, set STRING as an empty string. + ((not content) + (setq string "")) + ;; If CONTENT is a string, format CONTENT and set as STRING. + ((stringp content) + (setq string (fountain-export-replace-in-string content format)) + ;; If the format is filled, fill STRING in temporary buffer + (if (plist-get export-format-plist :fill) + (setq string (fountain-export-fill-string string element)))) + ;; If CONTENT is a list, work through the list setting each element + ;; as CHILD-ELEMENT-LIST and recursively calling this function. + ((listp content) + (dolist (child-element-list content) + (setq string + (concat string + (fountain-export-element child-element-list format))))) + ;; Otherwise, CONTENT is either not exported or malformed, then set + ;; an empty string. + (t + (setq string ""))) + ;; Set the FORMAT-TEMPLATE, which is the big alist of template strings + ;; for each element. From this, get the ELEMENT-TEMPLATE. + (setq format-template (symbol-value (plist-get export-format-plist :template)) + element-template (car (cdr (assq element format-template)))) + (cond + ;; If there is a FORMAT-TEMPLATE and an ELEMENT-TEMPLATE, replace + ;; template keys in that template. + ((and format-template element-template) + (while (string-match fountain-template-key-regexp element-template) + (setq element-template + ;; FIXME: can this be better written with pcase? + (replace-regexp-in-string + fountain-template-key-regexp + (lambda (match) + ;; Find KEY and corresponding VALUE in PLIST. + (let* ((key (match-string 1 match)) + (value (plist-get plist (intern key)))) + (cond + ;; If KEY is "content", replace with STRING. + ((string= key "content") + string) + ;; If KEY is "slugify", replace with slugified STRING. + ((string= key "slugify") + (fountain-slugify string)) + ;; If KEY's VALUE is a string, format and replace with + ;; VALUE. + ((stringp value) + (fountain-export-replace-in-string value format)) + ;; If KEY's VALUE is not a string but still non-nil + ;; attempt conditional replacement based on KEY's + ;; VALUE. + (value + (fountain-export-get-cond-replacement format element (intern key) value)) + ;; Otherwise, attempt expression replacements. + ((fountain-export-get-eval-replacement (intern key) format)) + (t "")))) + element-template t t))) + (setq string element-template)) + ;; If there's no ELEMENT-TEMPLATE for element in FORMAT-TEMPLATE, set + ;; an empty string + (format-template + (setq string ""))) + ;; Return the string. + (or string "")) + ;; Element is not exported, return an emtpy string. + ""))) + +(defun fountain-export-region (start end format &optional snippet) + "Return an export string of region between START and END in FORMAT. +If SNIPPET, do not include a document template wrapper. + +Save current outline visibility level, then show all. Then read +file metadata. Then calculate elements included in export from +assocation list in `fountain-export-include-elements' +corresponding to FORMAT. Then parse the region into an element tree. + +If exporting a standalone document, call +`fountain-export-format-element' with tree, FORMAT and list of +included elements, otherwise walk the element tree calling +`fountain-export-format-element' and concatenate the resulting +strings." + (let ((job (make-progress-reporter "Exporting...")) + tree string) + ;; Parse the region to TREE. + (save-excursion + (setq tree (fountain-prep-and-parse-region start end))) + ;; If exporting a standalone document, list TREE inside a document element. + (unless (or snippet (not fountain-export-make-standalone)) + (setq tree + (list (list 'document + (append + (list 'begin start + 'end end + 'export t) + (fountain-read-metadata)) + tree)))) + ;; Walk through TREE, concatenating exported elements to STRING. + (while tree + (setq string + (concat string (fountain-export-element (pop tree) format))) + (progress-reporter-update job)) + (progress-reporter-done job) + ;; Return exported STRING. + string)) + +(defun fountain-export-buffer (format &optional snippet buffer) + "Export current buffer or BUFFER to export format FORMAT. + +If destination buffer is not empty, ask to overwrite or generate +a new buffer. If destination buffer is the same as source buffer, +generate a new buffer. + +Switch to destination buffer if complete without errors, +otherwise kill destination buffer." + ;; If called interactively, present export format options. + (interactive + (list (intern + (completing-read "Export format: " + (mapcar #'car fountain-export-formats) nil t)) + (car current-prefix-arg))) + (setq buffer (or buffer (current-buffer))) + (let ((dest-buffer (get-buffer-create + (fountain-export-get-filename format buffer))) + (hook (plist-get (cdr (assq format fountain-export-formats)) + :hook)) + string complete) + (unwind-protect + (with-current-buffer buffer + ;; If DEST-BUFFER is not empty, check if it is the current buffer, or + ;; if not, if the user does not wish to overwrite. + (when (< 0 (buffer-size dest-buffer)) + (if (or (eq (current-buffer) dest-buffer) + (not (y-or-n-p (format "Buffer `%s' is not empty; overwrite? " + dest-buffer)))) + ;; If so, generate a new buffer. + (progn + (setq dest-buffer + (generate-new-buffer (buffer-name dest-buffer))) + (message "Using new buffer `%s'" dest-buffer)))) + ;; Export the region to STRING. + (setq string + (fountain-export-region (point-min) (point-max) format snippet)) + ;; Insert STRING into DEST-BUFFER. + (with-current-buffer dest-buffer + (with-silent-modifications + (erase-buffer) + (insert string))) + ;; Switch to DEST-BUFFER and save. + (switch-to-buffer dest-buffer) + (write-file (buffer-name) t) + ;; Set COMPLETE flag and run hooks. + (setq complete t) + (run-hooks hook)) + ;; If export failed, kill DEST-BUFFER. + (unless complete + (kill-buffer dest-buffer))))) + +(defun fountain-export-default () + "Call function defined in `fountain-export-default-command'." + (interactive) + (funcall fountain-export-default-command)) + +(defun fountain-export-shell-command (&optional buffer) + "Call shell command defined in variable `fountain-export-shell-command'. +Command acts on current buffer or BUFFER." + (interactive) + (let* ((buffer (or buffer (current-buffer))) + (file (buffer-file-name buffer))) + (if file + (async-shell-command ; FIXME use start-process + (format fountain-export-shell-command (shell-quote-argument file)) + "*Fountain Export Process*") + (user-error "Buffer `%s' is not visiting a file" buffer)))) + + +;;; -> plaintext + +(defgroup fountain-plaintext-export () + "Options for exporting Fountain files to plaintext." + :prefix "fountain-export-txt-" + :group 'fountain-export) + +(defcustom fountain-export-txt-title-page-template + "\ +{{title}}\n +{{credit}}\n +{{author}}\n\n +{{contact}} +{{date}}\n\n" + "Template for plaintext title page." + :type 'string + :group 'fountain-plaintext-export) + +(defcustom fountain-export-txt-template + '((document "{{title-page}}{{content}}") + (section "{{content}}") + (section-heading "{{content}}\n\n") + (scene "{{content}}") + (scene-heading "{{scene-heading-spacing}}{{content}}\n\n") + (dual-dialog "{{content}}\n") + (dialog "{{content}}\n") + (character "{{content}}\n") + (paren "{{content}}\n") + (lines "{{content}}\n") + (trans "{{content}}\n\n") + (action "{{content}}\n\n") + (page-break " \n\n") + (synopsis "{{content}}\n\n") + (note "[ note: {{content}} ]\n\n") + (center "{{content}}")) + (define-fountain-export-template-docstring 'txt) + :type 'fountain-element-list-type + :group 'fountain-plaintext-export) + +(defcustom fountain-export-txt-hook + nil + "Hook run with export buffer on sucessful export to plaintext." + :type 'hook + :group 'fountain-plaintext-export) + +(defun fountain-export-buffer-to-txt () + "Convenience function for exporting buffer to plaintext." + (interactive) + (fountain-export-buffer 'txt)) + + +;;; -> PostScript + +;; (defgroup fountain-postscript-export () +;; "Options for exporting Fountain files to PostScript." +;; :prefix 'fountain-export-ps- +;; :group 'fountain-export) + +;; (defcustom fountain-export-ps-top-margin +;; 1.0 +;; "Float representing top page margin in inches. + +;; There is no corresponding bottom margin option, as page length +;; is calculated using `fountain-pages-max-lines'." +;; :type 'float +;; :group 'fountain-export) + +;; (defcustom fountain-export-ps-left-margin +;; 1.5 +;; "Float representing left page margin in inches. + +;; There is no corresponding right margin option, as text width +;; is calculated using `fountain-fill'." +;; :type 'float +;; :group 'fountain-export) + +;; (defcustom fountain-export-ps-hook +;; nil +;; "Hook run with export buffer on sucessful export to PostScript." +;; :type 'hook +;; :group 'fountain-export) + +;; (defun fountain-export-buffer-to-ps () +;; "Convenience function for exporting buffer to PostScript." +;; (interactive) +;; (let ((ps-paper-type fountain-export-page-size) +;; (ps-left-margin (* fountain-export-left-margin 72)) +;; (ps-top-margin (* fountain-export-top-margin 72)) +;; (ps-font-size 12) +;; ps-print-color-p +;; ps-print-header) +;; (ps-print-buffer (fountain-export-get-filename 'ps)))) +;; (fountain-export-buffer 'ps)) + + +;;; -> HTML + +(defgroup fountain-html-export () + "Options for export Fountain files to HTML." + :prefix "foutnain-export-html-" + :group 'fountain-export) + +(defcustom fountain-export-html-title-page-template + "<section class=\"title-page\"> +<div class=\"title\"> +<h1>{{title}}</h1> +<p>{{credit}}</p> +<p>{{author}}</p> +</div> +<p class=\"contact\">{{contact}}</p> +</section>" + "Template for HTML title page." + :type 'string + :group 'fountain-html-export) + +(defcustom fountain-export-html-template + '((document "\ +<head> +<meta charset=\"utf-8\"> +<meta name=\"author\" content=\"{{author}}\" /> +<meta name=\"generator\" content=\"Emacs {{emacs-version}} running Fountain Mode {{fountain-version}}\" /> +<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0, user-scalable=no\"> +<title>{{title}}</title> +<style type=\"text/css\"> +{{stylesheet}} +</style> +</head> +<body> +<section class=\"screenplay\"> +{{title-page}} +{{content}}\ +</section> +</body>") + (section "<section class=\"section\">\n{{content}}</section>\n") + (section-heading "<a href=\"#{{slugify}}\"><p class=\"section-heading\" id=\"{{slugify}}\">{{content}}</p></a>\n") + (scene "<section class=\"scene\">\n{{content}}</section>\n") + (scene-heading "<a href=\"#{{scene-number}}\"><p class=\"scene-heading\" id=\"{{scene-number}}\">{{content}}</p></a>\n") + (dual-dialog "<div class=\"dual-dialog\">\n{{content}}</div>\n") + (dialog "<div class=\"dialog\">\n{{content}}</div>\n") + (character "<p class=\"character\">{{content}}</p>\n") + (paren "<p class=\"paren\">{{content}}</p>\n") + (lines "<p class=\"lines\">{{content}}</p>\n") + (trans "<p class=\"trans\">{{content}}</p>\n") + (action "<p class=\"action\">{{content}}</p>\n") + (page-break "<a href=\"#p{{content}}\"><hr id=\"{{content}}\">\n<p class=\"page-number\">{{content}}</p></a>") + (synopsis "<p class=\"synopsis\">{{content}}</p>\n") + (note "<p class=\"note\">{{content}}</p>\n") + (center "<p class=\"center\">{{content}}</p>\n")) + (define-fountain-export-template-docstring 'html) + :type 'fountain-element-list-type + :group 'fountain-html-export) + +(defcustom fountain-export-html-stylesheet + "\ +.screenplay { + font-family: {{font}}; + font-size: 12pt; + line-height: 1; + max-width: 6in; + margin: 1em auto; + -webkit-text-size-adjust: none; +} +.screenplay h1, h2, h3, h4, h5, h6 { + font-weight: inherit; + font-size: inherit; +} +.screenplay a { + color: inherit; + text-decoration: none; +} +.screenplay .underline { + text-decoration: underline; +} +.screenplay .title-page { + margin: 0 auto 1em; +} +.screenplay .title-page .title { + text-align: center; +} +.screenplay .title-page .title h1 { + text-transform: uppercase; + text-decoration: underline; +} +.screenplay .section-heading { + text-align: center; +} +.screenplay .section-heading:hover { + background-color: lightyellow; +} +.screenplay .scene { + margin-top: {{scene-heading-spacing}}; +} +.screenplay .scene-heading { + margin-bottom: 0; +} +.screenplay .scene-heading:hover { + background-color: lightyellow; +} +.screenplay .action { + margin: 1em 0; + white-space: pre-wrap; +} +.screenplay .dialog { + width: 75%; + max-width: 4in; + margin-top: 1em; + margin-bottom: 1em; + margin-left: 17%; +} +.screenplay .dialog .character { + margin-top: 0; + margin-bottom: 0; + margin-left: 25%; +} +.screenplay .dialog .lines { + max-width: 3.5in; + margin-top: 0; + margin-bottom: 0; + white-space: pre-wrap; +} +.screenplay .dialog .paren { + max-width: 2in; + margin-top: 0; + margin-bottom: 0; + margin-left: 15%; + text-indent: -0.6em; + page-break-inside: avoid; + page-break-after: avoid; +} +.screenplay .dual-dialog { + width: 100%; + margin: 1em 0; +} +.screenplay .dual-dialog .dialog { + max-width: 50%; + margin-top: 0; + margin-left: 0; + margin-right: 0; + float: left; + clear: none; +} +.screenplay .dual-dialog .dialog .lines { + width: 95%; +} +.screenplay .trans { + max-width: 2in; + margin-left: 63%; + clear: both; + page-break-before: avoid; +} +.screenplay .note { + display: block; + font-size: 11pt; + font-family: \"Comic Sans MS\", \"Marker Felt\", \"sans-serif\"; + line-height: 1.5; + background-color: lightgoldenrodyellow; + padding: 1em; +} +.screenplay .synopsis { + margin-top: 0; + color: grey; + font-style: italic; +} +.screenplay .center { + text-align: center; + white-space: pre-wrap; +}" + "Stylesheet for HTML export. + +Screenplay content is wrapped in class \"screenplay\", which +means all screenplay elements require the \".screenplay\" class +parent." + :type 'string + :link '(url-link "https://github.com/rnkn/mcqueen") + :group 'fountain-html-export) + +(defcustom fountain-export-html-title-template + "<div class=\"title\">{{title-template}}</div> +<h1>{{title}}</h1> +<p>{{credit}}</p> +<p>{{author}}</p> +<p class=\"contact\">{{contact-template}}</p> +" + "HTML template for title page export." + :type 'string + :group 'fountain-html-export) + +(defcustom fountain-export-html-hook + nil + "Hook run with export buffer on sucessful export to HTML." + :type 'hook + :group 'fountain-html-export) + +(defun fountain-export-buffer-to-html () + "Convenience function for exporting buffer to HTML." + (interactive) + (fountain-export-buffer 'html)) + + +;;; -> LaTeX + +(defgroup fountain-latex-export () + "Options for exporting Fountain files to LaTeX." + :prefix "fountain-export-tex-" + :group 'fountain-export) + +(defcustom fountain-export-tex-title-page-template + "\ +\\title{{{title}}} +\\author{{{author}}} +\\date{{{date}}} +\\newcommand{\\credit}{{{credit}}} +\\newcommand{\\contact}{{{contact}}} + +\\thispagestyle{empty} +\\vspace*{3in} + +\\begin{center} + \\uline{\\begin{MakeUppercase}\\thetitle\\end{MakeUppercase}}\\par + \\credit\\par + \\theauthor\\par +\\end{center} + +\\vspace{3in} +\\iftoggle{contactalignright}{% + \\begin{flushright} + \\contact + \\end{flushright} +}{% + \\contact +} +\\clearpage" + "Template for LaTeX title page." + :type 'string + :group 'fountain-latex-export) + +(defcustom fountain-export-tex-template + '((document "\ +\\documentclass[12pt,{{page-size}}]{article} + +% Conditionals +\\usepackage{etoolbox} +\\newtoggle{contactalignright} +\\newtoggle{doublespacesceneheadings} +\\newtoggle{underlinesceneheadings} +\\newtoggle{boldsceneheadings} +\\newtoggle{includescenenumbers} +\\newtoggle{numberfirstpage} + +\\settoggle{contactalignright}{{{title-contact-align}}} +\\settoggle{doublespacesceneheadings}{{{scene-heading-spacing}}} +\\settoggle{underlinesceneheadings}{{{scene-heading-underline}}} +\\settoggle{boldsceneheadings}{{{scene-heading-bold}}} +\\settoggle{includescenenumbers}{{{include-scene-numbers}}} +\\settoggle{numberfirstpage}{{{number-first-page}}} + +% Page Layout Settings +\\usepackage[left=1.5in,right=1in,top=1in,bottom=0.75in]{geometry} + +% Font Settings +\\usepackage{fontspec} +\\setmonofont{{{font}}} +\\renewcommand{\\familydefault}{\\ttdefault} + +% Text Settings +\\setlength{\\baselineskip}{12pt plus 0pt minus 0pt} +\\setlength{\\parskip}{12pt plus 0pt minus 0pt} +\\setlength{\\topskip}{0pt plus 0pt minus 0pt} +\\setlength{\\headheight}{\\baselineskip} +\\setlength{\\headsep}{\\baselineskip} +\\linespread{0.85} +\\hyphenpenalty=10000 +\\widowpenalty=10000 +\\clubpenalty=10000 +\\frenchspacing +\\raggedright + +% Underlining +\\usepackage[normalem]{ulem} +\\renewcommand{\\ULthickness}{1pt} + +% Header & Footer Settings +\\usepackage{fancyhdr} +\\pagestyle{fancy} +\\fancyhf{} +\\fancyhead[R]{\\thepage.} +\\renewcommand{\\headrulewidth}{0pt} + +% Margin Settings +\\usepackage{marginnote} +\\renewcommand*{\\raggedleftmarginnote}{\\hspace{0.2in}} + +% Section Headings +\\newcommand{\\sectionheading}[1]{% + \\begin{center} + \\uline{#1} + \\end{center} +} + +% Scene Headings +\\newcommand*{\\sceneheading}[2][]{% + \\def\\thesceneheading{#2} + \\iftoggle{doublespacesceneheadings}{% + \\vspace{\\parskip} + }{} + \\iftoggle{boldsceneheadings}{% + \\let\\BFtmp\\thesceneheading + \\renewcommand{\\thesceneheading}{\\textbf{\\BFtmp}} + }{} + \\iftoggle{underlinesceneheadings}{% + \\let\\ULtmp\\thesceneheading + \\renewcommand{\\thesceneheading}{\\uline{\\ULtmp}} + }{} + \\thesceneheading\\nopagebreak[4]% + \\iftoggle{includescenenumbers}{% + \\normalmarginpar\\marginnote{#1}\\reversemarginpar\\marginnote{#1}% + }{} +} + +% Dialogue +\\usepackage{xstring} +\\newcommand{\\contd}{{{contd}}} +\\newcommand{\\more}{{{more}}} +\\newlength{\\characterindent} +\\newlength{\\characterwidth} +\\newlength{\\dialogindent} +\\newlength{\\dialogwidth} +\\setlength{\\characterindent}{1in} +\\setlength{\\characterwidth}{4in} +\\setlength{\\dialogindent}{1in} +\\setlength{\\dialogwidth}{3.5in} +\\newcommand*{\\character}[1]{% + \\hspace*{\\characterindent}\\parbox[t]{\\characterwidth}{#1}% +} +\\newenvironment{dialog}[1]{% + \\setlength{\\parskip}{0pt} + \\begin{list}{}{% + \\setlength{\\topsep}{0pt} + \\setlength{\\partopsep}{0pt} + \\setlength{\\parsep}{0pt} + \\setlength{\\leftmargin}{\\dialogindent} + \\setlength{\\rightmargin}{\\dimexpr\\linewidth-\\leftmargin-\\dialogwidth} + }% + \\item\\character{#1}\\mark{#1}\\nopagebreak[4]% + }{% + \\mark{\\empty}\\end{list}% +} +\\newcommand*{\\paren}[1]{% + \\par% + \\hspace*{0.5in}\\parbox[t]{2in}{% + \\hangindent=0.1in\\hangafter=1#1}\\par\\nopagebreak[4] + \\vspace{2pt}% +} + +% Transitions +\\newlength{\\transindent} +\\newlength{\\transwidth} +\\setlength{\\transindent}{4in} +\\setlength{\\transwidth}{2in} +\\newcommand*{\\trans}[1]{% + \\nopagebreak[4]\\hspace*{\\transindent}\\parbox[t]{\\transwidth}{#1} +} + +% Center Text +\\newcommand{\\centertext}[1]{% + \\setlength{\\topsep}{0pt} + \\begin{center}#1\\end{center} +} + +% Page Breaking Settings +\\usepackage{atbegshi} +\\AtBeginShipout{% + \\if\\botmark\\empty + \\else + \\hspace*{\\dialogindent}\\character{\\StrDel[1]{\\botmark}{\\contd}\\space\\contd}% + \\fi% +} + +% Title Page +\\usepackage{titling} + +% Document +\\begin{document} + +{{title-page}} + +\\setcounter{page}{1} +\\iftoggle{numberfirstpage}{}{\\thispagestyle{empty}} +{{content}}\ +\\end{document} + +% Local Variables: +% tex-command: \"xelatex\" +% TeX-engine: xetex +% End:") + (section "{{content}}") + (section-heading "\\sectionheading{{{content}}}\n\n") + (scene "{{content}}") + (scene-heading "\\sceneheading{{{content}}}\n\n") + (dual-dialog "{{content}}") + (dialog "\\begin{dialog}{{content}}\\end{dialog}\n\n") + (character "{{{content}}}\n") + (paren "\\paren{{{content}}}\n") + (lines "{{content}}\n") + (trans "\\trans{{{content}}}\n\n") + (action "{{content}}\n\n") + (page-break "\\clearpage\n\n") + (synopsis nil) + (note nil) + (center "\\centertext{{{content}}}\n\n")) + (define-fountain-export-template-docstring 'tex) + :type 'fountain-element-list-type + :group 'fountain-latex-export) + +(defcustom fountain-export-tex-hook + nil + "Hook run with export buffer on sucessful export to LaTeX." + :type 'hook + :group 'fountain-latex-export) + +(defun fountain-export-buffer-to-latex () + "Convenience function for exporting buffer to LaTeX." + (interactive) + (fountain-export-buffer 'tex)) + + +;;; -> FDX + +(defgroup fountain-final-draft-export () + "Options for exporting Fountain files to Final Draft." + :prefix "fountain-export-fdx-" + :group 'fountain-export) + +(defcustom fountain-export-fdx-title-page-template + "\ +<TitlePage> +<Content> +<Paragraph Alignment=\"Center\"> +<Text>{{title}}</Text> +</Paragraph> +<Paragraph Alignment=\"Center\"> +<Text></Text> +</Paragraph> +<Paragraph Alignment=\"Center\"> +<Text>{{credit}}</Text> +</Paragraph> +<Paragraph Alignment=\"Center\"> +<Text></Text> +</Paragraph> +<Paragraph Alignment=\"Center\"> +<Text>{{author}}</Text> +</Paragraph> +<Paragraph Alignment=\"Left\"> +<Text>{{contact}}</Text> +</Paragraph> +</Content> +</TitlePage>" + "Template for Final Draft title page." + :type 'string + :group 'fountain-final-draft-export) + +(defcustom fountain-export-fdx-template + '((document "\ +<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\" ?> +<FinalDraft DocumentType=\"Script\" Template=\"No\" Version=\"1\"> +<Content> +{{content}}\ +</Content> +{{title-page}} +</FinalDraft>") + (section "{{content}}") + (section-heading nil) + (scene "{{content}}") + (scene-heading "<Paragraph Number=\"{{scene-number}}\" Type=\"Scene Heading\" StartsNewPage=\"{{starts-new-page}}\">\n<Text>{{content}}</Text>\n</Paragraph>\n") + (dual-dialog "<Paragraph StartsNewPage=\"{{starts-new-page}}\">\n<DualDialogue>\n{{content}}</DualDialogue>\n</DualDialogue>\n") + (dialog "{{content}}") + (character "<Paragraph Type=\"Character\" StartsNewPage=\"{{starts-new-page}}\">\n<Text>{{content}}</Text>\n</Paragraph>\n") + (paren "<Paragraph Type=\"Parenthetical\" StartsNewPage=\"{{starts-new-page}}\">\n<Text>{{content}}</Text>\n</Paragraph>\n") + (lines "<Paragraph Type=\"Dialogue\" StartsNewPage=\"{{starts-new-page}}\">\n<Text>{{content}}</Text>\n</Paragraph>\n") + (trans "<Paragraph Type=\"Transition\" StartsNewPage=\"{{starts-new-page}}\">\n<Text>{{content}}</Text>\n</Paragraph>\n") + (action "<Paragraph Type=\"Action\" StartsNewPage=\"{{starts-new-page}}\">\n<Text>{{content}}</Text>\n</Paragraph>\n") + (page-break nil) + (synopsis nil) + (note nil) + (center "<Paragraph Alignment=\"Center\" Type=\"Action\" StartsNewPage=\"{{starts-new-page}}\">\n<Text>{{content}}</Text>\n</Paragraph>\n")) + (define-fountain-export-template-docstring 'fdx) + :type 'fountain-element-list-type + :group 'fountain-final-draft-export) + +(defcustom fountain-export-fdx-hook + nil + "Hook run with export buffer on sucessful export to Final Draft." + :type 'hook + :group 'fountain-final-draft-export) + +(defun fountain-export-buffer-to-fdx () + "Convenience function for exporting buffer to Final Draft." + (interactive) + (fountain-export-buffer 'fdx)) + + +;;; -> Fountain + +(defgroup fountain-fountain-export () + "Options for exporting Fountain files to Fountain." + :prefix "fountain-export-fountain-" + :group 'fountain-export) + +(defcustom fountain-export-fountain-title-page-template + "\ +title: {{title}} +credit: {{credit}} +author: {{author}} +date: {{date}} +contact: {{contact}}" + "Template for Fountain title page. +This just adds the current metadata to the exported file." + :type 'string + :group 'fountain-fountain-export) + +(defcustom fountain-export-fountain-template + '((document "\ +{{title-page}} + +{{content}}") + (section "{{content}}") + (section-heading "{{level}} {{content}}\n\n") + (scene "{{content}}") + (scene-heading "{{scene-heading-spacing}}{{forced}}{{content}}\n\n") + (dual-dialog "{{content}}\n") + (dialog "{{content}}\n") + (character "{{forced}}{{content}}{{dual-dialog}}\n") + (paren "{{content}}\n") + (lines "{{content}}\n") + (trans "{{forced}}{{content}}\n\n") + (action "{{forced}}{{content}}\n\n") + (page-break "=== {{content}} ===\n\n") + (synopsis "= {{content}}\n\n") + (note "[[ {{content}} ]]\n\n") + (center "> {{content}} <")) + (define-fountain-export-template-docstring 'fountain) + :type 'fountain-element-list-type + :group 'fountain-fountain-export) + +(defcustom fountain-export-fountain-hook + nil + "Hook run with export buffer on sucessful export to Fountain." + :type 'hook + :group 'fountain-fountain-export) + +(defun fountain-export-buffer-to-fountain () + "Convenience function for exporting buffer to Fountain." + (interactive) + (fountain-export-buffer 'fountain)) + + +;;; Outlining + +(require 'outline) + +(defvar-local fountain--outline-cycle + 0 + "Internal local integer representing global outline cycling status. + + 0: Show all + 1: Show level 1 section headings + 2: Show level 2 section headings + 3: Show level 3 section headings + 4: Show level 4 section headings + 5: Show level 5 section headings + 6: Show scene headings + +Used by `fountain-outline-cycle'.") + +(defvar-local fountain--outline-cycle-subtree + 0 + "Internal local integer representing subtree outline cycling status. + +Used by `fountain-outline-cycle'.") + +(defcustom fountain-outline-startup-level + 0 + "Outline level to show when visiting a file. + +This can be set on a per-file basis by including in metadata: + +\tstartup-level: N" + :type '(choice (const :tag "Show all" 0) + (const :tag "Show top-level" 1) + (const :tag "Show scene headings" 6) + (integer :tag "Custom level")) + :group 'fountain) + +(defcustom fountain-outline-custom-level + nil + "Additional section headings to include in outline cycling." + :type '(choice (const :tag "Only top-level" nil) + (const :tag "Include level 2" 2) + (const :tag "Include level 3" 3) + (const :tag "Include level 4" 4) + (const :tag "Include level 5" 5)) + :group 'fountain) + +(defalias 'fountain-outline-next 'outline-next-visible-heading) +(defalias 'fountain-outline-previous 'outline-previous-visible-heading) +(defalias 'fountain-outline-forward 'outline-forward-same-level) +(defalias 'fountain-outline-backward 'outline-backward-same-level) +(defalias 'fountain-outline-up 'outline-up-heading) +(defalias 'fountain-outline-mark 'outline-mark-subtree) + +(when (< emacs-major-version 25) + (defalias 'outline-show-all 'show-all) + (defalias 'outline-show-entry 'show-entry) + (defalias 'outline-show-subtree 'show-subtree) + (defalias 'outline-show-children 'show-children) + (defalias 'outline-hide-subtree 'hide-subtree) + (defalias 'outline-hide-sublevels 'hide-sublevels)) + +(defun fountain-outline-invisible-p (&optional pos) + "Non-nil if the character after POS has outline invisible property. +If POS is nil, use `point' instead." + (eq (get-char-property (or pos (point)) 'invisible) 'outline)) + +(defun fountain-outline-shift-down (&optional n) + "Move the current subtree down past N headings of same level." + (interactive "p") + (outline-back-to-heading) + (let* (hanging-line + (move-fun + (if (< 0 n) + 'outline-get-next-sibling + 'outline-get-last-sibling)) + (end-point-fun + (lambda () + (outline-end-of-subtree) + ;; Add newline if none at eof. + (if (and (eobp) + (/= (char-before) ?\n)) + (insert-char ?\n)) + ;; Temporary newline if only 1 at eof + (when (and (eobp) + (not (fountain-blank-before-p))) + (insert-char ?\n) + (setq hanging-line t)) + ;; Avoid eobp signal. + (unless (eobp) + (forward-char 1)) + (point))) + (beg (point)) + (folded + (save-match-data + (outline-end-of-heading) + (outline-invisible-p))) + (end + (save-match-data + (funcall end-point-fun))) + (insert-point (make-marker)) + (i (abs n))) + (goto-char beg) + (while (< 0 i) + (or (funcall move-fun) + (progn (goto-char beg) + (message "Cannot shift past higher level"))) + (setq i (1- i))) + (if (< 0 n) + (funcall end-point-fun)) + (set-marker insert-point (point)) + (insert (delete-and-extract-region beg end)) + (goto-char insert-point) + (if folded + (outline-hide-subtree)) + ;; Remove temporary newline. + (if hanging-line + (save-excursion + (goto-char (point-max)) + (delete-char -1))) + (set-marker insert-point nil))) + +(defun fountain-outline-shift-up (&optional n) + "Move the current subtree up past N headings of same level." + (interactive "p") + (fountain-outline-shift-down (- n))) + +(defun fountain-outline-hide-level (n &optional silent) + "Set outline visibilty to outline level N. +Display a message unless SILENT." + (cond ((= n 0) + (outline-show-all) + (unless silent (message "Showing all"))) + ((= n 6) + (outline-hide-sublevels n) + (unless silent (message "Showing scene headings"))) + (t + (outline-hide-sublevels n) + (unless silent (message "Showing level %s headings" n)))) + (setq fountain--outline-cycle n)) + +(defun fountain-outline-cycle (&optional arg) ; FIXME: document + "\\<fountain-mode-map>Cycle outline visibility depending on ARG. + +1. If ARG is nil, cycle outline visibility of current subtree and + its children (\\[fountain-outline-cycle]). + +2. If ARG is 4, cycle outline visibility of buffer (\\[universal-argument] \\[fountain-outline-cycle], + same as \\[fountain-outline-cycle-global]). + +3. If ARG is 16, show all (\\[universal-argument] \\[universal-argument] \\[fountain-outline-cycle]). + +4. If ARG is 64, show outline visibility set in + `fountain-outline-custom-level' (\\[universal-argument] \\[universal-argument] \\[universal-argument] \\[fountain-outline-cycle])." + (interactive "p") + (let ((custom-level + (if fountain-outline-custom-level + (save-excursion + (goto-char (point-min)) + (let (found) + (while (and (not found) + (outline-next-heading)) + (if (= (funcall outline-level) + fountain-outline-custom-level) + (setq found t))) + (if found fountain-outline-custom-level))))) + (highest-level + (save-excursion + (goto-char (point-max)) + (outline-back-to-heading t) + (let ((level (funcall outline-level))) + (while (and (not (bobp)) + (< 1 level)) + (outline-up-heading 1 t) + (unless (bobp) + (setq level (funcall outline-level)))) + level)))) + (cond ((eq arg 4) + (cond + ((and (= fountain--outline-cycle 1) custom-level) + (fountain-outline-hide-level custom-level)) + ((< 0 fountain--outline-cycle 6) + (fountain-outline-hide-level 6)) + ((= fountain--outline-cycle 6) + (fountain-outline-hide-level 0)) + ((= highest-level 6) + (fountain-outline-hide-level 6)) + (t + (fountain-outline-hide-level highest-level)))) + ((eq arg 16) + (outline-show-all) + (message "Showing all") + (setq fountain--outline-cycle 0)) + ((and (eq arg 64) custom-level) + (fountain-outline-hide-level custom-level)) + (t + (save-excursion + (outline-back-to-heading) + (let ((eoh + (save-excursion + (outline-end-of-heading) + (point))) + (eos + (save-excursion + (outline-end-of-subtree) + (point))) + (eol + (save-excursion + (forward-line 1) + (while (and (not (eobp)) + (get-char-property (1- (point)) 'invisible)) + (forward-line 1)) + (point))) + (children + (save-excursion + (outline-back-to-heading) + (let ((level (funcall outline-level))) + (outline-next-heading) + (and (outline-on-heading-p t) + (< level (funcall outline-level))))))) + (cond + ((= eos eoh) + (message "Empty heading") + (setq fountain--outline-cycle-subtree 0)) + ((and (<= eos eol) + children) + (outline-show-entry) + (outline-show-children) + (message "Showing headings") + (setq fountain--outline-cycle-subtree 2)) + ((or (<= eos eol) + (= fountain--outline-cycle-subtree 2)) + (outline-show-subtree) + (message "Showing contents") + (setq fountain--outline-cycle-subtree 3)) + (t + (outline-hide-subtree) + (message "Hiding contents") + (setq fountain--outline-cycle-subtree 1))))))))) + +(defun fountain-outline-cycle-global () + "Globally cycle outline visibility. + +Calls `fountain-outline-cycle' with argument 4 to cycle buffer +outline visibility through the following states: + +1. Top-level section headings + +2. Value of `fountain-outline-custom-level' + +3. All section headings and scene headings + +4. Everything" + (interactive) + (fountain-outline-cycle 4)) + +(defun fountain-outline-level () + "Return the heading's nesting level in the outline. +Assumes that point is at the beginning of a heading and match +data reflects `outline-regexp'." + (cond ((string-match fountain-end-regexp (match-string 0)) + 1) + ((string-prefix-p "#" (match-string 0)) + (string-width (match-string 2))) + (t 6))) + + +;;; Navigation + +(defun fountain-forward-scene (&optional n) + "Move forward N scene headings (backward if N is negative). +If N is 0, move to beginning of scene." + (interactive "^p") + (unless n (setq n 1)) + (let* ((p (if (<= n 0) -1 1)) + (move-fun + (lambda () + (while (not (or (eq (point) (buffer-end p)) + (fountain-match-scene-heading))) + (forward-line p))))) + (if (/= n 0) + (while (/= n 0) + (if (fountain-match-scene-heading) + (forward-line p)) + (funcall move-fun) + (setq n (- n p))) + (forward-line 0) + (funcall move-fun)))) + +(defun fountain-backward-scene (&optional n) + "Move backward N scene headings (foward if N is negative)." + (interactive "^p") + (or n (setq n 1)) + (fountain-forward-scene (- n))) + +(defun fountain-beginning-of-scene () ; FIXME: needed? + "Move point to beginning of current scene." + (interactive "^") + (fountain-forward-scene 0)) + +(defun fountain-end-of-scene () ; FIXME: needed? + "Move point to end of current scene." + (interactive "^") + (fountain-forward-scene 1) + (unless (eobp) + (forward-char -1))) + +(defun fountain-mark-scene () ; FIXME: extending region + "Put mark at end of this scene, point at beginning." + (interactive) + ;; (if (or extend + ;; (and (region-active-p) + ;; (eq last-command this-command))) + ;; (progn + ;; (fountain-forward-scene 1) + ;; (push-mark) + ;; (exchange-point-and-mark)) + (push-mark) + (fountain-forward-scene 0) + (if (not (or (fountain-match-section-heading) + (fountain-match-scene-heading))) + (progn + (goto-char (mark)) + (user-error "Before first scene heading")) + (push-mark) + (fountain-forward-scene 1) + (exchange-point-and-mark))) + +(defun fountain-goto-scene (n) + "Move point to Nth scene in current buffer. + +Ignores revised scene numbers scenes. + + 10 = 10 + 10B = 10 + A10 = 9" + (interactive "NGo to scene: ") + (push-mark) + (goto-char (point-min)) + (let ((scene (if (fountain-match-scene-heading) + (car (fountain-scene-number-to-list (match-string 6))) + 0))) + (while (and (< scene n) + (< (point) (point-max))) + (fountain-forward-scene 1) + (if (fountain-match-scene-heading) + (setq scene (or (car (fountain-scene-number-to-list (match-string 6))) + (1+ scene))))))) + +(defun fountain-goto-page (n) + "Move point to Nth appropropriate page in current buffer." + (interactive "NGo to page: ") + (push-mark) + (goto-char (point-min)) + (fountain-forward-page n (fountain-get-export-elements))) + +(defun fountain-forward-character (&optional n limit) + "Goto Nth next character (or Nth previous is N is negative). +If LIMIT is 'dialog, halt at end of dialog. If LIMIT is 'scene, +halt at end of scene." + (interactive "^p") + (unless n (setq n 1)) + (let* ((p (if (<= n 0) -1 1)) + (move-fun + (lambda () + (while (cond ((eq limit 'dialog) + (and (not (= (point) (buffer-end p))) + (or (and (bolp) (eolp)) + (forward-comment p) + (fountain-match-dialog) + (fountain-match-paren)))) + ((eq limit 'scene) + (not (or (= (point) (buffer-end p)) + (fountain-match-character) + (fountain-match-scene-heading)))) + ((not (or (= (point) (buffer-end p)) + (fountain-match-character))))) + (forward-line p))))) + (if (/= n 0) + (while (/= n 0) + (if (fountain-match-character) + (forward-line p)) + (funcall move-fun) + (setq n (- n p))) + (forward-line 0) + (funcall move-fun)))) + +(defun fountain-backward-character (&optional n) + "Move backward N character (foward if N is negative)." + (interactive "^p") + (setq n (or n 1)) + (fountain-forward-character (- n))) + + +;;; Endnotes + +(defgroup fountain-endnotes () + "Options for displaying endnotes. + +Fountain endnotes are kept at the end of a script following an +endotes page break, defined as three or more \"=\" and the word +\"end\" (case-insensitive). + + === end [===] + +The endnotes section is a good place to keep extensive notes or +scenes you want to move out of the script, but still wish to +reference. Endnotes are not exported. + +WARNING: if using other Fountain apps, check to make sure they +support endnotes." + :group 'fountain) + +(defcustom fountain-endnotes-buffer-name + "%s<endnotes>" + "Name of buffer in which to display file endnotes. +`%s' is replaced with `buffer-name'. + +To hide this buffer from the buffer list, prefix with a space." + :type 'string + :group 'fountain-endnotes) + +(defcustom fountain-endnotes-select-window + nil + "If non-nil, switch to endnotes window upon displaying it." + :type 'boolean + :group 'fountain-endnotes) + +(defcustom fountain-endnotes-window-side + 'right + "Preferred side of frame to display endnotes window." + :type '(choice (const :tag "Left" left) + (const :tag "Right" right) + (const :tag "Top" top) + (const :tag "Bottom" bottom)) + :group 'fountain-endnotes) + +(defcustom fountain-endnotes-window-size + '(0.3 0.25) + "Height and width of the endnotes window as a fraction of root window." + :type '(list (float :tag "Height") + (float :tag "Width")) + :group 'fountain-endnotes) + +;; (defcustom fountain-endnotes-display-function +;; 'display-buffer-pop-up-window +;; "Buffer display function used to display endnotes." +;; :type '(radio (const :tag "Pop-up new window" display-buffer-pop-up-window) +;; (const :tag "Pop-up new frame" display-buffer-pop-up-frame) +;; (const :tag "Show in same window" display-buffer-same-window)) +;; :group 'fountain-endnotes) + +(defun fountain-show-or-hide-endnotes () + "Pop up a window containing endnotes of current buffer. + +Display a window containing an indirect clone of the current +buffer, narrowed to the first endnotes page break to the end of +buffer. + +The window displayed is a special \"side\" window, which will +persist even when calling \\[delete-other-windows]." + (interactive) + (set-buffer (or (buffer-base-buffer) (current-buffer))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let ((beg (if (re-search-forward fountain-end-regexp nil t) + (point))) + (src (current-buffer)) + (buf (format fountain-endnotes-buffer-name (buffer-name)))) + (if beg + (if (get-buffer-window buf (selected-frame)) + (delete-windows-on buf (selected-frame)) + (display-buffer-in-side-window + (or (get-buffer buf) + (make-indirect-buffer src buf t)) + (list (cons 'inhibit-same-window t) + (cons 'side fountain-endnotes-window-side) + (cons 'window-height (car fountain-endnotes-window-size)) + (cons 'window-width (cadr fountain-endnotes-window-size)))) + (with-current-buffer buf + (narrow-to-region (1+ beg) (point-max))) + (if fountain-endnotes-select-window + (select-window (get-buffer-window buf (selected-frame)))) + (message "Showing `%s' endnotes; %s to hide" src + (key-description (where-is-internal this-command + overriding-local-map t)))) + (user-error "Buffer `%s' does not contain endnotes" (buffer-name))))))) + + +;;; Editing + +(defcustom fountain-auto-upcase-scene-headings + t + "If non-nil, automatically upcase lines matching `fountain-scene-heading-regexp'." + :type 'boolean + :group 'fountain) + +(defvar-local fountain--auto-upcase-line + nil + "Integer of line number to auto-upcase. +If nil, auto-upcase is deactivated.") + +(defvar-local fountain--auto-upcase-overlay + nil + "Overlay used for auto-upcasing current line.") + +(defun fountain-auto-upcase-make-overlay () + "Make the auto-upcase overlay on current line. + +If overlay `fountain--auto-upcase-overlay' already exists, delete +it first. + +Make the overlay and add the face +`fountain-auto-upcase-highlight'." + (if (overlayp fountain--auto-upcase-overlay) + (delete-overlay fountain--auto-upcase-overlay)) + (setq fountain--auto-upcase-overlay + (make-overlay (line-beginning-position 1) + (line-beginning-position 2) nil nil t)) + (overlay-put fountain--auto-upcase-overlay 'face 'fountain-auto-upcase-highlight)) + +(defun fountain-auto-upcase-deactivate-maybe (&optional deactivate) + "Maybe deactivate auto-upcasing. +Always deactivate if optional argument DEACTIVATE is non-nil. + +Added as hook to `post-command-hook'." + (when (or deactivate + (and (integerp fountain--auto-upcase-line) + (/= fountain--auto-upcase-line + (count-lines (point-min) (line-beginning-position))))) + (setq fountain--auto-upcase-line nil) + (if (overlayp fountain--auto-upcase-overlay) + (delete-overlay fountain--auto-upcase-overlay)) + (message "Auto-upcasing disabled"))) + +(defun fountain-auto-upcase () + "Upcase all or part of the current line contextually. + +If `fountain-auto-upcase-scene-headings' is non-nil and point is +at a scene heading, activate auto upcasing for beginning of line +to scene number or point. + +Otherwise, activate auto-upcasing for the whole line. + +Added as hook to `post-self-insert-hook'." + (cond ((and fountain-auto-upcase-scene-headings + (fountain-match-scene-heading)) + (setq fountain--auto-upcase-line + (count-lines (point-min) (line-beginning-position))) + (fountain-auto-upcase-make-overlay) + (upcase-region (line-beginning-position) + (or (match-end 3) + (point)))) + ((and (integerp fountain--auto-upcase-line) + (= fountain--auto-upcase-line + (count-lines (point-min) (line-beginning-position)))) + (fountain-upcase-line)))) + +(defun fountain-dwim (&optional arg) + "\\<fountain-mode-map>Call a command based on context (Do What I Mean). + +1. If point is at a scene heading or section heading, or if + prefixed with ARG (\\[universal-argument] \\[fountain-dwim]) call `fountain-outline-cycle' + and pass ARG, e.g. \\[universal-argument] \\[universal-argument] \\[fountain-dwim] is the same as + \\[universal-argument] \\[universal-argument] \\[fountain-outline-cycle]. + +2. If point is at an directive to an included file, call + `fountain-include-find-file'. + +3. Otherwise, upcase the current line and active auto-upcasing. + This highlights the current line with face + `fountain-auto-upcase-highlight' and will continue to upcase + inserted characters until the command is called again + (\\[fountain-dwim]) or point moves to a different line (either + by inserting a newline or point motion). This allows a + flexible style of entering character names. You may press + \\[fountain-dwim] before, during or after typing the name to + get the same result." + (interactive "p") + (cond ((< 1 arg) + (fountain-outline-cycle arg)) + ((or (fountain-match-section-heading) + (fountain-match-scene-heading)) + (fountain-outline-cycle)) + ((fountain-match-include) + (fountain-include-find-file)) + (fountain--auto-upcase-line + (fountain-auto-upcase-deactivate-maybe t)) + (t + (setq fountain--auto-upcase-line + (count-lines (point-min) (line-beginning-position))) + (fountain-auto-upcase-make-overlay) + (fountain-upcase-line) + (message "Auto-upcasing enabled")))) + +(defun fountain-upcase-line (&optional arg) + "Upcase the line. +If prefixed with ARG, insert `.' at beginning of line to force +a scene heading." + (interactive "P") + (if arg + (save-excursion + (forward-line 0) + (insert "."))) + (upcase-region (line-beginning-position) (line-end-position))) + +(defun fountain-upcase-line-and-newline (&optional arg) + "Upcase the line and insert a newline. +If prefixed with ARG, insert `.' at beginning of line to force +a scene heading." + (interactive "P") + (if arg + (unless (fountain-match-scene-heading) + (save-excursion + (forward-line 0) + (insert ".")))) + (upcase-region (line-beginning-position) (point)) + (newline)) + +(defun fountain-delete-comments-in-region (start end) + "Delete comments in region between START and END." + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char start) + (while (< (point) end) + (let ((x (point))) + (if (forward-comment 1) + (delete-region x (point)) + (unless (eobp) (forward-char 1))))))) + +(defun fountain-insert-alternate-character () + "Insert second-last character within the scene, and newline." + (interactive) + (let* ((n -1) + (character-1 (fountain-get-character n 'scene)) + (character-2 character-1)) + (while (and (stringp character-1) + (string= character-1 character-2)) + (setq n (1- n) + character-2 (fountain-get-character n 'scene))) + (if character-2 + (let ((x (save-excursion + (skip-chars-backward "\s\n\t") + (point)))) + (delete-region x (point)) + (newline 2) + (insert character-2)) + (message "No alternate character within scene")) + (newline))) + +(defun fountain-insert-synopsis () + "Insert synopsis below scene heading of current scene." + (interactive) + (widen) + (when (outline-back-to-heading) + (forward-line 1) + (or (bolp) (newline)) + (unless (and (bolp) (eolp) + (fountain-blank-after-p)) + (save-excursion + (newline))) + (insert "= ") + (if (outline-invisible-p) (fountain-outline-cycle)))) + +(defun fountain-insert-note (&optional arg) + "Insert a note based on `fountain-note-template' underneath current element. +If region is active and it is appropriate to act on, only +surround region with note delimiters (`[[ ]]'). If prefixed with +ARG (\\[universal-argument]), only insert note delimiters." + (interactive "P") + (let ((comment-start "[[") + (comment-end "]]")) + (if (or arg (use-region-p)) + (comment-dwim nil) + (unless (and (bolp) (eolp)) + (re-search-forward "^[\s\t]*$" nil 'move)) + (unless (fountain-blank-after-p) + (save-excursion + (newline))) + (comment-indent) + (insert + (replace-regexp-in-string + fountain-template-key-regexp + (lambda (match) + (let ((key (match-string 1 match))) + (cdr + (assoc-string key (list (cons 'title (file-name-base (buffer-name))) + (cons 'time (format-time-string fountain-time-format)) + (cons 'fullname user-full-name) + (cons 'nick (capitalize user-login-name)) + (cons 'email user-mail-address)))))) + fountain-note-template))))) + +(defun fountain-continued-dialog-refresh () + "Add or remove continued dialog in buffer. + +If `fountain-add-continued-dialog' is non-nil, add +`fountain-continued-dialog-string' on characters speaking in +succession, otherwise remove all occurences. + +If `fountain-continued-dialog-string' has changed, also attempt +to remove previous string first." + (interactive) + (save-excursion + (save-restriction + (widen) + (let ((job (make-progress-reporter "Refreshing continued dialog...")) + (backup (car (get 'fountain-continued-dialog-string + 'backup-value))) + (replace-fun + (lambda (string job) + (goto-char (point-min)) + (while (re-search-forward + (concat "\s*" string) nil t) + (let ((inhibit-changing-match-data t)) + (when (fountain-match-character) + (delete-region (match-beginning 0) (match-end 0)))) + (progress-reporter-update job)))) + case-fold-search) + (if (string= fountain-continued-dialog-string backup) + (setq backup (eval (car (get 'fountain-continued-dialog-string + 'standard-value))))) + ;; Delete all matches of backup string. + (if (stringp backup) (funcall replace-fun backup job)) + ;; Delete all matches of current string. + (funcall replace-fun fountain-continued-dialog-string job) + ;; When fountain-add-continued-dialog, add string where appropriate. + (when fountain-add-continued-dialog + (goto-char (point-min)) + (while (< (point) (point-max)) + (when (and (not (looking-at-p + (concat ".*" fountain-continued-dialog-string "$"))) + (fountain-match-character) + (string= (fountain-get-character 0) + (fountain-get-character -1 'scene))) + (re-search-forward "\s*$" (line-end-position) t) + (replace-match (concat "\s" fountain-continued-dialog-string))) + (forward-line 1) + (progress-reporter-update job))) + (progress-reporter-done job))))) + + +;;; Scene Numbers + +(defcustom fountain-prefix-revised-scene-numbers + nil + "If non-nil, new scene numbers get prefixed revision characters. + +If nil, when inserting new scene headings after numbering +existing scene headings, revised scene number format works as +follows: + + 10 + 10A <- new scene + 11 + +If non-nil, revised scene number format works as follows: + + 10 + A11 <- new scene + 11 + +WARNING: Using conflicting revised scene number format in the +same script may result in errors in output." + :type 'boolean + :group 'fountain) + +(defcustom fountain-scene-number-first-revision + ?A + "Character to start revised scene numbers." + :type 'character + :group 'fountain-scene-number) + +(defcustom fountain-scene-number-separator + nil + "character to separate scene numbers." + :type '(choice (const nil) + (character ?-)) + :group 'fountain-scene-number) + +(defun fountain-scene-number-to-list (string) ; FIXME: alternate separators and starting char + "Read scene number STRING and return a list. + +If `fountain-prefix-revised-scene-numbers' is non-nil: + + \"10\" -> (10) + \"AA10\" -> (9 1 1) + +Or if nil: + + \"10\" -> (10) + \"10AA\" -> (10 1 1)" + (let (number revision) + (when (stringp string) + (if fountain-prefix-revised-scene-numbers + (when (string-match "\\([a-z]*\\)[\\.-]*\\([0-9]+\\)[\\.-]*" string) + (setq number (string-to-number (match-string 2 string)) + revision (match-string 1 string)) + (unless (string-empty-p revision) (setq number (1- number)))) + (when (string-match "\\([0-9]+\\)[\\.-]*\\([a-z]*\\)[\\.-]*" string) + (setq number (string-to-number (match-string-no-properties 1 string)) + revision (match-string-no-properties 2 string)))) + (setq revision (mapcar #'(lambda (n) (- (upcase n) 64)) revision)) + (cons number revision)))) + +(defun fountain-scene-number-to-string (scene-num-list) + "Read scene number SCENE-NUM-LIST and return a string. + +If `fountain-prefix-revised-scene-numbers' is non-nil: + + (10) -> \"10\" + (9 1 2) -> \"AB10\" + +Or, if nil: + + (10) -> \"10\" + (9 1 2) -> \"9AB\"" + (let ((number (car scene-num-list)) + separator revision) + (if (< 1 (length scene-num-list)) + (setq separator + (if fountain-scene-number-separator + (char-to-string fountain-scene-number-separator) + "") + revision + (mapconcat #'(lambda (char) + (char-to-string + (+ (1- char) fountain-scene-number-first-revision))) + (cdr scene-num-list) separator))) + (if fountain-prefix-revised-scene-numbers + (progn + (unless (string-empty-p revision) (setq number (1+ number))) + (concat revision separator (number-to-string number))) + (concat (number-to-string number) separator revision)))) + +(defun fountain-get-scene-number (&optional n) + "Return the scene number of the Nth next scene as a list. +Return Nth previous if N is negative. + +Scene numbers will not be accurate if buffer contains directives +to include external files." + (unless n (setq n 0)) + (save-excursion + (save-restriction + (widen) + ;; Make sure we're at a scene heading. + (fountain-forward-scene 0) + ;; Go to the Nth scene. + (unless (= n 0) (fountain-forward-scene n)) + ;; Unless we're at a scene heading now, raise a user error. + (unless (fountain-match-scene-heading) + (user-error "Before first scene heading")) + (let ((x (point)) + (err-order "Scene `%s' seems to be out of order") + found) + ;; First, check if there are any scene numbers already. If not we can + ;; save a lot of work. + ;; FIXME: this is just extra work since we're doing for each scene heading + (save-match-data + (goto-char (point-min)) + (while (not (or found (eobp))) + (if (and (re-search-forward fountain-scene-heading-regexp nil 'move) + (match-string 6)) + (setq found t)))) + (if found + ;; There are scene numbers, so this scene number needs to be + ;; calculated relative to those. + (let ((current-scene (fountain-scene-number-to-list (match-string 6))) + last-scene next-scene) + ;; Check if scene heading is already numbered and if there is a + ;; NEXT-SCENE. No previousscene number can be greater or equal to + ;; this. + (goto-char x) + (while (not (or next-scene (eobp))) + (fountain-forward-scene 1) + (if (fountain-match-scene-heading) + (setq next-scene (fountain-scene-number-to-list (match-string 6))))) + (cond + ;; If there's both a NEXT-SCENE and CURRENT-SCENE, but NEXT-SCENE + ;; is less or equal to CURRENT-SCENE, scene numbers are out of + ;; order. + ((and current-scene next-scene + (version-list-<= next-scene current-scene)) + (user-error err-order (fountain-scene-number-to-string current-scene))) + ;; Otherwise, if there is a CURRENT-SCENE and either no + ;; NEXT-SCENE or there is and it's greater then CURRENT-SCENE, + ;; just return CURRENT-SCENE. + (current-scene) + (t + ;; There is no CURRENT-SCENE yet, so go to the first scene + ;; heading and if it's already numberd set it to that, or just + ;; (list 1). + (goto-char (point-min)) + (unless (fountain-match-scene-heading) + (fountain-forward-scene 1)) + (if (<= (point) x) + (setq current-scene + (or (fountain-scene-number-to-list (match-string 6)) + (list 1)))) + ;; While before point X, go forward through each scene heading, + ;; setting LAST-SCENE to CURRENT-SCENE and CURRENT-SCENE to an + ;; incement of (car LAST-SCENE). + (while (< (point) x (point-max)) + (fountain-forward-scene 1) + (when (fountain-match-scene-heading) + (setq last-scene current-scene + current-scene (or (fountain-scene-number-to-list (match-string 6)) + (list (1+ (car last-scene))))) + ;; However, this might make CURRENT-SCENE greater or equal + ;; to NEXT-SCENE (a problem), so if there is a NEXT-SCENE, + ;; and NEXT-SCENE is less or equal to CURRENT-SCENE: + ;; + ;; 1. pop (car LAST-SCENE), which should always be less than + ;; NEXT-SCENE as N + ;; 2. set CURRENT-SCENE to (list TMP-SCENE (1+ N)) + ;; 3. set TMP-SCENE to (list TMP-SCENE n) + ;; + ;; Loop through this so that the last (or only) element of + ;; CURRENT-SCENE is incremented by 1, and TMP-SCENE is + ;; appended with N or 1. e.g. + ;; + ;; CURRENT-SCENE (4 2) -> (4 3) + ;; TMP-SCENE (4 2) -> (4 2 1) + ;; + ;; Return CURRENT-SCENE. + (let (n tmp-scene) + (while (and next-scene (version-list-<= next-scene current-scene)) + (setq n (pop last-scene) + current-scene (append tmp-scene (list (1+ (or n 0)))) + tmp-scene (append tmp-scene (list (or n 1)))) + (if (version-list-<= next-scene tmp-scene) + (user-error err-order (fountain-scene-number-to-string current-scene))))))) + current-scene))) + ;; Otherwise there were no scene numbers, so we can just count + ;; the scenes. + (goto-char (point-min)) + (unless (fountain-match-scene-heading) + (fountain-forward-scene 1)) + (let ((current-scene 1)) + (while (< (point) x) + (fountain-forward-scene 1) + (if (fountain-match-scene-heading) + (setq current-scene (1+ current-scene)))) + (list current-scene))))))) + +(defun fountain-remove-scene-numbers () + "Remove scene numbers from scene headings in current buffer." + (interactive) + (save-excursion + (save-restriction + (widen) + (let (buffer-invisibility-spec) + (goto-char (point-min)) + (unless (fountain-match-scene-heading) + (fountain-forward-scene 1)) + (while (and (fountain-match-scene-heading) + (< (point) (point-max))) + (if (match-string 6) + (delete-region (match-beginning 4) + (match-end 7))) + (fountain-forward-scene 1)))))) + +(defun fountain-add-scene-numbers () + "Add scene numbers to scene headings in current buffer. + +Adding scene numbers to scene headings after numbering existing +scene headings will use a prefix or suffix letter, depending on +the value of `fountain-prefix-revised-scene-numbers': + + 10 + 10A <- new scene + 10B <- new scene + 11 + +If further scene headings are inserted: + + 10 + 10A + 10AA <- new scene + 10B + 11 + +In this example, you can't automatically number a new scene +between 10 and 10A (which might be numbered as 10aA). Instead, +add these scene numbers manually. Note that if +`fountain-auto-upcase-scene-headings' is non-nil you will need to +insert the scene number delimiters (\"##\") first, to protect the +scene number from being auto-upcased." + (interactive) + (save-excursion + (save-restriction + (widen) + (let ((job (make-progress-reporter "Adding scene numbers...")) + buffer-invisibility-spec) + (goto-char (point-min)) + (unless (fountain-match-scene-heading) + (fountain-forward-scene 1)) + (while (and (fountain-match-scene-heading) + (< (point) (point-max))) + (unless (match-string 6) + (end-of-line) + (delete-horizontal-space t) + (insert "\s#" (fountain-scene-number-to-string (fountain-get-scene-number)) "#")) + (fountain-forward-scene 1) + (progress-reporter-update job)) + (progress-reporter-done job))))) + + +;;; Font Lock + +(defvar fountain-font-lock-keywords-plist + `(;; Action + ((lambda (limit) + (fountain-match-element 'fountain-match-action limit)) + ((:level 1 :subexp 0 :face fountain-action + :invisible action) + (:level 2 :subexp 1 :face fountain-non-printing + :invisible fountain-syntax-chars + :override t + :laxmatch t)) + fountain-align-action) + ;; Section Headings + (,fountain-section-heading-regexp + ((:level 2 :subexp 0 :face fountain-section-heading + :invisible section-heading) + (:level 2 :subexp 2 :face fountain-non-printing + :override t)) + fountain-align-scene-heading) + ;; Scene Headings + ((lambda (limit) + (fountain-match-element 'fountain-match-scene-heading limit)) + ((:level 2 :subexp 0 :face fountain-scene-heading + :invisible scene-heading) + (:level 2 :subexp 2 :face fountain-non-printing + :invisible fountain-syntax-chars + :override prepend + :laxmatch t) + (:level 2 :subexp 4 + :laxmatch t) + (:level 2 :subexp 5 :face fountain-non-printing + :invisible fountain-syntax-chars + :override prepend + :laxmatch t) + (:level 2 :subexp 6 + :override prepend + :laxmatch t) + (:level 2 :subexp 7 :face fountain-non-printing + :invisible fountain-syntax-chars + :override prepend + :laxmatch t)) + fountain-align-scene-heading) + ;; Character + ((lambda (limit) + (fountain-match-element 'fountain-match-character limit)) + ((:level 3 :subexp 0 :face fountain-character + :invisible character) + (:level 3 :subexp 2 + :invisible fountain-syntax-chars + :override t + :laxmatch t) + (:level 3 :subexp 5 :face highlight + :override append + :laxmatch t)) + fountain-align-character) + ;; Parenthetical + ((lambda (limit) + (fountain-match-element 'fountain-match-paren limit)) + ((:level 3 :subexp 0 :face fountain-paren + :invisible paren)) + fountain-align-paren) + ;; Dialog + ((lambda (limit) + (fountain-match-element 'fountain-match-dialog limit)) + ((:level 3 :subexp 0 :face fountain-dialog + :invisible dialog)) + fountain-align-dialog) + ;; Transition + ((lambda (limit) + (fountain-match-element 'fountain-match-trans limit)) + ((:level 3 :subexp 0 :face fountain-trans + :invisible trans) + (:level 2 :subexp 2 :face fountain-comment + :invisible fountain-syntax-chars + :override t + :laxmatch t)) + fountain-align-trans) + ;; Center text + (,fountain-center-regexp + ((:level 2 :subexp 2 :face fountain-comment + :invisible fountain-syntax-chars + :override t) + (:level 3 :subexp 3 + :invisible center) + (:level 2 :subexp 4 :face fountain-comment + :invisible fountain-syntax-chars + :override t)) + fountain-align-center) + ;; Page-break + (,fountain-page-break-regexp + ((:level 2 :subexp 0 :face fountain-page-break + :invisible page-break) + (:level 2 :subexp 2 :face fountain-page-number + :override t + :laxmatch t))) + ;; Synopses + (,fountain-synopsis-regexp + ((:level 2 :subexp 0 :face fountain-synopsis + :invisible synopsis) + (:level 2 :subexp 2 :face fountain-comment + :invisible fountain-syntax-chars + :override t)) + fountain-align-synopsis) + ;; Notes + (,fountain-note-regexp + ((:level 2 :subexp 0 :face fountain-note + :invisible note))) + ;; Inclusions + (,fountain-include-regexp + ((:level 2 :subexp 0 :face fountain-include + :invisible include))) + ;; Metedata + ((lambda (limit) + (fountain-match-element 'fountain-match-metadata limit)) + ((:level 2 :subexp 0 :face fountain-metadata-key + :invisible metadata + :laxmatch t) + (:level 2 :subexp 3 :face fountain-metadata-value + :override t + :laxmatch t))) + ;; Underline text + (,fountain-underline-regexp + ((:level 2 :subexp 2 :face fountain-non-printing + :invisible fountain-emphasis-delim + :override append) + (:level 1 :subexp 3 :face underline + :override append) + (:level 2 :subexp 4 :face fountain-non-printing + :invisible fountain-emphasis-delim + :override append))) + ;; Italic text + (,fountain-italic-regexp + ((:level 2 :subexp 2 :face fountain-non-printing + :invisible fountain-emphasis-delim + :override append) + (:level 1 :subexp 3 :face italic + :override append) + (:level 2 :subexp 4 :face fountain-non-printing + :invisible fountain-emphasis-delim + :override append))) + ;; Bold text + (,fountain-bold-regexp + ((:level 2 :subexp 2 :face fountain-non-printing + :invisible fountain-emphasis-delim + :override append) + (:level 1 :subexp 3 :face bold + :override append) + (:level 2 :subexp 4 :face fountain-non-printing + :invisible fountain-emphasis-delim + :override append))) + ;; Bold-Italic text + (,fountain-bold-italic-regexp + ((:level 2 :subexp 2 :face fountain-non-printing + :invisible fountain-emphasis-delim + :override append) + (:level 1 :subexp 3 :face bold-italic + :override append) + (:level 2 :subexp 4 :face fountain-non-printing + :invisible fountain-emphasis-delim + :override append))) + ;; Lyrics + (,fountain-lyrics-regexp + ((:level 1 :subexp 2 :face fountain-non-printing + :invisible fountain-emphasis-delim + :override append) + (:level 1 :subexp 3 :face italic + :override append)))) + "List of face properties to create element Font Lock keywords. +Takes the format: + + (ELEMENT MATCHER SUB-PLIST) + +The first element, ELEMENT, is a string naming the element; if +nil, this face is not considered an element. MATCHER is a regular +expression or search function. SUB-PLIST is a list of plists, +assigning the following keywords: + + :level integer representing level of `font-lock-maximum-decoration' + at which face is applied + :subexp subexpression to match + :face face name to apply + :invisible if t, adds :face property to invisible text property + :override as per `font-lock-keywords' + :laxmatch as per `font-lock-keywords'") + +(defun fountain-get-font-lock-decoration () + "Return the value of `font-lock-maximum-decoration' for `fountain-mode'." + (let ((n (if (listp font-lock-maximum-decoration) + (cdr (or (assq 'fountain-mode font-lock-maximum-decoration) + (assq 't font-lock-maximum-decoration))) + font-lock-maximum-decoration))) + (cond ((null n) 2) + ((eq n t) 3) + ((integerp n) n) + (t 2)))) + +(defun fountain-set-font-lock-decoration (n) + "Set `font-lock-maximum-decoration' for `fountain-mode' to N." + (interactive "NMaximum decoration (1-3): ") + (if (and (integerp n) + (<= 1 n 3)) + (let ((level (cond ((= n 1) 1) + ((= n 2) nil) + ((= n 3) t)))) + (cond ((listp font-lock-maximum-decoration) + (setq font-lock-maximum-decoration + (assq-delete-all 'fountain-mode font-lock-maximum-decoration)) + (customize-set-variable 'font-lock-maximum-decoration + (cons (cons 'fountain-mode level) + font-lock-maximum-decoration))) + ((or (booleanp font-lock-maximum-decoration) + (integerp font-lock-maximum-decoration)) + (customize-set-variable 'font-lock-maximum-decoration + (list (cons 'fountain-mode level) + (cons 't font-lock-maximum-decoration))))) + (message "Syntax highlighting is now: %s" + (cond ((= n 1) "minimum") + ((= n 2) "default") + ((= n 3) "maximum"))) + (font-lock-refresh-defaults) + (font-lock-ensure (save-excursion + (goto-char (point-min)) + (re-search-forward fountain-end-regexp nil 'move) + (point)) + (point-max))) + (user-error "Decoration must be an integer 1-3"))) + +(defun fountain-create-font-lock-keywords () + "Return a new list of `font-lock-mode' keywords. +Uses `fountain-font-lock-keywords-plist' to create a list of +keywords suitable for Font Lock." + (fountain-init-vars) + (let ((dec (fountain-get-font-lock-decoration)) + keywords) + (dolist (var fountain-font-lock-keywords-plist keywords) + (let ((matcher (car var)) + (plist-list (nth 1 var)) + (align (fountain-get-align (symbol-value (nth 2 var)))) + align-props facespec) + (if (and align fountain-align-elements) + (setq align-props + `(line-prefix + (space :align-to ,align) + wrap-prefix + (space :align-to ,align)))) + (dolist (var plist-list) + (let ((subexp (plist-get var :subexp)) + (face (if (<= (plist-get var :level) dec) + (plist-get var :face))) + (invisible (plist-get var :invisible)) + invisible-props) + (if invisible + (setq invisible-props (list 'invisible invisible))) + (setq facespec + (append facespec + (list `(,subexp '(face ,face + ,@align-props + ,@invisible-props) + ,(plist-get var :override) + ,(plist-get var :laxmatch))))))) + (setq keywords + (append keywords + (list (cons matcher facespec)))))))) + +(defun fountain-match-element (fun limit) + "If FUN returns non-nil before LIMIT, return non-nil." + (let (match) + (while (and (null match) + (< (point) limit)) + (if (funcall fun) + (setq match t)) + (forward-line 1)) + match)) + +(defun fountain-redisplay-scene-numbers (start end) + (goto-char start) + (while (< (point) (min end (point-max))) + (if (fountain-match-scene-heading) + (if (and fountain-display-scene-numbers-in-margin + (match-string 6)) + (put-text-property (match-beginning 4) (match-end 7) + 'display (list '(margin right-margin) + (match-string-no-properties 6))) + (remove-text-properties (match-beginning 0) (match-end 0) + '(display)))) + (forward-line 1))) + + +;;; Key Bindings + +(defvar fountain-mode-map + (let ((map (make-sparse-keymap))) + ;; Editing commands: + (define-key map (kbd "TAB") #'fountain-dwim) + (define-key map (kbd "C-c RET") #'fountain-upcase-line-and-newline) + (define-key map (kbd "<S-return>") #'fountain-upcase-line-and-newline) + (define-key map (kbd "C-c C-c") #'fountain-upcase-line) + (define-key map (kbd "C-c C-d") #'fountain-continued-dialog-refresh) + (define-key map (kbd "C-c C-z") #'fountain-insert-note) + (define-key map (kbd "C-c C-a") #'fountain-insert-synopsis) + (define-key map (kbd "C-c C-x i") #'auto-insert) + (define-key map (kbd "C-c C-x #") #'fountain-add-scene-numbers) + (define-key map (kbd "C-c C-x _") #'fountain-remove-scene-numbers) + (define-key map (kbd "C-c C-x f") #'fountain-set-font-lock-decoration) + (define-key map (kbd "C-c C-x RET") #'fountain-insert-page-break) + ;; FIXME: include-find-file feels like it should be C-c C-c... + ;; (define-key map (kbd "C-c C-c") #'fountain-include-find-file) + ;; Navigation commands: + (define-key map [remap forward-list] #'fountain-forward-scene) + (define-key map [remap backward-list] #'fountain-backward-scene) + (define-key map [remap beginning-of-defun] #'fountain-beginning-of-scene) + (define-key map [remap end-of-defun] #'fountain-end-of-scene) + (define-key map [remap mark-defun] #'fountain-mark-scene) + (define-key map (kbd "M-g s") #'fountain-goto-scene) + (define-key map (kbd "M-g p") #'fountain-goto-page) + (define-key map (kbd "M-n") #'fountain-forward-character) + (define-key map (kbd "M-p") #'fountain-backward-character) + ;; Outline commands: + (define-key map (kbd "C-c C-n") #'fountain-outline-next) + (define-key map (kbd "C-c C-p") #'fountain-outline-previous) + (define-key map (kbd "C-c C-f") #'fountain-outline-forward) + (define-key map (kbd "C-c C-b") #'fountain-outline-backward) + (define-key map (kbd "C-c C-u") #'fountain-outline-up) + (define-key map (kbd "C-c C-^") #'fountain-outline-shift-up) + (define-key map (kbd "C-c C-v") #'fountain-outline-shift-down) + (define-key map (kbd "C-c C-SPC") #'fountain-outline-mark) + (define-key map (kbd "C-c TAB") #'fountain-outline-cycle) + (define-key map (kbd "<backtab>") #'fountain-outline-cycle-global) + (define-key map (kbd "S-TAB") #'fountain-outline-cycle-global) + ;; Pages + (define-key map (kbd "C-c C-x p") #'fountain-count-pages) + ;; Endnotes: + (define-key map (kbd "M-s e") #'fountain-show-or-hide-endnotes) + ;; Exporting commands: + (define-key map (kbd "C-c C-e e") #'fountain-export-buffer) + (define-key map (kbd "C-c C-e C-e") #'fountain-export-default) + (define-key map (kbd "C-c C-e h") #'fountain-export-buffer-to-html) + (define-key map (kbd "C-c C-e l") #'fountain-export-buffer-to-latex) + (define-key map (kbd "C-c C-e d") #'fountain-export-buffer-to-fdx) + (define-key map (kbd "C-c C-e t") #'fountain-export-buffer-to-txt) + (define-key map (kbd "C-c C-e f") #'fountain-export-buffer-to-fountain) + (define-key map (kbd "C-c C-e s") #'fountain-export-shell-command) + map) + "Mode map for `fountain-mode'.") + + +;;; Menu + +(require 'easymenu) + +(easy-menu-define fountain-mode-menu fountain-mode-map + "Menu for `fountain-mode'." + '("Fountain" + ("Navigate" + ["Next Scene Heading" fountain-forward-scene] + ["Previous Scene Heading" fountain-backward-scene] + "---" + ["Next Character" fountain-forward-character] + ["Previous Character" fountain-backward-character] + "---" + ["Go to Scene Heading..." fountain-goto-scene] + ["Go to Page..." fountain-goto-page]) + ("Outline" + ["Cycle Scene/Section Visibility" fountain-outline-cycle] + ["Cycle Global Visibility" fountain-outline-cycle-global] + "---" + ["Up Heading" fountain-outline-up] + ["Next Heading" fountain-outline-next] + ["Previous Heading" fountain-outline-previous] + ["Forward Heading" fountain-outline-forward] + ["Backward Heading" fountain-outline-backward] + "---" + ["Mark Section/Scene" fountain-outline-mark] + ["Shift Section/Scene Up" fountain-outline-shift-up] + ["Shift Section/Scene Down" fountain-outline-shift-down]) + ("Scene Numbers" + ["Add Scene Numbers" fountain-add-scene-numbers] + ["Remove Scene Numbers" fountain-remove-scene-numbers] + "---" + ["Display Scene Numbers in Margin" + (customize-set-variable 'fountain-display-scene-numbers-in-margin + (not fountain-display-scene-numbers-in-margin)) + :style toggle + :selected fountain-display-scene-numbers-in-margin]) + ("Page Numbers" + ["Count Pages" fountain-count-pages] + "---" + ["Don't Show in Mode Line" + (customize-set-variable 'fountain-pages-show-in-mode-line nil) + :style radio + :selected (not fountain-pages-show-in-mode-line)] + ["In Mode Line with Manual Update" + (customize-set-variable 'fountain-pages-show-in-mode-line 'force) + :style radio + :selected (eq fountain-pages-show-in-mode-line 'force)] + ["In Mode Line with Automatic Update" + (customize-set-variable 'fountain-pages-show-in-mode-line 'timer) + :style radio + :selected (eq fountain-pages-show-in-mode-line 'timer)]) + "---" + ["Insert Metadata..." auto-insert] + ["Insert Synopsis" fountain-insert-synopsis] + ["Insert Note" fountain-insert-note] + ["Insert Page Break..." fountain-insert-page-break] + ["Refresh Continued Dialog" fountain-continued-dialog-refresh] + "---" + ("Show/Hide" + ["Endnotes" fountain-show-or-hide-endnotes] + ["Emphasis Delimiters" + (customize-set-variable 'fountain-hide-emphasis-delim + (not fountain-hide-emphasis-delim)) + :style toggle + :selected (not fountain-hide-emphasis-delim)] + ["Syntax Characters" + (customize-set-variable 'fountain-hide-syntax-chars + (not fountain-hide-syntax-chars)) + :style toggle + :selected (not fountain-hide-syntax-chars)]) + ("Syntax Highlighting" + ["Minimum" + (fountain-set-font-lock-decoration 1) + :style radio + :selected (= (fountain-get-font-lock-decoration) 1)] + ["Default" + (fountain-set-font-lock-decoration 2) + :style radio + :selected (= (fountain-get-font-lock-decoration) 2)] + ["Maximum" + (fountain-set-font-lock-decoration 3) + :style radio + :selected (= (fountain-get-font-lock-decoration) 3)]) + "---" + ("Export" + ["Export buffer..." fountain-export-buffer] + ["Default" fountain-export-default] + "---" + ["Buffer to plain text" fountain-export-buffer-to-txt] + ["Buffer to LaTeX" fountain-export-buffer-to-latex] + ["Buffer to HTML" fountain-export-buffer-to-html] + ["Buffer to Final Draft" fountain-export-buffer-to-fdx] + ["Buffer to Fountain" fountain-export-buffer-to-fountain] + "---" + ["Run Shell Command" fountain-export-shell-command] + "---" + ["US Letter Page Size" (customize-set-variable 'fountain-export-page-size 'letter) + :style radio + :selected (eq fountain-export-page-size 'letter)] + ["A4 Page Size" (customize-set-variable 'fountain-export-page-size 'a4) + :style radio + :selected (eq fountain-export-page-size 'a4)] + "---" + ["Include Title Page" + (customize-set-variable 'fountain-export-include-title-page + (not fountain-export-include-title-page)) + :style toggle + :selected fountain-export-include-title-page] + ["Bold Scene Headings" + (if (memq 'bold fountain-export-scene-heading-format) + (customize-set-variable 'fountain-export-scene-heading-format + (remq 'bold fountain-export-scene-heading-format)) + (customize-set-variable 'fountain-export-scene-heading-format + (cons 'bold fountain-export-scene-heading-format))) + :style toggle + :selected (memq 'bold fountain-export-scene-heading-format)] + ["Double-Space Scene Headings" + (if (memq 'double-space fountain-export-scene-heading-format) + (customize-set-variable 'fountain-export-scene-heading-format + (remq 'double-space fountain-export-scene-heading-format)) + (customize-set-variable 'fountain-export-scene-heading-format + (cons 'double-space fountain-export-scene-heading-format))) + :style toggle + :selected (memq 'double-space fountain-export-scene-heading-format)] + ["Underline Scene Headings" + (if (memq 'underline fountain-export-scene-heading-format) + (customize-set-variable 'fountain-export-scene-heading-format + (remq 'underline fountain-export-scene-heading-format)) + (customize-set-variable 'fountain-export-scene-heading-format + (cons 'underline fountain-export-scene-heading-format))) + :style toggle + :selected (memq 'underline fountain-export-scene-heading-format)] + "---" + ["Customize Export" + (customize-group 'fountain-export)]) + "---" + ["Display Elements Auto-Aligned" + (customize-set-variable 'fountain-align-elements + (not fountain-align-elements)) + :style toggle + :selected fountain-align-elements] + ["Auto-Upcase Scene Headings" + (customize-set-variable 'fountain-auto-upcase-scene-headings + (not fountain-auto-upcase-scene-headings)) + :style toggle + :selected fountain-auto-upcase-scene-headings] + ["Add Continued Dialog" + (customize-set-variable 'fountain-add-continued-dialog + (not fountain-add-continued-dialog)) + :style toggle + :selected fountain-add-continued-dialog] + "---" + ["Save Options" fountain-save-options] + ["Customize Mode" (customize-group 'fountain)] + ["Customize Faces" (customize-group 'fountain-faces)])) + +(defun fountain-save-options () + "Save `fountain-mode' options with `customize'." + (interactive) + (let (unsaved) + (dolist (option '(fountain-align-elements + fountain-auto-upcase-scene-headings + fountain-add-continued-dialog + fountain-display-scene-numbers-in-margin + fountain-pages-show-in-mode-line + fountain-hide-emphasis-delim + fountain-hide-syntax-chars + font-lock-maximum-decoration + fountain-export-page-size + fountain-export-include-title-page + fountain-export-scene-heading-format)) + (if (customize-mark-to-save option) + (setq unsaved t))) + (if unsaved (custom-save-all)))) + + +;;; Syntax Table + +(defvar fountain-mode-syntax-table + (make-syntax-table) + "Syntax table for `fountain-mode'.") + + +;;; Mode Definition + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.fountain\\'" . fountain-mode)) + +;;;###autoload +(define-derived-mode fountain-mode text-mode "Fountain" + "Major mode for screenwriting in Fountain markup." + :group 'fountain + (fountain-init-vars) + (let ((n (plist-get (fountain-read-metadata) 'startup-level))) + (if (stringp n) + (setq-local fountain-outline-startup-level + (min (string-to-number n) 6)))) + (add-hook 'post-self-insert-hook + #'fountain-auto-upcase nil t) + (add-hook 'post-command-hook + #'fountain-auto-upcase-deactivate-maybe nil t) + (if fountain-patch-emacs-bugs (fountain-patch-emacs-bugs)) + (jit-lock-register #'fountain-redisplay-scene-numbers t) + (fountain-init-mode-line) + (fountain-restart-page-count-timer) + (fountain-outline-hide-level fountain-outline-startup-level t)) + +(provide 'fountain-mode) + +;; Local Variables: +;; coding: utf-8 +;; fill-column: 80 +;; indent-tabs-mode: nil +;; require-final-newline: t +;; End: + +;;; fountain-mode.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/imenu-list-0.8/imenu-list-autoloads.el @@ -0,0 +1,57 @@ +;;; imenu-list-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) + +;;;### (autoloads nil "imenu-list" "imenu-list.el" (23212 29366 399107 +;;;;;; 872000)) +;;; Generated autoloads from imenu-list.el + +(autoload 'imenu-list-noselect "imenu-list" "\ +Update and show the imenu-list buffer, but don't select it. +If the imenu-list buffer doesn't exist, create it. + +\(fn)" t nil) + +(autoload 'imenu-list "imenu-list" "\ +Update and show the imenu-list buffer. +If the imenu-list buffer doesn't exist, create it. + +\(fn)" t nil) + +(defvar imenu-list-minor-mode nil "\ +Non-nil if Imenu-List minor mode is enabled. +See the `imenu-list-minor-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `imenu-list-minor-mode'.") + +(custom-autoload 'imenu-list-minor-mode "imenu-list" nil) + +(autoload 'imenu-list-minor-mode "imenu-list" "\ +Toggle Imenu-List minor mode on or off. +With a prefix argument ARG, enable Imenu-List minor mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. +\\{imenu-list-minor-mode-map} + +\(fn &optional ARG)" t nil) + +(autoload 'imenu-list-smart-toggle "imenu-list" "\ +Enable or disable `imenu-list-minor-mode' according to buffer's visibility. +If the imenu-list buffer is displayed in any window, disable +`imenu-list-minor-mode', otherwise enable it. +Note that all the windows in every frame searched, even invisible ones, not +only those in the selected frame. + +\(fn)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; imenu-list-autoloads.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/imenu-list-0.8/imenu-list-pkg.el @@ -0,0 +1,2 @@ +;;; -*- no-byte-compile: t -*- +(define-package "imenu-list" "0.8" "Show imenu entries in a seperate buffer" '((cl-lib "0.5")) :commit "27170d27c9594989587c03c23f753a809f6a0e10" :url "https://github.com/bmag/imenu-list")
new file mode 100644 --- /dev/null +++ b/elpa/imenu-list-0.8/imenu-list.el @@ -0,0 +1,672 @@ +;;; imenu-list.el --- Show imenu entries in a seperate buffer + +;; Copyright (C) 2015-2017 Bar Magal & Contributors + +;; Author: Bar Magal (2015) +;; Version: 0.8 +;; Package-Version: 0.8 +;; Homepage: https://github.com/bmag/imenu-list +;; Package-Requires: ((cl-lib "0.5")) + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; Shows a list of imenu entries for the current buffer, in another +;; buffer with the name "*Ilist*". +;; +;; Activation and deactivation: +;; M-x imenu-list-minor-mode +;; +;; Key shortcuts from "*Ilist*" buffer: +;; <enter>: Go to current definition +;; <space>: display current definition +;; <tab>: expand/collapse subtree +;; +;; Change "*Ilist*" buffer's position and size: +;; `imenu-list-position', `imenu-list-size'. +;; +;; Should invoking `imenu-list-minor-mode' also select the "*Ilist*" +;; window? +;; `imenu-list-focus-after-activation' + +;;; Code: + +(require 'imenu) +(require 'cl-lib) + +(defconst imenu-list-buffer-name "*Ilist*" + "Name of the buffer that is used to display imenu entries.") + +(defvar imenu-list--imenu-entries nil + "A copy of the imenu entries of the buffer we want to display in the +imenu-list buffer.") + +(defvar imenu-list--line-entries nil + "List of imenu entries displayed in the imenu-list buffer. +The first item in this list corresponds to the first line in the +imenu-list buffer, the second item matches the second line, and so on.") + +(defvar imenu-list--displayed-buffer nil + "The buffer who owns the saved imenu entries.") + +(defvar imenu-list--last-location nil + "Location from which last `imenu-list-update' was done. +Used to avoid updating if the point didn't move.") + +;;; fancy display + +(defgroup imenu-list nil + "Variables for `imenu-list' package." + :group 'imenu) + +(defcustom imenu-list-mode-line-format + '("%e" mode-line-front-space mode-line-mule-info mode-line-client + mode-line-modified mode-line-remote mode-line-frame-identification + (:propertize "%b" face mode-line-buffer-id) " " + (:eval (buffer-name imenu-list--displayed-buffer)) " " + mode-line-end-spaces) + "Local mode-line format for the imenu-list buffer. +This is the local value of `mode-line-format' to use in the imenu-list +buffer. See `mode-line-format' for allowed values." + :group 'imenu-list) + +(defcustom imenu-list-focus-after-activation nil + "Non-nil to select the imenu-list window automatically when +`imenu-list-minor-mode' is activated." + :group 'imenu-list + :type 'boolean) + +(defcustom imenu-list-custom-position-translator nil + "Custom translator of imenu positions to buffer positions. +Imenu can be customized on a per-buffer basis not to use regular buffer +positions as the positions that are stored in the imenu index. In such +cases, imenu-list needs to know how to translate imenu positions back to +buffer positions. `imenu-list-custom-position-translator' should be a +function that returns a position-translator function suitable for the +current buffer, or nil. See `imenu-list-position-translator' for details." + :group 'imenu-list + :type 'function) + +(defface imenu-list-entry-face + '((t)) + "Basic face for imenu-list entries in the imenu-list buffer." + :group 'imenu-list) + +(defface imenu-list-entry-face-0 + '((((class color) (background light)) + :inherit imenu-list-entry-face + :foreground "maroon") + (((class color) (background dark)) + :inherit imenu-list-entry-face + :foreground "gold")) + "Face for outermost imenu-list entries (depth 0)." + :group 'imenu-list) + +(defface imenu-list-entry-subalist-face-0 + '((t :inherit imenu-list-entry-face-0 + :weight bold :underline t)) + "Face for subalist entries with depth 0." + :group 'imenu-list) + +(defface imenu-list-entry-face-1 + '((((class color) (background light)) + :inherit imenu-list-entry-face + :foreground "dark green") + (((class color) (background dark)) + :inherit imenu-list-entry-face + :foreground "light green")) + "Face for imenu-list entries with depth 1." + :group 'imenu-list) + +(defface imenu-list-entry-subalist-face-1 + '((t :inherit imenu-list-entry-face-1 + :weight bold :underline t)) + "Face for subalist entries with depth 1." + :group 'imenu-list) + +(defface imenu-list-entry-face-2 + '((((class color) (background light)) + :inherit imenu-list-entry-face + :foreground "dark blue") + (((class color) (background dark)) + :inherit imenu-list-entry-face + :foreground "light blue")) + "Face for imenu-list entries with depth 2." + :group 'imenu-list) + +(defface imenu-list-entry-subalist-face-2 + '((t :inherit imenu-list-entry-face-2 + :weight bold :underline t)) + "Face for subalist entries with depth 2." + :group 'imenu-list) + +(defface imenu-list-entry-face-3 + '((((class color) (background light)) + :inherit imenu-list-entry-face + :foreground "orange red") + (((class color) (background dark)) + :inherit imenu-list-entry-face + :foreground "sandy brown")) + "Face for imenu-list entries with depth 3." + :group 'imenu-list) + +(defface imenu-list-entry-subalist-face-3 + '((t :inherit imenu-list-entry-face-3 + :weight bold :underline t)) + "Face for subalist entries with depth 0." + :group 'imenu-list) + +(defun imenu-list--get-face (depth subalistp) + "Get face for entry. +DEPTH is the depth of the entry in the list. +SUBALISTP non-nil means that there are more entries \"under\" the +current entry (current entry is a \"father\")." + (cl-case depth + (0 (if subalistp 'imenu-list-entry-subalist-face-0 'imenu-list-entry-face-0)) + (1 (if subalistp 'imenu-list-entry-subalist-face-1 'imenu-list-entry-face-1)) + (2 (if subalistp 'imenu-list-entry-subalist-face-2 'imenu-list-entry-face-2)) + (3 (if subalistp 'imenu-list-entry-subalist-face-3 'imenu-list-entry-face-3)) + (t (if subalistp 'imenu-list-entry-subalist-face-3 'imenu-list-entry-face-3)))) + +;;; collect entries + +(defun imenu-list-rescan-imenu () + "Force imenu to rescan the current buffer." + (setq imenu--index-alist nil) + (imenu--make-index-alist)) + +(defun imenu-list-collect-entries () + "Collect all `imenu' entries of the current buffer." + (imenu-list-rescan-imenu) + (setq imenu-list--imenu-entries imenu--index-alist) + (setq imenu-list--displayed-buffer (current-buffer))) + + +;;; print entries + +(defun imenu-list--depth-string (depth) + "Return a prefix string representing an entry's DEPTH." + (let ((indents (cl-loop for i from 1 to depth collect " "))) + (format "%s%s" + (mapconcat #'identity indents "") + (if indents " " "")))) + +(defun imenu-list--action-goto-entry (event) + "Goto the entry that was clicked. +EVENT holds the data of what was clicked." + (let ((window (posn-window (event-end event))) + (pos (posn-point (event-end event))) + (ilist-buffer (get-buffer imenu-list-buffer-name))) + (when (and (windowp window) + (eql (window-buffer window) ilist-buffer)) + (with-current-buffer ilist-buffer + (goto-char pos) + (imenu-list-goto-entry))))) + +(defun imenu-list--action-toggle-hs (event) + "Toggle hide/show state of current block. +EVENT holds the data of what was clicked. +See `hs-minor-mode' for information on what is hide/show." + (let ((window (posn-window (event-end event))) + (pos (posn-point (event-end event))) + (ilist-buffer (get-buffer imenu-list-buffer-name))) + (when (and (windowp window) + (eql (window-buffer window) ilist-buffer)) + (with-current-buffer ilist-buffer + (goto-char pos) + (hs-toggle-hiding))))) + +(defun imenu-list--insert-entry (entry depth) + "Insert a line for ENTRY with DEPTH." + (if (imenu--subalist-p entry) + (progn + (insert (imenu-list--depth-string depth)) + (insert-button (format "+ %s" (car entry)) + 'face (imenu-list--get-face depth t) + 'help-echo (format "Toggle: %s" + (car entry)) + 'follow-link t + 'action ;; #'imenu-list--action-goto-entry + #'imenu-list--action-toggle-hs + ) + (insert "\n")) + (insert (imenu-list--depth-string depth)) + (insert-button (format "%s" (car entry)) + 'face (imenu-list--get-face depth nil) + 'help-echo (format "Go to: %s" + (car entry)) + 'follow-link t + 'action #'imenu-list--action-goto-entry) + (insert "\n"))) + +(defun imenu-list--insert-entries-internal (index-alist depth) + "Insert all imenu entries in INDEX-ALIST into the current buffer. +DEPTH is the depth of the code block were the entries are written. +Each entry is inserted in its own line. +Each entry is appended to `imenu-list--line-entries' as well." + (dolist (entry index-alist) + (setq imenu-list--line-entries (append imenu-list--line-entries (list entry))) + (imenu-list--insert-entry entry depth) + (when (imenu--subalist-p entry) + (imenu-list--insert-entries-internal (cdr entry) (1+ depth))))) + +(defun imenu-list-insert-entries () + "Insert all imenu entries into the current buffer. +The entries are taken from `imenu-list--imenu-entries'. +Each entry is inserted in its own line. +Each entry is appended to `imenu-list--line-entries' as well + (`imenu-list--line-entries' is cleared in the beginning of this +function)." + (read-only-mode -1) + (erase-buffer) + (setq imenu-list--line-entries nil) + (imenu-list--insert-entries-internal imenu-list--imenu-entries 0) + (read-only-mode 1)) + + +;;; goto entries + +(defcustom imenu-list-after-jump-hook '(recenter) + "Hook to run after jumping to an entry from the imenu-list buffer. +This hook is ran also when the focus remains on the imenu-list +buffer, or in other words: this hook is ran by both +`imenu-list-goto-entry' and `imenu-list-display-entry'." + :group 'imenu-list + :type 'hook) + +(defun imenu-list--find-entry () + "Find in `imenu-list--line-entries' the entry in the current line." + (nth (1- (line-number-at-pos)) imenu-list--line-entries)) + +(defun imenu-list-goto-entry () + "Switch to the original buffer and display the entry under point." + (interactive) + (let ((entry (imenu-list--find-entry))) + (pop-to-buffer imenu-list--displayed-buffer) + (imenu entry) + (run-hooks 'imenu-list-after-jump-hook) + (imenu-list--show-current-entry))) + +(defun imenu-list-display-entry () + "Display in original buffer the entry under point." + (interactive) + (let ((entry (imenu-list--find-entry))) + (save-selected-window + (pop-to-buffer imenu-list--displayed-buffer) + (imenu entry) + (run-hooks 'imenu-list-after-jump-hook) + (imenu-list--show-current-entry)))) + +(defalias 'imenu-list-<= + (if (ignore-errors (<= 1 2 3)) + #'<= + #'(lambda (x y z) + "Return t if X <= Y and Y <= Z." + (and (<= x y) (<= y z))))) + +(defun imenu-list-position-translator () + "Get the correct position translator function for the current buffer. +A position translator is a function that takes a position as described in +`imenu--index-alist' and returns a number or marker that points to the +real position in the buffer that the position parameter points to. +This is necessary because positions in `imenu--index-alist' do not have to +be numbers or markers, although usually they are. For example, +`semantic-create-imenu-index' uses overlays as position paramters. +If `imenu-list-custom-position-translator' is non-nil, then +`imenu-list-position-translator' asks it for a translator function. +If `imenu-list-custom-position-translator' is called and returns nil, then +continue with the regular logic to find a translator function." + (cond + ((and imenu-list-custom-position-translator + (funcall imenu-list-custom-position-translator))) + ((or (eq imenu-create-index-function 'semantic-create-imenu-index) + (and (eq imenu-create-index-function + 'spacemacs/python-imenu-create-index-python-or-semantic) + (bound-and-true-p semantic-mode))) + ;; semantic uses overlays, return overlay's start as position + #'overlay-start) + ;; default - return position as is + (t #'identity))) + +(defun imenu-list--current-entry () + "Find entry in `imenu-list--line-entries' matching current position." + (let ((point-pos (point-marker)) + (offset (point-min-marker)) + (get-pos-fn (imenu-list-position-translator)) + match-entry) + (dolist (entry imenu-list--line-entries match-entry) + ;; "special entry" is described in `imenu--index-alist' + (unless (imenu--subalist-p entry) + (let* ((is-special-entry (listp (cdr entry))) + (entry-pos-raw (if is-special-entry + (cadr entry) + (cdr entry))) + ;; sometimes imenu doesn't use numbers/markers as positions, so we + ;; need to translate them back to "real" positions + ;; (see https://github.com/bmag/imenu-list/issues/20) + (entry-pos (funcall get-pos-fn entry-pos-raw))) + (when (imenu-list-<= offset entry-pos point-pos) + (setq offset entry-pos) + (setq match-entry entry))))))) + +(defun imenu-list--show-current-entry () + "Move the imenu-list buffer's point to the current position's entry." + (when (get-buffer-window (imenu-list-get-buffer-create)) + (let ((line-number (cl-position (imenu-list--current-entry) + imenu-list--line-entries + :test 'equal))) + (with-selected-window (get-buffer-window (imenu-list-get-buffer-create)) + (goto-char (point-min)) + (forward-line line-number) + (hl-line-mode 1))))) + +;;; window display settings + +(defcustom imenu-list-size 0.3 + "Size (height or width) for the imenu-list buffer. +Either a positive integer (number of rows/columns) or a percentage." + :group 'imenu-list + :type 'number) + +(defcustom imenu-list-position 'right + "Position of the imenu-list buffer. +Either 'right, 'left, 'above or 'below. This value is passed directly to +`split-window'." + :group 'imenu-list + :type '(choice (const above) + (const below) + (const left) + (const right))) + +(defcustom imenu-list-auto-resize nil + "If non-nil, auto-resize window after updating the imenu-list buffer. +Resizing the width works only for emacs 24.4 and newer. Resizing the +height doesn't suffer that limitation." + :group 'imenu-list + :type 'boolean) + +(defcustom imenu-list-update-hook nil + "Hook to run after updating the imenu-list buffer." + :group 'imenu-list + :type 'hook) + +(defun imenu-list-split-size () + "Convert `imenu-list-size' to proper argument for `split-window'." + (let ((frame-size (if (member imenu-list-position '(left right)) + (frame-width) + (frame-height)))) + (cond ((integerp imenu-list-size) (- imenu-list-size)) + (t (- (round (* frame-size imenu-list-size))))))) + +(defun imenu-list-display-buffer (buffer alist) + "Display the imenu-list buffer at the side. +This function should be used with `display-buffer-alist'. +See `display-buffer-alist' for a description of BUFFER and ALIST." + (or (get-buffer-window buffer) + (let ((window (ignore-errors (split-window (frame-root-window) (imenu-list-split-size) imenu-list-position)))) + (when window + (window--display-buffer buffer window 'window alist t) + window)))) + +(defun imenu-list-install-display-buffer () + "Install imenu-list display settings to `display-buffer-alist'." + (cl-pushnew `(,(concat "^" (regexp-quote imenu-list-buffer-name) "$") + imenu-list-display-buffer) + display-buffer-alist + :test #'equal)) + +(defun imenu-list-purpose-display-condition (_purpose buffer _alist) + "Display condition for use with window-purpose. +Return t if BUFFER is the imenu-list buffer. + +This function should be used in `purpose-special-action-sequences'. +See `purpose-special-action-sequences' for a description of _PURPOSE, +BUFFER and _ALIST." + (string-equal (buffer-name buffer) imenu-list-buffer-name)) + +(defun imenu-list-install-purpose-display () + "Install imenu-list display settings for window-purpose. +Install entry for imenu-list in `purpose-special-action-sequences'." + (cl-pushnew '(imenu-list-purpose-display-condition imenu-list-display-buffer) + purpose-special-action-sequences + :test #'equal)) + +(imenu-list-install-display-buffer) +(eval-after-load 'window-purpose + '(imenu-list-install-purpose-display)) + + +;;; define major mode + +(defun imenu-list-get-buffer-create () + "Return the imenu-list buffer. +If it doesn't exist, create it." + (or (get-buffer imenu-list-buffer-name) + (let ((buffer (get-buffer-create imenu-list-buffer-name))) + (with-current-buffer buffer + (imenu-list-major-mode) + buffer)))) + +(defun imenu-list-resize-window () + (let ((fit-window-to-buffer-horizontally t)) + (mapc #'fit-window-to-buffer + (get-buffer-window-list (imenu-list-get-buffer-create))))) + +(defun imenu-list-update (&optional raise-imenu-errors force-update) + "Update the imenu-list buffer. +If the imenu-list buffer doesn't exist, create it. +If RAISE-IMENU-ERRORS is non-nil, any errors encountered while trying to +create the index will be raised. Otherwise, such errors will be printed +instead. +When RAISE-IMENU-ERRORS is nil, then the return value indicates if an +error has occured. If the return value is nil, then there was no error. +Oherwise `imenu-list-update' will return the error that has occured, as + (ERROR-SYMBOL . SIGNAL-DATA). +If FORCE-UPDATE is non-nil, the imenu-list buffer is updated even if the +imenu entries did not change since the last update." + (catch 'index-failure + (let ((old-entries imenu-list--imenu-entries) + (location (point-marker))) + ;; don't update if `point' didn't move - fixes issue #11 + (unless (and (null force-update) + imenu-list--last-location + (marker-buffer imenu-list--last-location) + (= location imenu-list--last-location)) + (setq imenu-list--last-location location) + (if raise-imenu-errors + (imenu-list-collect-entries) + (condition-case err + (imenu-list-collect-entries) + (error + (message "imenu-list: couldn't create index because of error: %S" err) + (throw 'index-failure err)))) + (when (or force-update + ;; check if Ilist buffer is alive, in case it was killed + ;; since last update + (null (get-buffer imenu-list-buffer-name)) + (not (equal old-entries imenu-list--imenu-entries))) + (with-current-buffer (imenu-list-get-buffer-create) + (imenu-list-insert-entries))) + (imenu-list--show-current-entry) + (when imenu-list-auto-resize + (imenu-list-resize-window)) + (run-hooks 'imenu-list-update-hook) + nil)))) + +(defun imenu-list-refresh () + "Refresh imenu-list buffer." + (interactive) + (with-current-buffer imenu-list--displayed-buffer + (imenu-list-update nil t))) + +(defun imenu-list-show () + "Show the imenu-list buffer. +If the imenu-list buffer doesn't exist, create it." + (interactive) + (pop-to-buffer imenu-list-buffer-name)) + +(defun imenu-list-show-noselect () + "Show the imenu-list buffer, but don't select it. +If the imenu-list buffer doesn't exist, create it." + (interactive) + (display-buffer imenu-list-buffer-name)) + +;;;###autoload +(defun imenu-list-noselect () + "Update and show the imenu-list buffer, but don't select it. +If the imenu-list buffer doesn't exist, create it." + (interactive) + (imenu-list-update) + (imenu-list-show-noselect)) + +;;;###autoload +(defun imenu-list () + "Update and show the imenu-list buffer. +If the imenu-list buffer doesn't exist, create it." + (interactive) + (imenu-list-update) + (imenu-list-show)) + +(defun imenu-list-quit-window () + "Disable `imenu-list-minor-mode' and hide the imenu-list buffer. +If `imenu-list-minor-mode' is already disabled, just call `quit-window'." + (interactive) + ;; the reason not to call `(imenu-list-minor-mode -1)' regardless of current + ;; state, is that it quits all of imenu-list windows instead of just the + ;; current one. + (if imenu-list-minor-mode + ;; disabling `imenu-list-minor-mode' also quits the window + (imenu-list-minor-mode -1) + (quit-window))) + +(defvar imenu-list-major-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") #'imenu-list-goto-entry) + (define-key map (kbd "SPC") #'imenu-list-display-entry) + (define-key map (kbd "n") #'next-line) + (define-key map (kbd "p") #'previous-line) + (define-key map (kbd "TAB") #'hs-toggle-hiding) + (define-key map (kbd "f") #'hs-toggle-hiding) + (define-key map (kbd "g") #'imenu-list-refresh) + (define-key map (kbd "q") #'imenu-list-quit-window) + map)) + +(define-derived-mode imenu-list-major-mode special-mode "Ilist" + "Major mode for showing the `imenu' entries of a buffer (an Ilist). +\\{imenu-list-mode-map}" + (read-only-mode 1) + (imenu-list-install-hideshow)) +(add-hook 'imenu-list-major-mode-hook #'hs-minor-mode) + +(defun imenu-list--set-mode-line () + "Locally change `mode-line-format' to `imenu-list-mode-line-format'." + (setq-local mode-line-format imenu-list-mode-line-format)) +(add-hook 'imenu-list-major-mode-hook #'imenu-list--set-mode-line) + +(defun imenu-list-install-hideshow () + "Install imenu-list settings for hideshow." + ;; "\\b\\B" is a regexp that can't match anything + (setq-local comment-start "\\b\\B") + (setq-local comment-end "\\b\\B") + (setq hs-special-modes-alist + (cl-delete 'imenu-list-major-mode hs-special-modes-alist :key #'car)) + (push `(imenu-list-major-mode "\\s-*\\+ " "\\s-*\\+ " ,comment-start imenu-list-forward-sexp nil) + hs-special-modes-alist)) + +(defun imenu-list-forward-sexp (&optional arg) + "Move to next entry of same depth. +This function is intended to be used by `hs-minor-mode'. Don't use it +for anything else. +ARG is ignored." + (beginning-of-line) + (while (= (char-after) 32) + (forward-char)) + ;; (when (= (char-after) ?+) + ;; (forward-char 2)) + (let ((spaces (- (point) (point-at-bol)))) + (forward-line) + ;; ignore-errors in case we're at the last line + (ignore-errors (forward-char spaces)) + (while (and (not (eobp)) + (= (char-after) 32)) + (forward-line) + ;; ignore-errors in case we're at the last line + (ignore-errors (forward-char spaces)))) + (forward-line -1) + (end-of-line)) + +;;; define minor mode + +(defvar imenu-list--timer nil) + +(defcustom imenu-list-idle-update-delay idle-update-delay + "Idle time delay before automatically updating the imenu-list buffer." + :group 'imenu-list + :type 'number + :initialize 'custom-initialize-default + :set (lambda (sym val) + (prog1 (set-default sym val) + (when imenu-list--timer (imenu-list-start-timer))))) + +(defun imenu-list-start-timer () + (imenu-list-stop-timer) + (setq imenu-list--timer + (run-with-idle-timer imenu-list-idle-update-delay t + #'imenu-list-update-safe))) + +(defun imenu-list-stop-timer () + (when imenu-list--timer + (cancel-timer imenu-list--timer) + (setq imenu-list--timer nil))) + +(defun imenu-list-update-safe () + "Call `imenu-list-update', return nil if an error occurs." + (ignore-errors (imenu-list-update t))) + +;;;###autoload +(define-minor-mode imenu-list-minor-mode + nil :global t + (if imenu-list-minor-mode + (progn + (imenu-list-get-buffer-create) + (imenu-list-start-timer) + (let ((orig-buffer (current-buffer))) + (if imenu-list-focus-after-activation + (imenu-list-show) + (imenu-list-show-noselect)) + (with-current-buffer orig-buffer + (imenu-list-update nil t)))) + (imenu-list-stop-timer) + (ignore-errors (quit-windows-on imenu-list-buffer-name)) + ;; make sure *Ilist* is buried even if it wasn't shown in any window + (when (get-buffer imenu-list-buffer-name) + (bury-buffer (get-buffer imenu-list-buffer-name))))) + +;;;###autoload +(defun imenu-list-smart-toggle () + "Enable or disable `imenu-list-minor-mode' according to buffer's visibility. +If the imenu-list buffer is displayed in any window, disable +`imenu-list-minor-mode', otherwise enable it. +Note that all the windows in every frame searched, even invisible ones, not +only those in the selected frame." + (interactive) + (if (get-buffer-window imenu-list-buffer-name t) + (imenu-list-minor-mode -1) + (imenu-list-minor-mode 1))) + +(provide 'imenu-list) + +;;; imenu-list.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/olivetti-1.5.9/olivetti-autoloads.el @@ -0,0 +1,33 @@ +;;; olivetti-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) + +;;;### (autoloads nil "olivetti" "olivetti.el" (23186 64005 331915 +;;;;;; 229000)) +;;; Generated autoloads from olivetti.el + +(autoload 'turn-on-olivetti-mode "olivetti" "\ +Turn on `olivetti-mode' unconditionally. + +\(fn)" t nil) + +(autoload 'olivetti-mode "olivetti" "\ +Olivetti provides a nice writing environment. + +Window margins are set to relative widths to accomodate a text +body width set with `olivetti-body-width'. + +When `olivetti-hide-mode-line' is non-nil, the mode line is also +hidden. + +\(fn &optional ARG)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; olivetti-autoloads.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/olivetti-1.5.9/olivetti-pkg.el @@ -0,0 +1,2 @@ +;;; -*- no-byte-compile: t -*- +(define-package "olivetti" "1.5.9" "Minor mode for a nice writing environment" '((emacs "24.4")) :commit "35d275d8bdfc5107c25db5a4995b65ba936f1d56" :url "https://github.com/rnkn/olivetti" :keywords '("wp"))
new file mode 100644 --- /dev/null +++ b/elpa/olivetti-1.5.9/olivetti.el @@ -0,0 +1,381 @@ +;;; olivetti.el --- Minor mode for a nice writing environment -*- lexical-binding: t; -*- + +;; Copyright (c) 2014-2017 Paul Rankin + +;; Author: Paul Rankin <hello@paulwrankin.com> +;; Keywords: wp +;; Package-Version: 1.5.9 +;; Version: 1.5.8 +;; Package-Requires: ((emacs "24.4")) +;; URL: https://github.com/rnkn/olivetti + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Olivetti is a simple Emacs minor mode for a nice writing environment. + +;; Features +;; -------- + +;; - Set a desired text body width to automatically resize window margins +;; to keep the text comfortably in the middle of the window. +;; - Text body width can be the number of characters (an integer) or a +;; fraction of the window width (a float between 0.0 and 1.0). +;; - Interactively change body width with: +;; `olivetti-shrink` C-c [ [ [ ... +;; `olivetti-expand` C-c ] ] ] ... +;; `olivetti-set-width` C-c \ +;; - If `olivetti-body-width` is an integer, the text body width will scale +;; with use of `text-scale-mode`, whereas if a fraction (float) then the +;; text body width will remain at that fraction. +;; - Optionally remember the state of `visual-line-mode` on entry and +;; recall its state on exit. +;; - Optionally hide the mode-line for distraction-free writing. + +;; Requirements +;; ------------ + +;; - Emacs 24.4 + +;; Installation +;; ------------ + +;; Olivetti is available through [MELPA] and [MELPA-stable]. I +;; encourage installing the stable version. + +;; Alternately, download the [latest release] and put it in your +;; `load-path`. + +;; [melpa]: https://melpa.org/ "MELPA" +;; [melpa-stable]: https://stable.melpa.org/ "MELPA Stable" +;; [latest release]: https://github.com/rnkn/olivetti/releases/latest "Olivetti latest release" + +;; Known Bugs +;; ---------- + +;; - `display-line-numbers-mode` (included in Emacs 26.1) has a poor implementation +;; that causes problems with modes that work with the text body width or margins. +;; Discussion at <https://debbugs.gnu.org/28248> and +;; <https://debbugs.gnu.org/28844>. Use `linum-mode` instead. +;; - `linum-mode` in Emacs versions earlier than 26.1 has a bug that overwrites +;; margin settings, making it incompatible with modes that work with margins. +;; More information here: <https://debbugs.gnu.org/20674>. + +;; Please report bugs on GitHub [Issues] page. + +;; [issues]: https://github.com/rnkn/olivetti/issues "Olivetti issues" + +;; History +;; ------- + +;; See [Releases]. + +;; [releases]: https://github.com/rnkn/olivetti/releases "Olivetti releases" + + +;;; Code: + +(defgroup olivetti () + "Minor mode for a nice writing environment" + :prefix "olivetti-" + :group 'wp) + + +;;; Variables + +(defvar-local olivetti--visual-line-mode + nil + "Non-nil if `visual-line-mode' is active when `olivetti-mode' is turned on.") + + +;;; Options + +(defcustom olivetti-body-width + 80 + "Text body width to which to adjust relative margin width. + +If an integer, set text body width to that integer in columns; if +a floating point between 0.0 and 1.0, set text body width to +that fraction of the total window width. + +An integer is best if you want text body width to remain +constant, while a floating point is best if you want text body +width to change with window width. + +The floating point can anything between 0.0 and 1.0 (exclusive), +but it's better to use a value between about 0.33 and 0.9 for +best effect. + +This option does not affect file contents." + :type '(choice (integer 80) (float 0.5)) + :group 'olivetti) +(make-variable-buffer-local 'olivetti-body-width) + +(defcustom olivetti-minimum-body-width + 40 + "Minimum width in columns that text body width may be set." + :type 'integer + :group 'olivetti) + +(defcustom olivetti-hide-mode-line + nil + "Hide the mode line." + :type 'boolean + :group 'olivetti) + +(defcustom olivetti-lighter + " Olv" + "Mode-line indicator for `olivetti-mode'." + :type '(choice (const :tag "No lighter" "") string) + :group 'olivetti) + +(defcustom olivetti-recall-visual-line-mode-entry-state + t + "Recall the state of `visual-line-mode' upon exiting. + +When non-nil, if `visual-line-mode' is inactive upon activating +`olivetti-mode', then `visual-line-mode' will be deactivated upon +exiting. The reverse is not true." + :type 'boolean + :group 'olivetti) + + +;;; Set Environment + +(defun olivetti-set-environment (&optional frame) + "Set text body width to `olivetti-body-width' with relative margins. + +Cycle through all windows displaying current buffer and first +find the `olivetti-safe-width' to which to set +`olivetti-body-width', then find the appropriate margin size +relative to each window. Finally set the window margins, taking +care that the maximum size is 0." + (dolist (window (get-buffer-window-list nil nil t)) + (let* ((n (olivetti-safe-width (if (integerp olivetti-body-width) + (olivetti-scale-width olivetti-body-width) + olivetti-body-width) + window)) + (fringes (window-fringes window)) + (window-width (- (window-total-width window) + (+ (/ (car fringes) + (float (frame-char-width))) + (/ (cadr fringes) + (float (frame-char-width)))))) + (width (cond ((integerp n) n) + ((floatp n) (* window-width + n)))) + (margin (max (round (/ (- window-width + width) + 2)) + 0))) + (set-window-parameter window 'split-window 'olivetti-split-window) + (set-window-margins window margin margin)) + (if olivetti-hide-mode-line (olivetti-set-mode-line)))) + +(defun olivetti-reset-all-windows () + "Remove Olivetti's parameters and margins from all windows. + +Cycle through all windows displaying current buffer and call +`olivetti-reset-window'." + (dolist (window (get-buffer-window-list nil nil t)) + (olivetti-reset-window window))) + +(defun olivetti-reset-window (window) + "Remove Olivetti's parameters and margins from WINDOW." + (if (eq (window-parameter window 'split-window) 'olivetti-split-window) + (set-window-parameter window 'split-window nil)) + (set-window-margins window nil)) + +(defun olivetti-split-window (&optional window size side pixelwise) + "Call `split-window' after resetting WINDOW." + (olivetti-reset-window window) + (split-window window size side pixelwise)) + +(defun olivetti-split-window-sensibly (&optional window) + "Like `olivetti-split-window' but calls `split-window-sensibly'." + (olivetti-reset-window window) + (split-window-sensibly window)) + + +;;; Set Mode-Line + +(defun olivetti-set-mode-line (&optional arg) + "Set the mode line formating appropriately. + +If ARG is 'toggle, toggle the value of `olivetti-hide-mode-line', +then rerun. + +If ARG is 'exit, kill `mode-line-format' then rerun. + +If ARG is nil and `olivetti-hide-mode-line' is non-nil, hide the +mode line." + (cond ((eq arg 'toggle) + (setq olivetti-hide-mode-line + (not olivetti-hide-mode-line)) + (olivetti-set-mode-line)) + ((or (eq arg 'exit) + (not olivetti-hide-mode-line)) + (kill-local-variable 'mode-line-format)) + (olivetti-hide-mode-line + (setq-local mode-line-format nil)))) + +(defun olivetti-toggle-hide-mode-line () + "Toggle the visibility of the mode-line. + +Toggles the value of `olivetti-hide-mode-line' and runs +`olivetti-set-mode-line'." + (interactive) + (olivetti-set-mode-line 'toggle)) + + +;;; Calculate Width + +(defun olivetti-scale-width (n) + "Scale N in accordance with the face height. + +For compatibility with `text-scale-mode', if +`face-remapping-alist' includes a :height property on the default +face, scale N by that factor, otherwise scale by 1." + (let ((face-height (or (plist-get (cadr (assq 'default + face-remapping-alist)) + :height) + 1))) + (round (* n face-height)))) + +(defun olivetti-safe-width (n window) + "Parse N to a safe value for `olivetti-body-width' for WINDOW." + (let ((window-width (- (window-total-width window) + (% (window-total-width window) 2))) + (min-width (+ olivetti-minimum-body-width + (% olivetti-minimum-body-width 2)))) + (cond ((integerp n) + (max (min n window-width) min-width)) + ((floatp n) + (let ((min-width + (string-to-number (format "%0.2f" + (/ (float min-width) + window-width)))) + (width + (string-to-number (format "%0.2f" + (min n 1.0))))) + (max width min-width))) + ((user-error "`olivetti-body-width' must be an integer or a float") + (setq olivetti-body-width + (eval (car (get 'olivetti-body-width 'standard-value)))))))) + + +;;; Width Interaction + +(defun olivetti-set-width (n) + "Set text body width to N with relative margins. + +N may be an integer specifying columns or a float specifying a +fraction of the window width." + (interactive + (list (or current-prefix-arg + (read-number "Set text body width (integer or float): " + olivetti-body-width)))) + (setq olivetti-body-width n) + (olivetti-set-environment) + (message "Text body width set to %s" olivetti-body-width)) + +(defun olivetti-expand (&optional arg) + "Incrementally increase the value of `olivetti-body-width'. + +If prefixed with ARG, incrementally decrease." + (interactive "P") + (let* ((p (if arg -1 1)) + (n (cond ((integerp olivetti-body-width) + (+ olivetti-body-width (* 2 p))) + ((floatp olivetti-body-width) + (+ olivetti-body-width (* 0.01 p)))))) + (setq olivetti-body-width (olivetti-safe-width n (selected-window)))) + (olivetti-set-environment) + (message "Text body width set to %s" olivetti-body-width) + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map "]" 'olivetti-expand) + (define-key map "[" 'olivetti-shrink) map))) + +(defun olivetti-shrink (&optional arg) + "Incrementally decrease the value of `olivetti-body-width'. + +If prefixed with ARG, incrementally increase." + (interactive "P") + (let ((p (unless arg t))) + (olivetti-expand p))) + + +;;; Mode Definition + +;;;###autoload +(defun turn-on-olivetti-mode () + "Turn on `olivetti-mode' unconditionally." + (interactive) + (olivetti-mode 1)) + +(defvar olivetti-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c [") #'olivetti-shrink) + (define-key map (kbd "C-c ]") #'olivetti-expand) + (define-key map (kbd "C-c \\") #'olivetti-set-width) + map) + "Mode map for `olivetti-mode'.") + +;;;###autoload +(define-minor-mode olivetti-mode + "Olivetti provides a nice writing environment. + +Window margins are set to relative widths to accomodate a text +body width set with `olivetti-body-width'. + +When `olivetti-hide-mode-line' is non-nil, the mode line is also +hidden." + :init-value nil + :lighter olivetti-lighter + (if olivetti-mode + (progn + (dolist (hook '(window-configuration-change-hook + window-size-change-functions + after-setting-font-hook + text-scale-mode-hook)) + (add-hook hook 'olivetti-set-environment t t)) + (add-hook 'change-major-mode-hook + 'olivetti-reset-all-windows nil t) + (setq-local split-window-preferred-function + 'olivetti-split-window-sensibly) + (setq olivetti--visual-line-mode visual-line-mode) + (unless olivetti--visual-line-mode (visual-line-mode 1)) + (olivetti-set-environment)) + (dolist (hook '(window-configuration-change-hook + window-size-change-functions + after-setting-font-hook + text-scale-mode-hook)) + (remove-hook hook 'olivetti-set-environment t)) + (olivetti-reset-all-windows) + (olivetti-set-mode-line 'exit) + (if (and olivetti-recall-visual-line-mode-entry-state + (not olivetti--visual-line-mode)) + (visual-line-mode 0)) + (kill-local-variable 'split-window-preferred-function) + (kill-local-variable 'olivetti--visual-line-mode))) + + + +(provide 'olivetti) + +;;; olivetti.el ends here