Browse Source

Work around XEmacs indentation problems.

There is an old XEmacs bug with indentation in the presence of
an extent with an invisibility property.  We work around this now
by turning the invisibility property off, temporarily.
Carsten Dominik 17 years ago
parent
commit
1f6c502765
9 changed files with 97 additions and 33 deletions
  1. 9 0
      ChangeLog
  2. 3 3
      lisp/org-agenda.el
  3. 3 1
      lisp/org-clock.el
  4. 2 2
      lisp/org-colview-xemacs.el
  5. 2 2
      lisp/org-colview.el
  6. 53 0
      lisp/org-compat.el
  7. 1 1
      lisp/org-macs.el
  8. 7 7
      lisp/org-table.el
  9. 17 17
      lisp/org.el

+ 9 - 0
ChangeLog

@@ -1,5 +1,14 @@
 2008-04-24  Carsten Dominik  <dominik@science.uva.nl>
 2008-04-24  Carsten Dominik  <dominik@science.uva.nl>
 
 
+	* lisp/org.el (org-indent-item, org-add-planning-info)
+	(org-insert-property-drawer): Use compatibility function
+	`org-indent-to-column'.
+	(org-indent-line-function): Use compatibility function
+	`org-indent-line-to'.
+
+	* lisp/org-compat.el (org-indent-to-column, org-indent-line-to):
+	New compatibility functions to work around an XEmacs bug.
+
 	* lisp/org-colview.el (org-columns, org-agenda-columns): Remember
 	* lisp/org-colview.el (org-columns, org-agenda-columns): Remember
 	is `flyspell-mode' was active when entering column display, and
 	is `flyspell-mode' was active when entering column display, and
 	turn it off if it is on.
 	turn it off if it is on.

+ 3 - 3
lisp/org-agenda.el

