Mercurial > emacs
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.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Tue, 01 Nov 2005 07:18:10 +0000 |
parents | ef5c1ec14e1f |
children | be6d79a520af |
comparison
equal
deleted
inserted
replaced
66594:d39ae3be63d4 | 66595:1d442f601f13 |
---|---|
991 (let ((char-string | 991 (let ((char-string |
992 (if (or (if (boundp 'edebug-active) edebug-active) | 992 (if (or (if (boundp 'edebug-active) edebug-active) |
993 (memq this-command '(eval-last-sexp eval-print-last-sexp))) | 993 (memq this-command '(eval-last-sexp eval-print-last-sexp))) |
994 (prin1-char value)))) | 994 (prin1-char value)))) |
995 (if char-string | 995 (if char-string |
996 (format " (0%o, 0x%x) = %s" value value char-string) | 996 (format " (#o%o, #x%x, %s)" value value char-string) |
997 (format " (0%o, 0x%x)" value value))))) | 997 (format " (#o%o, #x%x)" value value))))) |
998 | 998 |
999 ;; We define this, rather than making `eval' interactive, | 999 ;; We define this, rather than making `eval' interactive, |
1000 ;; for the sake of completion of names like eval-region, eval-current-buffer. | 1000 ;; for the sake of completion of names like eval-region, eval-current-buffer. |
1001 (defun eval-expression (eval-expression-arg | 1001 (defun eval-expression (eval-expression-arg |
1002 &optional eval-expression-insert-value) | 1002 &optional eval-expression-insert-value) |
2391 (list string "yank-handler specified for empty string")))) | 2391 (list string "yank-handler specified for empty string")))) |
2392 (if (fboundp 'menu-bar-update-yank-menu) | 2392 (if (fboundp 'menu-bar-update-yank-menu) |
2393 (menu-bar-update-yank-menu string (and replace (car kill-ring)))) | 2393 (menu-bar-update-yank-menu string (and replace (car kill-ring)))) |
2394 (if (and replace kill-ring) | 2394 (if (and replace kill-ring) |
2395 (setcar kill-ring string) | 2395 (setcar kill-ring string) |
2396 (setq kill-ring (cons string kill-ring)) | 2396 (push string kill-ring) |
2397 (if (> (length kill-ring) kill-ring-max) | 2397 (if (> (length kill-ring) kill-ring-max) |
2398 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))) | 2398 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))) |
2399 (setq kill-ring-yank-pointer kill-ring) | 2399 (setq kill-ring-yank-pointer kill-ring) |
2400 (if interprogram-cut-function | 2400 (if interprogram-cut-function |
2401 (funcall interprogram-cut-function string (not replace)))) | 2401 (funcall interprogram-cut-function string (not replace)))) |
3001 When calling from a program, give three arguments: | 3001 When calling from a program, give three arguments: |
3002 BUFFER (or buffer name), START and END. | 3002 BUFFER (or buffer name), START and END. |
3003 START and END specify the portion of the current buffer to be copied." | 3003 START and END specify the portion of the current buffer to be copied." |
3004 (interactive "BCopy to buffer: \nr") | 3004 (interactive "BCopy to buffer: \nr") |
3005 (let ((oldbuf (current-buffer))) | 3005 (let ((oldbuf (current-buffer))) |
3006 (save-excursion | 3006 (with-current-buffer (get-buffer-create buffer) |
3007 (set-buffer (get-buffer-create buffer)) | |
3008 (barf-if-buffer-read-only) | 3007 (barf-if-buffer-read-only) |
3009 (erase-buffer) | 3008 (erase-buffer) |
3010 (save-excursion | 3009 (save-excursion |
3011 (insert-buffer-substring oldbuf start end))))) | 3010 (insert-buffer-substring oldbuf start end))))) |
3012 | 3011 |
4886 is the substring.)") | 4885 is the substring.)") |
4887 | 4886 |
4888 ;; This function goes in completion-setup-hook, so that it is called | 4887 ;; This function goes in completion-setup-hook, so that it is called |
4889 ;; after the text of the completion list buffer is written. | 4888 ;; after the text of the completion list buffer is written. |
4890 (defun completion-setup-function () | 4889 (defun completion-setup-function () |
4891 (let ((mainbuf (current-buffer)) | 4890 (let* ((mainbuf (current-buffer)) |
4892 (mbuf-contents (minibuffer-contents))) | 4891 (mbuf-contents (minibuffer-contents)) |
4892 (common-string-length (length mbuf-contents))) | |
4893 ;; When reading a file name in the minibuffer, | 4893 ;; When reading a file name in the minibuffer, |
4894 ;; set default-directory in the minibuffer | 4894 ;; set default-directory in the minibuffer |
4895 ;; so it will get copied into the completion list buffer. | 4895 ;; so it will get copied into the completion list buffer. |
4896 (if minibuffer-completing-file-name | 4896 (if minibuffer-completing-file-name |
4897 (with-current-buffer mainbuf | 4897 (with-current-buffer mainbuf |
4899 ;; If partial-completion-mode is on, point might not be after the | 4899 ;; If partial-completion-mode is on, point might not be after the |
4900 ;; last character in the minibuffer. | 4900 ;; last character in the minibuffer. |
4901 ;; FIXME: This still doesn't work if the text to be completed | 4901 ;; FIXME: This still doesn't work if the text to be completed |
4902 ;; starts with a `-'. | 4902 ;; starts with a `-'. |
4903 (when (and partial-completion-mode (not (eobp))) | 4903 (when (and partial-completion-mode (not (eobp))) |
4904 (setq mbuf-contents | 4904 (setq common-string-length |
4905 (substring mbuf-contents 0 (- (point) (point-max))))) | 4905 (- common-string-length (- (point) (point-max))))) |
4906 (with-current-buffer standard-output | 4906 (with-current-buffer standard-output |
4907 (completion-list-mode) | 4907 (completion-list-mode) |
4908 (make-local-variable 'completion-reference-buffer) | 4908 (set (make-local-variable 'completion-reference-buffer) mainbuf) |
4909 (setq completion-reference-buffer mainbuf) | |
4910 (if minibuffer-completing-file-name | 4909 (if minibuffer-completing-file-name |
4911 ;; For file name completion, | 4910 ;; For file name completion, |
4912 ;; use the number of chars before the start of the | 4911 ;; use the number of chars before the start of the |
4913 ;; last file name component. | 4912 ;; last file name component. |
4914 (setq completion-base-size | 4913 (setq completion-base-size |
4924 (setq completion-base-size | 4923 (setq completion-base-size |
4925 (funcall (get minibuffer-completion-table 'completion-base-size-function))) | 4924 (funcall (get minibuffer-completion-table 'completion-base-size-function))) |
4926 (setq completion-base-size 0)))) | 4925 (setq completion-base-size 0)))) |
4927 ;; Put faces on first uncommon characters and common parts. | 4926 ;; Put faces on first uncommon characters and common parts. |
4928 (when (or completion-common-substring completion-base-size) | 4927 (when (or completion-common-substring completion-base-size) |
4929 (let* ((common-string-length | 4928 (setq common-string-length |
4930 (if completion-common-substring | 4929 (if completion-common-substring |
4931 (length completion-common-substring) | 4930 (length completion-common-substring) |
4932 (- (length mbuf-contents) completion-base-size))) | 4931 (- common-string-length completion-base-size))) |
4933 (element-start (next-single-property-change | 4932 (let ((element-start (point-min)) |
4934 (point-min) | 4933 (maxp (point-max)) |
4935 'mouse-face)) | 4934 element-common-end) |
4936 (element-common-end | 4935 (while (and (setq element-start |
4937 (and element-start | 4936 (next-single-property-change |
4938 (+ (or element-start nil) common-string-length))) | 4937 element-start 'mouse-face)) |
4939 (maxp (point-max))) | 4938 (< (setq element-common-end |
4940 (while (and element-start (< element-common-end maxp)) | 4939 (+ element-start common-string-length)) |
4940 maxp)) | |
4941 (when (and (get-char-property element-start 'mouse-face) | 4941 (when (and (get-char-property element-start 'mouse-face) |
4942 (get-char-property element-common-end 'mouse-face)) | 4942 (get-char-property element-common-end 'mouse-face)) |
4943 (put-text-property element-start element-common-end | 4943 (put-text-property element-start element-common-end |
4944 'font-lock-face 'completions-common-part) | 4944 'font-lock-face 'completions-common-part) |
4945 (put-text-property element-common-end (1+ element-common-end) | 4945 (put-text-property element-common-end (1+ element-common-end) |
4946 'font-lock-face 'completions-first-difference)) | 4946 'font-lock-face 'completions-first-difference))))) |
4947 (setq element-start (next-single-property-change | |
4948 element-start | |
4949 'mouse-face)) | |
4950 (if element-start | |
4951 (setq element-common-end (+ element-start common-string-length)))))) | |
4952 ;; Insert help string. | 4947 ;; Insert help string. |
4953 (goto-char (point-min)) | 4948 (goto-char (point-min)) |
4954 (if (display-mouse-p) | 4949 (if (display-mouse-p) |
4955 (insert (substitute-command-keys | 4950 (insert (substitute-command-keys |
4956 "Click \\[mouse-choose-completion] on a completion to select it.\n"))) | 4951 "Click \\[mouse-choose-completion] on a completion to select it.\n"))) |
4958 "In this buffer, type \\[choose-completion] to \ | 4953 "In this buffer, type \\[choose-completion] to \ |
4959 select the completion near point.\n\n"))))) | 4954 select the completion near point.\n\n"))))) |
4960 | 4955 |
4961 (add-hook 'completion-setup-hook 'completion-setup-function) | 4956 (add-hook 'completion-setup-hook 'completion-setup-function) |
4962 | 4957 |
4963 (define-key minibuffer-local-completion-map [prior] | 4958 (define-key minibuffer-local-completion-map [prior] 'switch-to-completions) |
4964 'switch-to-completions) | 4959 (define-key minibuffer-local-completion-map "\M-v" 'switch-to-completions) |
4965 (define-key minibuffer-local-must-match-map [prior] | |
4966 'switch-to-completions) | |
4967 (define-key minibuffer-local-completion-map "\M-v" | |
4968 'switch-to-completions) | |
4969 (define-key minibuffer-local-must-match-map "\M-v" | |
4970 'switch-to-completions) | |
4971 | 4960 |
4972 (defun switch-to-completions () | 4961 (defun switch-to-completions () |
4973 "Select the completion list window." | 4962 "Select the completion list window." |
4974 (interactive) | 4963 (interactive) |
4975 ;; Make sure we have a completions window. | 4964 ;; Make sure we have a completions window. |