comparison lisp/simple.el @ 66595:1d442f601f13

(eval-expression-print-format): Use lisp-readable syntax for octal and hexa output, and merge the char into the paren. (kill-new): Use push. (copy-to-buffer): Use with-current-buffer. (completion-setup-function): Move code in loop to remove redundancy. (minibuffer-local-must-match-map): Don't add bindings that duplicate those inherited from minibuffer-local-completion-map.

66594:d39ae3be63d4

      (let ((char-string
             (if (or (if (boundp 'edebug-active) edebug-active)
                     (memq this-command '(eval-last-sexp eval-print-last-sexp)))
                 (prin1-char value))))
        (if char-string
            (format " (0%o, 0x%x) = %s" value value char-string)
          (format " (0%o, 0x%x)" value value)))))

;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-current-buffer.
(defun eval-expression (eval-expression-arg
			&optional eval-expression-insert-value)

		(list string "yank-handler specified for empty string"))))
  (if (fboundp 'menu-bar-update-yank-menu)
      (menu-bar-update-yank-menu string (and replace (car kill-ring))))
  (if (and replace kill-ring)
      (setcar kill-ring string)
    (setq kill-ring (cons string kill-ring))
    (if (> (length kill-ring) kill-ring-max)
	(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
  (setq kill-ring-yank-pointer kill-ring)
  (if interprogram-cut-function
      (funcall interprogram-cut-function string (not replace))))

When calling from a program, give three arguments:
BUFFER (or buffer name), START and END.
START and END specify the portion of the current buffer to be copied."
  (interactive "BCopy to buffer: \nr")
  (let ((oldbuf (current-buffer)))
    (save-excursion
      (set-buffer (get-buffer-create buffer))
      (barf-if-buffer-read-only)
      (erase-buffer)
      (save-excursion
	(insert-buffer-substring oldbuf start end)))))


is the substring.)")

;; This function goes in completion-setup-hook, so that it is called
;; after the text of the completion list buffer is written.
(defun completion-setup-function ()
  (let ((mainbuf (current-buffer))
	(mbuf-contents (minibuffer-contents)))
    ;; When reading a file name in the minibuffer,
    ;; set default-directory in the minibuffer
    ;; so it will get copied into the completion list buffer.
    (if minibuffer-completing-file-name
	(with-current-buffer mainbuf

    ;; If partial-completion-mode is on, point might not be after the
    ;; last character in the minibuffer.
    ;; FIXME: This still doesn't work if the text to be completed
    ;; starts with a `-'.
    (when (and partial-completion-mode (not (eobp)))
      (setq mbuf-contents
	    (substring mbuf-contents 0 (- (point) (point-max)))))
    (with-current-buffer standard-output
      (completion-list-mode)
      (make-local-variable 'completion-reference-buffer)
      (setq completion-reference-buffer mainbuf)
      (if minibuffer-completing-file-name
	  ;; For file name completion,
	  ;; use the number of chars before the start of the
	  ;; last file name component.
	  (setq completion-base-size

		(setq completion-base-size
		      (funcall (get minibuffer-completion-table 'completion-base-size-function)))
	      (setq completion-base-size 0))))
      ;; Put faces on first uncommon characters and common parts.
      (when (or completion-common-substring completion-base-size)
	(let* ((common-string-length
		(if completion-common-substring
		    (length completion-common-substring)
		  (- (length mbuf-contents) completion-base-size)))
	       (element-start (next-single-property-change
			       (point-min)
			       'mouse-face))
	       (element-common-end
		(and element-start
		     (+ (or element-start nil) common-string-length)))
	       (maxp (point-max)))
	  (while (and element-start (< element-common-end maxp))
	    (when (and (get-char-property element-start 'mouse-face)
		       (get-char-property element-common-end 'mouse-face))
	      (put-text-property element-start element-common-end
				 'font-lock-face 'completions-common-part)
	      (put-text-property element-common-end (1+ element-common-end)
				 'font-lock-face 'completions-first-difference))
	    (setq element-start (next-single-property-change
				 element-start
				 'mouse-face))
	    (if element-start
		(setq element-common-end  (+ element-start common-string-length))))))
      ;; Insert help string.
      (goto-char (point-min))
      (if (display-mouse-p)
	  (insert (substitute-command-keys
		   "Click \\[mouse-choose-completion] on a completion to select it.\n")))

	       "In this buffer, type \\[choose-completion] to \
select the completion near point.\n\n")))))

(add-hook 'completion-setup-hook 'completion-setup-function)

(define-key minibuffer-local-completion-map [prior]
  'switch-to-completions)
(define-key minibuffer-local-must-match-map [prior]
  'switch-to-completions)
(define-key minibuffer-local-completion-map "\M-v"
  'switch-to-completions)
(define-key minibuffer-local-must-match-map "\M-v"
  'switch-to-completions)

(defun switch-to-completions ()
  "Select the completion list window."
  (interactive)
  ;; Make sure we have a completions window.

66595:1d442f601f13

      (let ((char-string
             (if (or (if (boundp 'edebug-active) edebug-active)
                     (memq this-command '(eval-last-sexp eval-print-last-sexp)))
                 (prin1-char value))))
        (if char-string
            (format " (#o%o, #x%x, %s)" value value char-string)
          (format " (#o%o, #x%x)" value value)))))

;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-current-buffer.
(defun eval-expression (eval-expression-arg
			&optional eval-expression-insert-value)

		(list string "yank-handler specified for empty string"))))
  (if (fboundp 'menu-bar-update-yank-menu)
      (menu-bar-update-yank-menu string (and replace (car kill-ring))))
  (if (and replace kill-ring)
      (setcar kill-ring string)
    (push string kill-ring)
    (if (> (length kill-ring) kill-ring-max)
	(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
  (setq kill-ring-yank-pointer kill-ring)
  (if interprogram-cut-function
      (funcall interprogram-cut-function string (not replace))))

When calling from a program, give three arguments:
BUFFER (or buffer name), START and END.
START and END specify the portion of the current buffer to be copied."
  (interactive "BCopy to buffer: \nr")
  (let ((oldbuf (current-buffer)))
    (with-current-buffer (get-buffer-create buffer)
      (barf-if-buffer-read-only)
      (erase-buffer)
      (save-excursion
	(insert-buffer-substring oldbuf start end)))))


is the substring.)")

;; This function goes in completion-setup-hook, so that it is called
;; after the text of the completion list buffer is written.
(defun completion-setup-function ()
  (let* ((mainbuf (current-buffer))
         (mbuf-contents (minibuffer-contents))
         (common-string-length (length mbuf-contents)))
    ;; When reading a file name in the minibuffer,
    ;; set default-directory in the minibuffer
    ;; so it will get copied into the completion list buffer.
    (if minibuffer-completing-file-name
	(with-current-buffer mainbuf

    ;; If partial-completion-mode is on, point might not be after the
    ;; last character in the minibuffer.
    ;; FIXME: This still doesn't work if the text to be completed
    ;; starts with a `-'.
    (when (and partial-completion-mode (not (eobp)))
      (setq common-string-length
            (- common-string-length (- (point) (point-max)))))
    (with-current-buffer standard-output
      (completion-list-mode)
      (set (make-local-variable 'completion-reference-buffer) mainbuf)
      (if minibuffer-completing-file-name
	  ;; For file name completion,
	  ;; use the number of chars before the start of the
	  ;; last file name component.
	  (setq completion-base-size

		(setq completion-base-size
		      (funcall (get minibuffer-completion-table 'completion-base-size-function)))
	      (setq completion-base-size 0))))
      ;; Put faces on first uncommon characters and common parts.
      (when (or completion-common-substring completion-base-size)
        (setq common-string-length
		(if completion-common-substring
		    (length completion-common-substring)
                  (- common-string-length completion-base-size)))
	(let ((element-start (point-min))
              (maxp (point-max))
              element-common-end)
	  (while (and (setq element-start
                            (next-single-property-change
                             element-start 'mouse-face))
                      (< (setq element-common-end
                               (+ element-start common-string-length))
                         maxp))
	    (when (and (get-char-property element-start 'mouse-face)
		       (get-char-property element-common-end 'mouse-face))
	      (put-text-property element-start element-common-end
				 'font-lock-face 'completions-common-part)
	      (put-text-property element-common-end (1+ element-common-end)
				 'font-lock-face 'completions-first-difference)))))
      ;; Insert help string.
      (goto-char (point-min))
      (if (display-mouse-p)
	  (insert (substitute-command-keys
		   "Click \\[mouse-choose-completion] on a completion to select it.\n")))

	       "In this buffer, type \\[choose-completion] to \
select the completion near point.\n\n")))))

(add-hook 'completion-setup-hook 'completion-setup-function)

(define-key minibuffer-local-completion-map [prior] 'switch-to-completions)
(define-key minibuffer-local-completion-map "\M-v"  'switch-to-completions)

(defun switch-to-completions ()
  "Select the completion list window."
  (interactive)
  ;; Make sure we have a completions window.