@@ -4601,7 +4601,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
       (beginning-of-line 1)
       (beginning-of-line 1)
       (save-excursion
       (save-excursion
 	(org-agenda-change-all-lines newhead hdmarker 'fixface))
 	(org-agenda-change-all-lines newhead hdmarker 'fixface))
-      (move-to-column col))))
+      (org-move-to-column col))))
 
 
 (defun org-agenda-add-note (&optional arg)
 (defun org-agenda-add-note (&optional arg)
   "Add a time-stamped note to the entry at point."
   "Add a time-stamped note to the entry at point."
@@ -4646,7 +4646,7 @@ the new TODO state."
 		pl (get-text-property (point) 'prefix-length)
 		pl (get-text-property (point) 'prefix-length)
 		undone-face (get-text-property (point) 'undone-face)
 		undone-face (get-text-property (point) 'undone-face)
 		done-face (get-text-property (point) 'done-face))
 		done-face (get-text-property (point) 'done-face))
-	  (move-to-column pl)
+	  (org-move-to-column pl)
 	  (cond
 	  (cond
 	   ((equal new "")
 	   ((equal new "")
 	    (beginning-of-line 1)
 	    (beginning-of-line 1)
@@ -4813,7 +4813,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
       (goto-char (point-max))
       (goto-char (point-max))
       (while (not (bobp))
       (while (not (bobp))
 	(when (equal marker (get-text-property (point) 'org-marker))
 	(when (equal marker (get-text-property (point) 'org-marker))
-	  (move-to-column (- (window-width) (length stamp)) t)
+	  (org-move-to-column (- (window-width) (length stamp)) t)
           (if (featurep 'xemacs)
           (if (featurep 'xemacs)
 	      ;; Use `duplicable' property to trigger undo recording
 	      ;; Use `duplicable' property to trigger undo recording
               (let ((ex (make-extent nil nil))
               (let ((ex (make-extent nil nil))

+ 3 - 1
lisp/org-clock.el

@@ -362,7 +362,7 @@ will be easy to remove."
 	 (l (if level (org-get-valid-level level 0) 0))
 	 (l (if level (org-get-valid-level level 0) 0))
 	 (off 0)
 	 (off 0)
 	 ov tx)
 	 ov tx)
-    (move-to-column c)
+    (org-move-to-column c)
     (unless (eolp) (skip-chars-backward "^ \t"))
     (unless (eolp) (skip-chars-backward "^ \t"))
     (skip-chars-backward " \t")
     (skip-chars-backward " \t")
     (setq ov (org-make-overlay (1- (point)) (point-at-eol))
     (setq ov (org-make-overlay (1- (point)) (point-at-eol))
@@ -609,6 +609,8 @@ the currently selected interval size."
 	   cc beg end pos tbl tbl1 range-text rm-file-column scope-is-list)
 	   cc beg end pos tbl tbl1 range-text rm-file-column scope-is-list)
       (setq org-clock-file-total-minutes nil)
       (setq org-clock-file-total-minutes nil)
       (when step
       (when step
+	(unless (or block (and ts te))
+	  (error "Clocktable `:step' can only be used with `:block' or `:tstart,:end'"))
 	(org-clocktable-steps params)
 	(org-clocktable-steps params)
 	(throw 'exit nil))
 	(throw 'exit nil))
       (when block
       (when block

+ 2 - 2
lisp/org-colview-xemacs.el

@@ -595,7 +595,7 @@ Where possible, use the standard interface for changing this line."
 		(mapc 'org-delete-overlay line-overlays)
 		(mapc 'org-delete-overlay line-overlays)
 		(org-columns-eval eval))
 		(org-columns-eval eval))
 	    (org-columns-display-here)))
 	    (org-columns-display-here)))
-	(move-to-column col)
+	(org-move-to-column col)
 	(if (and (org-mode-p)
 	(if (and (org-mode-p)
 		 (nth 3 (assoc key org-columns-current-fmt-compiled)))
 		 (nth 3 (assoc key org-columns-current-fmt-compiled)))
 	    (org-columns-update key)))))))
 	    (org-columns-update key)))))))
@@ -710,7 +710,7 @@ Where possible, use the standard interface for changing this line."
 	      (mapc 'org-delete-overlay line-overlays)
 	      (mapc 'org-delete-overlay line-overlays)
 	      (org-columns-eval '(org-entry-put pom key nval)))
 	      (org-columns-eval '(org-entry-put pom key nval)))
 	  (org-columns-display-here)))
 	  (org-columns-display-here)))
-      (move-to-column col)
+      (org-move-to-column col)
       (and (nth 3 (assoc key org-columns-current-fmt-compiled))
       (and (nth 3 (assoc key org-columns-current-fmt-compiled))
 	   (org-columns-update key))))))
 	   (org-columns-update key))))))
 
 

+ 2 - 2
lisp/org-colview.el

@@ -402,7 +402,7 @@ Where possible, use the standard interface for changing this line."
 		(mapc 'org-delete-overlay line-overlays)
 		(mapc 'org-delete-overlay line-overlays)
 		(org-columns-eval eval))
 		(org-columns-eval eval))
 	    (org-columns-display-here)))
 	    (org-columns-display-here)))
-	(move-to-column col)
+	(org-move-to-column col)
 	(if (and (org-mode-p)
 	(if (and (org-mode-p)
 		 (nth 3 (assoc key org-columns-current-fmt-compiled)))
 		 (nth 3 (assoc key org-columns-current-fmt-compiled)))
 	    (org-columns-update key)))))))
 	    (org-columns-update key)))))))
@@ -517,7 +517,7 @@ Where possible, use the standard interface for changing this line."
 	      (mapc 'org-delete-overlay line-overlays)
 	      (mapc 'org-delete-overlay line-overlays)
 	      (org-columns-eval '(org-entry-put pom key nval)))
 	      (org-columns-eval '(org-entry-put pom key nval)))
 	  (org-columns-display-here)))
 	  (org-columns-display-here)))
