xemacs-beta: lisp/simple.el comparison

comparison lisp/simple.el @ 223:2c611d1463a6 r20-4b10

Import from CVS: tag r20-4b10

author	cvs
date	Mon, 13 Aug 2007 10:10:54 +0200
parents	262b8bb4a523
children	85a06df23a9a

comparison

equal deleted inserted replaced

-:aae4c8b01452
+:2c611d1463a6
 (if arg
 (progn
 (setq goal-column nil)
 (display-message 'command "No goal column"))
 (setq goal-column (current-column))
-(message (substitute-command-keys
+(lmessage 'command
-	      "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
+	"Goal column %d (use %s with an arg to unset it)"
-	     goal-column))
+goal-column
+(substitute-command-keys "\\[set-goal-column]")))
 nil)
 ;; deleted FSFmacs terminal randomness hscroll-point-visible stuff.
 ;; hscroll-step
 ;; hscroll-point-visible
 	      ;; No place to break => stop trying.
 	      (setq give-up t)))))))
 ;; Put FSF one in until I can one or the other working properly, then the
 ;; other one is history.
-(defun fsf:do-auto-fill ()
+;(defun fsf:do-auto-fill ()
-(let (fc justify
+;  (let (fc justify
-	   ;; bol
+;	   ;; bol
-	   give-up
+;	   give-up
-	   (fill-prefix fill-prefix))
+;	   (fill-prefix fill-prefix))
-(if (or (not (setq justify (current-justification)))
+;    (if (or (not (setq justify (current-justification)))
-	    (null (setq fc (current-fill-column)))
+;	    (null (setq fc (current-fill-column)))
-	    (and (eq justify 'left)
+;	    (and (eq justify 'left)
-		 (<= (current-column) fc))
+;		 (<= (current-column) fc))
-	    (save-excursion (beginning-of-line)
+;	    (save-excursion (beginning-of-line)
-			    ;; (setq bol (point))
+;			    ;; (setq bol (point))
-			    (and auto-fill-inhibit-regexp
+;			    (and auto-fill-inhibit-regexp
-				 (looking-at auto-fill-inhibit-regexp))))
+;				 (looking-at auto-fill-inhibit-regexp))))
-	nil ;; Auto-filling not required
+;	nil ;; Auto-filling not required
-(if (memq justify '(full center right))
+;      (if (memq justify '(full center right))
-	  (save-excursion (unjustify-current-line)))
+;	  (save-excursion (unjustify-current-line)))
-;; Choose a fill-prefix automatically.
+;      ;; Choose a fill-prefix automatically.
-(if (and adaptive-fill-mode
+;      (if (and adaptive-fill-mode
-	       (or (null fill-prefix) (string= fill-prefix "")))
+;	       (or (null fill-prefix) (string= fill-prefix "")))
-	  (let ((prefix
+;	  (let ((prefix
-		 (fill-context-prefix
+;		 (fill-context-prefix
-		  (save-excursion (backward-paragraph 1) (point))
+;		  (save-excursion (backward-paragraph 1) (point))
-		  (save-excursion (forward-paragraph 1) (point))
+;		  (save-excursion (forward-paragraph 1) (point))
-		  ;; Don't accept a non-whitespace fill prefix
+;		  ;; Don't accept a non-whitespace fill prefix
-		  ;; from the first line of a paragraph.
+;		  ;; from the first line of a paragraph.
-		  "^[ \t]*$")))
+;		  "^[ \t]*$")))
-	    (and prefix (not (equal prefix ""))
+;	    (and prefix (not (equal prefix ""))
-		 (setq fill-prefix prefix))))
+;		 (setq fill-prefix prefix))))
-(while (and (not give-up) (> (current-column) fc))
+;      (while (and (not give-up) (> (current-column) fc))
-	;; Determine where to split the line.
+;	;; Determine where to split the line.
-	(let ((fill-point
+;	(let ((fill-point
-	       (let ((opoint (point))
+;	       (let ((opoint (point))
-		     bounce
+;		     bounce
-		     (first t))
+;		     (first t))
-		 (save-excursion
+;		 (save-excursion
-		   (move-to-column (1+ fc))
+;		   (move-to-column (1+ fc))
-		   ;; Move back to a word boundary.
+;		   ;; Move back to a word boundary.
-		   (while (or first
+;		   (while (or first
-			      ;; If this is after period and a single space,
+;			      ;; If this is after period and a single space,
-			      ;; move back once more--we don't want to break
+;			      ;; move back once more--we don't want to break
-			      ;; the line there and make it look like a
+;			      ;; the line there and make it look like a
-			      ;; sentence end.
+;			      ;; sentence end.
-			      (and (not (bobp))
+;			      (and (not (bobp))
-				   (not bounce)
+;				   (not bounce)
-				   sentence-end-double-space
+;				   sentence-end-double-space
-				   (save-excursion (forward-char -1)
+;				   (save-excursion (forward-char -1)
-						   (and (looking-at "\\. ")
+;						   (and (looking-at "\\. ")
-							(not (looking-at "\\.  "))))))
+;							(not (looking-at "\\.  "))))))
-		     (setq first nil)
+;		     (setq first nil)
-		     (skip-chars-backward "^ \t\n")
+;		     (skip-chars-backward "^ \t\n")
-		     ;; If we find nowhere on the line to break it,
+;		     ;; If we find nowhere on the line to break it,
-		     ;; break after one word.  Set bounce to t
+;		     ;; break after one word.  Set bounce to t
-		     ;; so we will not keep going in this while loop.
+;		     ;; so we will not keep going in this while loop.
-		     (if (bolp)
+;		     (if (bolp)
-			 (progn
+;			 (progn
-			   (re-search-forward "[ \t]" opoint t)
+;			   (re-search-forward "[ \t]" opoint t)
-			   (setq bounce t)))
+;			   (setq bounce t)))
-		     (skip-chars-backward " \t"))
+;		     (skip-chars-backward " \t"))
-		   ;; Let fill-point be set to the place where we end up.
+;		   ;; Let fill-point be set to the place where we end up.
-		   (point)))))
+;		   (point)))))
-	  ;; If that place is not the beginning of the line,
+;	  ;; If that place is not the beginning of the line,
-	  ;; break the line there.
+;	  ;; break the line there.
-	  (if (save-excursion
+;	  (if (save-excursion
-		(goto-char fill-point)
+;		(goto-char fill-point)
-		(not (bolp)))
+;		(not (bolp)))
-	      (let ((prev-column (current-column)))
+;	      (let ((prev-column (current-column)))
-		;; If point is at the fill-point, do not `save-excursion'.
+;		;; If point is at the fill-point, do not `save-excursion'.
-		;; Otherwise, if a comment prefix or fill-prefix is inserted,
+;		;; Otherwise, if a comment prefix or fill-prefix is inserted,
-		;; point will end up before it rather than after it.
+;		;; point will end up before it rather than after it.
-		(if (save-excursion
+;		(if (save-excursion
-		      (skip-chars-backward " \t")
+;		      (skip-chars-backward " \t")
-		      (= (point) fill-point))
+;		      (= (point) fill-point))
-		    (funcall comment-line-break-function t)
+;		    (funcall comment-line-break-function t)
-		  (save-excursion
+;		  (save-excursion
-		    (goto-char fill-point)
+;		    (goto-char fill-point)
-		    (funcall comment-line-break-function t)))
+;		    (funcall comment-line-break-function t)))
-		;; Now do justification, if required
+;		;; Now do justification, if required
-		(if (not (eq justify 'left))
+;		(if (not (eq justify 'left))
-		    (save-excursion
+;		    (save-excursion
-		      (end-of-line 0)
+;		      (end-of-line 0)
-		      (justify-current-line justify nil t)))
+;		      (justify-current-line justify nil t)))
-		;; If making the new line didn't reduce the hpos of
+;		;; If making the new line didn't reduce the hpos of
-		;; the end of the line, then give up now;
+;		;; the end of the line, then give up now;
-		;; trying again will not help.
+;		;; trying again will not help.
-		(if (>= (current-column) prev-column)
+;		(if (>= (current-column) prev-column)
-		    (setq give-up t)))
+;		    (setq give-up t)))
-	    ;; No place to break => stop trying.
+;	    ;; No place to break => stop trying.
-	    (setq give-up t))))
+;	    (setq give-up t))))
-;; Justify last line.
+;      ;; Justify last line.
-(justify-current-line justify t t)
+;      (justify-current-line justify t t)
-t)))
+;      t)))
 (defvar normal-auto-fill-function 'do-auto-fill
 "The function to use for `auto-fill-function' if Auto Fill mode is turned on.
 Some major modes set this.")
 (interactive "p")
 (if (region-active-p)
 (downcase-region (region-beginning) (region-end))
 (downcase-word arg)))
-;;;
+;; Most of the zmacs code is now in elisp.  The only thing left in C
-;;; Most of the zmacs code is now in elisp.  The only thing left in C
+;; are the variables zmacs-regions, zmacs-region-active-p and
-;;; are the variables zmacs-regions, zmacs-region-active-p and
+;; zmacs-region-stays plus the function zmacs_update_region which
-;;; zmacs-region-stays plus the function zmacs_update_region which
+;; simply calls the lisp level zmacs-update-region.  It must remain
-;;; calls the lisp level zmacs-update-region.  It must remain since it
+;; for convenience, since it is called by core C code.
-;;; must be called by core C code.
-;;;
-;;; Huh?  Why couldn't "core C code" just use
-;;; call0(Qzmacs_update_region)??? -hniksic
 (defvar zmacs-activate-region-hook nil
 "Function or functions called when the region becomes active;
 see the variable `zmacs-regions'.")
 by default--see the `log-message-ignore-labels' variable):
 message       default label used by the `message' function
 error         default label used for reporting errors
 * progress      progress indicators like \"Converting... 45%\"
 * prompt        prompt-like messages like \"I-search: foo\"
+* command       helper command messages like \"Mark set\"
 * no-log        messages that should never be logged"
 (clear-message label frame stdout-p t)
 (append-message label message frame stdout-p))
 (defun current-message (&optional frame)

Mercurial > hg > xemacs-beta

comparison lisp/simple.el @ 223:2c611d1463a6 r20-4b10