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))
bidi-fixer encoding-msg pos total percent col hscroll))))))
\f
;; 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.")
(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)
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)
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).
(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)
(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,
(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)
HCoop / bpt / emacs.git / blobdiff