-      (move-to-column col)
+      (org-move-to-column col)
       (and (nth 3 (assoc key org-columns-current-fmt-compiled))
       (and (nth 3 (assoc key org-columns-current-fmt-compiled))
 	   (org-columns-update key))))))
 	   (org-columns-update key))))))
 
 

+ 53 - 0
lisp/org-compat.el

@@ -195,6 +195,59 @@ that can be added."
       (member arg buffer-invisibility-spec)
       (member arg buffer-invisibility-spec)
     nil))
     nil))
 
 
+(defun org-indent-to-column (column &optional minimum buffer)
+  "Work around a bug with extents with invisibility in XEmacs."
+ (if (featurep 'xemacs)
+     (let ((ext-inv (extent-list
+                     nil (point-at-bol) (point-at-eol)
+                     'all-extents-closed-open 'invisible))
+           ext-inv-specs)
+       (dolist (ext ext-inv)
+         (when (extent-property ext 'invisible)
+           (add-to-list 'ext-inv-specs (list ext (extent-property
+						  ext 'invisible)))
+           (set-extent-property ext 'invisible nil)))
+       (indent-to-column column minimum buffer)
+       (dolist (ext-inv-spec ext-inv-specs)
+         (set-extent-property (car ext-inv-spec) 'invisible
+			      (cadr ext-inv-spec))))
+   (indent-to-column column minimum)))
+
+(defun org-indent-line-to (column)
+  "Work around a bug with extents with invisibility in XEmacs."
+ (if (featurep 'xemacs)
+     (let ((ext-inv (extent-list
+                     nil (point-at-bol) (point-at-eol)
+                     'all-extents-closed-open 'invisible))
+           ext-inv-specs)
+       (dolist (ext ext-inv)
+         (when (extent-property ext 'invisible)
+           (add-to-list 'ext-inv-specs (list ext (extent-property
+						  ext 'invisible)))
+           (set-extent-property ext 'invisible nil)))
+       (indent-line-to column)
+       (dolist (ext-inv-spec ext-inv-specs)
+         (set-extent-property (car ext-inv-spec) 'invisible
+			      (cadr ext-inv-spec))))
+   (indent-line-to column)))
+
+(defun org-move-to-column (column &optional force buffer)
+ (if (featurep 'xemacs)
+     (let ((ext-inv (extent-list
+                     nil (point-at-bol) (point-at-eol)
+                     'all-extents-closed-open 'invisible))
+           ext-inv-specs)
+       (dolist (ext ext-inv)
+         (when (extent-property ext 'invisible)
+           (add-to-list 'ext-inv-specs (list ext (extent-property ext
+								  'invisible)))
+           (set-extent-property ext 'invisible nil)))
+       (move-to-column column force buffer)
+       (dolist (ext-inv-spec ext-inv-specs)
+         (set-extent-property (car ext-inv-spec) 'invisible
+			      (cadr ext-inv-spec))))
+   (move-to-column column force)))
+ 
 
 
 (provide 'org-compat)
 (provide 'org-compat)
 
 

+ 1 - 1
lisp/org-macs.el

@@ -61,7 +61,7 @@
      (unwind-protect
      (unwind-protect
 	 (progn ,@body)
 	 (progn ,@body)
        (goto-line _line)
        (goto-line _line)
-       (move-to-column _col))))
+       (org-move-to-column _col))))
 
 
 (defmacro org-without-partial-completion (&rest body)
 (defmacro org-without-partial-completion (&rest body)
   `(let ((pc-mode (and (boundp 'partial-completion-mode)
   `(let ((pc-mode (and (boundp 'partial-completion-mode)

+ 7 - 7
lisp/org-table.el

@@ -867,12 +867,12 @@ in order to easily repeat the interval."
 		   (string-match "^[0-9]+$" txt))
 		   (string-match "^[0-9]+$" txt))
 	      (setq txt (format "%d" (+ (string-to-number txt) 1))))
 	      (setq txt (format "%d" (+ (string-to-number txt) 1))))
 	  (insert txt)
 	  (insert txt)
-	  (move-to-column col)
+	  (org-move-to-column col)
 	  (if (and org-table-copy-increment (org-at-timestamp-p t))
 	  (if (and org-table-copy-increment (org-at-timestamp-p t))
 	      (org-timestamp-up 1)
 	      (org-timestamp-up 1)
 	    (org-table-maybe-recalculate-line))
 	    (org-table-maybe-recalculate-line))
 	  (org-table-align)
 	  (org-table-align)
-	  (move-to-column col))
+	  (org-move-to-column col))
       (error "No non-empty field found"))))
       (error "No non-empty field found"))))
 
 
 (defun org-table-check-inside-data-field ()
 (defun org-table-check-inside-data-field ()
@@ -1036,12 +1036,12 @@ However, when FORCE is non-nil, create new columns if necessary."
       t
       t
     (let ((col (current-column))
     (let ((col (current-column))
 	  (end (org-table-end)))
 	  (end (org-table-end)))
-      (move-to-column col)
+      (org-move-to-column col)
       (while (and (< (point) end)
       (while (and (< (point) end)
 		  (or (not (= (current-column) col))
 		  (or (not (= (current-column) col))
 		      (org-at-table-hline-p)))
 		      (org-at-table-hline-p)))
 	(beginning-of-line 2)
 	(beginning-of-line 2)
-	(move-to-column col))
+	(org-move-to-column col))
       (if (and (org-at-table-p)
       (if (and (org-at-table-p)
 	       (not (org-at-table-hline-p)))
 	       (not (org-at-table-hline-p)))
 	  t
 	  t
@@ -1152,7 +1152,7 @@ However, when FORCE is non-nil, create new columns if necessary."
     (beginning-of-line tonew)
     (beginning-of-line tonew)
     (insert txt)
     (insert txt)
     (beginning-of-line 0)
     (beginning-of-line 0)
-    (move-to-column col)
+    (org-move-to-column col)
     (unless (or hline1p hline2p)
     (unless (or hline1p hline2p)
       (org-table-fix-formulas
       (org-table-fix-formulas
        "@" (list (cons (number-to-string dline1) (number-to-string dline2))
        "@" (list (cons (number-to-string dline1) (number-to-string dline2))
@@ -1194,7 +1194,7 @@ With prefix ABOVE, insert above the current line."
     (beginning-of-line (if above 1 2))
     (beginning-of-line (if above 1 2))
     (insert line "\n")
     (insert line "\n")
     (beginning-of-line (if above 1 -1))
     (beginning-of-line (if above 1 -1))
-    (move-to-column col)
+    (org-move-to-column col)
     (and org-table-overlay-coordinates (org-table-align))))
     (and org-table-overlay-coordinates (org-table-align))))
 
 
 (defun org-table-hline-and-move (&optional same-column)
 (defun org-table-hline-and-move (&optional same-column)
@@ -1232,7 +1232,7 @@ In particular, this does handle wide and invisible characters."
 	(dline (org-table-current-dline)))
 	(dline (org-table-current-dline)))
     (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
     (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
     (if (not (org-at-table-p)) (beginning-of-line 0))
     (if (not (org-at-table-p)) (beginning-of-line 0))
-    (move-to-column col)
+    (org-move-to-column col)
     (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
     (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
 			    dline -1 dline)))
 			    dline -1 dline)))
 
 

+ 17 - 17
lisp/org.el

@@ -5639,7 +5639,7 @@ with something like \"1.\" or \"2)\"."
 	  (goto-char (match-beginning 2))
 	  (goto-char (match-beginning 2))
 	  (insert (format fmt (setq n (1+ n)))))))
 	  (insert (format fmt (setq n (1+ n)))))))
     (goto-line line)
     (goto-line line)
-    (move-to-column col)))
+    (org-move-to-column col)))
 
 
 (defun org-fix-bullet-type ()
 (defun org-fix-bullet-type ()
   "Make sure all items in this list have the same bullet as the firsst item."
   "Make sure all items in this list have the same bullet as the firsst item."
@@ -5671,7 +5671,7 @@ with something like \"1.\" or \"2)\"."
 	  (looking-at "\\S-+")
 	  (looking-at "\\S-+")
 	  (replace-match bullet))))
 	  (replace-match bullet))))
     (goto-line line)
     (goto-line line)
-    (move-to-column col)
+    (org-move-to-column col)
     (if (string-match "[0-9]" bullet)
     (if (string-match "[0-9]" bullet)
 	(org-renumber-ordered-list 1))))
 	(org-renumber-ordered-list 1))))
 
 
