"Stephen J. Turnbull" <stephen(a)xemacs.org> writes:
Michael Sperber writes:
> xemacs-base package:
>
> 2013-12-03 Michael Sperber <mike(a)xemacs.org>
>
> * simple-more.el:
> (move-beginning-of-line, move-end-of-line): New file, with some
> FSF functions.
Isn't there a better place in xemacs-base for these (I grant that
they're commonly-enough used that fsf-compat is wrong)? Hm. Maybe not.
:-) I'm open for suggestions.
Anyway, I found a number of problems in the patch and submit a revised
one, with an additional function (invisible-p). Comments welcome - I
intend to push Tuesday. I'll play with the fsf-compat patch a while
longer and resubmit that then.
Have you tested that they work in 21.4?
Good point. I couldn't get 21.4 to work on my Mac. I'd appreciate help
on this one, and I promise to fix 21.4-related issues if anybody reports
them.. (I did an inspection and don't see anything 21.5-specific in the
code.) Is that enough?
Changelog of revised file:
2013-12-08 Michael Sperber <mike(a)xemacs.org>
* subr-more.el (condition-case-unless-debug): Added, from GNU Emacs.
(with-demoted-errors): Added, from GNU Emacs.
* simple-more.el:
(move-beginning-of-line, move-end-of-line, invisible-p): New file,
with some functions from GNU Emacs.
* field.el (field): Add a provide, needed for simple-more.el.
--
Regards,
Mike
diff --git a/field.el b/field.el
--- a/field.el
+++ b/field.el
@@ -59,6 +59,8 @@
;;; Code:
+(provide 'field)
+
(defgroup field nil
"Text fields."
:group 'editing)
diff --git a/simple-more.el b/simple-more.el
new file mode 100644
--- /dev/null
+++ b/simple-more.el
@@ -0,0 +1,133 @@
+;;; subr-more.el --- Complement the basic editing commands for XEmacs
+
+;; Copyright (C) 1985-1987, 1993-2012 Free Software Foundation, Inc.
+
+;; Maintainer: XEmacs Development Team
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+(require 'field)
+
+;;;###autoload
+(defun move-beginning-of-line (arg)
+ "Move point to beginning of current line as displayed.
+\(If there's an image in the line, this disregards newlines
+which are part of the text that the image rests on.)
+
+With argument ARG not nil or 1, move forward ARG - 1 lines first.
+If point reaches the beginning or end of buffer, it stops there.
+To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
+ (interactive "p")
+ (or arg (setq arg 1))
+
+ (let ((orig (point))
+ first-vis first-vis-field-value)
+
+ ;; Move by lines, if ARG is not 1 (the default).
+ (if (/= arg 1)
+ (line-move (1- arg)))
+
+ ;; Move to beginning-of-line, ignoring fields and invisible text.
+ (skip-chars-backward "^\n")
+ (while (and (not (bobp)) (invisible-p (1- (point))))
+ (goto-char (previous-single-char-property-change (point)))
+ (skip-chars-backward "^\n"))
+
+ ;; Now find first visible char in the line
+ (while (and (not (eobp)) (invisible-p (point)))
+ (goto-char (next-single-char-property-change (point))))
+ (setq first-vis (point))
+
+ ;; See if fields would stop us from reaching FIRST-VIS.
+ (setq first-vis-field-value
+ (constrain-to-field first-vis orig (/= arg 1) t nil))
+
+ (goto-char (if (/= first-vis-field-value first-vis)
+ ;; If yes, obey them.
+ first-vis-field-value
+ ;; Otherwise, move to START with attention to fields.
+ ;; (It is possible that fields never matter in this case.)
+ (constrain-to-field (point) orig
+ (/= arg 1) t nil)))))
+
+
+;;;###autoload
+(defun move-end-of-line (arg)
+ "Move point to end of current line as displayed.
+With argument ARG not nil or 1, move forward ARG - 1 lines first.
+If point reaches the beginning or end of buffer, it stops there."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (let (done)
+ (while (not done)
+ (let ((newpos
+ (save-excursion
+ (let ((goal-column 0))
+ (line-move arg)
+ (and
+ ;; With bidi reordering, we may not be at bol,
+ ;; so make sure we are.
+ (skip-chars-backward "^\n")
+ (not (bobp))
+ (progn
+ (while (and (not (bobp)) (invisible-p (1- (point))))
+ (goto-char (previous-single-char-property-change
+ (point) 'invisible)))
+ (backward-char 1)))
+ (point)))))
+ (goto-char newpos)
+ (if (and (> (point) newpos)
+ (eq (preceding-char) ?\n))
+ (backward-char 1)
+ (if (and (> (point) newpos) (not (eobp))
+ (not (eq (following-char) ?\n)))
+ ;; If we skipped something intangible and now we're not
+ ;; really at eol, keep going.
+ (setq arg 1)
+ (setq done t)))))))
+
+(defun invisible-p (pos-or-prop)
+ "Non-nil if the property makes the text invisible.
+POS-OR-PROP can be a marker or number, in which case it is taken to be
+a position in the current buffer and the value of the `invisible' property
+is checked; or it can be some other value, which is then presumed to be the
+value of the `invisible' property of the text of interest.
+The non-nil value returned can be t for truly invisible text or something
+else if the text is replaced by an ellipsis."
+ (cond
+ ((null pos-or-prop) nil)
+ ((or (integerp pos-or-prop)
+ (markerp pos-or-prop))
+ (get-char-property (point) 'invisible))
+ ((eq t buffer-invisibility-spec)
+ t)
+ (t
+ ;; see the C function invisible_p
+ (let ((rest buffer-invisibility-spec)
+ (done nil))
+ (while (and rest (not done))
+ (let ((e (car rest)))
+ (cond
+ ((eq pos-or-prop e)
+ (setq done t))
+ ((and (consp e) (eq pos-or-prop (car e)))
+ (setq done (or (cdr e) t)))))
+ (setq rest (cdr rest)))
+ done))))
+
+;;; simple-more.el ends here
diff --git a/subr-more.el b/subr-more.el
--- a/subr-more.el
+++ b/subr-more.el
@@ -146,4 +146,29 @@
Otherwise, return nil."
(or (null object) (eq object t)))
+;;;###autoload
+(defmacro condition-case-unless-debug (var bodyform &rest handlers)
+ "Like `condition-case' except that it does not catch anything when debugging.
+More specifically if `debug-on-error' is set, then it does not catch any
signal."
+ (declare (debug condition-case) (indent 2))
+ (let ((bodysym (make-symbol "body")))
+ `(let ((,bodysym (lambda () ,bodyform)))
+ (if debug-on-error
+ (funcall ,bodysym)
+ (condition-case ,var
+ (funcall ,bodysym)
+ ,@handlers)))))
+
+;;;###autoload
+(defmacro with-demoted-errors (&rest body)
+ "Run BODY and demote any errors to simple messages.
+If `debug-on-error' is non-nil, run BODY without catching its errors.
+This is to be used around code which is not expected to signal an error
+but which should be robust in the unexpected case that an error is signaled."
+ (declare (debug t) (indent 0))
+ (let ((err (make-symbol "err")))
+ `(condition-case-unless-debug ,err
+ (progn ,@body)
+ (error (message "Error: %S" ,err) nil))))
+
;;; subr-more.el ends here
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches