commit/xemacs-base: sperber: Add some functions from GNU Emacs.

1 new commit in xemacs-base: https://bitbucket.org/xemacs/xemacs-base/commits/27829d5c84bc/ Changeset: 27829d5c84bc User: sperber Date: 2013-12-12 13:58:08 Summary: Add some functions from GNU Emacs. 2013-12-08 Michael Sperber <mike(a)xemacs.org&gt; * 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. Affected #: 5 files diff -r ca80885735351782c2994ad8eb92df52cec46470 -r 27829d5c84bc2d35bba94e2897930e68ebbd487a ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,14 ＠＠ +2013-12-08 Michael Sperber <mike(a)xemacs.org&gt; + + * 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. + 2013-09-02 Norbert Koch <viteno(a)xemacs.org&gt; * Makefile (VERSION): XEmacs package 2.37 released. diff -r ca80885735351782c2994ad8eb92df52cec46470 -r 27829d5c84bc2d35bba94e2897930e68ebbd487a Makefile --- a/Makefile +++ b/Makefile ＠＠ -35,7 +35,7 ＠＠ chistory.elc comint.elc comint-xemacs.elc compile.elc debug.elc \ easy-mmode.elc ebuff-menu.elc echistory.elc ehelp.elc edmacro.elc \ electric.elc enriched.elc env.elc facemenu.elc ffap.elc field.elc \ - file-util.elc subr-more.elc \ + file-util.elc subr-more.elc simple-more.elc \ helper.elc imenu.elc iso-syntax.elc macros.elc novice.elc outline.elc \ passwd.elc pp.elc regexp-opt.elc regi.elc ring.elc shell.elc \ skeleton.elc sort.elc thing.elc time-stamp.elc timer-funcs.elc \ diff -r ca80885735351782c2994ad8eb92df52cec46470 -r 27829d5c84bc2d35bba94e2897930e68ebbd487a field.el --- a/field.el +++ b/field.el ＠＠ -59,6 +59,8 ＠＠  ;;; Code: +(provide 'field) + (defgroup field nil "Text fields." :group 'editing) diff -r ca80885735351782c2994ad8eb92df52cec46470 -r 27829d5c84bc2d35bba94e2897930e68ebbd487a simple-more.el --- /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 -r ca80885735351782c2994ad8eb92df52cec46470 -r 27829d5c84bc2d35bba94e2897930e68ebbd487a 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 Repository URL: https://bitbucket.org/xemacs/xemacs-base/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches