Mercurial > hg > xemacs-beta

comparison lisp/simple.el @ 375:a300bb07d72d r21-2b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b3
author cvs
date Mon, 13 Aug 2007 11:04:51 +0200
parents cc15677e0335
children 8626e4521993
comparison
equal deleted inserted replaced
374:4ebeb1a5388b 375:a300bb07d72d
91 91
92 (defgroup warnings nil 92 (defgroup warnings nil
93 "Warnings customizations." 93 "Warnings customizations."
94 :group 'minibuffer) 94 :group 'minibuffer)
95 95
96
97 (defcustom search-caps-disable-folding t
98 "*If non-nil, upper case chars disable case fold searching.
99 This does not apply to \"yanked\" strings."
100 :type 'boolean
101 :group 'editing-basics)
102
103 ;; This is stolen (and slightly modified) from FSF emacs's
104 ;; `isearch-no-upper-case-p'.
105 (defun no-upper-case-p (string &optional regexp-flag)
106 "Return t if there are no upper case chars in STRING.
107 If REGEXP-FLAG is non-nil, disregard letters preceded by `\\' (but not `\\\\')
108 since they have special meaning in a regexp."
109 (let ((case-fold-search nil))
110 (not (string-match (if regexp-flag
111 "\\(^\\|\\\\\\\\\\|[^\\]\\)[A-Z]"
112 "[A-Z]")
113 string))
114 ))
115
116 (defmacro with-search-caps-disable-folding (string regexp-flag &rest body) "\
117 Eval BODY with `case-fold-search' let to nil if `search-caps-disable-folding'
118 is non-nil, and if STRING (either a string or a regular expression according
119 to REGEXP-FLAG) contains uppercase letters."
120 `(let ((case-fold-search
121 (if (and case-fold-search search-caps-disable-folding)
122 (no-upper-case-p ,string ,regexp-flag)
123 case-fold-search)))
124 ,@body))
125 (put 'with-search-caps-disable-folding 'lisp-indent-function 2)
126 (put 'with-search-caps-disable-folding 'edebug-form-spec
127 '(sexp sexp &rest form))
128
129 (defmacro with-interactive-search-caps-disable-folding (string regexp-flag
130 &rest body)
131 "Same as `with-search-caps-disable-folding', but only in the case of a
132 function called interactively."
133 `(let ((case-fold-search
134 (if (and (interactive-p)
135 case-fold-search search-caps-disable-folding)
136 (no-upper-case-p ,string ,regexp-flag)
137 case-fold-search)))
138 ,@body))
139 (put 'with-interactive-search-caps-disable-folding 'lisp-indent-function 2)
140 (put 'with-interactive-search-caps-disable-folding 'edebug-form-spec
141 '(sexp sexp &rest form))
96 142
97 (defun newline (&optional arg) 143 (defun newline (&optional arg)
98 "Insert a newline, and move to left margin of the new line if it's blank. 144 "Insert a newline, and move to left margin of the new line if it's blank.
99 The newline is marked with the text-property `hard'. 145 The newline is marked with the text-property `hard'.
100 With arg, insert that many newlines. 146 With arg, insert that many newlines.
454 500
455 (defun zap-to-char (arg char) 501 (defun zap-to-char (arg char)
456 "Kill up to and including ARG'th occurrence of CHAR. 502 "Kill up to and including ARG'th occurrence of CHAR.
457 Goes backward if ARG is negative; error if CHAR not found." 503 Goes backward if ARG is negative; error if CHAR not found."
458 (interactive "*p\ncZap to char: ") 504 (interactive "*p\ncZap to char: ")
459 (kill-region (point) (progn 505 (kill-region (point) (with-interactive-search-caps-disable-folding
506 (char-to-string char) nil
460 (search-forward (char-to-string char) nil nil arg) 507 (search-forward (char-to-string char) nil nil arg)
461 ; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
462 (point)))) 508 (point))))
463 509
464 (defun zap-up-to-char (arg char) 510 (defun zap-up-to-char (arg char)
465 "Kill up to ARG'th occurrence of CHAR. 511 "Kill up to ARG'th occurrence of CHAR.
466 Goes backward if ARG is negative; error if CHAR not found." 512 Goes backward if ARG is negative; error if CHAR not found."
467 (interactive "*p\ncZap up to char: ") 513 (interactive "*p\ncZap up to char: ")
468 (kill-region (point) (progn 514 (kill-region (point) (with-interactive-search-caps-disable-folding
469 (search-forward (char-to-string char) nil nil arg) 515 (char-to-string char) nil
470 (goto-char (if (> arg 0) (1- (point)) (1+ (point)))) 516 (search-forward (char-to-string char) nil nil arg)
471 (point)))) 517 (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
518 (point))))
472 519
473 (defun beginning-of-buffer (&optional arg) 520 (defun beginning-of-buffer (&optional arg)
474 "Move point to the beginning of the buffer; leave mark at previous position. 521 "Move point to the beginning of the buffer; leave mark at previous position.
475 With arg N, put point N/10 of the way from the beginning. 522 With arg N, put point N/10 of the way from the beginning.
476 523