Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 101323. ------------------------------------------------------------ revno: 101323 committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-09-04 00:50:02 +0000 message: Fix previous merge from Gnus trunk. diff: === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-09-04 00:36:13 +0000 +++ lisp/gnus/gnus-html.el 2010-09-04 00:50:02 +0000 @@ -111,7 +111,6 @@ (defun gnus-html-wash-tags () (let (tag parameters string start end images url) - (mm-url-decode-entities) (goto-char (point-min)) (while (re-search-forward " * *\n" nil t) (replace-match "" t t)) @@ -223,7 +222,8 @@ (while (re-search-forward "" nil t) (replace-match "" t t)) (when images - (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))))) + (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))) + (mm-url-decode-entities))) (defun gnus-html-insert-image () "Fetch and insert the image under point." ------------------------------------------------------------ revno: 101322 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-09-04 00:45:13 +0000 message: mm-util.el: Just return the image directories, not all directories in the path in addition to the image directories; Maintain a cache of the image directories. This means that the `g' command in Gnus doesn't have to stat dozens of directories each time; nnmh.el: Only recurse down into subdirectories if the link count is more than 2. This results in a 100x speed up on my nnmh spool, and that's from an SSD disk, and not over nfs. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-04 00:36:13 +0000 +++ lisp/gnus/ChangeLog 2010-09-04 00:45:13 +0000 @@ -1,5 +1,15 @@ +2010-09-04 Lars Magne Ingebrigtsen + + * nnmh.el (nnmh-request-list-1): Optimize for speed. + 2010-09-03 Lars Magne Ingebrigtsen + * mm-util.el (mm-image-load-path): Just return the image directories, + not all directories in the path in addition to the image directories. + (mm-image-load-path): Maintain a cache of the image directories so that + the `g' command in Gnus doesn't have to stat dozens of directories each + time. + * gnus-html.el (gnus-html-put-image): Allow images to be removed. (gnus-html-wash-tags): Add a new `i' command to insert images. (gnus-html-insert-image): New command and keystroke. === modified file 'lisp/gnus/mm-util.el' --- lisp/gnus/mm-util.el 2010-09-02 00:55:51 +0000 +++ lisp/gnus/mm-util.el 2010-09-04 00:45:13 +0000 @@ -1429,16 +1429,23 @@ ;; Reset the umask. (set-default-file-modes umask))))) +(defvar mm-image-load-path-cache nil) + (defun mm-image-load-path (&optional package) - (let (dir result) - (dolist (path load-path (nreverse result)) - (when (and path - (file-directory-p - (setq dir (concat (file-name-directory - (directory-file-name path)) - "etc/images/" (or package "gnus/"))))) - (push dir result)) - (push path result)))) + (if (and mm-image-load-path-cache + (equal load-path (car mm-image-load-path-cache))) + (cdr mm-image-load-path-cache) + (let (dir result) + (dolist (path load-path) + (when (and path + (file-directory-p + (setq dir (concat (file-name-directory + (directory-file-name path)) + "etc/images/" (or package "gnus/"))))) + (push dir result))) + (setq result (nreverse result) + mm-image-load-path-cache (cons load-path result)) + result))) ;; Fixme: This doesn't look useful where it's used. (if (fboundp 'detect-coding-region) === modified file 'lisp/gnus/nnmh.el' --- lisp/gnus/nnmh.el 2010-09-02 01:42:32 +0000 +++ lisp/gnus/nnmh.el 2010-09-04 00:45:13 +0000 @@ -207,21 +207,29 @@ (defun nnmh-request-list-1 (dir) (setq dir (expand-file-name dir)) ;; Recurse down all directories. - (let ((dirs (and (file-readable-p dir) - (nnheader-directory-files dir t nil t))) - rdir) + (let ((files (nnheader-directory-files dir t nil t)) + (max 0) + min rdir attributes num) ;; Recurse down directories. - (while (setq rdir (pop dirs)) - (when (and (file-directory-p rdir) + (dolist (rdir files) + (setq attributes (file-attributes rdir)) + (when (null (nth 0 attributes)) + (setq file (file-name-nondirectory rdir)) + (when (string-match "^[0-9]+$" file) + (setq num (string-to-number file)) + (setq max (max max num)) + (when (or (null min) + (< num min)) + (setq min num)))) + (when (and (eq (nth 0 attributes) t) ; Is a directory + (> (nth 1 attributes) 2) ; Has sub-directories (file-readable-p rdir) (not (equal (file-truename rdir) (file-truename dir)))) - (nnmh-request-list-1 rdir)))) - ;; For each directory, generate an active file line. - (unless (string= (expand-file-name nnmh-toplev) dir) - (let ((files (mapcar 'string-to-number - (directory-files dir nil "^[0-9]+$" t)))) - (when files + (nnmh-request-list-1 rdir))) + ;; For each directory, generate an active file line. + (unless (string= (expand-file-name nnmh-toplev) dir) + (when min (with-current-buffer nntp-server-buffer (goto-char (point-max)) (insert @@ -233,14 +241,13 @@ (file-truename (file-name-as-directory (expand-file-name nnmh-toplev)))) dir) - (mm-string-to-multibyte ;Why? Isn't it multibyte already? + (mm-string-to-multibyte ;Why? Isn't it multibyte already? (mm-encode-coding-string (nnheader-replace-chars-in-string (substring dir (match-end 0)) ?/ ?.) nnmail-pathname-coding-system))) - (apply 'max files) - (apply 'min files))))))) + max min)))))) t) (deffoo nnmh-request-newgroups (date &optional server) ------------------------------------------------------------ revno: 101321 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-09-04 00:36:13 +0000 message: gnus-html.el: Remove more white space before image spacers; Decode entities at the end. So that entities inside the tags don't mess up the rest of the "parsing". diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-04 00:30:49 +0000 +++ lisp/gnus/ChangeLog 2010-09-04 00:36:13 +0000 @@ -5,6 +5,10 @@ (gnus-html-insert-image): New command and keystroke. (gnus-html-redisplay-with-images): New command and keystroke. (gnus-html-show-images): Renamed command. + (gnus-html-wash-tags): Remove more white space before image + spacers. + (gnus-html-wash-tags): Decode entities at the end, so that entities + inside the tags don't mess up the rest of the "parsing". * gnus-agent.el (gnus-agent-auto-agentize-methods): Change the default so that nnimap methods aren't agentized by default. There's apparently === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-09-04 00:30:49 +0000 +++ lisp/gnus/gnus-html.el 2010-09-04 00:36:13 +0000 @@ -113,7 +113,7 @@ (let (tag parameters string start end images url) (mm-url-decode-entities) (goto-char (point-min)) - (while (re-search-forward " *\n" nil t) + (while (re-search-forward " * *\n" nil t) (replace-match "" t t)) (goto-char (point-min)) (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t) ------------------------------------------------------------ revno: 101320 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-09-04 00:30:49 +0000 message: gnus-html.el: Add the new command gnus-html-show-images. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-09-02 10:17:02 +0000 +++ doc/misc/ChangeLog 2010-09-04 00:30:49 +0000 @@ -1,4 +1,9 @@ +2010-09-03 Lars Magne Ingebrigtsen + + * gnus.texi (Article Display): Document gnus-html-show-images. + 2010-09-02 Jan Djärv + * cl.texi (Basic Setf): Remove x-get-cut-buffer and x-get-cutbuffer. 2010-09-01 Lars Magne Ingebrigtsen === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2010-09-02 00:55:51 +0000 +++ doc/misc/gnus.texi 2010-09-04 00:30:49 +0000 @@ -10351,6 +10351,14 @@ Remove all images from the article buffer (@code{gnus-article-remove-images}). +@item W D W +@kindex W D W (Summary) +@findex gnus-html-show-images +If you're reading an @acronym{HTML} article rendered with +@code{gnus-article-html}, then you can insert any blocked images in +the buffer with this command. +(@code{gnus-html-show-images}). + @end table === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-04 00:21:34 +0000 +++ lisp/gnus/ChangeLog 2010-09-04 00:30:49 +0000 @@ -3,6 +3,8 @@ * gnus-html.el (gnus-html-put-image): Allow images to be removed. (gnus-html-wash-tags): Add a new `i' command to insert images. (gnus-html-insert-image): New command and keystroke. + (gnus-html-redisplay-with-images): New command and keystroke. + (gnus-html-show-images): Renamed command. * gnus-agent.el (gnus-agent-auto-agentize-methods): Change the default so that nnimap methods aren't agentized by default. There's apparently === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-09-04 00:26:18 +0000 +++ lisp/gnus/gnus-html.el 2010-09-04 00:30:49 +0000 @@ -362,6 +362,18 @@ url blocked-images)) ret)) +(defun gnus-html-show-images () + "Show any images that are in the HTML-rendered article buffer. +This only works if the article in question is HTML." + (interactive) + (gnus-with-article-buffer + (let ((overlays (overlays-in (point-min) (point-max))) + overlay images) + (while (setq overlay (pop overlays)) + (when (overlay-get overlay 'gnus-image) + (push (overlay-get overlay 'gnus-image) images))) + (gnus-html-schedule-image-fetching (current-buffer) images)))) + ;;;###autoload (defun gnus-html-prefetch-images (summary) (let (blocked-images urls) === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2010-09-02 03:35:06 +0000 +++ lisp/gnus/gnus-sum.el 2010-09-04 00:30:49 +0000 @@ -2110,6 +2110,7 @@ "d" gnus-article-display-face "s" gnus-treat-smiley "D" gnus-article-remove-images + "W" gnus-html-show-images "f" gnus-treat-from-picon "m" gnus-treat-mail-picon "n" gnus-treat-newsgroups-picon) ------------------------------------------------------------ revno: 101319 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-09-04 00:26:18 +0000 message: gnus-html.el: Fix up the logic that marks resized images for buffer deletion; Have the image insertion work even if the missing image is in an . diff: === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-09-04 00:21:34 +0000 +++ lisp/gnus/gnus-html.el 2010-09-04 00:26:18 +0000 @@ -161,11 +161,15 @@ :help-echo url :keymap gnus-html-image-map :button-keymap gnus-html-image-map) - (gnus-put-text-property - start end - 'gnus-image (list url - (set-marker (make-marker) start) - (set-marker (make-marker) end)))) + (let ((overlay (gnus-make-overlay start end)) + (spec (list url + (set-marker (make-marker) start) + (set-marker (make-marker) end)))) + (gnus-overlay-put overlay 'local-map gnus-html-image-map) + (gnus-overlay-put overlay 'gnus-image spec) + (gnus-put-text-property + start end + 'gnus-image spec))) (let ((file (gnus-html-image-id url)) width height) (when (string-match "height=\"?\\([0-9]+\\)" parameters) @@ -292,7 +296,8 @@ (= (car size) 30) (= (cdr size) 30)))) (progn - (gnus-put-image (gnus-html-rescale-image image file size) + (setq image (gnus-html-rescale-image image file size)) + (gnus-put-image image (gnus-string-or string "*") 'external) (gnus-add-image 'external image) ------------------------------------------------------------ revno: 101318 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-09-04 00:21:34 +0000 message: gnus-agent.el: Change the default so that nnimap methods aren't agentized by default. There's apparently many problems related to agent/imap behaviour; gnus-art.el: Don't reuse the 'gnus-data text property, but use a new property. This avoids stomping over other functions that use this for other things; gnus-html.el: Add a new `i' command to insert images. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-04 00:12:44 +0000 +++ lisp/gnus/ChangeLog 2010-09-04 00:21:34 +0000 @@ -1,5 +1,13 @@ 2010-09-03 Lars Magne Ingebrigtsen + * gnus-html.el (gnus-html-put-image): Allow images to be removed. + (gnus-html-wash-tags): Add a new `i' command to insert images. + (gnus-html-insert-image): New command and keystroke. + + * gnus-agent.el (gnus-agent-auto-agentize-methods): Change the default + so that nnimap methods aren't agentized by default. There's apparently + many problems related to agent/imap behaviour. + * gnus-art.el (gnus-article-copy-string): New command and key binding. * gnus-html.el: Doc fix. === modified file 'lisp/gnus/gnus-agent.el' --- lisp/gnus/gnus-agent.el 2010-09-02 03:39:33 +0000 +++ lisp/gnus/gnus-agent.el 2010-09-04 00:21:34 +0000 @@ -184,7 +184,7 @@ :type 'boolean :group 'gnus-agent) -(defcustom gnus-agent-auto-agentize-methods '(nntp nnimap) +(defcustom gnus-agent-auto-agentize-methods '(nntp) "Initially, all servers from these methods are agentized. The user may remove or add servers using the Server buffer. See Info node `(gnus)Server Buffer'." === modified file 'lisp/gnus/gnus-art.el' --- lisp/gnus/gnus-art.el 2010-09-04 00:12:44 +0000 +++ lisp/gnus/gnus-art.el 2010-09-04 00:21:34 +0000 @@ -7832,8 +7832,8 @@ 'gnus-button-push from) (gnus-put-text-property start end - 'gnus-data (buffer-substring-no-properties - start end)))))))))) + 'gnus-string (buffer-substring-no-properties + start end)))))))))) (defun gnus-article-extend-url-button (beg start end) "Extend url button if url is folded into two or more lines. @@ -7945,7 +7945,7 @@ "Copy the string in the button to the kill ring." (interactive) (gnus-article-check-buffer) - (let ((data (get-text-property (point) 'gnus-data))) + (let ((data (get-text-property (point) 'gnus-string))) (when data (with-temp-buffer (insert data) === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-09-04 00:12:44 +0000 +++ lisp/gnus/gnus-html.el 2010-09-04 00:21:34 +0000 @@ -66,6 +66,12 @@ :group 'gnus-art :type 'float) +(defvar gnus-html-image-map + (let ((map (make-sparse-keymap))) + (define-key map "u" 'gnus-article-copy-string) + (define-key map "i" 'gnus-html-insert-image) + map)) + ;;;###autoload (defun gnus-article-html (handle) (let ((article-buffer (current-buffer))) @@ -142,12 +148,24 @@ (delete-region start end) (gnus-put-image image (gnus-string-or string "*"))))) ;; Normal, external URL. - (unless (gnus-html-image-url-blocked-p - url - (if (buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - gnus-blocked-images) - gnus-blocked-images)) + (if (gnus-html-image-url-blocked-p + url + (if (buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-blocked-images) + gnus-blocked-images)) + (progn + (widget-convert-button + 'link start end + :action 'gnus-html-insert-image + :help-echo url + :keymap gnus-html-image-map + :button-keymap gnus-html-image-map) + (gnus-put-text-property + start end + 'gnus-image (list url + (set-marker (make-marker) start) + (set-marker (make-marker) end)))) (let ((file (gnus-html-image-id url)) width height) (when (string-match "height=\"?\\([0-9]+\\)" parameters) @@ -184,6 +202,7 @@ (let ((overlay (gnus-make-overlay start end))) (gnus-overlay-put overlay 'evaporate t) (gnus-overlay-put overlay 'gnus-button-url url) + (gnus-put-text-property start end 'gnus-string url) (when gnus-article-mouse-face (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))))) ;; The upper-case IMG_ALT is apparently just an artifact that @@ -202,6 +221,12 @@ (when images (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))))) +(defun gnus-html-insert-image () + "Fetch and insert the image under point." + (interactive) + (gnus-html-schedule-image-fetching + (current-buffer) (list (get-text-property (point) 'gnus-image)))) + (defun gnus-html-schedule-image-fetching (buffer images) (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s" buffer images) @@ -268,7 +293,9 @@ (= (cdr size) 30)))) (progn (gnus-put-image (gnus-html-rescale-image image file size) - (gnus-string-or string "*")) + (gnus-string-or string "*") + 'external) + (gnus-add-image 'external image) t) (insert string) (when (fboundp 'find-image) ------------------------------------------------------------ revno: 101317 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-09-04 00:12:44 +0000 message: gnus-html: Comment fix.; gnus-art.el: Provide an `u' command on urls and the like that copies the string over to the kill ring; Also have the `u' command work for HTML links. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-03 06:10:04 +0000 +++ lisp/gnus/ChangeLog 2010-09-04 00:12:44 +0000 @@ -1,3 +1,9 @@ +2010-09-03 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-copy-string): New command and key binding. + + * gnus-html.el: Doc fix. + 2010-09-03 Katsumi Yamaoka * gnus-html.el (gnus-html-put-image): Use gnus-graphic-display-p, === modified file 'lisp/gnus/gnus-art.el' --- lisp/gnus/gnus-art.el 2010-09-02 00:55:51 +0000 +++ lisp/gnus/gnus-art.el 2010-09-04 00:12:44 +0000 @@ -4823,6 +4823,22 @@ (vector (caddr c) (car c) :active t)) gnus-mime-button-commands))) +(defvar gnus-url-button-commands + '((gnus-article-copy-string "u" "Copy URL to kill ring"))) + +(defvar gnus-url-button-map + (let ((map (make-sparse-keymap))) + (dolist (c gnus-url-button-commands) + (define-key map (cadr c) (car c))) + map)) + +(easy-menu-define + gnus-url-button-menu gnus-url-button-map "URL button menu." + `("Url Button" + ,@(mapcar (lambda (c) + (vector (caddr c) (car c) :active t)) + gnus-url-button-commands))) + (defmacro gnus-bind-safe-url-regexp (&rest body) "Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'." `(let ((mm-w3m-safe-url-regexp @@ -7813,7 +7829,11 @@ (unless (and (eq (car entry) 'gnus-button-url-regexp) (gnus-article-extend-url-button from start end)) (gnus-article-add-button start end - 'gnus-button-push from))))))))) + 'gnus-button-push from) + (gnus-put-text-property + start end + 'gnus-data (buffer-substring-no-properties + start end)))))))))) (defun gnus-article-extend-url-button (beg start end) "Extend url button if url is folded into two or more lines. @@ -7918,8 +7938,19 @@ (and data (list 'gnus-data data)))) (widget-convert-button 'link from to :action 'gnus-widget-press-button :help-echo (or text "Follow the link") + :keymap gnus-url-button-map :button-keymap gnus-widget-button-keymap)) +(defun gnus-article-copy-string () + "Copy the string in the button to the kill ring." + (interactive) + (gnus-article-check-buffer) + (let ((data (get-text-property (point) 'gnus-data))) + (when data + (with-temp-buffer + (insert data) + (copy-region-as-kill (point-min) (point-max)))))) + ;;; Internal functions: (defun gnus-article-set-globals () === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-09-03 06:10:04 +0000 +++ lisp/gnus/gnus-html.el 2010-09-04 00:12:44 +0000 @@ -1,4 +1,4 @@ -;;; gnus-html.el --- Quoted-Printable functions +;;; gnus-html.el --- Render HTML in a buffer. ;; Copyright (C) 2010 Free Software Foundation, Inc. ------------------------------------------------------------ revno: 101316 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-09-04 00:04:48 +0000 message: Added a .dir-locals.el file so that trailing whitespace is shown. diff: === added file 'lisp/gnus/.dir-locals.el' --- lisp/gnus/.dir-locals.el 1970-01-01 00:00:00 +0000 +++ lisp/gnus/.dir-locals.el 2010-09-04 00:04:48 +0000 @@ -0,0 +1,1 @@ +((emacs-lisp-mode . ((show-trailing-whitespace . t)))) ------------------------------------------------------------ revno: 101315 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2010-09-03 15:28:09 +0200 message: Use SMIE's blink-paren for octave-mode. * lisp/progmodes/octave-mod.el (octave-font-lock-close-quotes): Backslashes do not escape single-quotes, single-quotes do. (octave-block-else-regexp, octave-block-end-regexp) (octave-block-match-alist): Remove. (octave-smie-bnf-table): New var, with old content. (octave-smie-op-levels): Use it. (octave-smie-closer-alist): New var. (octave-mode): Use it. Setup smie-blink-matching and electric-indent. (octave-blink-matching-block-open): Remove. (octave-reindent-then-newline-and-indent, octave-electric-semi) (octave-electric-space): Let self-insert-command run expand-abbrev and blink parens. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-09-03 13:06:51 +0000 +++ lisp/ChangeLog 2010-09-03 13:28:09 +0000 @@ -1,5 +1,19 @@ 2010-09-03 Stefan Monnier + Use SMIE's blink-paren for octave-mode. + * progmodes/octave-mod.el (octave-font-lock-close-quotes): + Backslashes do not escape single-quotes, single-quotes do. + (octave-block-else-regexp, octave-block-end-regexp) + (octave-block-match-alist): Remove. + (octave-smie-bnf-table): New var, with old content. + (octave-smie-op-levels): Use it. + (octave-smie-closer-alist): New var. + (octave-mode): Use it. Setup smie-blink-matching and electric-indent. + (octave-blink-matching-block-open): Remove. + (octave-reindent-then-newline-and-indent, octave-electric-semi) + (octave-electric-space): Let self-insert-command run expand-abbrev and + blink parens. + * electric.el (electricity): New group. (electric-indent-chars): New var. (electric-indent-post-self-insert-function): New fun. === modified file 'lisp/progmodes/octave-mod.el' --- lisp/progmodes/octave-mod.el 2010-08-31 12:13:51 +0000 +++ lisp/progmodes/octave-mod.el 2010-09-03 13:28:09 +0000 @@ -193,10 +193,19 @@ ((eq (nth 3 state) ?\') ;; A '..' string. (save-excursion - (when (and (or (looking-at "\\('\\)") - (re-search-forward "[^\\]\\(?:\\\\\\\\\\)*\\('\\)" - nil t)) - (not (eobp))) + (when (re-search-forward "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)[^']" + nil t) + (goto-char (1- (point))) + ;; Remove any syntax-table property we may have applied to + ;; some of the (doubled) single quotes within the string. + ;; Since these are the only chars on which we place properties, + ;; we take a shortcut and just remove all properties. + (remove-text-properties (1+ (nth 8 state)) (match-beginning 1) + '(syntax-table nil)) + (when (eq (char-before (match-beginning 1)) ?\\) + ;; Backslash cannot escape a single quote. + (put-text-property (1- (match-beginning 1)) (match-beginning 1) + 'syntax-table (string-to-syntax "."))) (put-text-property (match-beginning 1) (match-end 1) 'syntax-table (string-to-syntax "\"'")))))) @@ -342,29 +351,6 @@ :type 'integer :group 'octave) -(defvar octave-block-else-regexp - (concat "\\<\\(" - (mapconcat 'identity octave-else-keywords "\\|") - "\\)\\>")) -(defvar octave-block-end-regexp - (concat "\\<\\(" - (mapconcat 'identity octave-end-keywords "\\|") - "\\)\\>")) -(defvar octave-block-else-or-end-regexp - (concat octave-block-else-regexp "\\|" octave-block-end-regexp)) -(defvar octave-block-match-alist - '(("do" . ("until")) - ("for" . ("end" "endfor")) - ("function" . ("end" "endfunction")) - ("if" . ("else" "elseif" "end" "endif")) - ("switch" . ("case" "otherwise" "end" "endswitch")) - ("try" . ("catch" "end" "end_try_catch")) - ("unwind_protect" . ("unwind_protect_cleanup" "end" "end_unwind_protect")) - ("while" . ("end" "endwhile"))) - "Alist with Octave's matching block keywords. -Has Octave's begin keywords as keys and a list of the matching else or -end keywords as associated values.") - (defvar octave-block-comment-start (concat (make-string 2 octave-comment-char) " ") "String to insert to start a new Octave comment on an empty line.") @@ -435,43 +421,49 @@ ;; could be convenient to treat it as one. (assoc "..."))) +(defconst octave-smie-bnf-table + '((atom) + ;; We can't distinguish the first element in a sequence with + ;; precedence grammars, so we can't distinguish the condition + ;; if the `if' from the subsequent body, for example. + ;; This has to be done later in the indentation rules. + (exp (exp "\n" exp) + ;; We need to mention at least one of the operators in this part + ;; of the grammar: if the BNF and the operator table have + ;; no overlap, SMIE can't know how they relate. + (exp ";" exp) + ("try" exp "catch" exp "end_try_catch") + ("try" exp "catch" exp "end") + ("unwind_protect" exp + "unwind_protect_cleanup" exp "end_unwind_protect") + ("unwind_protect" exp "unwind_protect_cleanup" exp "end") + ("for" exp "endfor") + ("for" exp "end") + ("do" exp "until" atom) + ("while" exp "endwhile") + ("while" exp "end") + ("if" exp "endif") + ("if" exp "else" exp "endif") + ("if" exp "elseif" exp "else" exp "endif") + ("if" exp "elseif" exp "elseif" exp "else" exp "endif") + ("if" exp "elseif" exp "elseif" exp "else" exp "end") + ("switch" exp "case" exp "endswitch") + ("switch" exp "case" exp "otherwise" exp "endswitch") + ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch") + ("switch" exp "case" exp "case" exp "otherwise" exp "end") + ("function" exp "endfunction") + ("function" exp "end")) + ;; (fundesc (atom "=" atom)) + )) + +(defconst octave-smie-closer-alist + (smie-bnf-closer-alist octave-smie-bnf-table)) + (defconst octave-smie-op-levels (smie-prec2-levels (smie-merge-prec2s (smie-bnf-precedence-table - '((atom) - ;; We can't distinguish the first element in a sequence with - ;; precedence grammars, so we can't distinguish the condition - ;; if the `if' from the subsequent body, for example. - ;; This has to be done later in the indentation rules. - (exp (exp "\n" exp) - ;; We need to mention at least one of the operators in this part - ;; of the grammar: if the BNF and the operator table have - ;; no overlap, SMIE can't know how they relate. - (exp ";" exp) - ("try" exp "catch" exp "end_try_catch") - ("try" exp "catch" exp "end") - ("unwind_protect" exp - "unwind_protect_cleanup" exp "end_unwind_protect") - ("unwind_protect" exp "unwind_protect_cleanup" exp "end") - ("for" exp "endfor") - ("for" exp "end") - ("do" exp "until" atom) - ("while" exp "endwhile") - ("while" exp "end") - ("if" exp "endif") - ("if" exp "else" exp "endif") - ("if" exp "elseif" exp "else" exp "endif") - ("if" exp "elseif" exp "elseif" exp "else" exp "endif") - ("if" exp "elseif" exp "elseif" exp "else" exp "end") - ("switch" exp "case" exp "endswitch") - ("switch" exp "case" exp "otherwise" exp "endswitch") - ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch") - ("switch" exp "case" exp "case" exp "otherwise" exp "end") - ("function" exp "endfunction") - ("function" exp "end")) - ;; (fundesc (atom "=" atom)) - ) + octave-smie-bnf-table '((assoc "\n" ";"))) (smie-precs-precedence-table @@ -646,9 +638,28 @@ 'octave-smie-forward-token) (set (make-local-variable 'forward-sexp-function) 'smie-forward-sexp-command) - (set (make-local-variable 'smie-closer-alist) - (mapcar (lambda (elem) (cons (car elem) (car (last elem)))) - octave-block-match-alist)) + (set (make-local-variable 'smie-closer-alist) octave-smie-closer-alist) + ;; Only needed for interactive calls to blink-matching-open. + (set (make-local-variable 'blink-matching-check-function) + #'smie-blink-matching-check) + + (when octave-blink-matching-block + (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local) + (set (make-local-variable 'smie-blink-matching-triggers) + (append smie-blink-matching-triggers '(\;) + ;; Rather than wait for SPC or ; to blink, try to blink as + ;; soon as we type the last char of a block ender. + ;; But strip ?d from this list so that we don't blink twice + ;; when the user writes "endif" (once at "end" and another + ;; time at "endif"). + (delq ?d (delete-dups + (mapcar (lambda (kw) + (aref (cdr kw) (1- (length (cdr kw))))) + smie-closer-alist)))))) + + ;; FIXME: maybe we should use (cons ?\; electric-indent-chars) + ;; since only ; is really octave-specific. + (set (make-local-variable 'electric-indent-chars) '(?\; ?\s ?\n)) (set (make-local-variable 'comment-start) octave-comment-start) (set (make-local-variable 'comment-end) "") @@ -846,54 +857,6 @@ (backward-up-list 1)) (mark-sexp)) -(defun octave-blink-matching-block-open () - "Blink the matching Octave begin block keyword. -If point is right after an Octave else or end type block keyword, move -cursor momentarily to the corresponding begin keyword. -Signal an error if the keywords are incompatible." - (interactive) - (let (bb-keyword bb-arg eb-keyword pos eol) - (if (and (octave-not-in-string-or-comment-p) - (looking-at "\\>") - (save-excursion - (skip-syntax-backward "w") - (octave-looking-at-kw octave-block-else-or-end-regexp))) - (save-excursion - (cond - ((match-end 1) - (setq eb-keyword - (buffer-substring-no-properties - (match-beginning 1) (match-end 1))) - (backward-up-list 1)) - ((match-end 2) - (setq eb-keyword - (buffer-substring-no-properties - (match-beginning 2) (match-end 2))) - (backward-sexp 1))) - (setq pos (match-end 0) - bb-keyword - (buffer-substring-no-properties - (match-beginning 0) pos) - pos (+ pos 1) - eol (line-end-position) - bb-arg - (save-excursion - (save-restriction - (goto-char pos) - (while (and (skip-syntax-forward "^<" eol) - (octave-in-string-p) - (not (forward-char 1)))) - (skip-syntax-backward " ") - (buffer-substring-no-properties pos (point))))) - (if (member eb-keyword - (cdr (assoc bb-keyword octave-block-match-alist))) - (progn - (message "Matches `%s %s'" bb-keyword bb-arg) - (if (pos-visible-in-window-p) - (sit-for blink-matching-delay))) - (error "Block keywords `%s' and `%s' do not match" - bb-keyword eb-keyword)))))) - (defun octave-beginning-of-defun (&optional arg) "Move backward to the beginning of an Octave function. With positive ARG, do it that many times. Negative argument -N means @@ -1082,9 +1045,6 @@ If Abbrev mode is on, expand abbrevs first." ;; FIXME: None of this is Octave-specific. (interactive) - (if abbrev-mode (expand-abbrev)) - (if octave-blink-matching-block - (octave-blink-matching-block-open)) (reindent-then-newline-and-indent)) (defun octave-electric-semi () @@ -1093,14 +1053,12 @@ Reindent the line if `octave-auto-indent' is non-nil. Insert a newline if `octave-auto-newline' is non-nil." (interactive) + (setq last-command-event ?\;) (if (not (octave-not-in-string-or-comment-p)) - (insert ";") - (if abbrev-mode (expand-abbrev)) - (if octave-blink-matching-block - (octave-blink-matching-block-open)) + (self-insert-command 1) (if octave-auto-indent (indent-according-to-mode)) - (insert ";") + (self-insert-command 1) (if octave-auto-newline (newline-and-indent)))) @@ -1115,9 +1073,6 @@ (progn (indent-according-to-mode) (self-insert-command 1)) - (if abbrev-mode (expand-abbrev)) - (if octave-blink-matching-block - (octave-blink-matching-block-open)) (if (and octave-auto-indent (save-excursion (skip-syntax-backward " ") ------------------------------------------------------------ revno: 101314 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2010-09-03 15:06:51 +0200 message: * lisp/electric.el (electricity): New group. (electric-indent-chars): New var. (electric-indent-post-self-insert-function): New fun. (electric-indent-mode): New minor mode. (electric-pair-skip-self): New custom. (electric-pair-post-self-insert-function): New function. (electric-pair-mode): New minor mode. diff: === modified file 'etc/NEWS' --- etc/NEWS 2010-09-02 09:52:24 +0000 +++ etc/NEWS 2010-09-03 13:06:51 +0000 @@ -427,6 +427,8 @@ * New Modes and Packages in Emacs 24.1 +** New global minor modes electric-pair-mode and electric-indent-mode. + ** pcase.el provides the ML-style pattern matching macro `pcase'. ** smie.el is a package providing a simple generic indentation engine. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-09-03 11:26:08 +0000 +++ lisp/ChangeLog 2010-09-03 13:06:51 +0000 @@ -1,5 +1,13 @@ 2010-09-03 Stefan Monnier + * electric.el (electricity): New group. + (electric-indent-chars): New var. + (electric-indent-post-self-insert-function): New fun. + (electric-indent-mode): New minor mode. + (electric-pair-skip-self): New custom. + (electric-pair-post-self-insert-function): New function. + (electric-pair-mode): New minor mode. + * calc/calc-aent.el (calcAlg-blink-matching-check): New fun, to replace calcAlg-blink-matching-open. (calc-alg-ent-map, calc-alg-ent-esc-map): Initialize in the declaration. === modified file 'lisp/electric.el' --- lisp/electric.el 2010-05-08 00:20:30 +0000 +++ lisp/electric.el 2010-09-03 13:06:51 +0000 @@ -24,10 +24,23 @@ ;;; Commentary: -; zaaaaaaap +;; "Electric" has been used in Emacs to refer to different things. +;; Among them: +;; +;; - electric modes and buffers: modes that typically pop-up in a modal kind of +;; way a transient buffer that automatically disappears as soon as the user +;; is done with it. +;; +;; - electric keys: self inserting keys which additionally perform some side +;; operation which happens to be often convenient at that time. Examples of +;; such side operations are: reindenting code, inserting a newline, +;; ... auto-fill-mode and abbrev-mode can be considered as built-in forms of +;; electric key behavior. ;;; Code: +(eval-when-compile (require 'cl)) + ;; This loop is the guts for non-standard modes which retain control ;; until some event occurs. It is a `do-forever', the only way out is ;; to throw. It assumes that you have set up the keymap, window, and @@ -157,6 +170,131 @@ (fit-window-to-buffer win max-height)) win))) +;;; Electric keys. + +(defgroup electricity () + "Electric behavior for self inserting keys." + :group 'editing) + +;; Electric indentation. + +(defvar electric-indent-chars '(?\n) + "Characters that should cause automatic reindentation.") + +(defun electric-indent-post-self-insert-function () + ;; FIXME: This reindents the current line, but what we really want instead is + ;; to reindent the whole affected text. That's the current line for simple + ;; cases, but not all cases. We do take care of the newline case in an + ;; ad-hoc fashion, but there are still missing cases such as the case of + ;; electric-pair-mode wrapping a region with a pair of parens. + ;; There might be a way to get it working by analyzing buffer-undo-list, but + ;; it looks challenging. + (when (and (memq last-command-event electric-indent-chars) + ;; Don't reindent while inserting spaces at beginning of line. + (or (not (memq last-command-event '(?\s ?\t))) + (save-excursion (skip-chars-backward " \t") (not (bolp)))) + ;; Not in a string or comment. + (not (nth 8 (syntax-ppss)))) + ;; For newline, we want to reindent both lines and basically behave like + ;; reindent-then-newline-and-indent (whose code we hence copied). + (when (and (eq last-command-event ?\n) + ;; Sanity check. + (eq (char-before) last-command-event)) + (let ((pos (copy-marker (1- (point)) t))) + (save-excursion + (goto-char pos) + (indent-according-to-mode) + ;; We are at EOL before the call to indent-according-to-mode, and + ;; after it we usually are as well, but not always. We tried to + ;; address it with `save-excursion' but that uses a normal marker + ;; whereas we need `move after insertion', so we do the + ;; save/restore by hand. + (goto-char pos) + ;; Remove the trailing whitespace after indentation because + ;; indentation may (re)introduce the whitespace. + (delete-horizontal-space t)))) + (indent-according-to-mode))) + +;;;###autoload +(define-minor-mode electric-indent-mode + "Automatically reindent lines of code when inserting particular chars. +`electric-indent-chars' specifies the set of chars that should cause reindentation." + :global t + :group 'electricity + (if electric-indent-mode + (add-hook 'post-self-insert-hook + #'electric-indent-post-self-insert-function) + (remove-hook 'post-self-insert-hook + #'electric-indent-post-self-insert-function))) + +;; Electric pairing. + +(defcustom electric-pair-skip-self t + "If non-nil, skip char instead of inserting a second closing paren. +When inserting a closing paren character right before the same character, +just skip that character instead, so that hitting ( followed by ) results +in \"()\" rather than \"())\". +This can be convenient for people who find it easier to hit ) than C-f." + :type 'boolean) + +(defun electric-pair-post-self-insert-function () + (let* ((syntax (and (eq (char-before) last-command-event) ; Sanity check. + (char-syntax last-command-event))) + ;; FIXME: when inserting the closer, we should maybe use + ;; self-insert-command, although it may prove tricky running + ;; post-self-insert-hook recursively, and we wouldn't want to trigger + ;; blink-matching-open. + (closer (if (eq syntax ?\() + (cdr (aref (syntax-table) last-command-event)) + last-command-event))) + (cond + ;; Wrap a pair around the active region. + ((and (memq syntax '(?\( ?\" ?\$)) (use-region-p)) + (if (> (mark) (point)) + (goto-char (mark)) + ;; We already inserted the open-paren but at the end of the region, + ;; so we have to remove it and start over. + (delete-char -1) + (save-excursion + (goto-char (mark)) + (insert last-command-event))) + (insert closer)) + ;; Backslash-escaped: no pairing, no skipping. + ((save-excursion + (goto-char (1- (point))) + (not (zerop (% (skip-syntax-backward "\\") 2)))) + nil) + ;; Skip self. + ((and (memq syntax '(?\) ?\" ?\$)) + electric-pair-skip-self + (eq (char-after) last-command-event)) + ;; This is too late: rather than insert&delete we'd want to only skip (or + ;; insert in overwrite mode). The difference is in what goes in the + ;; undo-log and in the intermediate state which might be visible to other + ;; post-self-insert-hook. We'll just have to live with it for now. + (delete-char 1)) + ;; Insert matching pair. + ((not (or (not (memq syntax `(?\( ?\" ?\$))) + overwrite-mode + ;; I find it more often preferable not to pair when the + ;; same char is next. + (eq last-command-event (char-after)) + (eq last-command-event (char-before (1- (point)))) + ;; I also find it often preferable not to pair next to a word. + (eq (char-syntax (following-char)) ?w))) + (save-excursion (insert closer)))))) + +;;;###autoload +(define-minor-mode electric-pair-mode + "Automatically pair-up parens when inserting an open paren." + :global t + :group 'electricity + (if electric-pair-mode + (add-hook 'post-self-insert-hook + #'electric-pair-post-self-insert-function) + (remove-hook 'post-self-insert-hook + #'electric-pair-post-self-insert-function))) + (provide 'electric) ;; arch-tag: dae045eb-dc2d-4fb7-9f27-9cc2ce277be8 ------------------------------------------------------------ revno: 101313 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2010-09-03 13:26:08 +0200 message: * lisp/calc/calc-aent.el (calcAlg-blink-matching-check): New fun, to replace calcAlg-blink-matching-open. (calc-alg-ent-map, calc-alg-ent-esc-map): Initialize in the declaration. (calc-do-alg-entry): Only touch the part of the keymap that varies. Use the new blink-matching-check-function. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-09-03 11:18:45 +0000 +++ lisp/ChangeLog 2010-09-03 11:26:08 +0000 @@ -1,5 +1,11 @@ 2010-09-03 Stefan Monnier + * calc/calc-aent.el (calcAlg-blink-matching-check): New fun, to replace + calcAlg-blink-matching-open. + (calc-alg-ent-map, calc-alg-ent-esc-map): Initialize in the declaration. + (calc-do-alg-entry): Only touch the part of the keymap that varies. + Use the new blink-matching-check-function. + Provide blink-matching support to SMIE. * emacs-lisp/smie.el (smie-bnf-closer-alist): New function. (smie-blink-matching-triggers, smie-blink-matching-inners): New vars. === modified file 'lisp/calc/calc-aent.el' --- lisp/calc/calc-aent.el 2010-06-22 07:41:10 +0000 +++ lisp/calc/calc-aent.el 2010-09-03 11:26:08 +0000 @@ -315,10 +315,24 @@ calc-dollar-used 0))) (calc-handle-whys)))) -(defvar calc-alg-ent-map nil +(defvar calc-alg-ent-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "'" 'calcAlg-previous) + (define-key map "`" 'calcAlg-edit) + (define-key map "\C-m" 'calcAlg-enter) + (define-key map "\C-j" 'calcAlg-enter) + map) "The keymap used for algebraic entry.") -(defvar calc-alg-ent-esc-map nil +(defvar calc-alg-ent-esc-map + (let ((map (make-keymap)) + (i 33)) + (set-keymap-parent map esc-map) + (while (< i 127) + (define-key map (vector i) 'calcAlg-escape) + (setq i (1+ i))) + map) "The keymap used for escapes in algebraic entry.") (defvar calc-alg-exp) @@ -326,19 +340,8 @@ ;;;###autoload (defun calc-do-alg-entry (&optional initial prompt no-normalize history) (let* ((calc-buffer (current-buffer)) - (blink-paren-function 'calcAlg-blink-matching-open) + (blink-matching-check-function 'calcAlg-blink-matching-check) (calc-alg-exp 'error)) - (unless calc-alg-ent-map - (setq calc-alg-ent-map (copy-keymap minibuffer-local-map)) - (define-key calc-alg-ent-map "'" 'calcAlg-previous) - (define-key calc-alg-ent-map "`" 'calcAlg-edit) - (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter) - (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter) - (let ((i 33)) - (setq calc-alg-ent-esc-map (copy-keymap esc-map)) - (while (< i 127) - (aset (nth 1 calc-alg-ent-esc-map) i 'calcAlg-escape) - (setq i (1+ i))))) (define-key calc-alg-ent-map "\e" nil) (if (eq calc-algebraic-mode 'total) (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map) @@ -430,18 +433,9 @@ exp)) (exit-minibuffer)))) -(defun calcAlg-blink-matching-open () - (let ((rightpt (point)) - (leftpt nil) - (rightchar (preceding-char)) - leftchar - rightsyntax - leftsyntax) - (save-excursion - (condition-case () - (setq leftpt (scan-sexps rightpt -1) - leftchar (char-after leftpt)) - (error nil))) +(defun calcAlg-blink-matching-check (leftpt rightpt) + (let ((rightchar (char-before rightpt)) + (leftchar (if leftpt (char-after leftpt)))) (if (and leftpt (or (and (= rightchar ?\)) (= leftchar ?\[)) @@ -450,20 +444,9 @@ (save-excursion (goto-char leftpt) (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)"))) - (let ((leftsaved (aref (syntax-table) leftchar)) - (rightsaved (aref (syntax-table) rightchar))) - (unwind-protect - (progn - (cond ((= leftchar ?\[) - (aset (syntax-table) leftchar (cons 4 ?\))) - (aset (syntax-table) rightchar (cons 5 ?\[))) - (t - (aset (syntax-table) leftchar (cons 4 ?\])) - (aset (syntax-table) rightchar (cons 5 ?\()))) - (blink-matching-open)) - (aset (syntax-table) leftchar leftsaved) - (aset (syntax-table) rightchar rightsaved))) - (blink-matching-open)))) + ;; [2..5) perfectly valid! + nil + (blink-matching-check-mismatch leftpt rightpt)))) ;;;###autoload (defun calc-alg-digit-entry () ------------------------------------------------------------ revno: 101312 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2010-09-03 13:18:45 +0200 message: Provide blink-matching support to SMIE. * lisp/emacs-lisp/smie.el (smie-bnf-closer-alist): New function. (smie-blink-matching-triggers, smie-blink-matching-inners): New vars. (smie-blink-matching-check, smie-blink-matching-open): New functions. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-09-03 11:12:46 +0000 +++ lisp/ChangeLog 2010-09-03 11:18:45 +0000 @@ -1,5 +1,10 @@ 2010-09-03 Stefan Monnier + Provide blink-matching support to SMIE. + * emacs-lisp/smie.el (smie-bnf-closer-alist): New function. + (smie-blink-matching-triggers, smie-blink-matching-inners): New vars. + (smie-blink-matching-check, smie-blink-matching-open): New functions. + * simple.el (newline): Fix last change to properly remove itself from the hook. === modified file 'lisp/emacs-lisp/smie.el' --- lisp/emacs-lisp/smie.el 2010-08-31 12:22:40 +0000 +++ lisp/emacs-lisp/smie.el 2010-09-03 11:18:45 +0000 @@ -75,6 +75,26 @@ ;;; Building precedence level tables from BNF specs. +;; We have 4 different representations of a "grammar": +;; - a BNF table, which is a list of BNF rules of the form +;; (NONTERM RHS1 ... RHSn) where each RHS is a list of terminals (tokens) +;; or nonterminals. Any element in these lists which does not appear as +;; the `car' of a BNF rule is taken to be a terminal. +;; - A list of precedences (key word "precs"), is a list, sorted +;; from lowest to highest precedence, of precedence classes that +;; have the form (ASSOCIATIVITY TERMINAL1 .. TERMINALn), where +;; ASSOCIATIVITY can be `assoc', `left', `right' or `nonassoc'. +;; - a 2 dimensional precedence table (key word "prec2"), is a 2D +;; table recording the precedence relation (can be `<', `=', `>', or +;; nil) between each pair of tokens. +;; - a precedence-level table (key word "levels"), while is a alist +;; giving for each token its left and right precedence level (a +;; number or nil). This is used in `smie-op-levels'. +;; The prec2 tables are only intermediate data structures: the source +;; code normally provides a mix of BNF and precs tables, and then +;; turns them into a levels table, which is what's used by the rest of +;; the SMIE code. + (defun smie-set-prec2tab (table x y val &optional override) (assert (and x y)) (let* ((key (cons x y)) @@ -206,6 +226,87 @@ (setq rhs (cdr rhs))))) prec2)) +;; (defun smie-prec2-closer-alist (prec2 include-inners) +;; "Build a closer-alist from a PREC2 table. +;; The return value is in the same form as `smie-closer-alist'. +;; INCLUDE-INNERS if non-nil means that inner keywords will be included +;; in the table, e.g. the table will include things like (\"if\" . \"else\")." +;; (let* ((non-openers '()) +;; (non-closers '()) +;; ;; For each keyword, this gives the matching openers, if any. +;; (openers (make-hash-table :test 'equal)) +;; (closers '()) +;; (done nil)) +;; ;; First, find the non-openers and non-closers. +;; (maphash (lambda (k v) +;; (unless (or (eq v '<) (member (cdr k) non-openers)) +;; (push (cdr k) non-openers)) +;; (unless (or (eq v '>) (member (car k) non-closers)) +;; (push (car k) non-closers))) +;; prec2) +;; ;; Then find the openers and closers. +;; (maphash (lambda (k _) +;; (unless (member (car k) non-openers) +;; (puthash (car k) (list (car k)) openers)) +;; (unless (or (member (cdr k) non-closers) +;; (member (cdr k) closers)) +;; (push (cdr k) closers))) +;; prec2) +;; ;; Then collect the matching elements. +;; (while (not done) +;; (setq done t) +;; (maphash (lambda (k v) +;; (when (eq v '=) +;; (let ((aopeners (gethash (car k) openers)) +;; (dopeners (gethash (cdr k) openers)) +;; (new nil)) +;; (dolist (o aopeners) +;; (unless (member o dopeners) +;; (setq new t) +;; (push o dopeners))) +;; (when new +;; (setq done nil) +;; (puthash (cdr k) dopeners openers))))) +;; prec2)) +;; ;; Finally, dump the resulting table. +;; (let ((alist '())) +;; (maphash (lambda (k v) +;; (when (or include-inners (member k closers)) +;; (dolist (opener v) +;; (unless (equal opener k) +;; (push (cons opener k) alist))))) +;; openers) +;; alist))) + +(defun smie-bnf-closer-alist (bnf &optional no-inners) + ;; We can also build this closer-alist table from a prec2 table, + ;; but it takes more work, and the order is unpredictable, which + ;; is a problem for smie-close-block. + ;; More convenient would be to build it from a levels table since we + ;; always have this table (contrary to the BNF), but it has all the + ;; disadvantages of the prec2 case plus the disadvantage that the levels + ;; table has lost some info which would result in extra invalid pairs. + "Build a closer-alist from a BNF table. +The return value is in the same form as `smie-closer-alist'. +NO-INNERS if non-nil means that inner keywords will be excluded +from the table, e.g. the table will not include things like (\"if\" . \"else\")." + (let ((nts (mapcar #'car bnf)) ;non terminals. + (alist '())) + (dolist (nt bnf) + (dolist (rhs (cdr nt)) + (unless (or (< (length rhs) 2) (member (car rhs) nts)) + (if no-inners + (let ((last (car (last rhs)))) + (unless (member last nts) + (pushnew (cons (car rhs) last) alist :test #'equal))) + ;; Reverse so that the "real" closer gets there first, + ;; which is important for smie-close-block. + (dolist (term (reverse (cdr rhs))) + (unless (member term nts) + (pushnew (cons (car rhs) term) alist :test #'equal))))))) + (nreverse alist))) + + (defun smie-prec2-levels (prec2) ;; FIXME: Rather than only return an alist of precedence levels, we should ;; also extract other useful data from it: @@ -223,7 +324,7 @@ `smie-bnf-precedence-table'." ;; For each operator, we create two "variables" (corresponding to ;; the left and right precedence level), which are represented by - ;; cons cells. Those are the vary cons cells that appear in the + ;; cons cells. Those are the very cons cells that appear in the ;; final `table'. The value of each "variable" is kept in the `car'. (let ((table ()) (csts ()) @@ -596,6 +697,81 @@ pos end)))) (t))))))) +(defvar smie-blink-matching-triggers '(?\s ?\n) + "Chars which might trigger `blink-matching-open'. +These can include the final chars of end-tokens, or chars that are +typically inserted right after an end token. +I.e. a good choice can be: + (delete-dups + (mapcar (lambda (kw) (aref (cdr kw) (1- (length (cdr kw))))) + smie-closer-alist))") + +(defcustom smie-blink-matching-inners t + "Whether SMIE should blink to matching opener for inner keywords. +If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"." + :type 'boolean) + +(defun smie-blink-matching-check (start end) + (save-excursion + (goto-char end) + (let ((ender (funcall smie-backward-token-function))) + (cond + ((not (and ender (rassoc ender smie-closer-alist))) + ;; This not is one of the begin..end we know how to check. + (blink-matching-check-mismatch start end)) + ((not start) t) + (t + (goto-char start) + (let ((starter (funcall smie-forward-token-function))) + (not (member (cons starter ender) smie-closer-alist)))))))) + +(defun smie-blink-matching-open () + "Blink the matching opener when applicable. +This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'." + (when (and blink-matching-paren + smie-closer-alist ; Optimization. + (eq (char-before) last-command-event) ; Sanity check. + (memq last-command-event smie-blink-matching-triggers) + (save-excursion + ;; FIXME: Here we assume that closers all end + ;; with a word-syntax char. + (unless (eq ?\w (char-syntax last-command-event)) + (forward-char -1)) + (and (looking-at "\\>") + (not (nth 8 (syntax-ppss)))))) + (save-excursion + (let ((pos (point)) + (token (funcall smie-backward-token-function))) + (if (= 1 (length token)) + ;; The trigger char is itself a token but is not + ;; one of the closers (e.g. ?\; in Octave mode), + ;; so go back to the previous token + (setq token (save-excursion + (funcall smie-backward-token-function))) + (goto-char pos)) + ;; Here we assume that smie-backward-token-function + ;; returns a token that is a string and whose content + ;; match the buffer's representation of this token. + (when (and (> (length token) 1) (stringp token) + (memq (aref token (1- (length token))) + smie-blink-matching-triggers) + (not (eq (aref token (1- (length token))) + last-command-event))) + ;; Token ends with a trigger char, so don't blink for + ;; anything else than this trigger char, lest we'd blink + ;; both when inserting the trigger char and when inserting a + ;; subsequent SPC. + (setq token nil)) + (when (and (rassoc token smie-closer-alist) + (or smie-blink-matching-inners + (null (nth 2 (assoc token smie-op-levels))))) + ;; The major mode might set blink-matching-check-function + ;; buffer-locally so that interactive calls to + ;; blink-matching-open work right, but let's not presume + ;; that's the case. + (let ((blink-matching-check-function #'smie-blink-matching-check)) + (blink-matching-open))))))) + ;;; The indentation engine. (defcustom smie-indent-basic 4 ------------------------------------------------------------ revno: 101311 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2010-09-03 13:12:46 +0200 message: * lisp/simple.el (newline): Fix last change to properly remove itself from the hook. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-09-02 21:57:08 +0000 +++ lisp/ChangeLog 2010-09-03 11:12:46 +0000 @@ -1,3 +1,8 @@ +2010-09-03 Stefan Monnier + + * simple.el (newline): Fix last change to properly remove itself from + the hook. + 2010-09-02 Stefan Monnier * simple.el (newline): Eliminate optimization. === modified file 'lisp/simple.el' --- lisp/simple.el 2010-09-02 21:57:08 +0000 +++ lisp/simple.el 2010-09-03 11:12:46 +0000 @@ -457,38 +457,43 @@ than the value of `fill-column' and ARG is nil." (interactive "*P") (barf-if-buffer-read-only) - (let ((was-page-start (and (bolp) - (looking-at page-delimiter))) - (beforepos (point))) - ;; Call self-insert so that auto-fill, abbrev expansion etc. happens. - ;; Set last-command-event to tell self-insert what to insert. - (let ((last-command-event ?\n) - ;; Don't auto-fill if we have a numeric argument. - (auto-fill-function (if arg nil auto-fill-function)) - (post-self-insert-hook post-self-insert-hook)) - ;; Do the rest in post-self-insert-hook, because we want to do it - ;; *before* other functions on that hook. - (add-hook 'post-self-insert-hook - (lambda () - ;; Mark the newline(s) `hard'. - (if use-hard-newlines - (set-hard-newline-properties - (- (point) (prefix-numeric-value arg)) (point))) - ;; If the newline leaves the previous line blank, and we - ;; have a left margin, delete that from the blank line. - (save-excursion - (goto-char beforepos) - (beginning-of-line) - (and (looking-at "[ \t]$") - (> (current-left-margin) 0) - (delete-region (point) - (line-end-position)))) - ;; Indent the line after the newline, except in one case: - ;; when we added the newline at the beginning of a line which - ;; starts a page. - (or was-page-start - (move-to-left-margin nil t)))) - (self-insert-command (prefix-numeric-value arg)))) + ;; Call self-insert so that auto-fill, abbrev expansion etc. happens. + ;; Set last-command-event to tell self-insert what to insert. + (let* ((was-page-start (and (bolp) (looking-at page-delimiter))) + (beforepos (point)) + (last-command-event ?\n) + ;; Don't auto-fill if we have a numeric argument. + (auto-fill-function (if arg nil auto-fill-function)) + (postproc + ;; Do the rest in post-self-insert-hook, because we want to do it + ;; *before* other functions on that hook. + (lambda () + ;; Mark the newline(s) `hard'. + (if use-hard-newlines + (set-hard-newline-properties + (- (point) (prefix-numeric-value arg)) (point))) + ;; If the newline leaves the previous line blank, and we + ;; have a left margin, delete that from the blank line. + (save-excursion + (goto-char beforepos) + (beginning-of-line) + (and (looking-at "[ \t]$") + (> (current-left-margin) 0) + (delete-region (point) + (line-end-position)))) + ;; Indent the line after the newline, except in one case: + ;; when we added the newline at the beginning of a line which + ;; starts a page. + (or was-page-start + (move-to-left-margin nil t))))) + (unwind-protect + (progn + (add-hook 'post-self-insert-hook postproc) + (self-insert-command (prefix-numeric-value arg))) + ;; We first used let-binding to protect the hook, but that was naive + ;; since add-hook affects the symbol-default value of the variable, + ;; whereas the let-binding might only protect the buffer-local value. + (remove-hook 'post-self-insert-hook postproc))) nil) (defun set-hard-newline-properties (from to) ------------------------------------------------------------ revno: 101310 committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2010-09-03 06:10:04 +0000 message: gnus-html.el (gnus-html-put-image): make avoidance of displaying small images work for XEmacs. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-03 02:29:03 +0000 +++ lisp/gnus/ChangeLog 2010-09-03 06:10:04 +0000 @@ -2,7 +2,7 @@ * gnus-html.el (gnus-html-put-image): Use gnus-graphic-display-p, glyph-width and glyph-height instead of display-graphic-p and - image-size for XEmacs. + image-size; make avoidance of displaying small images work for XEmacs. * gnus-util.el (gnus-graphic-display-p): Use device-on-window-system-p for XEmacs. === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-09-03 02:29:03 +0000 +++ lisp/gnus/gnus-html.el 2010-09-03 06:10:04 +0000 @@ -254,8 +254,16 @@ (if (and image ;; Kludge to avoid displaying 30x30 gif images, which ;; seems to be a signal of a broken image. - (not (and (listp image) - (eq (plist-get (cdr image) :type) 'gif) + (not (and (if (featurep 'xemacs) + (glyphp image) + (listp image)) + (eq (if (featurep 'xemacs) + (let ((data (cdadar (specifier-spec-list + (glyph-image image))))) + (and (vectorp data) + (aref data 0))) + (plist-get (cdr image) :type)) + 'gif) (= (car size) 30) (= (cdr size) 30)))) (progn