X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/4f0e6095fc0bcc8b9e8bcf6bf907b957b15cf699..3ca0d0b437e006f7b83b92b2d4fe99eeafcb9adf:/lisp/simple.el diff --git a/lisp/simple.el b/lisp/simple.el index 5fda902100..2564645e42 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -380,20 +380,68 @@ Other major modes are defined by comparison with this one." map) "Keymap used for programming modes.") -(defun prog-indent-sexp () - "Indent the expression after point." - (interactive) - (let ((start (point)) - (end (save-excursion (forward-sexp 1) (point)))) - (indent-region start end nil))) +(defun prog-indent-sexp (&optional defun) + "Indent the expression after point. +When interactively called with prefix, indent the enclosing defun +instead." + (interactive "P") + (save-excursion + (when defun + (end-of-line) + (beginning-of-defun)) + (let ((start (point)) + (end (progn (forward-sexp 1) (point)))) + (indent-region start end nil)))) (define-derived-mode prog-mode fundamental-mode "Prog" "Major mode for editing programming language source code." (set (make-local-variable 'require-final-newline) mode-require-final-newline) (set (make-local-variable 'parse-sexp-ignore-comments) t) + (make-local-variable 'prog-prettify-symbols-alist) ;; Any programming language is always written left to right. (setq bidi-paragraph-direction 'left-to-right)) +(defvar prog-prettify-symbols-alist nil) + +(defcustom prog-prettify-symbols nil + "Whether symbols should be prettified. +When set to an alist in the form `(STRING . CHARACTER)' it will +augment the mode's native prettify alist." + :type '(choice + (const :tag "No thanks" nil) + (const :tag "Mode defaults" t) + (alist :tag "Mode defaults augmented with your own list" + :key-type string :value-type character)) + :group 'languages) + +(defun prog--prettify-font-lock-compose-symbol (alist) + "Compose a sequence of ascii chars into a symbol. +Regexp match data 0 points to the chars." + ;; Check that the chars should really be composed into a symbol. + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (syntaxes (if (eq (char-syntax (char-after start)) ?w) + '(?w) '(?. ?\\)))) + (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes) + (memq (char-syntax (or (char-after end) ?\ )) syntaxes) + (nth 8 (syntax-ppss))) + ;; No composition for you. Let's actually remove any composition + ;; we may have added earlier and which is now incorrect. + (remove-text-properties start end '(composition)) + ;; That's a symbol alright, so add the composition. + (compose-region start end (cdr (assoc (match-string 0) alist))))) + ;; Return nil because we're not adding any face property. + nil) + +(defun prog-prettify-font-lock-symbols-keywords () + (when prog-prettify-symbols + (let ((alist (append prog-prettify-symbols-alist + (if (listp prog-prettify-symbols) + prog-prettify-symbols + nil)))) + `((,(regexp-opt (mapcar 'car alist) t) + (0 (prog--prettify-font-lock-compose-symbol ',alist))))))) + ;; Making and deleting lines. (defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)) @@ -1236,13 +1284,33 @@ in *Help* buffer. See also the command `describe-char'." bidi-fixer encoding-msg pos total percent col hscroll)))))) ;; Initialize read-expression-map. It is defined at C level. -(let ((m (make-sparse-keymap))) - (define-key m "\M-\t" 'lisp-complete-symbol) - ;; Might as well bind TAB to completion, since inserting a TAB char is much - ;; too rarely useful. - (define-key m "\t" 'lisp-complete-symbol) - (set-keymap-parent m minibuffer-local-map) - (setq read-expression-map m)) +(defvar read-expression-map + (let ((m (make-sparse-keymap))) + (define-key m "\M-\t" 'completion-at-point) + ;; Might as well bind TAB to completion, since inserting a TAB char is + ;; much too rarely useful. + (define-key m "\t" 'completion-at-point) + (set-keymap-parent m minibuffer-local-map) + m)) + +(defun read-minibuffer (prompt &optional initial-contents) + "Return a Lisp object read using the minibuffer, unevaluated. +Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS +is a string to insert in the minibuffer before reading. +\(INITIAL-CONTENTS can also be a cons of a string and an integer. +Such arguments are used as in `read-from-minibuffer'.)" + ;; Used for interactive spec `x'. + (read-from-minibuffer prompt initial-contents minibuffer-local-map + t minibuffer-history)) + +(defun eval-minibuffer (prompt &optional initial-contents) + "Return value of Lisp expression read using the minibuffer. +Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS +is a string to insert in the minibuffer before reading. +\(INITIAL-CONTENTS can also be a cons of a string and an integer. +Such arguments are used as in `read-from-minibuffer'.)" + ;; Used for interactive spec `X'. + (eval (read--expression prompt initial-contents))) (defvar minibuffer-completing-symbol nil "Non-nil means completing a Lisp symbol in the minibuffer.") @@ -1294,6 +1362,17 @@ display the result of expression evaluation." (defvar eval-expression-minibuffer-setup-hook nil "Hook run by `eval-expression' when entering the minibuffer.") +(defun read--expression (prompt &optional initial-contents) + (let ((minibuffer-completing-symbol t)) + (minibuffer-with-setup-hook + (lambda () + (add-hook 'completion-at-point-functions + #'lisp-completion-at-point nil t) + (run-hooks 'eval-expression-minibuffer-setup-hook)) + (read-from-minibuffer prompt initial-contents + read-expression-map t + 'read-expression-history)))) + ;; We define this, rather than making `eval' interactive, ;; for the sake of completion of names like eval-region, eval-buffer. (defun eval-expression (exp &optional insert-value) @@ -1310,12 +1389,7 @@ and `eval-expression-print-level'. If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive - (list (let ((minibuffer-completing-symbol t)) - (minibuffer-with-setup-hook - (lambda () (run-hooks 'eval-expression-minibuffer-setup-hook)) - (read-from-minibuffer "Eval: " - nil read-expression-map t - 'read-expression-history))) + (list (read--expression "Eval: ") current-prefix-arg)) (if (null eval-expression-debug-on-error) @@ -2846,7 +2920,7 @@ Command Output*' is deleted. Optional fourth arg OUTPUT-BUFFER specifies where to put the command's output. If the value is a buffer or buffer name, put -the output there. Any other value, including nil, means to +the output there. Any other value, excluding nil, means to insert the output in the current buffer. In either case, the output is inserted after point (leaving mark after it). @@ -2895,7 +2969,7 @@ interactively, this is t." (goto-char start) (and replace (push-mark (point) 'nomsg)) (setq exit-status - (call-process-region start end shell-file-name t + (call-process-region start end shell-file-name replace (if error-file (list t error-file) t) @@ -4835,13 +4909,25 @@ lines." (frame-char-width)) hscroll)))))) (if target-hscroll (set-window-hscroll (selected-window) target-hscroll)) - (or (and (= (vertical-motion - (cons (or goal-column - (if (consp temporary-goal-column) - (car temporary-goal-column) - temporary-goal-column)) - arg)) - arg) + ;; vertical-motion can move more than it was asked to if it moves + ;; across display strings with newlines. We don't want to ring + ;; the bell and announce beginning/end of buffer in that case. + (or (and (or (and (>= arg 0) + (>= (vertical-motion + (cons (or goal-column + (if (consp temporary-goal-column) + (car temporary-goal-column) + temporary-goal-column)) + arg)) + arg)) + (and (< arg 0) + (<= (vertical-motion + (cons (or goal-column + (if (consp temporary-goal-column) + (car temporary-goal-column) + temporary-goal-column)) + arg)) + arg))) (or (>= arg 0) (/= (point) opoint) ;; If the goal column lies on a display string, @@ -6714,15 +6800,21 @@ Called from `temp-buffer-show-hook'." (defun completion-setup-function () (let* ((mainbuf (current-buffer)) (base-dir - ;; When reading a file name in the minibuffer, - ;; try and find the right default-directory to set in the - ;; completion list buffer. - ;; FIXME: Why do we do that, actually? --Stef + ;; FIXME: This is a bad hack. We try to set the default-directory + ;; in the *Completions* buffer so that the relative file names + ;; displayed there can be treated as valid file names, independently + ;; from the completion context. But this suffers from many problems: + ;; - It's not clear when the completions are file names. With some + ;; completion tables (e.g. bzr revision specs), the listed + ;; completions can mix file names and other things. + ;; - It doesn't pay attention to possible quoting. + ;; - With fancy completion styles, the code below will not always + ;; find the right base directory. (if minibuffer-completing-file-name (file-name-as-directory (expand-file-name - (substring (minibuffer-completion-contents) - 0 (or completion-base-size 0))))))) + (buffer-substring (minibuffer-prompt-end) + (- (point) (or completion-base-size 0)))))))) (with-current-buffer standard-output (let ((base-size completion-base-size) ;Read before killing localvars. (base-position completion-base-position)