xemacs-beta: lisp/simple.el comparison

comparison lisp/simple.el @ 272:c5d627a313b1 r21-0b34

Import from CVS: tag r21-0b34

author	cvs
date	Mon, 13 Aug 2007 10:28:48 +0200
parents	966663fcf606
children	90d73dddcdc4

comparison

equal deleted inserted replaced

-:c7b7086b0a39
+:c5d627a313b1
 ;; A grab-bag of basic XEmacs commands not specifically related to some
 ;; major mode or to file-handling.
 ;; Changes for zmacs-style active-regions:
 ;;
 ;; beginning-of-buffer, end-of-buffer, count-lines-region,
 ;; count-lines-buffer, what-line, what-cursor-position, set-goal-column,
 ;; set-fill-column, prefix-arg-internal, and line-move (which is used by
 ;; next-line and previous-line) set zmacs-region-stays to t, so that they
 ;; don't affect the current region-hilighting state.
 ;;
 ;; mark-whole-buffer, mark-word, exchange-point-and-mark, and
 ;; set-mark-command (without an argument) call zmacs-activate-region.
 ;;
 ;; mark takes an optional arg like the new Fmark_marker() does.  When
 ;; the region is not active, mark returns nil unless the optional arg is true.
 ;;
 ;; push-mark, pop-mark, exchange-point-and-mark, and set-marker, and
 ;; set-mark-command use (mark t) so that they can access the mark whether
 ;; the region is active or not.
 ;;
 ;; shell-command, shell-command-on-region, yank, and yank-pop (which all
 ;; push a mark) have been altered to call exchange-point-and-mark with an
 ;; argument, meaning "don't activate the region".  These commands  only use
 ;; exchange-point-and-mark to position the newly-pushed mark correctly, so
 ;; Inserting a newline at the end of a line produces better redisplay in
 ;; try_window_id than inserting at the beginning of a line, and the textual
 ;; result is the same.  So, if we're at beginning of line, pretend to be at
 ;; the end of the previous line.
 ;; #### Does this have any relevance in XEmacs?
 (let ((flag (and (not (bobp))
 		   (bolp)
 		   ;; Make sure the newline before point isn't intangible.
 		   (not (get-char-property (1- (point)) 'intangible))
 		   ;; Make sure the newline before point isn't read-only.
 		   (not (get-char-property (1- (point)) 'read-only))
 		   ;; This should probably also test for the previous char
 		   ;;  being the *last* character too.
 		   (not (get-char-property (1- (point)) 'end-open))
 		   ;; Make sure the newline before point has the same
 		   ;; properties as the char before it (if any).
 		   (< (or (previous-extent-change (point)) -2)
 		      (- (point) 2))))
 	(was-page-start (and (bolp)
 			     (looking-at page-delimiter)))
 	(beforepos (point)))
 (if flag (backward-char 1))
 ;; [... code snipped ...]
 (defcustom kill-hooks nil
 "*Functions run when something is added to the XEmacs kill ring.
 These functions are called with one argument, the string most recently
 cut or copied.  You can use this to, for example, make the most recent
 kill become the X Clipboard selection."
 :type 'hook
 :group 'killing)
 ;;; `kill-hooks' seems not sufficient because
 (defun current-kill (n &optional do-not-move)
 "Rotate the yanking point by N places, and then return that kill.
 If N is zero, `interprogram-paste-function' is set, and calling it
 returns a string, then that string is added to the front of the
 kill ring and returned as the latest kill.
 If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
 yanking point\; just return the Nth kill forward."
 (let ((interprogram-paste (and (= n 0)
 				 interprogram-paste-function
 				 (funcall interprogram-paste-function))))
 (if interprogram-paste
 BUFFER may be a buffer or a buffer name."
 (interactive
 (list
 (progn
 (barf-if-buffer-read-only)
 (read-buffer "Insert buffer: "
 		   ;; XEmacs: we have different args
 		   (other-buffer (current-buffer) nil t)
 		   t))))
 (or (bufferp buffer)
 (setq buffer (get-buffer buffer)))
 This function is called with no args with point at the beginning of
 the comment's starting delimiter.")
 (defconst comment-indent-function
 ;; XEmacs - add at least one space after the end of the text on the
 ;; current line...
 (lambda ()
 (save-excursion
 (beginning-of-line)
 (let ((eol (save-excursion (end-of-line) (point))))
 	(and comment-start-skip
 	     (re-search-forward comment-start-skip eol t)
 	     (setq eol (match-beginning 0)))
 	(goto-char eol)
 	  ;; If that's different from current, change it.
 	  (skip-chars-backward " \t")
 	  (delete-region (point) begpos)
 	  (indent-to indent))
 	;; An existing comment?
 	(if cpos
 	    (progn (goto-char cpos)
 		   (set-marker cpos nil))
 	  ;; No, insert one.
 	  (insert starter)
 	  (save-excursion
 ;	   (fill-prefix fill-prefix))
 ;    (if (or (not (setq justify (current-justification)))
 ;	    (null (setq fc (current-fill-column)))
 ;	    (and (eq justify 'left)
 ;		 (<= (current-column) fc))
 ;	    (save-excursion (beginning-of-line)
 ;			    ;; (setq bol (point))
 ;			    (and auto-fill-inhibit-regexp
 ;				 (looking-at auto-fill-inhibit-regexp))))
 ;	nil ;; Auto-filling not required
 ;      (if (memq justify '(full center right))
 ;		  (save-excursion
 ;		    (goto-char fill-point)
 ;		    (funcall comment-line-break-function t)))
 ;		;; Now do justification, if required
 ;		(if (not (eq justify 'left))
 ;		    (save-excursion
 ;		      (end-of-line 0)
 ;		      (justify-current-line justify nil t)))
 ;		;; If making the new line didn't reduce the hpos of
 ;		;; the end of the line, then give up now;
 ;		;; trying again will not help.
 If you want to continue one comment across several lines, use \\[newline-and-indent].
 If a fill column is specified, it overrides the use of the comment column
 or comment indentation.
 The inserted newline is marked hard if `use-hard-newlines' is true,
 unless optional argument SOFT is non-nil."
 (interactive)
 (let (comcol comstart)
 (skip-chars-backward " \t")
 ;; 97/3/14 jhod: Kinsoku processing
 	  (indent-to-left-margin)
 	  (insert fill-prefix))
 ;; #### - Eric Eide reverts to v18 semantics for this function in
 ;; fa-extras, which I'm not gonna do.  His changes are to (1) execute
 ;; the save-excursion below unconditionally, and (2) uncomment the check
 ;; for (not comment-multi-line) further below.  --Stig
 ;;### jhod: probably need to fix this for kinsoku processing
 (if (not comment-multi-line)
 	  (save-excursion
 	    (if (and comment-start-skip
 		     (let ((opoint (point)))
 (princ "." t))
 ;; XEmacs
 (defun nuke-selective-display ()
 "Ensure that the buffer is not in selective-display mode.
-If `selective-display' is t, then restore the buffer text to it's original
+If `selective-display' is t, then restore the buffer text to its original
 state before disabling selective display."
 ;; by Stig@hackvan.com
 (interactive)
 (and (eq t selective-display)
 (save-excursion
 	 (save-restriction
 If VARIABLE has a `variable-interactive' property, that is used as if
 it were the arg to `interactive' (which see) to interactively read the value."
 (interactive
 (let* ((var (read-variable "Set variable: "))
 	  ;; #### - yucky code replication here.  This should use something
 	  ;; from help.el or hyper-apropos.el
 	  (minibuffer-help-form
 	   '(funcall myhelp))
 	  (myhelp
 	   #'(lambda ()
 	      (with-output-to-temp-buffer "*Help*"
 		 ;; as an interactive spec for prompting.
 		 (call-interactively (list 'lambda '(arg)
 					   (list 'interactive prop)
 					   'arg))
 	       (eval-minibuffer (format "Set %s to value: " var)))))))
-(if (specifierp (symbol-value var))
+(if (and (boundp var) (specifierp (symbol-value var)))
 (set-specifier (symbol-value var) val)
 (set var val)))
 ;; XEmacs
 (defun activate-region ()
 (interactive)
 (and zmacs-regions (zmacs-activate-region)))
 ;; XEmacs
 (defsubst region-exists-p ()
-"Non-nil iff the region exists.
+"Return t if the region exists.
 If active regions are in use (i.e. `zmacs-regions' is true), this means that
 the region is active.  Otherwise, this means that the user has pushed
 a mark in this buffer at some point in the past.
 The functions `region-beginning' and `region-end' can be used to find the
 limits of the region."
 (not (null (mark))))
 ;; XEmacs
 (defun region-active-p ()
-"Non-nil iff the region is active.
+"Return non-nil if the region is active.
 If `zmacs-regions' is true, this is equivalent to `region-exists-p'.
 Otherwise, this function always returns false."
 (and zmacs-regions zmacs-region-extent))
 ;; A bunch of stuff was moved elsewhere:
 (send-string-to-terminal "\n"))
 (defvar message-stack nil
 "An alist of label/string pairs representing active echo-area messages.
 The first element in the list is currently displayed in the echo area.
 Do not modify this directly--use the `message' or
 `display-message'/`clear-message' functions.")
 (defvar remove-message-hook 'log-message
 "A function or list of functions to be called when a message is removed
 from the echo area at the bottom of the frame.  The label of the removed
 ;; "^Deleting article "
 ;; W3
 ;; "^Parsed [0-9]+ of [0-9]+ ([0-9]+%)"
 )
 "List of regular expressions matching messages which shouldn't be logged.
 See `log-message'.
 Ideally, packages which generate messages which might need to be ignored
 should label them with 'progress, 'prompt, or 'no-log, so they can be
 filtered by the log-message-ignore-labels."
 :type '(repeat regexp)
 :group 'log-message)
 (defcustom log-message-ignore-labels
 '(help-echo command progress prompt no-log garbage-collecting auto-saving)
 "List of symbols indicating labels of messages which shouldn't be logged.
 See `display-message' for some common labels.  See also `log-message'."
 :type '(repeat (symbol :tag "Label"))
 :group 'log-message)
 "Show the \" *Message-Log*\" buffer, which contains old messages and errors."
 (interactive)
 (pop-to-buffer (get-buffer-create " *Message-Log*")))
 (defvar log-message-filter-function 'log-message-filter
 "Value must be a function of two arguments: a symbol (label) and
 a string (message).  It should return non-nil to indicate a message
 should be logged.  Possible values include 'log-message-filter and
 'log-message-filter-errors-only.")
 (defun log-message-filter (label message)
 * 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)
-"Returns the current message in the echo area, or nil.
+"Return the current message in the echo area, or nil.
 The FRAME argument is currently unused."
 (cdr (car message-stack)))
 ;;; may eventually be frame-dependent
 (defun current-message-label (&optional frame)

Mercurial > hg > xemacs-beta

comparison lisp/simple.el @ 272:c5d627a313b1 r21-0b34