Mercurial > emacs
changeset 110241:033d5544b038
Merge from mainline.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Wed, 01 Sep 2010 22:54:47 +0000 |
| parents | 16b0300d6454 (current diff) a718416592e8 (diff) |
| children | 2d39cc9376df |
| files | |
| diffstat | 14 files changed, 300 insertions(+), 254 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Wed Sep 01 00:35:05 2010 +0000 +++ b/lisp/ChangeLog Wed Sep 01 22:54:47 2010 +0000 @@ -1,3 +1,13 @@ +2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (blink-paren-function): Move from C to here. + (blink-paren-post-self-insert-function): New function. + (post-self-insert-hook): Use it. + + * emacs-lisp/pcase.el (pcase-split-memq): + Fix overenthusiastic optimisation. + (pcase-u1): Handle the case of a lambda pred. + 2010-08-31 Masatake YAMATO <yamato@redhat.com> * textmodes/nroff-mode.el (nroff-view): New command.
--- a/lisp/emacs-lisp/pcase.el Wed Sep 01 00:35:05 2010 +0000 +++ b/lisp/emacs-lisp/pcase.el Wed Sep 01 22:54:47 2010 +0000 @@ -290,9 +290,13 @@ (defun pcase-split-memq (elems pat) ;; Based on pcase-split-eq. (cond - ;; The same match will give the same result. + ;; The same match will give the same result, but we don't know how + ;; to check it. + ;; (??? + ;; (cons :pcase-succeed nil)) + ;; A match for one of the elements may succeed or fail. ((and (eq (car-safe pat) '\`) (member (cadr pat) elems)) - (cons :pcase-succeed nil)) + nil) ;; A different match will fail if this one succeeds. ((and (eq (car-safe pat) '\`) ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) @@ -383,18 +387,20 @@ `(,(cadr upat) ,sym) (let* ((exp (cadr upat)) ;; `vs' is an upper bound on the vars we need. - (vs (pcase-fgrep (mapcar #'car vars) exp))) - (if vs - ;; Let's not replace `vars' in `exp' since it's - ;; too difficult to do it right, instead just - ;; let-bind `vars' around `exp'. - `(let ,(mapcar (lambda (var) - (list var (cdr (assq var vars)))) - vs) - ;; FIXME: `vars' can capture `sym'. E.g. - ;; (pcase x ((and `(,x . ,y) (pred (fun x))))) - (,@exp ,sym)) - `(,@exp ,sym)))) + (vs (pcase-fgrep (mapcar #'car vars) exp)) + (call (if (functionp exp) + `(,exp ,sym) `(,@exp ,sym)))) + (if (null vs) + call + ;; Let's not replace `vars' in `exp' since it's + ;; too difficult to do it right, instead just + ;; let-bind `vars' around `exp'. + `(let ,(mapcar (lambda (var) + (list var (cdr (assq var vars)))) + vs) + ;; FIXME: `vars' can capture `sym'. E.g. + ;; (pcase x ((and `(,x . ,y) (pred (fun x))))) + ,call)))) (pcase-u1 matches code vars then-rest) (pcase-u else-rest)))) ((symbolp upat)
--- a/lisp/gnus/ChangeLog Wed Sep 01 00:35:05 2010 +0000 +++ b/lisp/gnus/ChangeLog Wed Sep 01 22:54:47 2010 +0000 @@ -1,3 +1,31 @@ +2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca> + + Fix up some byte-compiler warnings. + * gnus.el (gnus-group-find-parameter, gnus-kill-save-kill-buffer): + * gnus-cite.el (gnus-article-highlight-citation, gnus-dissect-cited-text) + (gnus-article-fill-cited-article, gnus-article-hide-citation) + (gnus-article-hide-citation-in-followups, gnus-cite-toggle): + * gnus-group.el (gnus-group-set-mode-line, gnus-group-quit) + (gnus-group-set-info, gnus-add-mark): Use with-current-buffer. + (gnus-group-update-group): Use save-excursion and with-current-buffer. + +2010-09-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-html.el (gnus-article-html): Decode contents by charset. + +2010-09-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-html.el (gnus-html-cache-directory, gnus-html-cache-size) + (gnus-html-frame-width, gnus-blocked-images) + * message.el (message-prune-recipient-rules): Add custom version. + * gnus-sum.el (gnus-auto-expirable-marks): Bump custom version. + + * gnus-ems.el (gnus-process-get, gnus-process-put): New compatibility + functions. + + * gnus-html.el (gnus-html-curl-sentinel): Replace process-get with + gnus-process-get. + 2010-08-31 Julien Danjou <julien@danjou.info> (tiny change) * nnimap.el (nnimap-request-newgroups): Use nnimap-request-list-method
--- a/lisp/gnus/gnus-cite.el Wed Sep 01 00:35:05 2010 +0000 +++ b/lisp/gnus/gnus-cite.el Wed Sep 01 22:54:47 2010 +0000 @@ -407,9 +407,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps `gnus-cite-attribution-prefix' are considered attribution lines." (interactive (list 'force)) - (save-excursion - (unless same-buffer - (set-buffer gnus-article-buffer)) + (with-current-buffer (if same-buffer (current-buffer) gnus-article-buffer) (gnus-cite-parse-maybe force) (let ((buffer-read-only nil) (alist gnus-cite-prefix-alist) @@ -462,8 +460,7 @@ (defun gnus-dissect-cited-text () "Dissect the article buffer looking for cited text." - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (gnus-cite-parse-maybe nil t) (let ((alist gnus-cite-prefix-alist) prefix numbers number marks m) @@ -523,8 +520,7 @@ "Do word wrapping in the current article. If WIDTH (the numerical prefix), use that text width when filling." (interactive (list t current-prefix-arg)) - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) (marks (gnus-dissect-cited-text)) @@ -578,67 +574,66 @@ (interactive (append (gnus-article-hidden-arg) (list 'force))) (gnus-set-format 'cited-opened-text-button t) (gnus-set-format 'cited-closed-text-button t) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - marks - (inhibit-point-motion-hooks t) - (props (nconc (list 'article-type 'cite) - gnus-hidden-properties)) - (point (point-min)) - found beg end start) - (while (setq point - (text-property-any point (point-max) - 'gnus-callback - 'gnus-article-toggle-cited-text)) - (setq found t) - (goto-char point) - (gnus-article-toggle-cited-text - (get-text-property point 'gnus-data) arg) - (forward-line 1) - (setq point (point))) - (unless found - (setq marks (gnus-dissect-cited-text)) - (while marks - (setq beg nil - end nil) - (while (and marks (string= (cdar marks) "")) - (setq marks (cdr marks))) - (when marks - (setq beg (caar marks))) - (while (and marks (not (string= (cdar marks) ""))) - (setq marks (cdr marks))) - (when marks + (with-current-buffer gnus-article-buffer + (let ((buffer-read-only nil) + marks + (inhibit-point-motion-hooks t) + (props (nconc (list 'article-type 'cite) + gnus-hidden-properties)) + (point (point-min)) + found beg end start) + (while (setq point + (text-property-any point (point-max) + 'gnus-callback + 'gnus-article-toggle-cited-text)) + (setq found t) + (goto-char point) + (gnus-article-toggle-cited-text + (get-text-property point 'gnus-data) arg) + (forward-line 1) + (setq point (point))) + (unless found + (setq marks (gnus-dissect-cited-text)) + (while marks + (setq beg nil + end nil) + (while (and marks (string= (cdar marks) "")) + (setq marks (cdr marks))) + (when marks + (setq beg (caar marks))) + (while (and marks (not (string= (cdar marks) ""))) + (setq marks (cdr marks))) + (when marks (setq end (caar marks))) - ;; Skip past lines we want to leave visible. - (when (and beg end gnus-cited-lines-visible) - (goto-char beg) - (forward-line (if (consp gnus-cited-lines-visible) - (car gnus-cited-lines-visible) - gnus-cited-lines-visible)) - (if (>= (point) end) - (setq beg nil) - (setq beg (point-marker)) - (when (consp gnus-cited-lines-visible) - (goto-char end) - (forward-line (- (cdr gnus-cited-lines-visible))) - (if (<= (point) beg) - (setq beg nil) + ;; Skip past lines we want to leave visible. + (when (and beg end gnus-cited-lines-visible) + (goto-char beg) + (forward-line (if (consp gnus-cited-lines-visible) + (car gnus-cited-lines-visible) + gnus-cited-lines-visible)) + (if (>= (point) end) + (setq beg nil) + (setq beg (point-marker)) + (when (consp gnus-cited-lines-visible) + (goto-char end) + (forward-line (- (cdr gnus-cited-lines-visible))) + (if (<= (point) beg) + (setq beg nil) (setq end (point-marker)))))) - (when (and beg end) - (gnus-add-wash-type 'cite) - ;; We use markers for the end-points to facilitate later - ;; wrapping and mangling of text. - (setq beg (set-marker (make-marker) beg) - end (set-marker (make-marker) end)) - (gnus-add-text-properties-when 'article-type nil beg end props) - (goto-char beg) - (when (and gnus-cite-blank-line-after-header - (not (save-excursion (search-backward "\n\n" nil t)))) - (insert "\n")) - (put-text-property - (setq start (point-marker)) - (progn + (when (and beg end) + (gnus-add-wash-type 'cite) + ;; We use markers for the end-points to facilitate later + ;; wrapping and mangling of text. + (setq beg (set-marker (make-marker) beg) + end (set-marker (make-marker) end)) + (gnus-add-text-properties-when 'article-type nil beg end props) + (goto-char beg) + (when (and gnus-cite-blank-line-after-header + (not (save-excursion (search-backward "\n\n" nil t)))) + (insert "\n")) + (put-text-property + (setq start (point-marker)) + (progn (gnus-article-add-button (point) (progn (eval gnus-cited-closed-text-button-line-format-spec) @@ -646,8 +641,8 @@ `gnus-article-toggle-cited-text (list (cons beg end) start)) (point)) - 'article-type 'annotation) - (set-marker beg (point)))))))) + 'article-type 'annotation) + (set-marker beg (point)))))))) (defun gnus-article-toggle-cited-text (args &optional arg) "Toggle hiding the text in REGION. @@ -750,11 +745,9 @@ (defun gnus-article-hide-citation-in-followups () "Hide cited text in non-root articles." (interactive) - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (let ((article (cdr gnus-article-current))) - (unless (save-excursion - (set-buffer gnus-summary-buffer) + (unless (with-current-buffer gnus-summary-buffer (gnus-article-displayed-root-p article)) (gnus-article-hide-citation))))) @@ -1097,8 +1090,7 @@ (gnus-overlay-put overlay 'face face)))))) (defun gnus-cite-toggle (prefix) - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (gnus-cite-parse-maybe nil t) (let ((buffer-read-only nil) (numbers (cdr (assoc prefix gnus-cite-prefix-alist)))
--- a/lisp/gnus/gnus-ems.el Wed Sep 01 00:35:05 2010 +0000 +++ b/lisp/gnus/gnus-ems.el Wed Sep 01 22:54:47 2010 +0000 @@ -305,26 +305,39 @@ (setq start end end nil)))))) -(if (fboundp 'set-process-plist) - (progn - (defalias 'gnus-set-process-plist 'set-process-plist) - (defalias 'gnus-process-plist 'process-plist)) - (defun gnus-set-process-plist (process plist) - "Replace the plist of PROCESS with PLIST. Returns PLIST." - (put 'gnus-process-plist process plist)) - (defun gnus-process-plist (process) - "Return the plist of PROCESS." - ;; Remove those of dead processes from `gnus-process-plist' - ;; to prevent it from growing. - (let ((plist (symbol-plist 'gnus-process-plist)) - proc) - (while (setq proc (car plist)) - (if (and (processp proc) - (memq (process-status proc) '(open run))) - (setq plist (cddr plist)) - (setcar plist (caddr plist)) - (setcdr plist (or (cdddr plist) '(nil)))))) - (get 'gnus-process-plist process))) +(eval-and-compile + (if (fboundp 'set-process-plist) + (progn + (defalias 'gnus-set-process-plist 'set-process-plist) + (defalias 'gnus-process-plist 'process-plist) + (defalias 'gnus-process-get 'process-get) + (defalias 'gnus-process-put 'process-put)) + (defun gnus-set-process-plist (process plist) + "Replace the plist of PROCESS with PLIST. Returns PLIST." + (put 'gnus-process-plist process plist)) + (defun gnus-process-plist (process) + "Return the plist of PROCESS." + ;; Remove those of dead processes from `gnus-process-plist' + ;; to prevent it from growing. + (let ((plist (symbol-plist 'gnus-process-plist)) + proc) + (while (setq proc (car plist)) + (if (and (processp proc) + (memq (process-status proc) '(open run))) + (setq plist (cddr plist)) + (setcar plist (caddr plist)) + (setcdr plist (or (cdddr plist) '(nil)))))) + (get 'gnus-process-plist process)) + (defun gnus-process-get (process propname) + "Return the value of PROCESS' PROPNAME property. +This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'." + (plist-get (gnus-process-plist process) propname)) + (defun gnus-process-put (process propname value) + "Change PROCESS' PROPNAME property to VALUE. +It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'." + (gnus-set-process-plist process + (plist-put (gnus-process-plist process) + propname value))))) (provide 'gnus-ems)
--- a/lisp/gnus/gnus-group.el Wed Sep 01 00:35:05 2010 +0000 +++ b/lisp/gnus/gnus-group.el Wed Sep 01 22:54:47 2010 +0000 @@ -1691,72 +1691,66 @@ "Update all lines where GROUP appear. If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already." - ;; Can't use `save-excursion' here, so we do it manually. - (let ((buf (current-buffer)) - mark) - (set-buffer gnus-group-buffer) - (setq mark (point-marker)) - ;; The buffer may be narrowed. - (save-restriction - (widen) - (let ((ident (gnus-intern-safe group gnus-active-hashtb)) - (loc (point-min)) - found buffer-read-only) - ;; Enter the current status into the dribble buffer. - (let ((entry (gnus-group-entry group))) - (when (and entry - (not (gnus-ephemeral-group-p group))) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) - ")")))) - ;; Find all group instances. If topics are in use, each group - ;; may be listed in more than once. - (while (setq loc (text-property-any - loc (point-max) 'gnus-group ident)) - (setq found t) - (goto-char loc) - (let ((gnus-group-indentation (gnus-group-group-indentation))) - (gnus-delete-line) - (gnus-group-insert-group-line-info group) - (save-excursion - (forward-line -1) - (gnus-run-hooks 'gnus-group-update-group-hook))) - (setq loc (1+ loc))) - (unless (or found visible-only) - ;; No such line in the buffer, find out where it's supposed to - ;; go, and insert it there (or at the end of the buffer). - (if gnus-goto-missing-group-function - (funcall gnus-goto-missing-group-function group) - (let ((entry (cddr (gnus-group-entry group)))) - (while (and entry (car entry) - (not - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe - (caar entry) gnus-active-hashtb))))) - (setq entry (cdr entry))) - (or entry (goto-char (point-max))))) - ;; Finally insert the line. - (let ((gnus-group-indentation (gnus-group-group-indentation))) - (gnus-group-insert-group-line-info group) - (save-excursion - (forward-line -1) - (gnus-run-hooks 'gnus-group-update-group-hook)))) - (when gnus-group-update-group-function - (funcall gnus-group-update-group-function group)) - (gnus-group-set-mode-line))) - (goto-char mark) - (set-marker mark nil) - (set-buffer buf))) + (with-current-buffer gnus-group-buffer + (save-excursion + ;; The buffer may be narrowed. + (save-restriction + (widen) + (let ((ident (gnus-intern-safe group gnus-active-hashtb)) + (loc (point-min)) + found buffer-read-only) + ;; Enter the current status into the dribble buffer. + (let ((entry (gnus-group-entry group))) + (when (and entry + (not (gnus-ephemeral-group-p group))) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string (nth 2 entry)) + ")")))) + ;; Find all group instances. If topics are in use, each group + ;; may be listed in more than once. + (while (setq loc (text-property-any + loc (point-max) 'gnus-group ident)) + (setq found t) + (goto-char loc) + (let ((gnus-group-indentation (gnus-group-group-indentation))) + (gnus-delete-line) + (gnus-group-insert-group-line-info group) + (save-excursion + (forward-line -1) + (gnus-run-hooks 'gnus-group-update-group-hook))) + (setq loc (1+ loc))) + (unless (or found visible-only) + ;; No such line in the buffer, find out where it's supposed to + ;; go, and insert it there (or at the end of the buffer). + (if gnus-goto-missing-group-function + (funcall gnus-goto-missing-group-function group) + (let ((entry (cddr (gnus-group-entry group)))) + (while (and entry (car entry) + (not + (gnus-goto-char + (text-property-any + (point-min) (point-max) + 'gnus-group (gnus-intern-safe + (caar entry) + gnus-active-hashtb))))) + (setq entry (cdr entry))) + (or entry (goto-char (point-max))))) + ;; Finally insert the line. + (let ((gnus-group-indentation (gnus-group-group-indentation))) + (gnus-group-insert-group-line-info group) + (save-excursion + (forward-line -1) + (gnus-run-hooks 'gnus-group-update-group-hook)))) + (when gnus-group-update-group-function + (funcall gnus-group-update-group-function group)) + (gnus-group-set-mode-line)))))) (defun gnus-group-set-mode-line () "Update the mode line in the group buffer." (when (memq 'group gnus-updated-mode-lines) ;; Yes, we want to keep this mode line updated. - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (let* ((gformat (or gnus-group-mode-line-format-spec (gnus-set-format 'group-mode))) (gnus-tmp-news-server (cadr gnus-select-method)) @@ -1769,8 +1763,7 @@ (and gnus-dribble-buffer (buffer-name gnus-dribble-buffer) (buffer-modified-p gnus-dribble-buffer) - (save-excursion - (set-buffer gnus-dribble-buffer) + (with-current-buffer gnus-dribble-buffer (not (zerop (buffer-size)))))) (mode-string (eval gformat))) ;; Say whether the dribble buffer has been modified. @@ -4433,8 +4426,7 @@ (gnus-run-hooks 'gnus-exit-gnus-hook) (gnus-configure-windows 'group t) (when (and (gnus-buffer-live-p gnus-dribble-buffer) - (not (zerop (save-excursion - (set-buffer gnus-dribble-buffer) + (not (zerop (with-current-buffer gnus-dribble-buffer (buffer-size))))) (gnus-dribble-enter ";;; Gnus was exited on purpose without saving the .newsrc files.")) @@ -4495,13 +4487,11 @@ (setcar (nthcdr (1- total) info) part-info))) (unless entry ;; This is a new group, so we just create it. - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (setq method (gnus-info-method info)) (when (gnus-server-equal method "native") (setq method nil)) - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (if method ;; It's a foreign group... (gnus-group-make-group @@ -4565,8 +4555,7 @@ "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not." (let ((buffer (gnus-summary-buffer-name group))) (if (gnus-buffer-live-p buffer) - (save-excursion - (set-buffer (get-buffer buffer)) + (with-current-buffer (get-buffer buffer) (gnus-summary-add-mark article mark)) (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists)) (list article)))))
--- a/lisp/gnus/gnus-html.el Wed Sep 01 00:35:05 2010 +0000 +++ b/lisp/gnus/gnus-html.el Wed Sep 01 22:54:47 2010 +0000 @@ -34,21 +34,25 @@ (defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/") "Where Gnus will cache images it downloads from the web." + :version "24.1" :group 'gnus-art :type 'directory) (defcustom gnus-html-cache-size 500000000 "The size of the Gnus image cache." + :version "24.1" :group 'gnus-art :type 'integer) (defcustom gnus-html-frame-width 70 "What width to use when rendering HTML." + :version "24.1" :group 'gnus-art :type 'integer) (defcustom gnus-blocked-images "." "Images that have URLs matching this regexp will be blocked." + :version "24.1" :group 'gnus-art :type 'regexp) @@ -62,7 +66,13 @@ (let* ((coding-system-for-read 'utf-8) (coding-system-for-write 'utf-8) (default-process-coding-system - (cons coding-system-for-read coding-system-for-write))) + (cons coding-system-for-read coding-system-for-write)) + (charset (mail-content-type-get (mm-handle-type handle) + 'charset))) + (when (and charset + (setq charset (mm-charset-to-coding-system charset)) + (not (eq charset 'ascii))) + (mm-decode-coding-region (point-min) (point-max) charset)) (call-process-region (point-min) (point-max) "w3m" nil article-buffer nil @@ -171,8 +181,8 @@ (defun gnus-html-curl-sentinel (process event) (when (string-match "finished" event) - (let* ((images (process-get process 'images)) - (buffer (process-get process 'buffer)) + (let* ((images (gnus-process-get process 'images)) + (buffer (gnus-process-get process 'buffer)) (spec (pop images)) (file (gnus-html-image-id (car spec)))) (when (and (buffer-live-p buffer)
--- a/lisp/gnus/gnus-sum.el Wed Sep 01 00:35:05 2010 +0000 +++ b/lisp/gnus/gnus-sum.el Wed Sep 01 22:54:47 2010 +0000 @@ -663,7 +663,7 @@ gnus-low-score-mark gnus-ancient-mark gnus-read-mark gnus-duplicate-mark) "*The list of marks converted into expiration if a group is auto-expirable." - :version "21.1" + :version "24.1" :group 'gnus-summary :type '(repeat character))
--- a/lisp/gnus/gnus.el Wed Sep 01 00:35:05 2010 +0000 +++ b/lisp/gnus/gnus.el Wed Sep 01 22:54:47 2010 +0000 @@ -3937,8 +3937,7 @@ If you call this function inside a loop, consider using the faster `gnus-group-fast-parameter' instead." - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (if symbol (gnus-group-fast-parameter group symbol allow-list) (nconc @@ -4097,8 +4096,7 @@ (defun gnus-kill-save-kill-buffer () (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) (when (get-file-buffer file) - (save-excursion - (set-buffer (get-file-buffer file)) + (with-current-buffer (get-file-buffer file) (when (buffer-modified-p) (save-buffer)) (kill-buffer (current-buffer))))))
--- a/lisp/gnus/message.el Wed Sep 01 00:35:05 2010 +0000 +++ b/lisp/gnus/message.el Wed Sep 01 22:54:47 2010 +0000 @@ -252,6 +252,7 @@ (defcustom message-prune-recipient-rules nil "Rules for how to prune the list of recipients when doing wide replies. This is a list of regexps and regexp matches." + :version "24.1" :group 'message-mail :group 'message-headers :link '(custom-manual "(message)Wide Reply")
--- a/lisp/htmlfontify.el Wed Sep 01 00:35:05 2010 +0000 +++ b/lisp/htmlfontify.el Wed Sep 01 22:54:47 2010 +0000 @@ -2349,7 +2349,7 @@ ;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file) -;;;;;; "hfy-cmap" "hfy-cmap.el" "3de2db2d213813bb3afe170ffd66cdde") +;;;;;; "hfy-cmap" "hfy-cmap.el" "7e622e4b131ea5efbe9d258f719822d6") ;;; Generated autoloads from hfy-cmap.el (autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\
--- a/lisp/simple.el Wed Sep 01 00:35:05 2010 +0000 +++ b/lisp/simple.el Wed Sep 01 22:54:47 2010 +0000 @@ -5607,7 +5607,23 @@ (message "Matches %s" (substring-no-properties open-paren-line-string))))))))) -(setq blink-paren-function 'blink-matching-open) +(defvar blink-paren-function 'blink-matching-open + "Function called, if non-nil, whenever a close parenthesis is inserted. +More precisely, a char with closeparen syntax is self-inserted.") + +(defun blink-paren-post-self-insert-function () + (when (and (eq (char-before) last-command-event) ; Sanity check. + (memq (char-syntax last-command-event) '(?\) ?\$)) + blink-paren-function + (not executing-kbd-macro) + (not noninteractive)) + (funcall blink-paren-function))) + +(add-hook 'post-self-insert-hook #'blink-paren-post-self-insert-function + ;; Most likely, this hook is nil, so this arg doesn't matter, + ;; but I use it as a reminder that this function usually + ;; likes to be run after others since it does `sit-for'. + 'append) ;; This executes C-g typed while Emacs is waiting for a command. ;; Quitting out of a program does not go through here;
--- a/src/ChangeLog Wed Sep 01 00:35:05 2010 +0000 +++ b/src/ChangeLog Wed Sep 01 22:54:47 2010 +0000 @@ -1,3 +1,11 @@ +2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * cmds.c (Vblink_paren_function): Remove. + (internal_self_insert): Make it insert N chars at a time. + Don't call blink-paren-function. + (Fself_insert_command): Adjust accordingly. + (syms_of_cmds): Don't declare blink-paren-function. + 2010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> * keyboard.c (Fwindow_system): Fix compilation for USE_LISP_UNION_TYPE.
--- a/src/cmds.c Wed Sep 01 00:35:05 2010 +0000 +++ b/src/cmds.c Wed Sep 01 22:54:47 2010 +0000 @@ -32,7 +32,7 @@ #include "dispextern.h" #include "frame.h" -Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function; +Lisp_Object Qkill_forward_chars, Qkill_backward_chars; /* A possible value for a buffer's overwrite-mode variable. */ Lisp_Object Qoverwrite_mode_binary; @@ -304,36 +304,16 @@ { int character = translate_char (Vtranslation_table_for_input, XINT (last_command_event)); - if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode)) - { - XSETFASTINT (n, XFASTINT (n) - 2); - /* The first one might want to expand an abbrev. */ - internal_self_insert (character, 1); - /* The bulk of the copies of this char can be inserted simply. - We don't have to handle a user-specified face specially - because it will get inherited from the first char inserted. */ - Finsert_char (make_number (character), n, Qt); - /* The last one might want to auto-fill. */ - internal_self_insert (character, 0); - } - else - while (XINT (n) > 0) - { - int val; - /* Ok since old and new vals both nonneg */ - XSETFASTINT (n, XFASTINT (n) - 1); - val = internal_self_insert (character, XFASTINT (n) != 0); - if (val == 2) - nonundocount = 0; - frame_make_pointer_invisible (); - } + int val = internal_self_insert (character, XFASTINT (n)); + if (val == 2) + nonundocount = 0; + frame_make_pointer_invisible (); } return Qnil; } -/* Insert character C. If NOAUTOFILL is nonzero, don't do autofill - even if it is enabled. +/* Insert N times character C If this insertion is suitable for direct output (completely simple), return 0. A value of 1 indicates this *might* not have been simple. @@ -343,12 +323,12 @@ static Lisp_Object Qpost_self_insert_hook, Vpost_self_insert_hook; static int -internal_self_insert (int c, int noautofill) +internal_self_insert (int c, int n) { int hairy = 0; Lisp_Object tem; register enum syntaxcode synt; - Lisp_Object overwrite, string; + Lisp_Object overwrite; /* Length of multi-byte form of C. */ int len; /* Working buffer and pointer for multi-byte form of C. */ @@ -391,32 +371,22 @@ /* This is the character after point. */ int c2 = FETCH_CHAR (PT_BYTE); - /* Column the cursor should be placed at after this insertion. - The correct value should be calculated only when necessary. */ - int target_clm = 0; - /* Overwriting in binary-mode always replaces C2 by C. Overwriting in textual-mode doesn't always do that. It inserts newlines in the usual way, and inserts any character at end of line or before a tab if it doesn't use the whole width of the tab. */ - if (EQ (overwrite, Qoverwrite_mode_binary) - || (c != '\n' - && c2 != '\n' - && ! (c2 == '\t' - && XINT (current_buffer->tab_width) > 0 - && XFASTINT (current_buffer->tab_width) < 20 - && (target_clm = ((int) current_column () /* iftc */ - + XINT (Fchar_width (make_number (c)))), - target_clm % XFASTINT (current_buffer->tab_width))))) + if (EQ (overwrite, Qoverwrite_mode_binary)) + chars_to_delete = n; + else if (c != '\n' && c2 != '\n') { int pos = PT; int pos_byte = PT_BYTE; + /* Column the cursor should be placed at after this insertion. + The correct value should be calculated only when necessary. */ + int target_clm = ((int) current_column () /* iftc */ + + n * XINT (Fchar_width (make_number (c)))); - if (target_clm == 0) - chars_to_delete = 1; - else - { /* The actual cursor position after the trial of moving to column TARGET_CLM. It is greater than TARGET_CLM if the TARGET_CLM is middle of multi-column @@ -428,14 +398,18 @@ chars_to_delete = PT - pos; if (actual_clm > target_clm) - { - /* We will delete too many columns. Let's fill columns + { /* We will delete too many columns. Let's fill columns by spaces so that the remaining text won't move. */ + EMACS_INT actual = PT_BYTE; + DEC_POS (actual); + if (FETCH_CHAR (actual) == '\t') + /* Rather than add spaces, let's just keep the tab. */ + chars_to_delete--; + else spaces_to_insert = actual_clm - target_clm; } - } + SET_PT_BOTH (pos, pos_byte); - hairy = 2; } hairy = 2; } @@ -474,16 +448,30 @@ if (chars_to_delete) { - string = make_string_from_bytes (str, 1, len); + int mc = ((NILP (current_buffer->enable_multibyte_characters) + && SINGLE_BYTE_CHAR_P (c)) + ? UNIBYTE_TO_CHAR (c) : c); + Lisp_Object string = Fmake_string (make_number (n), make_number (mc)); + if (spaces_to_insert) { tem = Fmake_string (make_number (spaces_to_insert), make_number (' ')); - string = concat2 (tem, string); + string = concat2 (string, tem); } replace_range (PT, PT + chars_to_delete, string, 1, 1, 1); - Fforward_char (make_number (1 + spaces_to_insert)); + Fforward_char (make_number (n + spaces_to_insert)); + } + else if (n > 1) + { + USE_SAFE_ALLOCA; + unsigned char *strn, *p; + SAFE_ALLOCA (strn, unsigned char*, n * len); + for (p = strn; n > 0; n--, p += len) + memcpy (p, str, len); + insert_and_inherit (strn, p - strn); + SAFE_FREE (); } else insert_and_inherit (str, len); @@ -491,7 +479,6 @@ if ((CHAR_TABLE_P (Vauto_fill_chars) ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c)) : (c == ' ' || c == '\n')) - && !noautofill && !NILP (current_buffer->auto_fill_function)) { Lisp_Object tem; @@ -509,13 +496,6 @@ hairy = 2; } - if ((synt == Sclose || synt == Smath) - && !NILP (Vblink_paren_function) && INTERACTIVE - && !noautofill) - { - call0 (Vblink_paren_function); - hairy = 2; - } /* Run hooks for electric keys. */ call1 (Vrun_hooks, Qpost_self_insert_hook); @@ -547,11 +527,6 @@ This run is run after inserting the charater. */); Vpost_self_insert_hook = Qnil; - DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function, - doc: /* Function called, if non-nil, whenever a close parenthesis is inserted. -More precisely, a char with closeparen syntax is self-inserted. */); - Vblink_paren_function = Qnil; - defsubr (&Sforward_point); defsubr (&Sforward_char); defsubr (&Sbackward_char);