Release 4.40

This commit is contained in:
Carsten Dominik 2008-01-31 11:32:08 +01:00
parent 2ff8fc1133
commit 8fd900c684
11 changed files with 4303 additions and 1505 deletions

11
README
View File

@ -1,4 +1,11 @@
The is a distribution of org-mode
The is a distribution of Org-mode, a plain text notes and project planning
tool for Emacs.
The homepage of org-mode is at http://www.astro.uva.nl/~domnik/Tools/org/
The homepage of Org-mode is at http://www.astro.uva.nl/~domnik/Tools/org/
The manual is in the file org.pdf, it includes a section about installation.
The xemacs directory contains special code for XEmacs users, in particular
a port of the GNU Emacs outline.el to XEmacs. Org-mode does not work
under XEmacs without this file installed. It did until version 4.37,
but no longer.

1353
org

File diff suppressed because it is too large Load Diff

View File

@ -1,12 +1,12 @@
;;; org-publish.el --- publish related org-mode files as a website
;; Copyright (C) 2006 David O'Toole
;; Copyright (C) 2006 Free Software Foundation, Inc.
;; Author: David O'Toole <dto@gnu.org>
;; Keywords: hypermedia, outlines
;; Version:
;; Version:
;; $Id: org-publish.el,v 1.67 2006/05/30 10:44:31 dto Exp dto $
;; $Id: org-publish.el,v 1.73 2006/06/15 12:43:48 dto Exp $
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@ -23,8 +23,6 @@
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;; This file is NOT part of GNU Emacs.
;;; Commentary:
;; Requires at least version 4.27 of org.el
@ -39,7 +37,7 @@
;; to allow configurable publishing of related sets of files as a
;; complete website.
;;
;; org-publish.el can do the following:
;; org-publish.el can do the following:
;;
;; + Publish all one's org-files to html
;; + Upload html, images, attachments and other files to a web server
@ -51,7 +49,7 @@
;; Special thanks to the org-mode maintainer Carsten Dominik for his
;; ideas, enthusiasm, and cooperation.
;;; Installation:
;;; Installation:
;; Put org-publish.el in your load path, byte-compile it, and then add
;; the following lines to your emacs initialization file:
@ -65,13 +63,13 @@
;; already in the file org-install.el, and hence don't need to be put
;; in your emacs initialization file in this case.
;;; Usage:
;;; Usage:
;;
;; The program's main configuration variable is
;; `org-publish-project-alist'. See below for example configurations
;; with commentary.
;; The main interactive functions are:
;; The main interactive functions are:
;;
;; M-x org-publish
;; M-x org-publish-all
@ -81,7 +79,7 @@
;;;; Simple example configuration:
;; (setq org-publish-project-alist
;; (list
;; (list
;; '("org" . (:base-directory "~/org/"
;; :base-extension "org"
;; :publishing-directory "~/public_html"
@ -103,10 +101,10 @@
;; following example configuration to your specific paths, run M-x
;; org-publish-all, and it should publish the files to the correct
;; directories on the web server, transforming the *.org files into
;; HTML, and leaving other files alone.
;; HTML, and leaving other files alone.
;; (setq org-publish-project-alist
;; (list
;; (list
;; '("orgfiles" :base-directory "~/org/"
;; :base-extension "org"
;; :publishing-directory "/ssh:user@host:~/html/notebook/"
@ -118,12 +116,12 @@
;; :style "<link rel=stylesheet href=\"../other/mystyle.css\" type=\"text/css\">"
;; :auto-preamble t
;; :auto-postamble nil)
;;
;;
;; ("images" :base-directory "~/images/"
;; :base-extension "jpg\\|gif\\|png"
;; :publishing-directory "/ssh:user@host:~/html/images/"
;; :publishing-function org-publish-attachment)
;;
;;
;; ("other" :base-directory "~/other/"
;; :base-extension "css"
;; :publishing-directory "/ssh:user@host:~/html/other/"
@ -140,13 +138,13 @@
;;; List of user-visible changes since version 1.27
;; 1.65: Remove old "composite projects". They're redundant.
;; 1.65: Remove old "composite projects". They're redundant.
;; 1.64: Allow meta-projects with :components
;; 1.57: Timestamps flag is now called "org-publish-use-timestamps-flag"
;; 1.52: Properly set default for :index-filename
;; 1.48: Composite projects allowed.
;; :include keyword allowed.
;; 1.43: Index no longer includes itself in the index.
;; 1.43: Index no longer includes itself in the index.
;; 1.42: Fix "function definition is void" error
;; when :publishing-function not set in org-publish-current-file.
;; 1.41: Fixed bug where index isn't published on first try.
@ -158,7 +156,7 @@
;;; Code:
(eval-when-compile
(eval-when-compile
(require 'cl))
(defgroup org-publish nil
@ -167,16 +165,16 @@
:group 'org)
(defcustom org-publish-project-alist nil
(defcustom org-publish-project-alist nil
"Association list to control publishing behavior.
Each element of the alist is a publishing 'project.' The CAR of
each element is a string, uniquely identifying the project. The
CDR of each element is in one of the following forms:
CDR of each element is in one of the following forms:
(:property value :property value ... )
OR,
(:components (\"project-1\" \"project-2\" ...))
When the CDR of an element of org-publish-project-alist is in
@ -191,7 +189,7 @@ setting overrides the value of the corresponding user variable
override everything.
Most properties are optional, but some should always be set:
:base-directory Directory containing publishing source files
:base-extension Extension (without the dot!) of source files.
This can be a regular expression.
@ -207,7 +205,7 @@ value may be a list of filenames to include. The filenames are
considered relative to the publishing directory.
When both :include and :exclude properties are given values, the
exclusion step happens first.
exclusion step happens first.
One special property controls which back-end function to use for
publishing files in the project. This can be used to extend the
@ -249,29 +247,29 @@ learn more about their use and default values.
The following properties may be used to control publishing of an
index of files or summary page for a given project.
:auto-index Whether to publish an index during
:auto-index Whether to publish an index during
org-publish-current-project or org-publish-all.
:index-filename Filename for output of index. Defaults
to 'index.org' (which becomes 'index.html')
:index-title Title of index page. Defaults to name of file.
:index-function Plugin function to use for generation of index.
Defaults to 'org-publish-org-index', which
Defaults to 'org-publish-org-index', which
generates a plain list of links to all files
in the project.
in the project.
"
:group 'org-publish
:type 'alist)
(defcustom org-publish-use-timestamps-flag t
"When non-nil, use timestamp checking to publish only changed files.
"When non-nil, use timestamp checking to publish only changed files.
When nil, do no timestamp checking and always publish all
files."
:group 'org-publish
:type 'boolean)
(defcustom org-publish-timestamp-directory "~/.org-timestamps/"
(defcustom org-publish-timestamp-directory "~/.org-timestamps/"
"Name of directory in which to store publishing timestamps."
:group 'org-publish
:type 'string)
@ -287,8 +285,8 @@ files."
(concat org-publish-timestamp-directory filename ".timestamp"))
(defun org-publish-needed-p (filename)
"Check whether file should be published.
(defun org-publish-needed-p (filename)
"Check whether file should be published.
If org-publish-use-timestamps-flag is set to nil, this function always
returns t. Otherwise, check the timestamps folder to determine
whether file should be published."
@ -304,7 +302,7 @@ whether file should be published."
;; check timestamp. ok if timestamp file doesn't exist
(let* ((timestamp (org-publish-timestamp-filename filename))
(rtn (file-newer-than-file-p filename timestamp)))
(if rtn
(if rtn
;; handle new timestamps
(if (not (file-exists-p timestamp))
;; create file
@ -321,11 +319,25 @@ whether file should be published."
(set-file-times timestamp)))
;;;; A hash mapping files to project names
(defvar org-publish-files (make-hash-table :test 'equal) "Hash
table mapping file names to project names.")
;;;; Checking filenames against this hash
(defun org-publish-validate-link (link)
(gethash (file-truename link) org-publish-files))
;;;; Getting project information out of org-publish-project-alist
(defun org-publish-get-plists (&optional project-name)
"Return a list of property lists for project PROJECT-NAME.
"Return a list of property lists for project PROJECT-NAME.
When argument is not given, return all property lists for all projects."
(let ((alist (if project-name
(list (assoc project-name org-publish-project-alist))
@ -333,19 +345,25 @@ When argument is not given, return all property lists for all projects."
(project nil)
(plists nil)
(components nil))
;;
;;
(while (setq project (pop alist))
;; what kind of project is it?
(if (setq components (plist-get (cdr project) :components))
;; meta project. annotate each plist with name of enclosing project
(setq plists
(append plists
(mapcar (lambda (p)
(plist-put p :project-name (car project)))
(mapcan 'org-publish-get-plists components))))
(setq plists
(append plists
(apply 'append
(mapcar 'org-publish-get-plists components))))
;; normal project
(let ((p (cdr project)))
(setq p (plist-put p :project-name (car project)))
(setq plists (append plists (list (cdr project)))))))
;;
(setq plists (append plists (list (cdr project)))))
;;
(dolist (p plists)
(let* ((exclude (plist-get p :exclude))
(files (org-publish-get-base-files p exclude)))
(dolist (f files)
(puthash (file-truename f) (car project) org-publish-files)))))
plists))
@ -371,8 +389,8 @@ matching filenames."
;; include extra files
(let ((inc nil))
(while (setq inc (pop include-list))
(setq allfiles (cons (concat dir inc) allfiles))))
(setq allfiles (cons (expand-file-name inc dir) allfiles))))
allfiles))
@ -380,14 +398,8 @@ matching filenames."
"Figure out which project a given FILENAME belongs to, if any.
Filename should contain full path. Returns name of project, or
nil if not found."
(let ((found nil))
(mapcar
(lambda (plist)
(let ((files (org-publish-get-base-files plist)))
(if (member (expand-file-name filename) files)
(setq found (plist-get plist :project-name)))))
(org-publish-get-plists))
found))
(org-publish-get-plists)
(gethash (file-truename filename) org-publish-files))
(defun org-publish-get-plist-from-filename (filename)
@ -396,18 +408,19 @@ nil if not found."
(mapcar
(lambda (plist)
(let ((files (org-publish-get-base-files plist)))
(if (member (expand-file-name filename) files)
(setq found plist))))
(if (member (expand-file-name filename) files)
(setq found plist))))
(org-publish-get-plists))
found))
;;;; Pluggable publishing back-end functions
(defun org-publish-org-to-html (plist filename)
"Publish an org file to HTML.
PLIST is the property list for the given project.
"Publish an org file to HTML.
PLIST is the property list for the given project.
FILENAME is the filename of the org file to be published."
(require 'org)
(let* ((arg (plist-get plist :headline-levels)))
@ -416,14 +429,14 @@ FILENAME is the filename of the org file to be published."
(org-export-as-html arg nil plist)
;; get rid of HTML buffer
(kill-buffer (current-buffer)))))
(defun org-publish-attachment (plist filename)
"Publish a file with no transformation of any kind.
PLIST is the property list for the given project.
PLIST is the property list for the given project.
FILENAME is the filename of the file to be published."
;; make sure eshell/cp code is loaded
(require 'eshell)
(require 'eshell)
(require 'esh-maint)
(require 'em-unix)
(let ((destination (file-name-as-directory (plist-get plist :publishing-directory))))
@ -450,7 +463,6 @@ FILENAME is the filename of the file to be published."
If :auto-index is set, publish the index too."
(let* ((exclude-regexp (plist-get plist :exclude))
(publishing-function (or (plist-get plist :publishing-function) 'org-publish-org-to-html))
(buf (current-buffer))
(index-p (plist-get plist :auto-index))
(index-filename (or (plist-get plist :index-filename) "index.org"))
(index-function (or (plist-get plist :index-function) 'org-publish-org-index))
@ -463,14 +475,12 @@ FILENAME is the filename of the file to be published."
;; check timestamps
(when (org-publish-needed-p f)
(funcall publishing-function plist f)
(org-publish-update-timestamp f))))
;; back to original buffer
(switch-to-buffer buf)))
(org-publish-update-timestamp f))))))
(defun org-publish-org-index (plist &optional index-filename)
"Create an index of pages in set defined by PLIST.
Optionally set the filename of the index with INDEX-FILENAME;
"Create an index of pages in set defined by PLIST.
Optionally set the filename of the index with INDEX-FILENAME;
default is 'index.org'."
(let* ((dir (file-name-as-directory (plist-get plist :base-directory)))
(exclude-regexp (plist-get plist :exclude))
@ -483,7 +493,7 @@ default is 'index.org'."
;; if buffer is already open, kill it to prevent error message
(if index-buffer
(kill-buffer index-buffer))
(with-temp-buffer
(with-temp-buffer
(while (setq f (pop files))
(let ((fn (file-name-nondirectory f)))
(unless (string= fn ifn) ;; index shouldn't index itself
@ -497,19 +507,21 @@ default is 'index.org'."
;(defun org-publish-meta-index (meta-plist &optional index-filename)
; "Create an index for a metaproject."
; (let* ((plists (
;;;; Interactive publishing functions
;;;###autoload
(defun org-publish (project-name &optional force)
"Publish the project PROJECT-NAME."
(interactive "sProject name: \nP")
(interactive (list (completing-read "Project name: " org-publish-project-alist
nil t)
current-prefix-arg))
(let ((org-publish-use-timestamps-flag (if force nil t))
(plists (org-publish-get-plists project-name)))
(mapcar 'org-publish-plist plists)))
;;;###autoload
(defun org-publish-current-project (&optional force)
@ -521,14 +533,14 @@ With prefix argument, force publishing all files in project."
(if (not project-name)
(error (format "File %s is not part of any known project." (buffer-file-name))))
(org-publish project-name)))
;;;###autoload
;;;###autoload
(defun org-publish-current-file (&optional force)
"Publish the current file.
With prefix argument, force publish the file."
(interactive "P")
(let ((org-publish-use-timestamps-flag
(let ((org-publish-use-timestamps-flag
(if force nil t)))
(org-publish-file (buffer-file-name))))

1925
org.el

File diff suppressed because it is too large Load Diff

BIN
org.pdf

Binary file not shown.

904
org.texi

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@ -1,5 +1,5 @@
% Reference Card for Org Mode
\def\orgversionnumber{4.37}
\def\orgversionnumber{4.40}
\def\year{2006}
%
%**start of header
@ -288,10 +288,8 @@ are preserved on all copies.
\section{Motion}
\key{next heading}{C-c C-n}
\key{previous heading}{C-c C-p}
\key{next heading, same level}{C-c C-f}
\key{previous heading, same level}{C-c C-b}
\key{next/previous heading}{C-c C-n/p}
\key{next/previous heading, same level}{C-c C-f/b}
\key{backward to higher level heading}{C-c C-u}
\key{jump to another place in document}{C-c C-j}
\key{previous/next plain list item}{S-UP/DOWN$^3$}
@ -306,13 +304,18 @@ are preserved on all copies.
\key{promote current subtree up one level}{M-S-LEFT}
\key{demote current subtree down one level}{M-S-RIGHT}
\key{move subtree/list item up}{M-S-UP}
\key{move subtree/list item down}{M-S-DOWN}
\key{move subtree/list item up/down}{M-S-UP/DOWN}
\key{kill subtree}{C-c C-x C-w}
\key{copy subtree}{C-c C-x M-w}
\key{yank subtree}{C-c C-x C-y}
\key{narrow buffer to current subtree}{C-x n s}
\key{archive subtree}{C-c \$}
\section{Archiving}
\key{toggle ARCHIVE tag}{C-c C-x C-a}
\metax{mark fully dine children}{C-u C-c C-x C-a}
\key{move subtree to achive file}{C-c \$}
\key{move all fully done children}{C-u C-c \$}
To set archive location for current file, add a line like$^2$:
\vskip -1mm
\beginexample%
@ -329,18 +332,8 @@ To set archive location for current file, add a line like$^2$:
%\key{agenda for the week}{C-c a$^1$}
%\key{agenda for date at cursor}{C-c C-o}
\section{Tags}
\key{set tags for current heading}{C-c C-c}
\key{realign tags in all headings}{C-u C-c C-c}
\key{create sparse tree with matching tags}{C-c \\}
\key{globally (agenda) match tags at cursor}{C-c C-o}
\section{Tables}
%Org-mode has its own built-in intuitive table editor with unique
%capabilities.
{\bf Creating a table}
%\metax{insert a new Org-mode table}{M-x org-table-create}
@ -466,6 +459,39 @@ formula, \kbd{:=} a named-field formula.
%\key{\kbd{vm://myself@some.where.org/folder\#id}}{\rm VM remote}
\section{Remember-mode Integration}
See the manual for how to make remember.el use Org-mode links and
files. The note-finishing command \kbd{C-c C-c} will first prompt for
an org file. In the file, find a location with:
\key{rotate subtree visibility}{TAB}
\key{next heading}{DOWN}
\key{previous heading}{UP}
Insert the note with one of the following:
\key{as sublevel of heading at cursor}{RET}
\key{right here (cursor not on heading)}{RET}
\key{before current heading}{LEFT}
\key{after current heading}{RIGHT}
\key{shortcut to end of buffer (cursor at buf-start)}{RET}
\key{Abort}{q}
\section{Completion}
In-buffer completion completes TODO keywords at headline start, TeX
macros after ``{\tt \\}'', option keywords after ``{\tt \#-}'', TAGS
after ``{\tt :}'', and dictionary words elsewhere.
\key{Complete word at point}{M-TAB}
\newcolumn
\title{Org-Mode Reference Card (2/2)}
\centerline{(for version \orgversionnumber)}
\section{TODO Items}
\key{rotate the state of the current item}{C-c C-t}
@ -480,6 +506,13 @@ formula, \kbd{:=} a named-field formula.
\key{\kbd{\#+SEQ_TODO: TODO TRY BLUFF DONE}}{\rm todo workflow}
\key{\kbd{\#+TYP_TODO: Phil home work DONE}}{\rm todo types}
\section{Tags}
\key{set tags for current heading}{C-c C-c}
\key{realign tags in all headings}{C-u C-c C-c}
\key{create sparse tree with matching tags}{C-c \\}
\key{globally (agenda) match tags at cursor}{C-c C-o}
\section{Timestamps}
\key{prompt for date and insert timestamp}{C-c .}
@ -502,18 +535,26 @@ formula, \kbd{:=} a named-field formula.
%\key{... forward/backward one month}{M-S-LEFT/RIGT}
\newcolumn
\title{Org-Mode Reference Card (2/2)}
\centerline{(for version \orgversionnumber)}
\section{Clocking Time}
\key{start clock on current item}{C-c C-x C-i}
\key{stop clock on current item}{C-c C-x C-o}
\key{cancel current clock}{C-c C-x C-x}
\key{display total subtree times}{C-c C-x C-d}
\key{remove displayed times}{C-c C-c}
\key{insert/update table with clock report}{C-c C-x C-r}
\section{Dynamic Blocks}
\key{update dynamic block at point}{C-c C-x C-u}
\metax{update all dynamic blocks}{C-u C-c C-x C-u}
\section{LaTeX and cdlatex-mode}
\key{preview LaTeX fragment}{C-c C-x C-l}
\key{Expand abbreviation (cdlatex-mode)}{TAB}
\key{Insert/modify math symbol (cdlatex-mode)}{` / '}
\section{Agenda Views}
@ -565,6 +606,7 @@ To set categories, add lines like$^2$:
\key{change state of current TODO item}{t}
\key{show tags of current headline}{T}
\key{set tags for current headline}{:}
\key{toggle ARCHIVE tag}{a}
\key{set priority of current item}{p}
\key{raise/lower priority of current item}{S-UP/DOWN$^3$}
\key{display weighted priority of current item}{P}
@ -577,7 +619,6 @@ To set categories, add lines like$^2$:
\key{Stop the clock (clock-out)}{O}
\key{Cancel current clock}{X}
\newcolumn
{\bf Calendar commands}
@ -593,6 +634,13 @@ To set categories, add lines like$^2$:
\key{quit agenda, remove agenda buffer}{q}
\key{exit agenda, remove all agenda buffers}{x}
\section{Calendar and Diary Integration}
To include entries from the Emacs diary in your Org-mode agenda:
\beginexample%
(setq org-agenda-include-diary t)
\endexample
\section{Exporting and Publishing}
Exporting creates files with extensions {\it .txt\/} and {\it .html\/}
@ -629,18 +677,19 @@ keywords. {\tt M-TAB} again just after keyword is complete inserts examples.
\key{language code for html}{\#+LANGUAGE:}
\key{free text description of file}{\#+TEXT:}
\key{... which can carry over multiple lines}{\#+TEXT:}
\key{settings for the export process - see below}{\#+OPTIONS:}
%\key{settings for the export process - see below}{\#+OPTIONS:}
\key{settings for the export process}{\#+OPTIONS:}
\key{set number of headline levels for export}{H:2}
\key{turn on/off section numbers}{num:t}
\key{turn on/off table of contents}{toc:t}
\key{turn on/off linebreak preservation}{\\n:nil}
\key{turn on/off quoted html tags}{@:t}
\key{turn on/off fixed width sections}{::t}
\key{turn on/off tables}{|:t}
\key{turn on/off \TeX\ syntax for sub/super-scripts}{\^{}:t}
\key{turn on/off emphasised text}{*:nil}
\key{turn on/off \TeX\ macros}{TeX:t}
%\key{set number of headline levels for export}{H:2}
%\key{turn on/off section numbers}{num:t}
%\key{turn on/off table of contents}{toc:t}
%\key{turn on/off linebreak preservation}{\\n:nil}
%\key{turn on/off quoted html tags}{@:t}
%\key{turn on/off fixed width sections}{::t}
%\key{turn on/off tables}{|:t}
%\key{turn on/off \TeX\ syntax for sub/super-scripts}{\^{}:t}
%\key{turn on/off emphasised text}{*:nil}
%\key{turn on/off \TeX\ macros}{TeX:t}
{\bf Comments: Text not being exported}
@ -651,53 +700,20 @@ Subtrees whose header starts with COMMENT are never exported.
\key{toggle COMMENT keyword on entry}{C-c ;}
\section{Completion}
In-buffer completion completes TODO keywords at headline start, TeX
macros after ``{\tt \\}'', option keywords after ``{\tt \#-}'', TAGS
after ``{\tt :}'', and dictionary words elsewhere.
%\section{CUA and pc-select compatibility}%
\key{Complete word at point}{M-TAB}
\section{Calendar and Diary Integration}
To include entries from the Emacs diary in your Org-mode agenda:
\beginexample%
(setq org-agenda-include-diary t)
\endexample
\section{Remember-mode Integration}
See the manual for how to make remember.el use Org-mode links and
files. The note-finishing command \kbd{C-c C-c} will first prompt for
an org file. In the file, find a location with:
\key{rotate subtree visibility}{TAB}
\key{next heading}{DOWN}
\key{previous heading}{UP}
Insert the note with one of the following:
\key{as sublevel of heading at cursor}{RET}
\key{right here (cursor not on heading)}{RET}
\key{before current heading}{LEFT}
\key{after current heading}{RIGHT}
\key{shortcut to end of buffer (cursor at buf-start)}{RET}
\key{Abort}{q}
\section{CUA and pc-select compatibility}
Configure the variable {\tt org-CUA-compatibility} to make Org-mode
avoid the \kbd{S-<cursor>} bindings used by these modes. When set,
Org-mode will change the following keybindings (also in the agenda
buffer, but not during date selection). See note mark four$^3$
throughout the reference card.
%\vskip-mm
\beginexample
S-UP $\to$ M-p S-DOWN $\to$ M-n
S-LEFT $\to$ M-- S-RIGHT $\to$ M-+
S-RET $\to$ C-S-RET
\endexample
%Configure the variable {\tt org-CUA-compatibility} to make Org-mode
%avoid the \kbd{S-<cursor>} bindings used by these modes. When set,
%Org-mode will change the following keybindings (also in the agenda
%buffer, but not during date selection). See note mark four$^3$
%throughout the reference card.
%%\vskip-mm
%\beginexample
%S-UP $\to$ M-p S-DOWN $\to$ M-n
%S-LEFT $\to$ M-- S-RIGHT $\to$ M-+
%S-RET $\to$ C-S-RET
%\endexample
\section{Notes}
$^1$ This is only a suggestion for a binding of this command. Choose

9
xemacs/README Normal file
View File

@ -0,0 +1,9 @@
This directory contains files that are necessary or at least useful
companions for Org-mode:
noutline.el Greg Chernov's port of the overlay-based implementation of
outline-mode. This is requires, and until XEmacs uses
this (or another port), you need to install it with Org-mode.
ps-print-invisible.el Greg Chernovs modification to ps-print, to
honor invisible text properties during printing.

1051
xemacs/noutline.el Normal file

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,225 @@
;;; ps-print-invisible.el - addon to ps-print package that deals
;; with invisible text printing in xemacs
;; Author: Greg Chernov
;;
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Put ps-print-invisible.el on your load path.
;; (require 'ps-print-invisible)
;; ps-print-buffer-with-faces will not print invisible parts of the buffer.
;; Work with invisible extents/text properties only
;; (xemacs hideshow and noutline packages).
(defun ps-generate-postscript-with-faces (from to)
;; Some initialization...
(setq ps-current-effect 0)
;; Build the reference lists of faces if necessary.
(when (or ps-always-build-face-reference
ps-build-face-reference)
(message "Collecting face information...")
(ps-build-reference-face-lists))
;; Black/white printer.
(setq ps-black-white-faces-alist nil)
(and (eq ps-print-color-p 'black-white)
(ps-extend-face-list ps-black-white-faces nil
'ps-black-white-faces-alist))
;; Generate some PostScript.
(save-restriction
(narrow-to-region from to)
(ps-print-ensure-fontified from to)
(let ((face 'default)
(position to))
(cond
((memq ps-print-emacs-type '(xemacs lucid))
;; Build the list of extents...
;;(debug)
(let ((a (cons 'dummy nil))
record type extent extent-list
(list-invisible (ps-print-find-invisible-xmas from to)))
(ps-x-map-extents 'ps-mapper nil from to a)
(setq a (sort (cdr a) 'car-less-than-car)
extent-list nil)
;; Loop through the extents...
(while a
(setq record (car a)
position (car record)
record (cdr record)
type (car record)
record (cdr record)
extent (car record))
;; Plot up to this record.
;; XEmacs 19.12: for some reason, we're getting into a
;; situation in which some of the records have
;; positions less than 'from'. Since we've narrowed
;; the buffer, this'll generate errors. This is a hack,
;; but don't call ps-plot-with-face unless from > point-min.
(and (>= from (point-min))
(ps-plot-with-face from (min position (point-max)) face))
(cond
((eq type 'push)
(and (or (ps-x-extent-face extent)
(extent-property extent 'invisible))
(setq extent-list (sort (cons extent extent-list)
'ps-extent-sorter))))
((eq type 'pull)
(setq extent-list (sort (delq extent extent-list)
'ps-extent-sorter))))
(setq face (if extent-list
(let ((prop (extent-property (car extent-list) 'invisible)))
(if (or (and (eq buffer-invisibility-spec t)
(not (null prop)))
(and (consp buffer-invisibility-spec)
(or (memq prop buffer-invisibility-spec)
(assq prop buffer-invisibility-spec))))
'emacs--invisible--face
(ps-x-extent-face (car extent-list))))
'default)
from position
a (cdr a)))))
((eq ps-print-emacs-type 'emacs)
(let ((property-change from)
(overlay-change from)
(save-buffer-invisibility-spec buffer-invisibility-spec)
(buffer-invisibility-spec nil)
before-string after-string)
(while (< from to)
(and (< property-change to) ; Don't search for property change
; unless previous search succeeded.
(setq property-change (next-property-change from nil to)))
(and (< overlay-change to) ; Don't search for overlay change
; unless previous search succeeded.
(setq overlay-change (min (ps-e-next-overlay-change from)
to)))
(setq position (min property-change overlay-change)
before-string nil
after-string nil)
;; The code below is not quite correct,
;; because a non-nil overlay invisible property
;; which is inactive according to the current value
;; of buffer-invisibility-spec nonetheless overrides
;; a face text property.
(setq face
(cond ((let ((prop (get-text-property from 'invisible)))
;; Decide whether this invisible property
;; really makes the text invisible.
(if (eq save-buffer-invisibility-spec t)
(not (null prop))
(or (memq prop save-buffer-invisibility-spec)
(assq prop save-buffer-invisibility-spec))))
'emacs--invisible--face)
((get-text-property from 'face))
(t 'default)))
(let ((overlays (ps-e-overlays-at from))
(face-priority -1)) ; text-property
(while (and overlays
(not (eq face 'emacs--invisible--face)))
(let* ((overlay (car overlays))
(overlay-invisible
(ps-e-overlay-get overlay 'invisible))
(overlay-priority
(or (ps-e-overlay-get overlay 'priority) 0)))
(and (> overlay-priority face-priority)
(setq before-string
(or (ps-e-overlay-get overlay 'before-string)
before-string)
after-string
(or (and (<= (ps-e-overlay-end overlay) position)
(ps-e-overlay-get overlay 'after-string))
after-string)
face-priority overlay-priority
face
(cond
((if (eq save-buffer-invisibility-spec t)
(not (null overlay-invisible))
(or (memq overlay-invisible
save-buffer-invisibility-spec)
(assq overlay-invisible
save-buffer-invisibility-spec)))
'emacs--invisible--face)
((ps-e-overlay-get overlay 'face))
(t face)
))))
(setq overlays (cdr overlays))))
;; Plot up to this record.
(and before-string
(ps-plot-string before-string))
(ps-plot-with-face from position face)
(and after-string
(ps-plot-string after-string))
(setq from position)))))
(ps-plot-with-face from to face))))
(defun ps-print-find-invisible-xmas (from to)
(let ((list nil))
(map-extents '(lambda (ex ignored)
(let ((prop (extent-property ex 'invisible)))
(if (or (and (eq buffer-invisibility-spec t)
(not (null prop)))
(or (memq prop buffer-invisibility-spec)
(assq prop buffer-invisibility-spec)))
(setq list (cons (list
(extent-start-position ex)
(extent-end-position ex))
list))))
nil)
(current-buffer)
from to nil 'start-and-end-in-region 'invisible)
(reverse list)))
(defun ps-mapper (extent list)
;;(debug)
(let ((beg (ps-x-extent-start-position extent))
(end (ps-x-extent-end-position extent))
(inv-lst list-invisible)
(found nil))
(while (and inv-lst
(not found))
(let ((inv-beg (caar inv-lst))
(inv-end (cadar inv-lst)))
(if (and (>= beg inv-beg)
(<= end inv-end)
(not (extent-property extent 'invisible)))
(setq found t))
(setq inv-lst (cdr inv-lst))))
(if (not found)
(nconc list
(list (list beg 'push extent)
(list end 'pull extent)))))
nil)
(provide 'ps-print-invisible)
;;; ps-print-invisible.el ends here