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

[email protected]
Newsgroups gmane.emacs.xemacs.patches
Message-ID <[email protected]>
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  <[email protected]>

	* 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  <[email protected]>
+
+	* 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  <[email protected]>
 
 	* 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.
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.