/[emacs]/emacs/lisp/simple.el
ViewVC logotype

Diff of /emacs/lisp/simple.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.759 by rms, Sat Oct 29 19:48:22 2005 UTC revision 1.760 by monnier, Tue Nov 1 07:18:10 2005 UTC
# Line 993  display the result of expression evaluat Line 993  display the result of expression evaluat
993                       (memq this-command '(eval-last-sexp eval-print-last-sexp)))                       (memq this-command '(eval-last-sexp eval-print-last-sexp)))
994                   (prin1-char value))))                   (prin1-char value))))
995          (if char-string          (if char-string
996              (format " (0%o, 0x%x) = %s" value value char-string)              (format " (#o%o, #x%x, %s)" value value char-string)
997            (format " (0%o, 0x%x)" value value)))))            (format " (#o%o, #x%x)" value value)))))
998    
999  ;; We define this, rather than making `eval' interactive,  ;; We define this, rather than making `eval' interactive,
1000  ;; for the sake of completion of names like eval-region, eval-current-buffer.  ;; for the sake of completion of names like eval-region, eval-current-buffer.
# Line 2393  argument should still be a \"useful\" st Line 2393  argument should still be a \"useful\" st
2393        (menu-bar-update-yank-menu string (and replace (car kill-ring))))        (menu-bar-update-yank-menu string (and replace (car kill-ring))))
2394    (if (and replace kill-ring)    (if (and replace kill-ring)
2395        (setcar kill-ring string)        (setcar kill-ring string)
2396      (setq kill-ring (cons string kill-ring))      (push string kill-ring)
2397      (if (> (length kill-ring) kill-ring-max)      (if (> (length kill-ring) kill-ring-max)
2398          (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))          (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
2399    (setq kill-ring-yank-pointer kill-ring)    (setq kill-ring-yank-pointer kill-ring)
# Line 3003  BUFFER (or buffer name), START and END. Line 3003  BUFFER (or buffer name), START and END.
3003  START and END specify the portion of the current buffer to be copied."  START and END specify the portion of the current buffer to be copied."
3004    (interactive "BCopy to buffer: \nr")    (interactive "BCopy to buffer: \nr")
3005    (let ((oldbuf (current-buffer)))    (let ((oldbuf (current-buffer)))
3006      (save-excursion      (with-current-buffer (get-buffer-create buffer)
       (set-buffer (get-buffer-create buffer))  
3007        (barf-if-buffer-read-only)        (barf-if-buffer-read-only)
3008        (erase-buffer)        (erase-buffer)
3009        (save-excursion        (save-excursion
# Line 4888  is the substring.)") Line 4887  is the substring.)")
4887  ;; This function goes in completion-setup-hook, so that it is called  ;; This function goes in completion-setup-hook, so that it is called
4888  ;; after the text of the completion list buffer is written.  ;; after the text of the completion list buffer is written.
4889  (defun completion-setup-function ()  (defun completion-setup-function ()
4890    (let ((mainbuf (current-buffer))    (let* ((mainbuf (current-buffer))
4891          (mbuf-contents (minibuffer-contents)))           (mbuf-contents (minibuffer-contents))
4892             (common-string-length (length mbuf-contents)))
4893      ;; When reading a file name in the minibuffer,      ;; When reading a file name in the minibuffer,
4894      ;; set default-directory in the minibuffer      ;; set default-directory in the minibuffer
4895      ;; so it will get copied into the completion list buffer.      ;; so it will get copied into the completion list buffer.
# Line 4901  is the substring.)") Line 4901  is the substring.)")
4901      ;; FIXME: This still doesn't work if the text to be completed      ;; FIXME: This still doesn't work if the text to be completed
4902      ;; starts with a `-'.      ;; starts with a `-'.
4903      (when (and partial-completion-mode (not (eobp)))      (when (and partial-completion-mode (not (eobp)))
4904        (setq mbuf-contents        (setq common-string-length
4905              (substring mbuf-contents 0 (- (point) (point-max)))))              (- common-string-length (- (point) (point-max)))))
4906      (with-current-buffer standard-output      (with-current-buffer standard-output
4907        (completion-list-mode)        (completion-list-mode)
4908        (make-local-variable 'completion-reference-buffer)        (set (make-local-variable 'completion-reference-buffer) mainbuf)
       (setq completion-reference-buffer mainbuf)  
4909        (if minibuffer-completing-file-name        (if minibuffer-completing-file-name
4910            ;; For file name completion,            ;; For file name completion,
4911            ;; use the number of chars before the start of the            ;; use the number of chars before the start of the
# Line 4926  is the substring.)") Line 4925  is the substring.)")
4925                (setq completion-base-size 0))))                (setq completion-base-size 0))))
4926        ;; Put faces on first uncommon characters and common parts.        ;; Put faces on first uncommon characters and common parts.
4927        (when (or completion-common-substring completion-base-size)        (when (or completion-common-substring completion-base-size)
4928          (let* ((common-string-length          (setq common-string-length
4929                  (if completion-common-substring                  (if completion-common-substring
4930                      (length completion-common-substring)                      (length completion-common-substring)
4931                    (- (length mbuf-contents) completion-base-size)))                    (- common-string-length completion-base-size)))
4932                 (element-start (next-single-property-change          (let ((element-start (point-min))
4933                                 (point-min)                (maxp (point-max))
4934                                 'mouse-face))                element-common-end)
4935                 (element-common-end            (while (and (setq element-start
4936                  (and element-start                              (next-single-property-change
4937                       (+ (or element-start nil) common-string-length)))                               element-start 'mouse-face))
4938                 (maxp (point-max)))                        (< (setq element-common-end
4939            (while (and element-start (< element-common-end maxp))                                 (+ element-start common-string-length))
4940                             maxp))
4941              (when (and (get-char-property element-start 'mouse-face)              (when (and (get-char-property element-start 'mouse-face)
4942                         (get-char-property element-common-end 'mouse-face))                         (get-char-property element-common-end 'mouse-face))
4943                (put-text-property element-start element-common-end                (put-text-property element-start element-common-end
4944                                   'font-lock-face 'completions-common-part)                                   'font-lock-face 'completions-common-part)
4945                (put-text-property element-common-end (1+ element-common-end)                (put-text-property element-common-end (1+ element-common-end)
4946                                   'font-lock-face 'completions-first-difference))                                   '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))))))  
4947        ;; Insert help string.        ;; Insert help string.
4948        (goto-char (point-min))        (goto-char (point-min))
4949        (if (display-mouse-p)        (if (display-mouse-p)
# Line 4960  select the completion near point.\n\n")) Line 4955  select the completion near point.\n\n"))
4955    
4956  (add-hook 'completion-setup-hook 'completion-setup-function)  (add-hook 'completion-setup-hook 'completion-setup-function)
4957    
4958  (define-key minibuffer-local-completion-map [prior]  (define-key minibuffer-local-completion-map [prior] 'switch-to-completions)
4959    'switch-to-completions)  (define-key minibuffer-local-completion-map "\M-v"  '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)  
4960    
4961  (defun switch-to-completions ()  (defun switch-to-completions ()
4962    "Select the completion list window."    "Select the completion list window."

Legend:
Removed from v.1.759  
changed lines
  Added in v.1.760

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26