@@ -5761,7 +5761,7 @@ I.e. to the text after the last item."
 	(beginning-of-line 1)
 	(beginning-of-line 1)
 	(skip-chars-forward " \t") (setq ind1 (current-column))
 	(skip-chars-forward " \t") (setq ind1 (current-column))
 	(delete-region (point-at-bol) (point))
 	(delete-region (point-at-bol) (point))
-	(or (eolp) (indent-to-column (+ ind1 delta)))
+	(or (eolp) (org-indent-to-column (+ ind1 delta)))
 	(beginning-of-line 2))))
 	(beginning-of-line 2))))
   (org-fix-bullet-type)
   (org-fix-bullet-type)
   (org-maybe-renumber-ordered-list-safe)
   (org-maybe-renumber-ordered-list-safe)
@@ -8202,7 +8202,7 @@ be removed."
 	    (insert-before-markers "\n")
 	    (insert-before-markers "\n")
 	    (backward-char 1)
 	    (backward-char 1)
 	    (narrow-to-region (point) (point))
 	    (narrow-to-region (point) (point))
-	    (indent-to-column col))
+	    (org-indent-to-column col))
 	  ;; Check if we have to remove something.
 	  ;; Check if we have to remove something.
 	  (setq list (cons what remove))
 	  (setq list (cons what remove))
 	  (while list
 	  (while list
@@ -8962,7 +8962,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state."
 	  (insert " ")
 	  (insert " ")
 	  (delete-region (point) (1+ (match-end 0)))
 	  (delete-region (point) (1+ (match-end 0)))
 	  (backward-char 1)
 	  (backward-char 1)
-	  (move-to-column
+	  (org-move-to-column
 	   (max (1+ (current-column))
 	   (max (1+ (current-column))
 		(1+ col)
 		(1+ col)
 		(if (> to-col 0)
 		(if (> to-col 0)
@@ -8970,7 +8970,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state."
 		  (- (abs to-col) (length tags))))
 		  (- (abs to-col) (length tags))))
 	   t)
 	   t)
 	  (insert tags)
 	  (insert tags)
-	  (move-to-column (min (current-column) col) t))
+	  (org-move-to-column (min (current-column) col) t))
       (goto-char pos))))
       (goto-char pos))))
 
 
 (defun org-set-tags (&optional arg just-align)
 (defun org-set-tags (&optional arg just-align)
@@ -9041,7 +9041,7 @@ With prefix ARG, realign all tags in headings in the current buffer."
 	(and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point)))
 	(and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point)))
 	tags)
 	tags)
        (t (error "Tags alignment failed")))
        (t (error "Tags alignment failed")))
