Release 4.40

README

@@ -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.

org-publish.el

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

orgcard.tex

@@ -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{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{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}
 
 {\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.
-
-\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}
+%\section{CUA and pc-select compatibility}%
 
-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

xemacs/README

@@ -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.

xemacs/noutline.el

@@ -0,0 +1,1051 @@
+;;; outline.el --- outline mode commands for Emacs
+
+;; ----------------------------------------------------------------------
+;; This is a port of GNU Emacs outline.el to XEmacs.  The port was
+;; done by Greg Chernov and is temporarily made available on the Org-mode
+;; homepage http://www.astro.uva.nl/~dominik/Tools/org/, and as part
+;; of the Org-mode distribution.
+;; ----------------------------------------------------------------------
+
+;; Copyright (C) 1986, 1993, 1994, 1995, 1997, 2000, 2001, 2002,
+;;   2003, 2004, 2005 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: outlines
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 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:
+
+;; This package is a major mode for editing outline-format documents.
+;; An outline can be `abstracted' to show headers at any given level,
+;; with all stuff below hidden.  See the Emacs manual for details.
+
+;;; Todo:
+
+;; - subtree-terminators
+;; - better handle comments before function bodies (i.e. heading)
+;; - don't bother hiding whitespace
+
+;;; Code:
+
+(require 'easymenu)
+
+;; XEmacs and compatibility
+
+(defalias 'match-string-no-properties 'match-string)
+
+(if (not (fboundp 'add-to-invisibility-spec))
+    (defun add-to-invisibility-spec (arg)
+      "Add elements to `buffer-invisibility-spec'.
+See documentation for `buffer-invisibility-spec' for the kind of elements
+that can be added."
+      (if (eq buffer-invisibility-spec t)
+	  (setq buffer-invisibility-spec (list t)))
+      (setq buffer-invisibility-spec
+	    (cons arg buffer-invisibility-spec))))
+
+(if (not (fboundp 'remove-from-invisibility-spec))
+    (defun remove-from-invisibility-spec (arg)
+      "Remove elements from `buffer-invisibility-spec'."
+      (if (consp buffer-invisibility-spec)
+	  (setq buffer-invisibility-spec
+		(delete arg buffer-invisibility-spec)))))
+
+(defvar font-lock-warning-face)
+
+
+(defgroup outlines nil
+  "Support for hierarchical outlining."
+  :prefix "outline-"
+  :group 'editing)
+
+(defcustom outline-regexp "[*\^L]+"
+  "*Regular expression to match the beginning of a heading.
+Any line whose beginning matches this regexp is considered to start a heading.
+Note that Outline mode only checks this regexp at the start of a line,
+so the regexp need not (and usually does not) start with `^'.
+The recommended way to set this is with a Local Variables: list
+in the file it applies to.  See also `outline-heading-end-regexp'."
+  :type '(choice regexp (const nil))
+  :group 'outlines)
+
+(defcustom outline-heading-end-regexp "\n"
+  "*Regular expression to match the end of a heading line.
+You can assume that point is at the beginning of a heading when this
+regexp is searched for.  The heading ends at the end of the match.
+The recommended way to set this is with a `Local Variables:' list
+in the file it applies to."
+  :type 'regexp
+  :group 'outlines)
+
+(defvar outline-mode-prefix-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "@" 'outline-mark-subtree)
+    (define-key map "\C-n" 'outline-next-visible-heading)
+    (define-key map "\C-p" 'outline-previous-visible-heading)
+    (define-key map "\C-i" 'show-children)
+    (define-key map "\C-s" 'show-subtree)
+    (define-key map "\C-d" 'hide-subtree)
+    (define-key map "\C-u" 'outline-up-heading)
+    (define-key map "\C-f" 'outline-forward-same-level)
+    (define-key map "\C-b" 'outline-backward-same-level)
+    (define-key map "\C-t" 'hide-body)
+    (define-key map "\C-a" 'show-all)
+    (define-key map "\C-c" 'hide-entry)
+    (define-key map "\C-e" 'show-entry)
+    (define-key map "\C-l" 'hide-leaves)
+    (define-key map "\C-k" 'show-branches)
+    (define-key map "\C-q" 'hide-sublevels)
+    (define-key map "\C-o" 'hide-other)
+    (define-key map "\C-^" 'outline-move-subtree-up)
+    (define-key map "\C-v" 'outline-move-subtree-down)
+    (define-key map [(control ?<)] 'outline-promote)
+    (define-key map [(control ?>)] 'outline-demote)
+    (define-key map "\C-m" 'outline-insert-heading)
+    ;; Where to bind outline-cycle ?
+    map))
+
+
+
+(defvar outline-mode-menu-heading
+  '("Headings"
+    ["Up" outline-up-heading t]
+    ["Next" outline-next-visible-heading t]
+    ["Previous" outline-previous-visible-heading t]
+    ["Next Same Level" outline-forward-same-level t]
+    ["Previous Same Level" outline-backward-same-level t]
+    ["New heading" outline-insert-heading t]
+    ["Copy to kill ring" outline-headers-as-kill :active (region-active-p)]
+    ["Move subtree up" outline-move-subtree-up t]
+    ["Move subtree down" outline-move-subtree-down t]
+    ["Promote subtree" outline-promote t]
+    ["Demote subtree" outline-demote t]))
+
+(defvar outline-mode-menu-show
+  '("Show"
+    ["Show All" show-all t]
+    ["Show Entry" show-entry t]
+    ["Show Branches" show-branches t]
+    ["Show Children" show-children t]
+    ["Show Subtree" show-subtree t]))
+
+(defvar outline-mode-menu-hide
+  '("Hide"
+    ["Hide Leaves" hide-leaves t]
+    ["Hide Body" hide-body t]
+    ["Hide Entry" hide-entry t]
+    ["Hide Subtree" hide-subtree t]
+    ["Hide Other" hide-other t]
+    ["Hide Sublevels" hide-sublevels t]))
+
+
+
+(defvar outline-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-c" outline-mode-prefix-map)
+    map))
+
+(defvar outline-font-lock-keywords
+  '(;;
+    ;; Highlight headings according to the level.
+    (eval . (list (concat "^\\(?:" outline-regexp "\\).+")
+		  0 '(outline-font-lock-face) nil t)))
+  "Additional expressions to highlight in Outline mode.")
+
+(defface outline-1
+  '((t (:foreground "Blue1")))
+  "Level 1."
+  :group 'outlines)
+
+(defface outline-2
+  '((t (:foreground "DarkGoldenrod")))
+  "Level 2."
+  :group 'outlines)
+
+(defface outline-3
+  '((t (:foreground "Purple")))
+  "Level 3."
+  :group 'outlines)
+
+(defface outline-4
+  '((t (:foreground "Firebrick")))
+  "Level 4."
+  :group 'outlines)
+
+(defface outline-5
+  '((t (:foreground "ForestGreen")))
+  "Level 5."
+  :group 'outlines)
+
+(defface outline-6
+  '((t (:foreground "CadetBlue")))
+  "Level 6."
+  :group 'outlines)
+
+(defface outline-7
+  '((t (:foreground "Orchid")))
+  "Level 7."
+  :group 'outlines)
+
+(defface outline-8
+  '((t (:foreground "RosyBrown")))
+  "Level 8."
+  :group 'outlines)
+
+
+
+(defvar outline-font-lock-faces
+  [outline-1 outline-2 outline-3 outline-4
+   outline-5 outline-6 outline-7 outline-8])
+
+(defvar outline-font-lock-levels nil)
+(make-variable-buffer-local 'outline-font-lock-levels)
+
+(defun outline-font-lock-face ()
+  ;; (save-excursion
+  ;;   (outline-back-to-heading t)
+  ;;   (let* ((count 0)
+  ;; 	   (start-level (funcall outline-level))
+  ;; 	   (level start-level)
+  ;; 	   face-level)
+  ;;     (while (not (setq face-level
+  ;; 			(if (or (bobp) (eq level 1)) 0
+  ;; 			  (cdr (assq level outline-font-lock-levels)))))
+  ;; 	(outline-up-heading 1 t)
+  ;; 	(setq count (1+ count))
+  ;; 	(setq level (funcall outline-level)))
+  ;;     ;; Remember for later.
+  ;;     (unless (zerop count)
+  ;; 	(setq face-level (+ face-level count))
+  ;; 	(push (cons start-level face-level) outline-font-lock-levels))
+  ;;     (condition-case nil
+  ;; 	  (aref outline-font-lock-faces face-level)
+  ;; 	(error font-lock-warning-face))))
+  (save-excursion
+    (goto-char (match-beginning 0))
+    (looking-at outline-regexp)
+    (condition-case nil
+	(aref outline-font-lock-faces (1- (funcall outline-level)))
+      (error font-lock-warning-face))))
+
+(defvar outline-view-change-hook nil
+  "Normal hook to be run after outline visibility changes.")
+
+(defvar outline-mode-hook nil
+  "*This hook is run when outline mode starts.")
+
+(defvar outline-blank-line nil
+  "*Non-nil means to leave unhidden blank line before heading.")
+
+;;;###autoload
+(define-derived-mode outline-mode text-mode "Outline"
+  "Set major mode for editing outlines with selective display.
+Headings are lines which start with asterisks: one for major headings,
+two for subheadings, etc.  Lines not starting with asterisks are body lines.
+
+Body text or subheadings under a heading can be made temporarily
+invisible, or visible again.  Invisible lines are attached to the end
+of the heading, so they move with it, if the line is killed and yanked
+back.  A heading with text hidden under it is marked with an ellipsis (...).
+
+Commands:\\<outline-mode-map>
+\\[outline-next-visible-heading]   outline-next-visible-heading      move by visible headings
+\\[outline-previous-visible-heading]   outline-previous-visible-heading
+\\[outline-forward-same-level]   outline-forward-same-level        similar but skip subheadings
+\\[outline-backward-same-level]   outline-backward-same-level
+\\[outline-up-heading]   outline-up-heading		    move from subheading to heading
+
+\\[hide-body]	make all text invisible (not headings).
+\\[show-all]	make everything in buffer visible.
+\\[hide-sublevels]  make only the first N levels of headers visible.
+
+The remaining commands are used when point is on a heading line.
+They apply to some of the body or subheadings of that heading.
+\\[hide-subtree]   hide-subtree	make body and subheadings invisible.
+\\[show-subtree]   show-subtree	make body and subheadings visible.
+\\[show-children]   show-children	make direct subheadings visible.
+		 No effect on body, or subheadings 2 or more levels down.
+		 With arg N, affects subheadings N levels down.
+\\[hide-entry]	   make immediately following body invisible.
+\\[show-entry]	   make it visible.
+\\[hide-leaves]	   make body under heading and under its subheadings invisible.
+		     The subheadings remain visible.
+\\[show-branches]  make all subheadings at all levels visible.
+
+The variable `outline-regexp' can be changed to control what is a heading.
+A line is a heading if `outline-regexp' matches something at the
+beginning of the line.  The longer the match, the deeper the level.
+
+Turning on outline mode calls the value of `text-mode-hook' and then of
+`outline-mode-hook', if they are non-nil."
+  (make-local-variable 'line-move-ignore-invisible)
+  (setq line-move-ignore-invisible t)
+  ;; Cause use of ellipses for invisible text.
+  (add-to-invisibility-spec '(outline . t))
+
+  (easy-menu-add outline-mode-menu-heading)
+  (easy-menu-add outline-mode-menu-show)
+  (easy-menu-add outline-mode-menu-hide)
+  (set (make-local-variable 'paragraph-start)
+       (concat paragraph-start "\\|\\(?:" outline-regexp "\\)"))
+  ;; Inhibit auto-filling of header lines.
+  (set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp)
+  (set (make-local-variable 'paragraph-separate)
+       (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)"))
+  (set (make-local-variable 'font-lock-defaults)
+       '(outline-font-lock-keywords t nil nil backward-paragraph))
+  (setq imenu-generic-expression
+	(list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0)))
+  (add-hook 'change-major-mode-hook 'show-all nil t))
+
+(defcustom outline-minor-mode-prefix "\C-c@"
+  "*Prefix key to use for Outline commands in Outline minor mode.
+The value of this variable is checked as part of loading Outline mode.
+After that, changing the prefix key requires manipulating keymaps."
+  :type 'string
+  :group 'outlines)
+
+;;;###autoload
+(define-minor-mode outline-minor-mode
+  "Toggle Outline minor mode.
+With arg, turn Outline minor mode on if arg is positive, off otherwise.
+See the command `outline-mode' for more information on this mode."
+  nil " Outl" (list (cons outline-minor-mode-prefix outline-mode-prefix-map))
+  :group 'outlines
+  (if outline-minor-mode
+      (progn
+	;; Turn off this mode if we change major modes.
+	(easy-menu-add outline-mode-menu-heading)
+	(easy-menu-add outline-mode-menu-show)
+	(easy-menu-add outline-mode-menu-hide)
+	(add-hook 'change-major-mode-hook
+		  (lambda () (outline-minor-mode -1))
+		  nil t)
+	(set (make-local-variable 'line-move-ignore-invisible) t)
+	;; Cause use of ellipses for invisible text.
+	(add-to-invisibility-spec '(outline . t)))
+    (easy-menu-remove outline-mode-menu-heading)
+    (easy-menu-remove outline-mode-menu-show)
+    (easy-menu-remove outline-mode-menu-hide)
+    (setq line-move-ignore-invisible nil)
+    ;; Cause use of ellipses for invisible text.
+    (remove-from-invisibility-spec '(outline . t))
+    ;; When turning off outline mode, get rid of any outline hiding.
+    (show-all)))
+
+(defvar outline-level 'outline-level
+  "*Function of no args to compute a header's nesting level in an outline.
+It can assume point is at the beginning of a header line and that the match
+data reflects the `outline-regexp'.")
+
+(defvar outline-heading-alist ()
+  "Alist associating a heading for every possible level.
+Each entry is of the form (HEADING . LEVEL).
+This alist is used two ways: to find the heading corresponding to
+a given level and to find the level of a given heading.
+If a mode or document needs several sets of outline headings (for example
+numbered and unnumbered sections), list them set by set and sorted by level
+within each set.  For example in texinfo mode:
+
+     (setq outline-heading-alist
+      '((\"@chapter\" . 2) (\"@section\" . 3) (\"@subsection\" . 4)
+           (\"@subsubsection\" . 5)
+        (\"@unnumbered\" . 2) (\"@unnumberedsec\" . 3)
+           (\"@unnumberedsubsec\" . 4)  (\"@unnumberedsubsubsec\" . 5)
+        (\"@appendix\" . 2) (\"@appendixsec\" . 3)...
+           (\"@appendixsubsec\" . 4) (\"@appendixsubsubsec\" . 5) ..))
+
+Instead of sorting the entries in each set, you can also separate the
+sets with nil.")
+(make-variable-buffer-local 'outline-heading-alist)
+
+;; This used to count columns rather than characters, but that made ^L
+;; appear to be at level 2 instead of 1.  Columns would be better for
+;; tab handling, but the default regexp doesn't use tabs, and anyone
+;; who changes the regexp can also redefine the outline-level variable
+;; as appropriate.
+(defun outline-level ()
+  "Return the depth to which a statement is nested in the outline.
+Point must be at the beginning of a header line.
+This is actually either the level specified in `outline-heading-alist'
+or else the number of characters matched by `outline-regexp'."
+  (or (cdr (assoc (match-string 0) outline-heading-alist))
+      (- (match-end 0) (match-beginning 0))))
+
+(defun outline-next-preface ()
+  "Skip forward to just before the next heading line.
+If there's no following heading line, stop before the newline
+at the end of the buffer."
+  (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
+			 nil 'move)
+      (goto-char (match-beginning 0)))
+  (if (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
+      (forward-char -1)))
+
+(defun outline-next-heading ()
+  "Move to the next (possibly invisible) heading line."
+  (interactive)
+  ;; Make sure we don't match the heading we're at.
+  (if (and (bolp) (not (eobp))) (forward-char 1))
+  (if (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
+			 nil 'move)
+      (goto-char (match-beginning 0))))
+
+(defun outline-previous-heading ()
+  "Move to the previous (possibly invisible) heading line."
+  (interactive)
+  (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+		      nil 'move))
+
+(defsubst outline-invisible-p (&optional pos)
+  "Non-nil if the character after point is invisible."
+  (get-char-property (or pos (point)) 'invisible))
+
+(defun outline-visible ()
+  (not (outline-invisible-p)))
+(make-obsolete 'outline-visible 'outline-invisible-p)
+
+(defun outline-back-to-heading (&optional invisible-ok)
+  "Move to previous heading line, or beg of this line if it's a heading.
+Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
+  (beginning-of-line)
+  (or (outline-on-heading-p invisible-ok)
+      (let (found)
+	(save-excursion
+	  (while (not found)
+	    (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+				    nil t)
+		(error "before first heading"))
+	    (setq found (and (or invisible-ok (not (outline-invisible-p)))
+			     (point)))))
+	(goto-char found)
+	found)))
+
+(defun outline-on-heading-p (&optional invisible-ok)
+  "Return t if point is on a (visible) heading line.
+If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
+  (save-excursion
+    (beginning-of-line)
+    (and (bolp) (or invisible-ok (not (outline-invisible-p)))
+	 (looking-at outline-regexp))))
+
+(defun outline-insert-heading ()
+  "Insert a new heading at same depth at point."
+  (interactive)
+  (let ((head (save-excursion
+		(condition-case nil
+		    (outline-back-to-heading)
+		  (error (outline-next-heading)))
+		(if (eobp)
+		    (or (caar outline-heading-alist) "")
+		  (match-string 0)))))
+    (unless (or (string-match "[ \t]\\'" head)
+		(not (string-match (concat "\\`\\(?:" outline-regexp "\\)")
+				   (concat head " "))))
+      (setq head (concat head " ")))
+    (unless (bolp) (end-of-line) (newline))
+    (insert head)
+    (unless (eolp)
+      (save-excursion (newline-and-indent)))
+    (run-hooks 'outline-insert-heading-hook)))
+
+(defun outline-invent-heading (head up)
+  (save-match-data
+    ;; Let's try to invent one by repeating or deleting the last char.
+    (let ((new-head (if up (substring head 0 -1)
+                      (concat head (substring head -1)))))
+      (if (string-match (concat "\\`\\(?:" outline-regexp "\\)")
+                        new-head)
+          ;; Why bother checking that it is indeed higher/lower level ?
+          new-head
+        ;; Didn't work, so ask what to do.
+        (read-string (format "%s heading for `%s': "
+                             (if up "Parent" "Demoted") head)
+                     head nil nil)))))
+
+(defun outline-promote (&optional children)
+  "Promote headings higher up the tree.
+If prefix argument CHILDREN is given, promote also all the children.
+If the region is active in `transient-mark-mode', promote all headings
+in the region."
+  (interactive
+   (list (if (and zmacs-regions (region-active-p)) 'region
+	   (outline-back-to-heading)
+	   (if current-prefix-arg nil 'subtree))))
+  (cond
+   ((eq children 'region)
+    (outline-map-region 'outline-promote (region-beginning) (region-end)))
+   (children
+    (outline-map-region 'outline-promote
+			(point)
+			(save-excursion (outline-get-next-sibling) (point))))
+   (t
+    (outline-back-to-heading t)
+    (let* ((head (match-string-no-properties 0))
+	   (level (save-match-data (funcall outline-level)))
+	   (up-head (or (outline-head-from-level (1- level) head)
+			;; Use the parent heading, if it is really
+			;; one level less.
+			(save-excursion
+			  (save-match-data
+			    (outline-up-heading 1 t)
+			    (and (= (1- level) (funcall outline-level))
+				 (match-string-no-properties 0))))
+                        ;; Bummer!! There is no lower level heading.
+                        (outline-invent-heading head 'up))))
+
+      (unless (rassoc level outline-heading-alist)
+	(push (cons head level) outline-heading-alist))
+
+      (replace-match up-head nil t)))))
+
+(defun outline-demote (&optional children)
+  "Demote headings lower down the tree.
+If prefix argument CHILDREN is given, demote also all the children.
+If the region is active in `transient-mark-mode', demote all headings
+in the region."
+  (interactive
+   (list (if (and zmacs-regions (region-active-p)) 'region
+	   (outline-back-to-heading)
+	   (if current-prefix-arg nil 'subtree))))
+  (cond
+   ((eq children 'region)
+    (outline-map-region 'outline-demote (region-beginning) (region-end)))
+   (children
+    (outline-map-region 'outline-demote
+			(point)
+			(save-excursion (outline-get-next-sibling) (point))))
+   (t
+    (let* ((head (match-string-no-properties 0))
+	   (level (save-match-data (funcall outline-level)))
+	   (down-head
+	    (or (outline-head-from-level (1+ level) head)
+		(save-excursion
+		  (save-match-data
+		    (while (and (progn (outline-next-heading) (not (eobp)))
+				(<= (funcall outline-level) level)))
+		    (when (eobp)
+		      ;; Try again from the beginning of the buffer.
+		      (goto-char (point-min))
+		      (while (and (progn (outline-next-heading) (not (eobp)))
+				  (<= (funcall outline-level) level))))
+		    (unless (eobp)
+		      (looking-at outline-regexp)
+		      (match-string-no-properties 0))))
+                ;; Bummer!! There is no higher-level heading in the buffer.
+                (outline-invent-heading head nil))))
+
+      (unless (rassoc level outline-heading-alist)
+	(push (cons head level) outline-heading-alist))
+      (replace-match down-head nil t)))))
+
+(defun outline-head-from-level (level head &optional alist)
+  "Get new heading with level LEVEL from ALIST.
+If there are no such entries, return nil.
+ALIST defaults to `outline-heading-alist'.
+Similar to (car (rassoc LEVEL ALIST)).
+If there are several different entries with same new level, choose
+the one with the smallest distance to the assocation of HEAD in the alist.
+This makes it possible for promotion to work in modes with several
+independent sets of headings (numbered, unnumbered, appendix...)"
+  (unless alist (setq alist outline-heading-alist))
+  (let ((l (rassoc level alist))
+	ll h hl l2 l2l)
+    (cond
+     ((null l) nil)
+     ;; If there's no HEAD after L, any other entry for LEVEL after L
+     ;; can't be much better than L.
+     ((null (setq h (assoc head (setq ll (memq l alist))))) (car l))
+     ;; If there's no other entry for LEVEL, just keep L.
+     ((null (setq l2 (rassoc level (cdr ll)))) (car l))
+     ;; Now we have L, L2, and H: see if L2 seems better than L.
+     ;; If H is after L2, L2 is better.
+     ((memq h (setq l2l (memq l2 (cdr ll))))
+      (outline-head-from-level level head l2l))
+     ;; Now we have H between L and L2.
+     ;; If there's a separator between L and H, prefer L2.
+     ((memq h (memq nil ll))
+      (outline-head-from-level level head l2l))
+     ;; If there's a separator between L2 and H, prefer L.
+     ((memq l2 (memq nil (setq hl (memq h ll)))) (car l))
+     ;; No separator between L and L2, check the distance.
+     ((< (* 2 (length hl)) (+ (length ll) (length l2l)))
+      (outline-head-from-level level head l2l))
+     ;; If all else fails, just keep L.
+     (t (car l)))))
+
+(defun outline-map-region (fun beg end)
+  "Call FUN for every heading between BEG and END.
+When FUN is called, point is at the beginning of the heading and
+the match data is set appropriately."
+  (save-excursion
+    (setq end (copy-marker end))
+    (goto-char beg)
+    (when (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t)
+      (goto-char (match-beginning 0))
+      (funcall fun)
+      (while (and (progn
+		    (outline-next-heading)
+		    (< (point) end))
+		  (not (eobp)))
+	(funcall fun)))))
+
+;; Vertical tree motion
+
+(defun outline-move-subtree-up (&optional arg)
+  "Move the currrent subtree up past ARG headlines of the same level."
+  (interactive "p")
+  (outline-move-subtree-down (- arg)))
+
+(defun outline-move-subtree-down (&optional arg)
+  "Move the currrent subtree down past ARG headlines of the same level."
+  (interactive "p")
+  (let ((movfunc (if (> arg 0) 'outline-get-next-sibling
+		   'outline-get-last-sibling))
+	(ins-point (make-marker))
+	(cnt (abs arg))
+	(tmp-string "")
+	beg end folded)
+    ;; Select the tree
+    (outline-back-to-heading)
+    (setq beg (point))
+    (save-match-data
+      (save-excursion (outline-end-of-heading)
+		      (setq folded (outline-invisible-p)))
+      (outline-end-of-subtree))
+    (if (= (char-after) ?\n) (forward-char 1))
+    (setq end (point))
+    ;; Find insertion point, with error handling
+    (goto-char beg)
+    (while (> cnt 0)
+      (or (funcall movfunc)
+	  (progn (goto-char beg)
+		 (error "Cannot move past superior level")))
+      (setq cnt (1- cnt)))
+    (if (> arg 0)
+	;; Moving forward - still need to move over subtree
+	(progn (outline-end-of-subtree)
+	       (if (= (char-after) ?\n) (forward-char 1))))
+    (move-marker ins-point (point))
+    (setq tmp-string (buffer-substring beg end))
+    (delete-region beg end)
+    (insert tmp-string)
+    (goto-char ins-point)
+    (if folded (hide-subtree))
+    (move-marker ins-point nil)))
+
+(defun outline-end-of-heading ()
+  (if (re-search-forward outline-heading-end-regexp nil 'move)
+      (forward-char -1)))
+
+(defun outline-next-visible-heading (arg)
+  "Move to the next visible heading line.
+With argument, repeats or can move backward if negative.
+A heading line is one that starts with a `*' (or that
+`outline-regexp' matches)."
+  (interactive "p")
+  (if (< arg 0)
+      (beginning-of-line)
+    (end-of-line))
+  (while (and (not (bobp)) (< arg 0))
+    (while (and (not (bobp))
+		(re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+				    nil 'move)
+		(outline-invisible-p)))
+    (setq arg (1+ arg)))
+  (while (and (not (eobp)) (> arg 0))
+    (while (and (not (eobp))
+		(re-search-forward (concat "^\\(?:" outline-regexp "\\)")
+				   nil 'move)
+		(outline-invisible-p (match-beginning 0))))
+    (setq arg (1- arg)))
+  (beginning-of-line))
+
+(defun outline-previous-visible-heading (arg)
+  "Move to the previous heading line.
+With argument, repeats or can move forward if negative.
+A heading line is one that starts with a `*' (or that
+`outline-regexp' matches)."
+  (interactive "p")
+  (outline-next-visible-heading (- arg)))
+
+(defun outline-mark-subtree ()
+  "Mark the current subtree in an outlined document.
+This puts point at the start of the current subtree, and mark at the end."
+  (interactive)
+  (let ((beg))
+    (if (outline-on-heading-p)
+	;; we are already looking at a heading
+	(beginning-of-line)
+      ;; else go back to previous heading
+      (outline-previous-visible-heading 1))
+    (setq beg (point))
+    (outline-end-of-subtree)
+    (push-mark (point) nil t)
+    (goto-char beg)))
+
+
+(defun outline-discard-extents (&optional beg end)
+  "Clear BEG and END of overlays whose property NAME has value VAL.
+Overlays might be moved and/or split.
+BEG and END default respectively to the beginning and end of buffer."
+  (unless beg (setq beg (point-min)))
+  (unless end (setq end (point-max)))
+  (if (< end beg)
+      (setq beg (prog1 end (setq end beg))))
+  (save-excursion
+    (map-extents 
+     #'(lambda (ex ignored) 
+	 (if (< (extent-start-position ex) beg)
+	    (if (> (extent-end-position ex) end)
+		(progn
+		  (set-extent-endpoints (copy-extent ex)
+					(extent-start-position ex) beg)
+		  (set-extent-endpoints ex end (extent-end-position ex)))
+	      (set-extent-endpoints ex (extent-start-position ex) beg)))
+	  (if (> (extent-end-position ex) end)
+	      (set-extent-endpoints ex end (extent-end-position ex))
+	       (delete-extent ex)))
+     (current-buffer) beg end nil 'end-closed 'outline)))
+
+
+;;;(defun outline-discard-extents (from to)
+;;;  "Delete hideshow extents in region defined by FROM and TO."
+;;;  (when (< to from)
+;;;    (setq from (prog1 to (setq to from))))
+;;;  (map-extents #'(lambda (ex ignored) (delete-extent ex))
+;;;	       (current-buffer) from to nil 'end-closed 'outline))
+
+(defun outline-flag-region (from to flag)
+  "Hide or show lines from FROM to TO, according to FLAG.
+If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
+  (when (< to from)
+    (setq from (prog1 to (setq to from))))
+  ;; first clear it all out
+  (outline-discard-extents from to)
+  (when flag
+    (let ((ex (make-extent from to)))
+      (set-extent-property ex 'invisible 'outline)
+      (set-extent-property ex 'outline flag)
+      (set-extent-property ex 'isearch-open-invisible 'outline-isearch-open-invisible)))
+  ;; Seems only used by lazy-lock.  I.e. obsolete.
+  (run-hooks 'outline-view-change-hook))
+  
+
+
+;; Function to be set as an outline-isearch-open-invisible' property
+;; to the overlay that makes the outline invisible (see
+;; `outline-flag-region').
+(defun outline-isearch-open-invisible (overlay)
+  ;; We rely on the fact that isearch places point on the matched text.
+  (show-entry))
+
+(defun hide-entry ()
+  "Hide the body directly following this heading."
+  (interactive)
+  (save-excursion
+    (outline-back-to-heading)
+    (outline-end-of-heading)
+    (outline-flag-region (point) (progn (outline-next-preface) (point)) t)))
+
+(defun show-entry ()
+  "Show the body directly following this heading.
+Show the heading too, if it is currently invisible."
+  (interactive)
+  (save-excursion
+    (outline-back-to-heading t)
+    (outline-flag-region (max 1 (1- (point)))
+			 (progn (outline-next-preface) (point)) nil)))
+
+(defun hide-body ()
+  "Hide all body lines in buffer, leaving all headings visible."
+  (interactive)
+  (hide-region-body (point-min) (point-max)))
+
+(defun hide-region-body (start end)
+  "Hide all body lines in the region, but not headings."
+  ;; Nullify the hook to avoid repeated calls to `outline-flag-region'
+  ;; wasting lots of time running `lazy-lock-fontify-after-outline'
+  ;; and run the hook finally.
+  (let (outline-view-change-hook)
+    (save-excursion
+      (save-restriction
+	(narrow-to-region start end)
+	(goto-char (point-min))
+	(if (outline-on-heading-p)
+	    (outline-end-of-heading)
+	  (outline-next-preface))
+	(while (not (eobp))
+	  (outline-flag-region (point)
+			       (progn (outline-next-preface) (point)) t)
+	  (unless (eobp)
+	    (forward-char (if (looking-at "\n\n") 2 1))
+	    (outline-end-of-heading))))))
+  (run-hooks 'outline-view-change-hook))
+
+(defun show-all ()
+  "Show all of the text in the buffer."
+  (interactive)
+  (outline-flag-region (point-min) (point-max) nil))
+
+(defun hide-subtree ()
+  "Hide everything after this heading at deeper levels."
+  (interactive)
+  (outline-flag-subtree t))
+
+(defun hide-leaves ()
+  "Hide all body after this heading at deeper levels."
+  (interactive)
+  (save-excursion
+    (outline-back-to-heading)
+    (outline-end-of-heading)
+    (hide-region-body (point) (progn (outline-end-of-subtree) (point)))))
+
+(defun show-subtree ()
+  "Show everything after this heading at deeper levels."
+  (interactive)
+  (outline-flag-subtree nil))
+
+(defun outline-show-heading ()
+  "Show the current heading and move to its end."
+  (outline-flag-region (- (point)
+ 			  (if (bobp) 0
+ 			    (if (and outline-blank-line
+                                     (eq (char-before (1- (point))) ?\n))
+ 				2 1)))
+		       (progn (outline-end-of-heading) (point))
+		       nil))
+
+(defun hide-sublevels (levels)
+  "Hide everything but the top LEVELS levels of headers, in whole buffer."
+  (interactive "p")
+  (if (< levels 1)
+      (error "Must keep at least one level of headers"))
+  (let (outline-view-change-hook)
+    (save-excursion
+      (goto-char (point-min))
+      ;; Skip the prelude, if any.
+      (unless (outline-on-heading-p t) (outline-next-heading))
+      ;; First hide everything.
+      (outline-flag-region (point) (point-max) t)
+      ;; Then unhide the top level headers.
+      (outline-map-region
+       (lambda ()
+	 (if (<= (funcall outline-level) levels)
+	     (outline-show-heading)))
+       (point) (point-max))))
+  (run-hooks 'outline-view-change-hook))
+
+(defun hide-other ()
+  "Hide everything except current body and parent and top-level headings."
+  (interactive)
+  (hide-sublevels 1)
+  (let (outline-view-change-hook)
+    (save-excursion
+      (outline-back-to-heading t)
+      (show-entry)
+      (while (condition-case nil (progn (outline-up-heading 1 t) (not (bobp)))
+	       (error nil))
+	(outline-flag-region (max 1 (1- (point)))
+			     (save-excursion (forward-line 1) (point))
+			     nil))))
+  (run-hooks 'outline-view-change-hook))
+
+(defun outline-toggle-children ()
+  "Show or hide the current subtree depending on its current state."
+  (interactive)
+  (save-excursion
+    (outline-back-to-heading)
+    (if (not (outline-invisible-p (point-at-eol)))
+	(hide-subtree)
+      (show-children)
+      (show-entry))))
+
+(defun outline-flag-subtree (flag)
+  (save-excursion
+    (outline-back-to-heading)
+    (outline-end-of-heading)
+    (outline-flag-region (point)
+			  (progn (outline-end-of-subtree) (point))
+			  flag)))
+
+(defun outline-end-of-subtree ()
+  (outline-back-to-heading)
+  (let ((first t)
+	(level (funcall outline-level)))
+    (while (and (not (eobp))
+		(or first (> (funcall outline-level) level)))
+      (setq first nil)
+      (outline-next-heading))
+    (if (bolp)
+	(progn
+	  ;; Go to end of line before heading
+	  (forward-char -1)
+          (if (and outline-blank-line (bolp))
+ 	      ;; leave blank line before heading
+ 	      (forward-char -1))))))
+
+(defun show-branches ()
+  "Show all subheadings of this heading, but not their bodies."
+  (interactive)
+  (show-children 1000))
+
+(defun show-children (&optional level)
+  "Show all direct subheadings of this heading.
+Prefix arg LEVEL is how many levels below the current level should be shown.
+Default is enough to cause the following heading to appear."
+  (interactive "P")
+  (setq level
+	(if level (prefix-numeric-value level)
+	  (save-excursion
+	    (outline-back-to-heading)
+	    (let ((start-level (funcall outline-level)))
+	      (outline-next-heading)
+	      (if (eobp)
+		  1
+		(max 1 (- (funcall outline-level) start-level)))))))
+  (let (outline-view-change-hook)
+    (save-excursion
+      (outline-back-to-heading)
+      (setq level (+ level (funcall outline-level)))
+      (outline-map-region
+       (lambda ()
+	 (if (<= (funcall outline-level) level)
+	     (outline-show-heading)))
+       (point)
+       (progn (outline-end-of-subtree)
+	      (if (eobp) (point-max) (1+ (point)))))))
+  (run-hooks 'outline-view-change-hook))
+
+
+
+(defun outline-up-heading (arg &optional invisible-ok)
+  "Move to the visible heading line of which the present line is a subheading.
+With argument, move up ARG levels.
+If INVISIBLE-OK is non-nil, also consider invisible lines."
+  (interactive "p")
+  (and (eq this-command 'outline-up-heading)
+       (or (eq last-command 'outline-up-heading) (push-mark)))
+  (outline-back-to-heading invisible-ok)
+  (let ((start-level (funcall outline-level)))
+    (if (eq start-level 1)
+	(error "Already at top level of the outline"))
+    (while (and (> start-level 1) (> arg 0) (not (bobp)))
+      (let ((level start-level))
+	(while (not (or (< level start-level) (bobp)))
+	  (if invisible-ok
+	      (outline-previous-heading)
+	    (outline-previous-visible-heading 1))
+	  (setq level (funcall outline-level)))
+	(setq start-level level))
+      (setq arg (- arg 1))))
+  (looking-at outline-regexp))
+
+(defun outline-forward-same-level (arg)
+  "Move forward to the ARG'th subheading at same level as this one.
+Stop at the first and last subheadings of a superior heading."
+  (interactive "p")
+  (outline-back-to-heading)
+  (while (> arg 0)
+    (let ((point-to-move-to (save-excursion
+			      (outline-get-next-sibling))))
+      (if point-to-move-to
+	  (progn
+	    (goto-char point-to-move-to)
+	    (setq arg (1- arg)))
+	(progn
+	  (setq arg 0)
+	  (error "No following same-level heading"))))))
+
+(defun outline-get-next-sibling ()
+  "Move to next heading of the same level, and return point or nil if none."
+  (let ((level (funcall outline-level)))
+    (outline-next-visible-heading 1)
+    (while (and (not (eobp)) (> (funcall outline-level) level))
+      (outline-next-visible-heading 1))
+    (if (or (eobp) (< (funcall outline-level) level))
+	nil
+      (point))))
+
+(defun outline-backward-same-level (arg)
+  "Move backward to the ARG'th subheading at same level as this one.
+Stop at the first and last subheadings of a superior heading."
+  (interactive "p")
+  (outline-back-to-heading)
+  (while (> arg 0)
+    (let ((point-to-move-to (save-excursion
+			      (outline-get-last-sibling))))
+      (if point-to-move-to
+	  (progn
+	    (goto-char point-to-move-to)
+	    (setq arg (1- arg)))
+	(progn
+	  (setq arg 0)
+	  (error "No previous same-level heading"))))))
+
+(defun outline-get-last-sibling ()
+  "Move to previous heading of the same level, and return point or nil if none."
+  (let ((level (funcall outline-level)))
+    (outline-previous-visible-heading 1)
+    (while (and (> (funcall outline-level) level)
+		(not (bobp)))
+      (outline-previous-visible-heading 1))
+    (if (< (funcall outline-level) level)
+	nil
+        (point))))
+
+(defun outline-headers-as-kill (beg end)
+  "Save the visible outline headers in region at the start of the kill ring.
+
+Text shown between the headers isn't copied.  Two newlines are
+inserted between saved headers.  Yanking the result may be a
+convenient way to make a table of contents of the buffer."
+  (interactive "r")
+  (save-excursion
+    (save-restriction
+      (narrow-to-region beg end)
+      (goto-char (point-min))
+      (let ((buffer (current-buffer))
+	    start end)
+	(with-temp-buffer
+	  (with-current-buffer buffer
+	    ;; Boundary condition: starting on heading:
+	    (when (outline-on-heading-p)
+	      (outline-back-to-heading)
+	      (setq start (point)
+		    end (progn (outline-end-of-heading)
+			       (point)))
+	      (insert-buffer-substring buffer start end)
+	      (insert "\n\n")))
+	  (let ((temp-buffer (current-buffer)))
+	    (with-current-buffer buffer
+	      (while (outline-next-heading)
+		(unless (outline-invisible-p)
+		  (setq start (point)
+			end (progn (outline-end-of-heading) (point)))
+		  (with-current-buffer temp-buffer
+		    (insert-buffer-substring buffer start end)
+		    (insert "\n\n"))))))
+	  (kill-new (buffer-string)))))))
+
+(provide 'outline)
+(provide 'noutline)
+
+;; arch-tag: 1724410e-7d4d-4f46-b801-49e18171e874
+;;; outline.el ends here

xemacs/ps-print-invisible.el

@@ -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