Commit 45a0ce09 authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

Remove XEmacs compat code from table.el

* lisp/textmodes/table.el:
(table-disable-menu, null, table-recognize-cell)
(table--make-cell-map, table--update-cell)
(table--update-cell-widened, table--update-cell-heightened)
(table--read-from-minibuffer, table--untabify)
(table--update-cell-face, table--warn-incompatibility)
(table--fill-region, table--set-timer): Remove XEmacs compat code.
parent 954b58f0
...@@ -1202,35 +1202,13 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu ...@@ -1202,35 +1202,13 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu
:help "Move point backward by cell(s)"]) :help "Move point backward by cell(s)"])
)) ))
;; XEmacs causes an error when encountering unknown keywords in the
;; menu definition. Specifically the :help keyword is new in Emacs 21
;; and causes error for the XEmacs function `check-menu-syntax'. IMHO
;; it is unwise to generate an error for unknown keywords because it
;; kills the nice backward compatible extensibility of keyword use.
;; Unknown keywords should be quietly ignore so that future extension
;; does not cause a problem in the old implementation. Sigh...
(when (featurep 'xemacs)
(defun table--tweak-menu-for-xemacs (menu)
(cond
((listp menu)
(mapcar #'table--tweak-menu-for-xemacs menu))
((vectorp menu)
(let ((len (length menu)))
(dotimes (i len)
;; replace :help with something harmless.
(if (eq (aref menu i) :help) (aset menu i :included)))))))
(mapcar #'table--tweak-menu-for-xemacs
(list table-global-menu table-cell-menu))
(defvar mark-active t))
;; register table menu under global tools menu ;; register table menu under global tools menu
(unless table-disable-menu (unless table-disable-menu
(easy-menu-define table-global-menu-map nil "Table global menu" table-global-menu) (easy-menu-define table-global-menu-map nil
(if (featurep 'xemacs) "Table global menu" table-global-menu)
(progn (easy-menu-add-item (current-global-map) '("menu-bar" "tools") "--")
(easy-menu-add-item nil '("Tools") table-global-menu-map)) (easy-menu-add-item (current-global-map)
(easy-menu-add-item (current-global-map) '("menu-bar" "tools") "--") '("menu-bar" "tools") table-global-menu-map))
(easy-menu-add-item (current-global-map) '("menu-bar" "tools") table-global-menu-map)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
...@@ -1310,8 +1288,8 @@ the last cache point coordinate." ...@@ -1310,8 +1288,8 @@ the last cache point coordinate."
;; set up the update timer unless it is explicitly inhibited. ;; set up the update timer unless it is explicitly inhibited.
(unless table-inhibit-update (unless table-inhibit-update
(table--update-cell))))) (table--update-cell)))))
(if (or (featurep 'xemacs) (if (null (fboundp 'font-lock-add-keywords))
(null (fboundp 'font-lock-add-keywords))) nil nil
;; Color it as a keyword. ;; Color it as a keyword.
(font-lock-add-keywords (font-lock-add-keywords
'emacs-lisp-mode 'emacs-lisp-mode
...@@ -2046,8 +2024,6 @@ plain text and loses all the table specific features." ...@@ -2046,8 +2024,6 @@ plain text and loses all the table specific features."
(erase-buffer) (erase-buffer)
(table--insert-rectangle rectangle))))) (table--insert-rectangle rectangle)))))
(restore-buffer-modified-p modified-flag)) (restore-buffer-modified-p modified-flag))
(if (featurep 'xemacs)
(table--warn-incompatibility))
cell))) cell)))
;;;###autoload ;;;###autoload
...@@ -3878,9 +3854,7 @@ converts a table into plain text without frames. It is a companion to ...@@ -3878,9 +3854,7 @@ converts a table into plain text without frames. It is a companion to
;; Add menu for table cells. ;; Add menu for table cells.
(unless table-disable-menu (unless table-disable-menu
(easy-menu-define table-cell-menu-map table-cell-map (easy-menu-define table-cell-menu-map table-cell-map
"Table cell menu" table-cell-menu) "Table cell menu" table-cell-menu))
(if (featurep 'xemacs)
(easy-menu-add table-cell-menu)))
(run-hooks 'table-cell-map-hook)) (run-hooks 'table-cell-map-hook))
;; Create the keymap after running the user init file so that the user ;; Create the keymap after running the user init file so that the user
...@@ -4093,7 +4067,7 @@ When the optional parameter NOW is nil it only sets up the update ...@@ -4093,7 +4067,7 @@ When the optional parameter NOW is nil it only sets up the update
timer. If it is non-nil the function copies the contents of the cell timer. If it is non-nil the function copies the contents of the cell
cache buffer into the designated cell in the table buffer." cache buffer into the designated cell in the table buffer."
(if (null table-update-timer) nil (if (null table-update-timer) nil
(table--cancel-timer table-update-timer) (cancel-timer table-update-timer)
(setq table-update-timer nil)) (setq table-update-timer nil))
(if (or (not now) (if (or (not now)
(and (boundp 'quail-converting) (and (boundp 'quail-converting)
...@@ -4136,7 +4110,7 @@ cache buffer into the designated cell in the table buffer." ...@@ -4136,7 +4110,7 @@ cache buffer into the designated cell in the table buffer."
(defun table--update-cell-widened (&optional now) (defun table--update-cell-widened (&optional now)
"Update the contents of the cells that are affected by widening operation." "Update the contents of the cells that are affected by widening operation."
(if (null table-widen-timer) nil (if (null table-widen-timer) nil
(table--cancel-timer table-widen-timer) (cancel-timer table-widen-timer)
(setq table-widen-timer nil)) (setq table-widen-timer nil))
(if (not now) (if (not now)
(setq table-widen-timer (setq table-widen-timer
...@@ -4175,7 +4149,7 @@ cache buffer into the designated cell in the table buffer." ...@@ -4175,7 +4149,7 @@ cache buffer into the designated cell in the table buffer."
(defun table--update-cell-heightened (&optional now) (defun table--update-cell-heightened (&optional now)
"Update the contents of the cells that are affected by heightening operation." "Update the contents of the cells that are affected by heightening operation."
(if (null table-heighten-timer) nil (if (null table-heighten-timer) nil
(table--cancel-timer table-heighten-timer) (cancel-timer table-heighten-timer)
(setq table-heighten-timer nil)) (setq table-heighten-timer nil))
(if (not now) (if (not now)
(setq table-heighten-timer (setq table-heighten-timer
...@@ -4270,10 +4244,6 @@ cdr is the history symbol." ...@@ -4270,10 +4244,6 @@ cdr is the history symbol."
(read-from-minibuffer (read-from-minibuffer
(format "%s (default %s): " (car prompt-history) default) (format "%s (default %s): " (car prompt-history) default)
"" nil nil (cdr prompt-history) default)) "" nil nil (cdr prompt-history) default))
(and (featurep 'xemacs)
(equal (car (symbol-value (cdr prompt-history))) "")
(set (cdr prompt-history)
(cdr (symbol-value (cdr prompt-history)))))
(car (symbol-value (cdr prompt-history)))) (car (symbol-value (cdr prompt-history))))
(defun table--buffer-substring-and-trim (beg end) (defun table--buffer-substring-and-trim (beg end)
...@@ -4584,10 +4554,7 @@ of line." ...@@ -4584,10 +4554,7 @@ of line."
(defun table--untabify (beg end) (defun table--untabify (beg end)
"Wrapper to raw untabify." "Wrapper to raw untabify."
(untabify beg end) (untabify beg end))
(if (featurep 'xemacs)
;; Cancel strange behavior of xemacs
(message "")))
(defun table--multiply-string (string multiplier) (defun table--multiply-string (string multiplier)
"Multiply string and return it." "Multiply string and return it."
...@@ -5208,9 +5175,7 @@ instead of the current buffer and returns the OBJECT." ...@@ -5208,9 +5175,7 @@ instead of the current buffer and returns the OBJECT."
(defun table--update-cell-face () (defun table--update-cell-face ()
"Update cell face according to the current mode." "Update cell face according to the current mode."
(if (featurep 'xemacs) (set-face-inverse-video 'table-cell table-fixed-width-mode))
(set-face-property 'table-cell 'underline table-fixed-width-mode)
(set-face-inverse-video 'table-cell table-fixed-width-mode)))
(table--update-cell-face) (table--update-cell-face)
...@@ -5263,27 +5228,12 @@ This feature is disabled when `table-disable-incompatibility-warning' ...@@ -5263,27 +5228,12 @@ This feature is disabled when `table-disable-incompatibility-warning'
is non-nil. The warning is done only once per session for each item." is non-nil. The warning is done only once per session for each item."
(unless (and table-disable-incompatibility-warning (unless (and table-disable-incompatibility-warning
(not (called-interactively-p 'interactive))) (not (called-interactively-p 'interactive)))
(cond ((and (featurep 'xemacs) (when (and (boundp 'flyspell-mode)
(not (get 'table-disable-incompatibility-warning 'xemacs))) flyspell-mode
(put 'table-disable-incompatibility-warning 'xemacs t) (not (get 'table-disable-incompatibility-warning 'flyspell)))
(display-warning 'table (put 'table-disable-incompatibility-warning 'flyspell t)
" (display-warning 'table
*** Warning *** "
Table package mostly works fine under XEmacs, however, due to the
peculiar implementation of text property under XEmacs, cell splitting
and any undo operation of table exhibit some known strange problems,
such that a border characters dissolve into adjacent cells. Please be
aware of this.
"
:warning))
((and (boundp 'flyspell-mode)
flyspell-mode
(not (get 'table-disable-incompatibility-warning 'flyspell)))
(put 'table-disable-incompatibility-warning 'flyspell t)
(display-warning 'table
"
*** Warning *** *** Warning ***
Flyspell minor mode is known to be incompatible with this table Flyspell minor mode is known to be incompatible with this table
...@@ -5291,8 +5241,7 @@ package. The flyspell version 1.5d at URL `http://kaolin.unice.fr/~serrano' ...@@ -5291,8 +5241,7 @@ package. The flyspell version 1.5d at URL `http://kaolin.unice.fr/~serrano'
works better than the previous versions however not fully compatible. works better than the previous versions however not fully compatible.
" "
:warning)) :warning))))
)))
(defun table--cell-blank-str (&optional n) (defun table--cell-blank-str (&optional n)
"Return blank table cell string of length N." "Return blank table cell string of length N."
...@@ -5338,7 +5287,6 @@ Current buffer must already be set to the cache buffer." ...@@ -5338,7 +5287,6 @@ Current buffer must already be set to the cache buffer."
(setq justify (or justify table-cell-info-justify)) (setq justify (or justify table-cell-info-justify))
(and justify (and justify
(not (eq justify 'left)) (not (eq justify 'left))
(not (featurep 'xemacs))
(set-marker-insertion-type marker-point t)) (set-marker-insertion-type marker-point t))
(table--remove-eol-spaces (point-min) (point-max)) (table--remove-eol-spaces (point-min) (point-max))
(if table-fixed-width-mode (if table-fixed-width-mode
...@@ -5486,19 +5434,7 @@ It returns COLUMN unless STR contains some wide characters." ...@@ -5486,19 +5434,7 @@ It returns COLUMN unless STR contains some wide characters."
(defun table--set-timer (seconds func args) (defun table--set-timer (seconds func args)
"Generic wrapper for setting up a timer." "Generic wrapper for setting up a timer."
(if (featurep 'xemacs) (run-with-idle-timer seconds nil func args))
;; the picky xemacs refuses to accept zero
(add-timeout (if (zerop seconds) 0.01 seconds) func args nil)
;;(run-at-time seconds nil func args)))
;; somehow run-at-time causes strange problem under Emacs 20.7
;; this problem does not show up under Emacs 21.0.90
(run-with-idle-timer seconds nil func args)))
(defun table--cancel-timer (timer)
"Generic wrapper for canceling a timer."
(if (featurep 'xemacs)
(disable-timeout timer)
(cancel-timer timer)))
(defun table--get-last-command () (defun table--get-last-command ()
"Generic wrapper for getting the real last command." "Generic wrapper for getting the real last command."
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment