Mercurial > hg > xemacs-beta

comparison lisp/simple.el @ 253:157b30c96d03 r20-5b25

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b25
author cvs
date Mon, 13 Aug 2007 10:20:27 +0200
parents f220cc83d72e
children 11cf20601dec
comparison
equal deleted inserted replaced
252:afb15df44434 253:157b30c96d03
396 is 'backward-delete-char, with 'backward-delete-char-untabify being a 396 is 'backward-delete-char, with 'backward-delete-char-untabify being a
397 popular alternate setting." 397 popular alternate setting."
398 :type 'function 398 :type 'function
399 :group 'editing-basics) 399 :group 'editing-basics)
400 400
401 (eval-when-compile
402 (defmacro delete-forward-p ()
403 '(and delete-key-deletes-forward
404 (or (eq 'tty (device-type))
405 (x-keysym-on-keyboard-sans-modifiers-p 'backspace)))))
406
401 (defun backward-or-forward-delete-char (arg) 407 (defun backward-or-forward-delete-char (arg)
402 "Delete either one character backwards or one character forwards. 408 "Delete either one character backwards or one character forwards.
403 Controlled by the state of `delete-key-deletes-forward' and whether the 409 Controlled by the state of `delete-key-deletes-forward' and whether the
404 BackSpace keysym even exists on your keyboard. If you don't have a 410 BackSpace keysym even exists on your keyboard. If you don't have a
405 BackSpace keysym, the delete key should always delete one character 411 BackSpace keysym, the delete key should always delete one character
406 backwards." 412 backwards."
407 (interactive "*p") 413 (interactive "*p")
408 (if (and delete-key-deletes-forward 414 (if (delete-forward-p)
409 (or (eq 'tty (device-type))
410 (x-keysym-on-keyboard-p "BackSpace")))
411 (delete-char arg) 415 (delete-char arg)
412 (funcall backward-delete-function arg))) 416 (funcall backward-delete-function arg)))
413 417
414 (defun backward-or-forward-kill-word (arg) 418 (defun backward-or-forward-kill-word (arg)
415 "Delete either one word backwards or one word forwards. 419 "Delete either one word backwards or one word forwards.
416 Controlled by the state of `delete-key-deletes-forward' and whether the 420 Controlled by the state of `delete-key-deletes-forward' and whether the
417 BackSpace keysym even exists on your keyboard. If you don't have a 421 BackSpace keysym even exists on your keyboard. If you don't have a
418 BackSpace keysym, the delete key should always delete one character 422 BackSpace keysym, the delete key should always delete one character
419 backwards." 423 backwards."
420 (interactive "*p") 424 (interactive "*p")
421 (if (and delete-key-deletes-forward 425 (if (delete-forward-p)
422 (or (eq 'tty (device-type))
423 (x-keysym-on-keyboard-p "BackSpace")))
424 (kill-word arg) 426 (kill-word arg)
425 (backward-kill-word arg))) 427 (backward-kill-word arg)))
426 428
427 (defun backward-or-forward-kill-sentence (arg) 429 (defun backward-or-forward-kill-sentence (arg)
428 "Delete either one sentence backwards or one sentence forwards. 430 "Delete either one sentence backwards or one sentence forwards.
429 Controlled by the state of `delete-key-deletes-forward' and whether the 431 Controlled by the state of `delete-key-deletes-forward' and whether the
430 BackSpace keysym even exists on your keyboard. If you don't have a 432 BackSpace keysym even exists on your keyboard. If you don't have a
431 BackSpace keysym, the delete key should always delete one character 433 BackSpace keysym, the delete key should always delete one character
432 backwards." 434 backwards."
433 (interactive "*P") 435 (interactive "*P")
434 (if (and delete-key-deletes-forward 436 (if (delete-forward-p)
435 (or (eq 'tty (device-type))
436 (x-keysym-on-keyboard-p "BackSpace")))
437 (kill-sentence arg) 437 (kill-sentence arg)
438 (backward-kill-sentence (prefix-numeric-value arg)))) 438 (backward-kill-sentence (prefix-numeric-value arg))))
439 439
440 (defun backward-or-forward-kill-sexp (arg) 440 (defun backward-or-forward-kill-sexp (arg)
441 "Delete either one sexpr backwards or one sexpr forwards. 441 "Delete either one sexpr backwards or one sexpr forwards.
442 Controlled by the state of `delete-key-deletes-forward' and whether the 442 Controlled by the state of `delete-key-deletes-forward' and whether the
443 BackSpace keysym even exists on your keyboard. If you don't have a 443 BackSpace keysym even exists on your keyboard. If you don't have a
444 BackSpace keysym, the delete key should always delete one character 444 BackSpace keysym, the delete key should always delete one character
445 backwards." 445 backwards."
446 (interactive "*p") 446 (interactive "*p")
447 (if (and delete-key-deletes-forward 447 (if (delete-forward-p)
448 (or (eq 'tty (device-type))
449 (x-keysym-on-keyboard-p "BackSpace")))
450 (kill-sexp arg) 448 (kill-sexp arg)
451 (backward-kill-sexp arg))) 449 (backward-kill-sexp arg)))
452 450
453 (defun zap-to-char (arg char) 451 (defun zap-to-char (arg char)
454 "Kill up to and including ARG'th occurrence of CHAR. 452 "Kill up to and including ARG'th occurrence of CHAR.
565 nil means discard it; anything else is stream for print." 563 nil means discard it; anything else is stream for print."
566 (interactive) 564 (interactive)
567 (eval-buffer (current-buffer) printflag)) 565 (eval-buffer (current-buffer) printflag))
568 566
569 ;; XEmacs 567 ;; XEmacs
570 (defun count-words-buffer (b) 568 (defun count-words-buffer (buffer)
571 (interactive "b") 569 "Print the number of words in BUFFER.
572 (save-excursion 570 If called noninteractively, the value is returned rather than printed.
573 (let ((buf (or b (current-buffer)))) 571 BUFFER defaults to the current buffer."
574 (set-buffer buf) 572 (interactive "bBuffer: ")
575 (message "Buffer has %d words" 573 (let ((words (count-words-region (point-min) (point-max) buffer)))
576 (count-words-region (point-min) (point-max)))))) 574 (when (interactive-p)
575 (message "Buffer has %d words" words))
576 words))
577 577
578 ;; XEmacs 578 ;; XEmacs
579 (defun count-words-region (start end) 579 (defun count-words-region (start end &optional buffer)
580 "Print the number of words in region between START and END in BUFFER.
581 If called noninteractively, the value is returned rather than printed.
582 BUFFER defaults to the current buffer."
580 (interactive "r") 583 (interactive "r")
581 (save-excursion 584 (save-excursion
582 (let ((n 0)) 585 (set-buffer (or buffer (current-buffer)))
586 (let ((words 0))
583 (goto-char start) 587 (goto-char start)
584 (while (< (point) end) 588 (while (< (point) end)
585 (if (forward-word 1) 589 (when (forward-word 1)
586 (setq n (1+ n)))) 590 (incf words)))
587 (message "Region has %d words" n) 591 (when (interactive-p)
588 n))) 592 (message "Region has %d words" words))
593 words)))
589 594
590 (defun count-lines-region (start end) 595 (defun count-lines-region (start end)
591 "Print number of lines and characters in the region." 596 "Print number of lines and characters in the region."
592 ;; XEmacs change 597 ;; XEmacs change
593 (interactive "_r") 598 (interactive "_r")
594 (message "Region has %d lines, %d characters" 599 (message "Region has %d lines, %d characters"
595 (count-lines start end) (- end start))) 600 (count-lines start end) (- end start)))
596 601
597 ;; XEmacs 602 ;; XEmacs
598 (defun count-lines-buffer (b) 603 (defun count-lines-buffer (buffer)
599 "Print number of lines and characters in the specified buffer." 604 "Print number of lines and characters in BUFFER."
600 (interactive "_b") 605 (interactive "_bBuffer: ")
601 (save-excursion 606 (save-excursion
602 (let ((buf (or b (current-buffer))) 607 (set-buffer (or buffer (current-buffer)))
603 cnt) 608 (let ((cnt (count-lines (point-min) (point-max))))
604 (set-buffer buf)
605 (setq cnt (count-lines (point-min) (point-max)))
606 (message "Buffer has %d lines, %d characters" 609 (message "Buffer has %d lines, %d characters"
607 cnt (- (point-max) (point-min))) 610 cnt (- (point-max) (point-min)))
608 cnt))) 611 cnt)))
609 612
610 (defun what-line () 613 (defun what-line ()
619 (beginning-of-line) 622 (beginning-of-line)
620 (setq start (point)) 623 (setq start (point))
621 (goto-char opoint) 624 (goto-char opoint)
622 (beginning-of-line) 625 (beginning-of-line)
623 (if (/= start 1) 626 (if (/= start 1)
624 (message "line %d (narrowed line %d)" 627 (message "Line %d (narrowed line %d)"
625 (1+ (count-lines 1 (point))) 628 (1+ (count-lines 1 (point)))
626 (1+ (count-lines start (point)))) 629 (1+ (count-lines start (point))))
627 (message "Line %d" (1+ (count-lines 1 (point))))))))) 630 (message "Line %d" (1+ (count-lines 1 (point)))))))))
628 631
629 632