From 190e88cfc9478e994bfa8b4c82c2a4cc96b6c959 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Fri, 20 Aug 2010 14:19:29 +0200 Subject: [PATCH] Remove the special noutline.el file for XEmacs The latest XEmacs package release does now contain a modern version of outline.el, put there by Michael Sperber. * Makefile: Remove targets related to noutline.el. * README: Remove the entry for the xemacs directory. * README_DIST: Remove the entry for the xemacs directory. * doc/org.texi (Installation): Remove the special installation instructions for XEmacs. * lisp/org.el (outline): Remove special code to load noutline.el for XEmacs. * xemacs/README: File removed. * xemacs/noutline.el: File removed. * xemacs/ps-print-invisible.el: File removed. --- Makefile | 9 - README | 6 - README_DIST | 6 - doc/org.texi | 12 - lisp/org.el | 4 - xemacs/README | 15 - xemacs/noutline.el | 1051 ---------------------------------- xemacs/ps-print-invisible.el | 225 -------- 8 files changed, 1328 deletions(-) delete mode 100644 xemacs/README delete mode 100644 xemacs/noutline.el delete mode 100644 xemacs/ps-print-invisible.el diff --git a/Makefile b/Makefile index e93f12756..3229f4657 100644 --- a/Makefile +++ b/Makefile @@ -166,7 +166,6 @@ SHELL = /bin/sh # Additional distribution files DISTFILES_extra= Makefile request-assign-future.txt contrib -DISTFILES_xemacs= xemacs/noutline.el xemacs/ps-print-invisible.el xemacs/README default: $(ELCFILES) $(ELCBFILES) @@ -205,10 +204,6 @@ install-info: $(INFOFILES) install-info-debian: $(INFOFILES) $(INSTALL_INFO) --infodir=$(infodir) $(INFOFILES) -install-noutline: xemacs/noutline.elc - if [ ! -d $(lispdir) ]; then $(MKDIR) $(lispdir); else true; fi ; - $(CP) xemacs/noutline.el xemacs/noutline.elc $(lispdir) - autoloads: lisp/org-install.el lisp/org-install.el: $(LISPFILES0) Makefile @@ -220,8 +215,6 @@ lisp/org-install.el: $(LISPFILES0) Makefile --eval '(save-buffer)' mv org-install.el lisp -xemacs/noutline.elc: xemacs/noutline.el - doc/org: doc/org.texi (cd doc; $(MAKEINFO) --no-split org.texi -o org) @@ -318,7 +311,6 @@ distfile: ${MAKE} lisp/org-install.el rm -rf org-$(TAG) org-$(TAG).zip $(MKDIR) org-$(TAG) - $(MKDIR) org-$(TAG)/xemacs $(MKDIR) org-$(TAG)/doc $(MKDIR) org-$(TAG)/lisp cp -r $(LISPFILES) org-$(TAG)/lisp @@ -326,7 +318,6 @@ distfile: cp -r $(DISTFILES_extra) org-$(TAG)/ cp -r README_DIST org-$(TAG)/README cp -r ORGWEBPAGE/Changes.org org-$(TAG)/ - cp -r $(DISTFILES_xemacs) org-$(TAG)/xemacs/ zip -r org-$(TAG).zip org-$(TAG) gtar zcvf org-$(TAG).tar.gz org-$(TAG) diff --git a/README b/README index 6e2a0ac68..a9d0003cf 100644 --- a/README +++ b/README @@ -21,12 +21,6 @@ doc/ The documentation files. org.texi is the source of the documentation, org.html and org.pdf are formatted versions of it. -xemacs/ - 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. - contrib/ A directory with third-party additions for Org. Some really cool stuff is in there. diff --git a/README_DIST b/README_DIST index 0e827278b..a687b1a18 100644 --- a/README_DIST +++ b/README_DIST @@ -17,12 +17,6 @@ doc/ The documentation files. org.texi is the source of the documentation, org.html and org.pdf are formatted versions of it. -xemacs/ - 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. - contrib/ A directory with third-party additions for Org. Some really cool stuff is in there. diff --git a/doc/org.texi b/doc/org.texi index fea733fab..2e61ddfc2 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -634,18 +634,6 @@ step for this directory: (setq load-path (cons "~/path/to/orgdir/contrib/lisp" load-path)) @end example -@sp 2 -@cartouche -XEmacs users now need to install the file @file{noutline.el} from -the @file{xemacs} sub-directory of the Org distribution. Use the -command: - -@example - make install-noutline -@end example -@end cartouche -@sp 2 - @noindent Now byte-compile the Lisp files with the shell command: @example diff --git a/lisp/org.el b/lisp/org.el index 3102d629a..e34ec1a67 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -86,10 +86,6 @@ (unless (boundp 'diary-fancy-buffer) (defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))) -;; For XEmacs, noutline is not yet provided by outline.el, so arrange for -;; the file noutline.el being loaded. -(if (featurep 'xemacs) (condition-case nil (require 'noutline))) -;; We require noutline, which might be provided in outline.el (require 'outline) (require 'noutline) ;; Other stuff we need. (require 'time-date) diff --git a/xemacs/README b/xemacs/README deleted file mode 100644 index 00c332c77..000000000 --- a/xemacs/README +++ /dev/null @@ -1,15 +0,0 @@ -This directory contains files that are necessary or at least useful -companions for Org-mode under XEmacs: - -noutline.el - - Greg Chernov's port of the overlay-based implementation of - outline-mode. This is required, and until XEmacs uses this (or - another port), you need to install it with Org-mode. The "Installation" - section in the Manual covers also the installation of this package. - -ps-print-invisible.el - - Greg Chernovs modification to ps-print, to honor invisible text - properties during printing. This file is not required for running - Org-mode, but it is useful when trying to print partial trees. \ No newline at end of file diff --git a/xemacs/noutline.el b/xemacs/noutline.el deleted file mode 100644 index f9ea1daeb..000000000 --- a/xemacs/noutline.el +++ /dev/null @@ -1,1051 +0,0 @@ -;;; 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 'xemacs) -(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-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." - (eq 'outline (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))) - - -(defvar outline-isearch-open-invisible-function nil - "Function called if `isearch' finishes in an invisible overlay. -The function is called with the overlay as its only argument. -If nil, `show-entry' is called to reveal the invisible text.") - -(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-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) - ;; FIXME: I don't think XEmacs uses this, actually. - (set-extent-property ex 'isearch-open-invisible - (or outline-isearch-open-invisible-function - '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 (and (bolp) (not (eolp))) - ;; We stopped at a nonempty line (the next heading). - (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 diff --git a/xemacs/ps-print-invisible.el b/xemacs/ps-print-invisible.el deleted file mode 100644 index 8f005fe86..000000000 --- a/xemacs/ps-print-invisible.el +++ /dev/null @@ -1,225 +0,0 @@ -;;; 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 \ No newline at end of file