-      (move-to-column col)
+      (org-move-to-column col)
       (unless just-align
       (unless just-align
 	(run-hooks 'org-after-tags-change-hook)))))
 	(run-hooks 'org-after-tags-change-hook)))))
 
 
@@ -9124,7 +9124,7 @@ This works in the agenda, and also in an org-mode buffer."
 	(replace-match ""))
 	(replace-match ""))
     (when flag
     (when flag
       (end-of-line 1)
       (end-of-line 1)
-      (move-to-column (- (window-width) 19) t)
+      (org-move-to-column (- (window-width) 19) t)
       (insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
       (insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
 
 
 (defun org-set-current-tags-overlay (current prefix)
 (defun org-set-current-tags-overlay (current prefix)
@@ -9729,9 +9729,9 @@ formats in the current buffer."
     (if (eq (char-before) ?*) (forward-char 1))
     (if (eq (char-before) ?*) (forward-char 1))
     (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
     (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
     (beginning-of-line 0)
     (beginning-of-line 0)
-    (indent-to-column indent)
+    (org-indent-to-column indent)
     (beginning-of-line 2)
     (beginning-of-line 2)
-    (indent-to-column indent)
+    (org-indent-to-column indent)
     (beginning-of-line 0)
     (beginning-of-line 0)
     (if hiddenp
     (if hiddenp
 	(save-excursion
 	(save-excursion
@@ -13008,7 +13008,7 @@ ones and overrule settings in the other lists."
     (setq pos (move-marker (make-marker) (point)))
     (setq pos (move-marker (make-marker) (point)))
     (insert (delete-and-extract-region beg end))
     (insert (delete-and-extract-region beg end))
     (goto-char pos)
     (goto-char pos)
-    (move-to-column col)))
+    (org-move-to-column col)))
 
 
 (defun org-move-line-up (arg)
 (defun org-move-line-up (arg)
   "Move the current line up.  With prefix argument, move it past ARG lines."
   "Move the current line up.  With prefix argument, move it past ARG lines."
@@ -13021,7 +13021,7 @@ ones and overrule settings in the other lists."
     (setq pos (move-marker (make-marker) (point)))
     (setq pos (move-marker (make-marker) (point)))
     (insert (delete-and-extract-region beg end))
     (insert (delete-and-extract-region beg end))
     (goto-char pos)
     (goto-char pos)
-    (move-to-column col)))
+    (org-move-to-column col)))
 
 
 (defun org-replace-escapes (string table)
 (defun org-replace-escapes (string table)
   "Replace %-escapes in STRING with values in TABLE.
   "Replace %-escapes in STRING with values in TABLE.
@@ -13122,8 +13122,8 @@ not an indirect buffer."
        (t (setq column (org-get-indentation))))))
        (t (setq column (org-get-indentation))))))
     (goto-char pos)
     (goto-char pos)
     (if (<= (current-column) (current-indentation))
     (if (<= (current-column) (current-indentation))
-	(indent-line-to column)
-      (save-excursion (indent-line-to column)))
+	(org-indent-line-to column)
+      (save-excursion (org-indent-line-to column)))
     (setq column (current-column))
     (setq column (current-column))
     (beginning-of-line 1)
     (beginning-of-line 1)
     (if (looking-at
     (if (looking-at
@@ -13131,7 +13131,7 @@ not an indirect buffer."
 	(replace-match (concat "\\1" (format org-property-format
 	(replace-match (concat "\\1" (format org-property-format
 					     (match-string 2) (match-string 3)))
 					     (match-string 2) (match-string 3)))
 		       t nil))
 		       t nil))
-    (move-to-column column)))
+    (org-move-to-column column)))
 
 
 (defun org-set-autofill-regexps ()
 (defun org-set-autofill-regexps ()
   (interactive)
   (interactive)
@@ -13227,12 +13227,12 @@ this line is also exported in fixed-width font."
 	    (beginning-of-line 1)
 	    (beginning-of-line 1)
 	    (cond
 	    (cond
 	     (arg
 	     (arg
-	      (move-to-column cc t)
+	      (org-move-to-column cc t)
 	      (insert ":\n")
 	      (insert ":\n")
 	      (forward-line -1))
 	      (forward-line -1))
 	     ((and off (looking-at re))
 	     ((and off (looking-at re))
 	      (replace-match "" t t nil 1))
 	      (replace-match "" t t nil 1))
-	     ((not off) (move-to-column cc t) (insert ":")))
+	     ((not off) (org-move-to-column cc t) (insert ":")))
 	    (forward-line 1)))
 	    (forward-line 1)))
       (save-excursion
       (save-excursion
 	(org-back-to-heading)
 	(org-back-to-heading)