Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 102155. ------------------------------------------------------------ revno: 102155 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-10-30 05:59:34 +0000 message: Merge changes made in Gnus trunk. gnus.el: Remove `gnus-nntp-service' variable. gnus.el: Make gnus-nntp-server and gnus-secondary-servers obsolete. gnus-sum.el (gnus-summary-delete-marked-as-read, gnus-summary-delete-marked-with): Remove obsolete defalias. gnus.el (gnus-use-long-file-name): Fix docstring. nnimap.el (nnimap-open-connection): Use AUTHENTICATE PLAIN on servers that say they support that. gnus-msg.el (gnus-inews-do-gcc): Don't have the backends do the slow *-request-group, which seems unnecessary. gnus-group.el (gnus-group-get-new-news-this-group): Don't have point move to the previous line on `M-g'. nnimap.el (nnimap-split-incoming-mail): Note that the INBOX has been selected. nnimap.el: Allow the user to say whether to split old messages or not in nnimap. shr.el (shr-tag-table-1): Only insert the images after the top-level table. shr.el (shr-tag-span): Drop colorisation of regions since we don't control the background color. shr.el (shr-tag-img): Ignore very small web bug type images. shr.el (shr-put-image): Add help-echo alt texts to the images. shr.el (shr-tag-video): Show the video poster image. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-10-29 10:49:27 +0000 +++ doc/misc/ChangeLog 2010-10-30 05:59:34 +0000 @@ -1,3 +1,13 @@ +2010-10-29 Lars Magne Ingebrigtsen + + * gnus.texi (Client-Side IMAP Splitting): Mention + nnimap-unsplittable-articles. + +2010-10-29 Julien Danjou + + * gnus.texi (Finding the News): Remove references to obsoletes + variables `gnus-nntp-server' and `gnus-secondary-servers'. + 2010-10-29 Eli Zaretskii * makefile.w32-in (MAKEINFO): Add -I$(emacsdir). @@ -19,7 +29,7 @@ 2010-10-24 Jay Belanger - * calc.texi: Use emacsver.texi to determine Emacs version. + * calc.texi: Use emacsver.texi to determine Emacs version. 2010-10-24 Juanma Barranquero === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2010-10-27 22:08:36 +0000 +++ doc/misc/gnus.texi 2010-10-30 05:59:34 +0000 @@ -1020,22 +1020,6 @@ If that fails as well, Gnus will try to use the machine running Emacs as an @acronym{NNTP} server. That's a long shot, though. -@vindex gnus-nntp-server -If @code{gnus-nntp-server} is set, this variable will override -@code{gnus-select-method}. You should therefore set -@code{gnus-nntp-server} to @code{nil}, which is what it is by default. - -@vindex gnus-secondary-servers -@vindex gnus-nntp-server -You can also make Gnus prompt you interactively for the name of an -@acronym{NNTP} server. If you give a non-numerical prefix to @code{gnus} -(i.e., @kbd{C-u M-x gnus}), Gnus will let you choose between the servers -in the @code{gnus-secondary-servers} list (if any). You can also just -type in the name of any server you feel like visiting. (Note that this -will set @code{gnus-nntp-server}, which means that if you then @kbd{M-x -gnus} later in the same Emacs session, Gnus will contact the same -server.) - @findex gnus-group-browse-foreign-server @kindex B (Group) However, if you use one @acronym{NNTP} server regularly and are just @@ -14945,6 +14929,11 @@ @item nnimap-split-fancy Uses the same syntax as @code{nnmail-split-fancy}. +@item nnimap-unsplittable-articles +List of flag symbols to ignore when doing splitting. That is, +articles that have these flags won't be considered when splitting. +The default is @samp{(%Deleted %Seen)}. + @end table @@ -30102,11 +30091,11 @@ (setq gnus-read-active-file 'some) @end lisp -On the other hand, if the manual says ``set @code{gnus-nntp-server} to -@samp{nntp.ifi.uio.no}'', that means: +On the other hand, if the manual says ``set @code{gnus-nntp-server-file} to +@samp{/etc/nntpserver}'', that means: @lisp -(setq gnus-nntp-server "nntp.ifi.uio.no") +(setq gnus-nntp-server-file "/etc/nntpserver") @end lisp So be careful not to mix up strings (the latter) with symbols (the === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-10-29 13:51:15 +0000 +++ lisp/gnus/ChangeLog 2010-10-30 05:59:34 +0000 @@ -1,5 +1,50 @@ +2010-10-30 Lars Magne Ingebrigtsen + + * shr.el (shr-tag-span): Drop colorisation of regions since we don't + control the background color. + (shr-tag-img): Ignore very small web bug type images. + (shr-put-image): Add help-echo alt texts to the images. + (shr-tag-video): Show the video poster image. + +2010-10-29 Lars Magne Ingebrigtsen + + * shr.el (shr-table-depth): New variable. + (shr-tag-table-1): Only insert the images after the top-level table. + + * nnimap.el (nnimap-split-incoming-mail): Fix typo. + + * gnus-util.el (gnus-list-memq-of-list): New function. + + * nnimap.el (nnimap-split-incoming-mail): Note that the INBOX has been + selected. + (nnimap-unsplittable-articles): New slot. + (nnimap-new-articles): Use it. + +2010-10-29 Stephen Berman (tiny change) + + * gnus-group.el (gnus-group-get-new-news-this-group): Don't have point + move to the previous line on `M-g'. + +2010-10-29 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-inews-do-gcc): Don't have the backends do the slow + *-request-group, which seems unnecessary. + + * nnimap.el (nnimap-quote-specials): Function copied over from + imap.el. + (nnimap-open-connection): Use AUTHENTICATE PLAIN on servers that say + they support that. Suggested by Tom Regner. + 2010-10-29 Julien Danjou + * gnus-sum.el (gnus-summary-delete-marked-as-read): Remove obsolete + defalias. + (gnus-summary-delete-marked-with): Remove obsolete defalias. + + * gnus.el: Remove `gnus-nntp-service' variable. + (gnus-secondary-servers): Make obsolete. + (gnus-nntp-server): Make obsolete. + * gnus-start.el (gnus-1): Remove x-splash calls. * gnus-ems.el (gnus-x-splash): Remove. === modified file 'lisp/gnus/gnus-group.el' --- lisp/gnus/gnus-group.el 2010-10-29 11:24:23 +0000 +++ lisp/gnus/gnus-group.el 2010-10-30 05:59:34 +0000 @@ -3988,7 +3988,7 @@ (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) (beg (unless n - (point))) + (point-marker))) group method (gnus-inhibit-demon t) ;; Binding this variable will inhibit multiple fetchings === modified file 'lisp/gnus/gnus-int.el' --- lisp/gnus/gnus-int.el 2010-10-24 22:32:38 +0000 +++ lisp/gnus/gnus-int.el 2010-10-30 05:59:34 +0000 @@ -100,8 +100,6 @@ ;; Stream is already opened. nil ;; Open NNTP server. - (unless gnus-nntp-service - (setq gnus-nntp-server nil)) (when confirm ;; Read server name with completion. (setq gnus-nntp-server === modified file 'lisp/gnus/gnus-msg.el' --- lisp/gnus/gnus-msg.el 2010-10-08 23:55:33 +0000 +++ lisp/gnus/gnus-msg.el 2010-10-30 05:59:34 +0000 @@ -1628,7 +1628,7 @@ (unless (gnus-check-server method) (error "Can't open server %s" (if (stringp method) method (car method)))) - (unless (gnus-request-group group nil method) + (unless (gnus-request-group group t method) (gnus-request-create-group group method)) (setq mml-externalize-attachments (if (stringp gnus-gcc-externalize-attachments) === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2010-10-28 22:03:15 +0000 +++ lisp/gnus/gnus-sum.el 2010-10-30 05:59:34 +0000 @@ -8303,10 +8303,6 @@ (gnus-summary-limit articles)) (gnus-summary-position-point)) -(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) -(make-obsolete - 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread "Emacs 20.4") - (defun gnus-summary-limit-to-unread (&optional all) "Limit the summary buffer to articles that are not marked as read. If ALL is non-nil, limit strictly to unread articles." @@ -8397,10 +8393,6 @@ (gnus-summary-limit gnus-newsgroup-replied)) (gnus-summary-position-point)) -(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) -(make-obsolete 'gnus-summary-delete-marked-with - 'gnus-summary-limit-exclude-marks "Emacs 20.4") - (defun gnus-summary-limit-exclude-marks (marks &optional reverse) "Exclude articles that are marked with MARKS (e.g. \"DK\"). If REVERSE, limit the summary buffer to articles that are marked === modified file 'lisp/gnus/gnus-util.el' --- lisp/gnus/gnus-util.el 2010-10-25 22:02:00 +0000 +++ lisp/gnus/gnus-util.el 2010-10-30 05:59:34 +0000 @@ -1974,6 +1974,14 @@ image))) image))) +(defun gnus-list-memq-of-list (elements list) + "Return non-nil if any of the members of ELEMENTS are in LIST." + (let ((found nil)) + (dolist (elem elements) + (setq found (or found + (memq elem list)))) + found)) + (provide 'gnus-util) ;;; gnus-util.el ends here === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2010-10-29 13:51:15 +0000 +++ lisp/gnus/gnus.el 2010-10-30 05:59:34 +0000 @@ -1256,15 +1256,6 @@ If you want to change servers, you should use `gnus-select-method'. See the documentation to that variable.") -;; Don't touch this variable. -(defvar gnus-nntp-service "nntp" - "NNTP service name (\"nntp\" or 119). -This is an obsolete variable, which is scarcely used. If you use an -nntp server for your newsgroup and want to change the port number -used to 899, you would say something along these lines: - - (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") - (defcustom gnus-nntpserver-file "/etc/nntpserver" "A file with only the name of the nntp server in it." :group 'gnus-files @@ -1288,20 +1279,11 @@ ;;;###autoload (custom-autoload 'gnus-select-method "gnus")) (defcustom gnus-select-method - (condition-case nil - (nconc - (list 'nntp (or (condition-case nil - (gnus-getenv-nntpserver) - (error nil)) - (when (and gnus-default-nntp-server - (not (string= gnus-default-nntp-server ""))) - gnus-default-nntp-server) - "news")) - (if (or (null gnus-nntp-service) - (equal gnus-nntp-service "nntp")) - nil - (list gnus-nntp-service))) - (error nil)) + (list 'nntp (or (gnus-getenv-nntpserver) + (when (and gnus-default-nntp-server + (not (string= gnus-default-nntp-server ""))) + gnus-default-nntp-server) + "news")) "Default method for selecting a newsgroup. This variable should be a list, where the first element is how the news is to be fetched, the second is the address. @@ -1386,14 +1368,14 @@ non-numeric prefix - `C-u M-x gnus', in short." :group 'gnus-server :type '(repeat string)) +(make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1") (defcustom gnus-nntp-server nil - "*The name of the host running the NNTP server. -This variable is semi-obsolete. Use the `gnus-select-method' -variable instead." + "The name of the host running the NNTP server." :group 'gnus-server :type '(choice (const :tag "disable" nil) string)) +(make-obsolete-variable 'gnus-nntp-server 'gnus-select-method "24.1") (defcustom gnus-secondary-select-methods nil "A list of secondary methods that will be used for reading news. @@ -1492,7 +1474,7 @@ integer)) (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v))) - "*Non-nil means that the default name of a file to save articles in is the group name. + "Non-nil means that the default name of a file to save articles in is the group name. If it's nil, the directory form of the group name is used instead. If this variable is a list, and the list contains the element @@ -1502,8 +1484,8 @@ will not be used for kill files. Note that the default for this variable varies according to what system -type you're using. On `usg-unix-v' and `xenix' this variable defaults -to nil while on all other systems it defaults to t." +type you're using. On `usg-unix-v' this variable defaults to nil while +on all other systems it defaults to t." :group 'gnus-start :type '(radio (sexp :format "Non-nil\n" :match (lambda (widget value) === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2010-10-27 08:07:41 +0000 +++ lisp/gnus/nnimap.el 2010-10-30 05:59:34 +0000 @@ -78,6 +78,9 @@ (defvoo nnimap-split-fancy nil "Uses the same syntax as nnmail-split-fancy.") +(defvoo nnimap-unsplittable-articles '(%Deleted %Seen) + "Articles with the flags in the list will not be considered when splitting.") + (make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'" "Emacs 24.1") @@ -412,9 +415,18 @@ ;; physical address. (nnimap-credentials nnimap-address ports))))) (setq nnimap-object nil) - (setq login-result (nnimap-command "LOGIN %S %S" - (car credentials) - (cadr credentials))) + (setq login-result + (if (member "AUTH=PLAIN" + (nnimap-capabilities nnimap-object)) + (nnimap-command + "AUTHENTICATE PLAIN %s" + (base64-encode-string + (format "\000%s\000%s" + (nnimap-quote-specials (car credentials)) + (nnimap-quote-specials (cadr credentials))))) + (nnimap-command "LOGIN %S %S" + (car credentials) + (cadr credentials)))) (unless (car login-result) ;; If the login failed, then forget the credentials ;; that are now possibly cached. @@ -431,6 +443,16 @@ (nnimap-command "ENABLE QRESYNC")) (nnimap-process nnimap-object)))))))) +(defun nnimap-quote-specials (string) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (re-search-forward "[\\\"]" nil t) + (forward-char -1) + (insert "\\") + (forward-char 1)) + (buffer-string))) + (defun nnimap-find-parameter (parameter elems) (let (result) (dolist (elem elems) @@ -1593,6 +1615,7 @@ new-articles) (erase-buffer) (nnimap-command "SELECT %S" nnimap-inbox) + (setf (nnimap-group nnimap-object) nnimap-inbox) (setq new-articles (nnimap-new-articles (nnimap-get-flags "1:*"))) (when new-articles (nnimap-fetch-inbox new-articles) @@ -1665,9 +1688,8 @@ (defun nnimap-new-articles (flags) (let (new) (dolist (elem flags) - (when (or (null (cdr elem)) - (and (not (memq '%Deleted (cdr elem))) - (not (memq '%Seen (cdr elem))))) + (unless (gnus-list-memq-of-list nnimap-unsplittable-articles + (cdr elem)) (push (car elem) new))) (gnus-compress-sequence (nreverse new)))) === modified file 'lisp/gnus/shr.el' --- lisp/gnus/shr.el 2010-10-28 12:45:51 +0000 +++ lisp/gnus/shr.el 2010-10-30 05:59:34 +0000 @@ -90,6 +90,7 @@ (defvar shr-list-mode nil) (defvar shr-content-cache nil) (defvar shr-kinsoku-shorten nil) +(defvar shr-table-depth 0) (defvar shr-map (let ((map (make-sparse-keymap))) @@ -369,18 +370,17 @@ (let ((alt (buffer-substring start end)) (inhibit-read-only t)) (delete-region start end) - (shr-put-image data start alt)))))) + (goto-char start) + (shr-put-image data alt)))))) (kill-buffer (current-buffer))) -(defun shr-put-image (data point alt) +(defun shr-put-image (data alt) (if (display-graphic-p) (let ((image (ignore-errors (shr-rescale-image data)))) (when image - (put-image image point alt))) - (save-excursion - (goto-char point) - (insert alt)))) + (insert-image image (or alt "*")))) + (insert alt))) (defun shr-rescale-image (data) (if (or (not (fboundp 'imagemagick-types)) @@ -470,14 +470,6 @@ (defun shr-tag-s (cont) (shr-fontize-cont cont 'strike-through)) -(defun shr-tag-span (cont) - (let ((start (point)) - (color (cdr (assq 'color (shr-parse-style (cdr (assq :style cont))))))) - (shr-generic cont) - (when color - (let ((overlay (make-overlay start (point)))) - (overlay-put overlay 'face (cons 'foreground-color color)))))) - (defun shr-parse-style (style) (when style (let ((plist nil)) @@ -501,24 +493,43 @@ (shr-urlify (or shr-start start) url))) (defun shr-tag-object (cont) - (let ((url (cdr (assq :src (cdr (assq 'embed cont))))) - (start (point))) + (let ((start (point)) + url) + (dolist (elem cont) + (when (eq (car elem) 'embed) + (setq url (or url (cdr (assq :src (cdr elem)))))) + (when (and (eq (car elem) 'param) + (equal (cdr (assq :name (cdr elem))) "movie")) + (setq url (or url (cdr (assq :value (cdr elem))))))) (when url (shr-insert " [multimedia] ") - (shr-urlify start url)))) - -(defun shr-tag-img (cont) - (when (and cont - (cdr (assq :src cont))) + (shr-urlify start url)) + (shr-generic cont))) + +(defun shr-tag-video (cont) + (let ((image (cdr (assq :poster cont))) + (url (cdr (assq :src cont))) + (start (point))) + (shr-tag-img nil image) + (shr-urlify start url))) + +(defun shr-tag-img (cont &optional url) + (when (or url + (and cont + (cdr (assq :src cont)))) (when (and (> (current-column) 0) (not (eq shr-state 'image))) (insert "\n")) (let ((alt (cdr (assq :alt cont))) - (url (cdr (assq :src cont)))) + (url (or url (cdr (assq :src cont))))) (let ((start (point-marker))) (when (zerop (length alt)) (setq alt "[img]")) (cond + ((or (member (cdr (assq :height cont)) '("0" "1")) + (member (cdr (assq :width cont)) '("0" "1"))) + ;; Ignore zero-sized or single-pixel images. + ) ((and (not shr-inhibit-images) (string-match "\\`cid:" url)) (let ((url (substring url (match-end 0))) @@ -526,7 +537,7 @@ (if (or (not shr-content-function) (not (setq image (funcall shr-content-function url)))) (insert alt) - (shr-put-image image (point) alt)))) + (shr-put-image image alt)))) ((or shr-inhibit-images (and shr-blocked-images (string-match shr-blocked-images url))) @@ -536,17 +547,17 @@ (shr-insert (substring alt 0 8)) (shr-insert alt)))) ((url-is-cached (shr-encode-url url)) - (shr-put-image (shr-get-image-data url) (point) alt)) + (shr-put-image (shr-get-image-data url) alt)) (t (insert alt) (ignore-errors (url-retrieve (shr-encode-url url) 'shr-image-fetched (list (current-buffer) start (point-marker)) t)))) - (insert " ") (put-text-property start (point) 'keymap shr-map) (put-text-property start (point) 'shr-alt alt) (put-text-property start (point) 'shr-image url) + (put-text-property start (point) 'help-echo alt) (setq shr-state 'image))))) (defun shr-tag-pre (cont) @@ -630,6 +641,7 @@ (setq cont (or (cdr (assq 'tbody cont)) cont)) (let* ((shr-inhibit-images t) + (shr-table-depth (1+ shr-table-depth)) (shr-kinsoku-shorten t) ;; Find all suggested widths. (columns (shr-column-specs cont)) @@ -651,8 +663,9 @@ ;; Finally, insert all the images after the table. The Emacs buffer ;; model isn't strong enough to allow us to put the images actually ;; into the tables. - (dolist (elem (shr-find-elements cont 'img)) - (shr-tag-img (cdr elem)))) + (when (zerop shr-table-depth) + (dolist (elem (shr-find-elements cont 'img)) + (shr-tag-img (cdr elem))))) (defun shr-tag-table (cont) (shr-ensure-paragraph) ------------------------------------------------------------ revno: 102154 committer: Glenn Morris branch nick: trunk timestamp: Fri 2010-10-29 19:27:44 -0700 message: Fix bug#7306; customization of minor-mode variables defined in C. * lisp/cus-start.el: Add :set properties for minor modes menu-bar-mode, tool-bar-mode, transient-mark-mode. Include the :set property in the dumped Emacs. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-10-29 19:20:28 +0000 +++ lisp/ChangeLog 2010-10-30 02:27:44 +0000 @@ -1,3 +1,9 @@ +2010-10-30 Glenn Morris + + * cus-start.el: Add :set properties for minor modes menu-bar-mode, + tool-bar-mode, transient-mark-mode. (Bug#7306) + Include the :set property in the dumped Emacs. + 2010-10-29 Stefan Monnier SMIE: change indent rules format, improve smie-setup. === modified file 'lisp/cus-start.el' --- lisp/cus-start.el 2010-10-29 06:51:36 +0000 +++ lisp/cus-start.el 2010-10-30 02:27:44 +0000 @@ -1,7 +1,7 @@ ;;; cus-start.el --- define customization properties of builtins ;; -;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: internal @@ -103,7 +103,8 @@ (force-mode-line-update t))) (transient-mark-mode editing-basics boolean nil (not noninteractive) - :initialize custom-initialize-delay) + :initialize custom-initialize-delay + :set custom-set-minor-mode) ;; callint.c (mark-even-if-inactive editing-basics boolean) ;; callproc.c @@ -217,8 +218,13 @@ (other :tag "hidden by keypress" 1)) "22.1") (make-pointer-invisible mouse boolean "23.2") - (menu-bar-mode frames boolean) - (tool-bar-mode (frames mouse) boolean) + (menu-bar-mode frames boolean nil t + ;; FIXME? +; :initialize custom-initialize-default + :set custom-set-minor-mode) + (tool-bar-mode (frames mouse) boolean nil t +; :initialize custom-initialize-default + :set custom-set-minor-mode) ;; fringe.c (overflow-newline-into-fringe fringe boolean) ;; indent.c @@ -486,11 +492,14 @@ (put symbol 'safe-local-variable (cadr prop))) (if (setq prop (memq :risky rest)) (put symbol 'risky-local-variable (cadr prop))) + (if (setq prop (memq :set rest)) + (put symbol 'custom-set (cadr prop))) ;; Note this is the _only_ initialize property we handle. (if (eq (cadr (memq :initialize rest)) 'custom-initialize-delay) (push symbol custom-delayed-init-variables)) - ;; If this is NOT while dumping Emacs, - ;; set up the rest of the customization info. + ;; If this is NOT while dumping Emacs, set up the rest of the + ;; customization info. This is the stuff that is not needed + ;; until someone does M-x customize etc. (unless purify-flag ;; Add it to the right group(s). (if (listp group) @@ -504,9 +513,7 @@ (setq prop (car rest) propval (cadr rest) rest (nthcdr 2 rest)) - (cond ((memq prop '(:risky :safe))) ; handled above - ((eq prop :set) - (put symbol 'custom-set propval)) + (cond ((memq prop '(:risky :safe :set))) ; handled above ((eq prop :tag) (put symbol 'custom-tag propval)))))))) ------------------------------------------------------------ revno: 102153 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2010-10-29 15:20:28 -0400 message: SMIE: change indent rules format, improve smie-setup. * lisp/emacs-lisp/smie.el (smie-precs-precedence-table) (smie-merge-prec2s, smie-bnf-precedence-table, smie-prec2-levels): Mark them pure so the tables gets built at compile time. (smie-bnf-precedence-table): Store the closer-alist in the table. (smie-prec2-levels): Preserve the closer-alist. (smie-blink-matching-open): Be more forgiving in case of indentation. (smie-hanging-p): Rename from smie-indent--hanging-p. (smie-bolp): Rename from smie-indent--bolp. (smie--parent, smie--after): New dynamic vars. (smie-parent-p, smie-next-p, smie-prev-p): New funs. (smie-indent-rules): Remove. (smie-indent--offset-rule): Remove fun. (smie-rules-function): New var. (smie-indent--rule): New fun. (smie-indent--offset, smie-indent-keyword, smie-indent-after-keyword) (smie-indent-exps): Use it. (smie-setup): Setup paren blinking; add keyword args for token functions; extract closer-alist from op-levels. (smie-indent-debug-log): Remove var. (smie-indent-debug): Remove fun. * lisp/progmodes/prolog.el (prolog-smie-indent-rules): Remove. (prolog-smie-rules): New fun to replace it. (prolog-mode-variables): Simplify. * lisp/progmodes/octave-mod.el (octave-smie-closer-alist): Remove, now that it's setup automatically. (octave-smie-indent-rules): Remove. (octave-smie-rules): New fun to replace it. (octave-mode): Simplify. diff: === modified file 'etc/NEWS' --- etc/NEWS 2010-10-26 07:42:46 +0000 +++ etc/NEWS 2010-10-29 19:20:28 +0000 @@ -587,6 +587,8 @@ * Incompatible Lisp Changes in Emacs 24.1 +** Remove obsolete name `e' (use `float-e' instead). + ** A backquote not followed by a space is now always treated as new-style. ** Test for special mode-class was moved from view-file to view-buffer. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-10-29 06:51:36 +0000 +++ lisp/ChangeLog 2010-10-29 19:20:28 +0000 @@ -1,3 +1,35 @@ +2010-10-29 Stefan Monnier + + SMIE: change indent rules format, improve smie-setup. + * emacs-lisp/smie.el (smie-precs-precedence-table) + (smie-merge-prec2s, smie-bnf-precedence-table, smie-prec2-levels): + Mark them pure so the tables gets built at compile time. + (smie-bnf-precedence-table): Store the closer-alist in the table. + (smie-prec2-levels): Preserve the closer-alist. + (smie-blink-matching-open): Be more forgiving in case of indentation. + (smie-hanging-p): Rename from smie-indent--hanging-p. + (smie-bolp): Rename from smie-indent--bolp. + (smie--parent, smie--after): New dynamic vars. + (smie-parent-p, smie-next-p, smie-prev-p): New funs. + (smie-indent-rules): Remove. + (smie-indent--offset-rule): Remove fun. + (smie-rules-function): New var. + (smie-indent--rule): New fun. + (smie-indent--offset, smie-indent-keyword, smie-indent-after-keyword) + (smie-indent-exps): Use it. + (smie-setup): Setup paren blinking; add keyword args for token + functions; extract closer-alist from op-levels. + (smie-indent-debug-log): Remove var. + (smie-indent-debug): Remove fun. + * progmodes/prolog.el (prolog-smie-indent-rules): Remove. + (prolog-smie-rules): New fun to replace it. + (prolog-mode-variables): Simplify. + * progmodes/octave-mod.el (octave-smie-closer-alist): Remove, now that + it's setup automatically. + (octave-smie-indent-rules): Remove. + (octave-smie-rules): New fun to replace it. + (octave-mode): Simplify. + 2010-10-29 Glenn Morris * files.el (temporary-file-directory): Remove (already defined in C). === modified file 'lisp/emacs-lisp/smie.el' --- lisp/emacs-lisp/smie.el 2010-10-07 11:27:19 +0000 +++ lisp/emacs-lisp/smie.el 2010-10-29 19:20:28 +0000 @@ -109,6 +109,7 @@ (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y))) (puthash key val table)))) +(put 'smie-precs-precedence-table 'pure t) (defun smie-precs-precedence-table (precs) "Compute a 2D precedence table from a list of precedences. PRECS should be a list, sorted by precedence (e.g. \"+\" will @@ -132,6 +133,7 @@ (smie-set-prec2tab prec2-table other-op op op1))))))) prec2-table)) +(put 'smie-merge-prec2s 'pure t) (defun smie-merge-prec2s (&rest tables) (if (null (cdr tables)) (car tables) @@ -147,6 +149,7 @@ table)) prec2))) +(put 'smie-bnf-precedence-table 'pure t) (defun smie-bnf-precedence-table (bnf &rest precs) (let ((nts (mapcar 'car bnf)) ;Non-terminals (first-ops-table ()) @@ -233,6 +236,7 @@ ;; Keep track of which tokens are openers/closer, so they can get a nil ;; precedence in smie-prec2-levels. (puthash :smie-open/close-alist (smie-bnf-classify bnf) prec2) + (puthash :smie-closer-alist (smie-bnf-closer-alist bnf) prec2) prec2)) ;; (defun smie-prec2-closer-alist (prec2 include-inners) @@ -377,6 +381,7 @@ (append names (list (car names))) " < "))) +(put 'smie-prec2-levels 'pure t) (defun smie-prec2-levels (prec2) ;; FIXME: Rather than only return an alist of precedence levels, we should ;; also extract other useful data from it: @@ -479,6 +484,8 @@ (eq 'closer (cdr (assoc (car x) classification-table)))) (setf (nth 2 x) i) (incf i))))) ;See other (incf i) above. + (let ((ca (gethash :smie-closer-alist prec2))) + (when ca (push (cons :smie-closer-alist ca) table))) table)) ;;; Parsing using a precedence level table. @@ -803,14 +810,22 @@ (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'." + (let ((pos (point)) ;Position after the close token. + token) (when (and blink-matching-paren smie-closer-alist ; Optimization. - (eq (char-before) last-command-event) ; Sanity check. + (or (eq (char-before) last-command-event) ;; Sanity check. + (save-excursion + (or (progn (skip-chars-backward " \t") + (setq pos (point)) + (eq (char-before) last-command-event)) + (progn (skip-chars-backward " \n\t") + (setq pos (point)) + (eq (char-before) last-command-event))))) (memq last-command-event smie-blink-matching-triggers) (not (nth 8 (syntax-ppss)))) (save-excursion - (let ((pos (point)) - (token (funcall smie-backward-token-function))) + (setq token (funcall smie-backward-token-function)) (when (and (eq (point) (1- pos)) (= 1 (length token)) (not (rassoc token smie-closer-alist))) @@ -818,17 +833,20 @@ ;; closers (e.g. ?\; in Octave mode), so go back to the ;; previous token. (setq pos (point)) - (setq token (save-excursion - (funcall smie-backward-token-function)))) + (setq token (funcall smie-backward-token-function))) (when (rassoc token smie-closer-alist) ;; We're after a close token. Let's still make sure we ;; didn't skip a comment to find that token. (funcall smie-forward-token-function) (when (and (save-excursion - ;; Trigger can be SPC, or reindent. - (skip-chars-forward " \n\t") + ;; Skip the trigger char, if applicable. + (if (eq (char-after) last-command-event) + (forward-char 1)) + (if (eq ?\n last-command-event) + ;; Skip any auto-indentation, if applicable. + (skip-chars-forward " \t")) (>= (point) pos)) - ;; If token ends with a trigger char, so don't blink for + ;; If token ends with a trigger char, 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 trigger char like SPC. @@ -850,34 +868,25 @@ "Basic amount of indentation." :type 'integer) -(defvar smie-indent-rules 'unset - ;; TODO: For SML, we need more rule formats, so as to handle - ;; structure Foo = - ;; Bar (toto) - ;; and - ;; structure Foo = - ;; struct ... end - ;; I.e. the indentation after "=" depends on the parent ("structure") - ;; as well as on the following token ("struct"). - "Rules of the following form. -\((:before . TOK) . OFFSET-RULES) how to indent TOK itself. -\(TOK . OFFSET-RULES) how to indent right after TOK. -\(list-intro . TOKENS) declare TOKENS as being followed by what may look like - a funcall but is just a sequence of expressions. -\(t . OFFSET) basic indentation step. -\(args . OFFSET) indentation of arguments. -\((T1 . T2) OFFSET) like ((:before . T2) (:parent T1 OFFSET)). - -OFFSET-RULES is a list of elements which can each either be: - -\(:hanging . OFFSET-RULES) if TOK is hanging, use OFFSET-RULES. -\(:parent PARENT . OFFSET-RULES) if TOK's parent is PARENT, use OFFSET-RULES. -\(:next TOKEN . OFFSET-RULES) if TOK is followed by TOKEN, use OFFSET-RULES. -\(:prev TOKEN . OFFSET-RULES) if TOK is preceded by TOKEN, use -\(:bolp . OFFSET-RULES) If TOK is first on a line, use OFFSET-RULES. -OFFSET the offset to use. - -PARENT can be either the name of the parent or a list of such names. +(defvar smie-rules-function 'ignore + "Function providing the indentation rules. +It takes two arguments METHOD and ARG where the meaning of ARG +and the expected return value depends on METHOD. +METHOD can be: +- :after, in which case ARG is a token and the function should return the + OFFSET to use for indentation after ARG. +- :before, in which case ARG is a token and the function should return the + OFFSET to use to indent ARG itself. +- :elem, in which case the function should return either: + - the offset to use to indent function arguments (ARG = `arg') + - the basic indentation step (ARG = `basic'). +- :list-intro, in which case ARG is a token and the function should return + non-nil if TOKEN is followed by a list of expressions (not separated by any + token) rather than an expression. + +When ARG is a token, the function is called with point just before that token. +A return value of nil always means to fallback on the default behavior, so the +function should return nil for arguments it does not expect. OFFSET can be of the form: `point' align with the token. @@ -886,91 +895,69 @@ \(+ OFFSETS...) use the sum of OFFSETS. VARIABLE use the value of VARIABLE as offset. -The precise meaning of `point' depends on various details: it can -either mean the position of the token we're indenting, or the -position of its parent, or the position right after its parent. - -A nil offset for indentation after an opening token defaults -to `smie-indent-basic'.") - -(defun smie-indent--hanging-p () - ;; A hanging keyword is one that's at the end of a line except it's not at - ;; the beginning of a line. - (and (save-excursion +This function will often use some of the following functions designed +specifically for it: +`smie-bolp', `smie-hanging-p', `smie-parent-p', `smie-next-p', `smie-prev-p'.") + +(defun smie-hanging-p () + "Return non-nil if the current token is \"hanging\". +A hanging keyword is one that's at the end of a line except it's not at +the beginning of a line." + (and (not (smie-bolp)) + (save-excursion (when (zerop (length (funcall smie-forward-token-function))) ;; Could be an open-paren. (forward-char 1)) (skip-chars-forward " \t") - (eolp)) - (not (smie-indent--bolp)))) + (eolp)))) -(defun smie-indent--bolp () +(defun smie-bolp () + "Return non-nil if the current token is the first on the line." (save-excursion (skip-chars-backward " \t") (bolp))) +(defvar smie--parent) (defvar smie--after) ;Dynamically scoped. + +(defun smie-parent-p (&rest parents) + "Return non-nil if the current token's parent is among PARENTS. +Only meaningful when called from within `smie-rules-function'." + (member (nth 2 (or smie--parent + (save-excursion + (let* ((pos (point)) + (tok (funcall smie-forward-token-function))) + (unless (cadr (assoc tok smie-op-levels)) + (goto-char pos)) + (setq smie--parent + (smie-backward-sexp 'halfsexp)))))) + parents)) + +(defun smie-next-p (&rest tokens) + "Return non-nil if the next token is among TOKENS. +Only meaningful when called from within `smie-rules-function'." + (let ((next + (save-excursion + (unless smie--after + (smie-indent-forward-token) (setq smie--after (point))) + (goto-char smie--after) + (smie-indent-forward-token)))) + (member (car next) tokens))) + +(defun smie-prev-p (&rest tokens) + "Return non-nil if the previous token is among TOKENS." + (let ((prev (save-excursion + (smie-indent-backward-token)))) + (member (car prev) tokens))) + + (defun smie-indent--offset (elem) - (or (cdr (assq elem smie-indent-rules)) - (cdr (assq t smie-indent-rules)) + (or (funcall smie-rules-function :elem elem) + (if (not (eq elem 'basic)) + (funcall smie-rules-function :elem 'basic)) smie-indent-basic)) -(defvar smie-indent-debug-log) - -(defun smie-indent--offset-rule (tokinfo &optional after parent) - "Apply the OFFSET-RULES in TOKINFO. -Point is expected to be right in front of the token corresponding to TOKINFO. -If computing the indentation after the token, then AFTER is the position -after the token, otherwise it should be nil. -PARENT if non-nil should be the parent info returned by `smie-backward-sexp'." - (let ((rules (cdr tokinfo)) - next prev - offset) - (while (consp rules) - (let ((rule (pop rules))) - (cond - ((not (consp rule)) (setq offset rule)) - ((eq (car rule) '+) (setq offset rule)) - ((eq (car rule) :hanging) - (when (smie-indent--hanging-p) - (setq rules (cdr rule)))) - ((eq (car rule) :bolp) - (when (smie-indent--bolp) - (setq rules (cdr rule)))) - ((eq (car rule) :eolp) - (unless after - (error "Can't use :eolp in :before indentation rules")) - (when (> after (line-end-position)) - (setq rules (cdr rule)))) - ((eq (car rule) :prev) - (unless prev - (save-excursion - (setq prev (smie-indent-backward-token)))) - (when (equal (car prev) (cadr rule)) - (setq rules (cddr rule)))) - ((eq (car rule) :next) - (unless next - (unless after - (error "Can't use :next in :before indentation rules")) - (save-excursion - (goto-char after) - (setq next (smie-indent-forward-token)))) - (when (equal (car next) (cadr rule)) - (setq rules (cddr rule)))) - ((eq (car rule) :parent) - (unless parent - (save-excursion - (if after (goto-char after)) - (setq parent (smie-backward-sexp 'halfsexp)))) - (when (if (listp (cadr rule)) - (member (nth 2 parent) (cadr rule)) - (equal (nth 2 parent) (cadr rule))) - (setq rules (cddr rule)))) - (t (error "Unknown rule %s for indentation of %s" - rule (car tokinfo)))))) - ;; If `offset' is not set yet, use `rules' to handle the case where - ;; the tokinfo uses the old-style ((PARENT . TOK). OFFSET). - (unless offset (setq offset rules)) - (when (boundp 'smie-indent-debug-log) - (push (list (point) offset tokinfo) smie-indent-debug-log)) - offset)) +(defun smie-indent--rule (kind token &optional after parent) + (let ((smie--parent parent) + (smie--after after)) + (funcall smie-rules-function kind token))) (defun smie-indent--column (offset &optional base parent virtual-point) "Compute the actual column to use for a given OFFSET. @@ -1012,6 +999,9 @@ (if (consp parent) (goto-char (cadr parent))) (smie-indent-virtual)) ((eq offset nil) nil) + ;; FIXME: would be good to get rid of this since smie-rules-function + ;; can usually do the lookup trivially, but in cases where + ;; smie-rules-function returns (+ point VAR) it's not nearly as trivial. ((and (symbolp offset) (boundp 'offset)) (smie-indent--column (symbol-value offset) base parent virtual-point)) (t (error "Unknown indentation offset %s" offset)))) @@ -1046,11 +1036,11 @@ need to compute the column at which point should be indented in order to figure out the indentation of some other (further down) point." ;; Trust pre-existing indentation on other lines. - (if (smie-indent--bolp) (current-column) (smie-indent-calculate))) + (if (smie-bolp) (current-column) (smie-indent-calculate))) (defun smie-indent-fixindent () ;; Obey the `fixindent' special comment. - (and (smie-indent--bolp) + (and (smie-bolp) (save-excursion (comment-normalize-vars) (re-search-forward (concat comment-start-skip @@ -1090,43 +1080,31 @@ (save-excursion (goto-char pos) ;; Different cases: - ;; - smie-indent--bolp: "indent according to others". + ;; - smie-bolp: "indent according to others". ;; - common hanging: "indent according to others". ;; - SML-let hanging: "indent like parent". ;; - if-after-else: "indent-like parent". ;; - middle-of-line: "trust current position". (cond ((null (cdr toklevels)) nil) ;Not a keyword. - ((smie-indent--bolp) + ((smie-bolp) ;; For an open-paren-like thingy at BOL, always indent only ;; based on other rules (typically smie-indent-after-keyword). nil) (t ;; We're only ever here for virtual-indent, which is why ;; we can use (current-column) as answer for `point'. - (let* ((tokinfo (or (assoc (cons :before token) - smie-indent-rules) + (let* ((offset (or (smie-indent--rule :before token) ;; By default use point unless we're hanging. - `((:before . ,token) (:hanging nil) point))) - ;; (after (prog1 (point) (goto-char pos))) - (offset (smie-indent--offset-rule tokinfo))) + (unless (smie-hanging-p) 'point)))) (smie-indent--column offset))))) ;; FIXME: This still looks too much like black magic!! - ;; FIXME: Rather than a bunch of rules like (PARENT . TOKEN), we - ;; want a single rule for TOKEN with different cases for each PARENT. (let* ((parent (smie-backward-sexp 'halfsexp)) - (tokinfo - (or (assoc (cons (caddr parent) token) - smie-indent-rules) - (assoc (cons :before token) smie-indent-rules) - ;; Default rule. - `((:before . ,token) - ;; (:parent open 0) - point))) (offset (save-excursion (goto-char pos) - (smie-indent--offset-rule tokinfo nil parent)))) + (or (smie-indent--rule :before token nil parent) + 'point)))) ;; Different behaviors: ;; - align with parent. ;; - parent + offset. @@ -1151,10 +1129,10 @@ nil) ((eq (car parent) (car toklevels)) ;; We bumped into a same-level operator. align with it. - (if (and (smie-indent--bolp) (/= (point) pos) + (if (and (smie-bolp) (/= (point) pos) (save-excursion (goto-char (goto-char (cadr parent))) - (not (smie-indent--bolp))) + (not (smie-bolp))) ;; Check the offset of `token' rather then its parent ;; because its parent may have used a special rule. E.g. ;; function foo; @@ -1190,8 +1168,8 @@ ;; -> d ;; So as to align with the earliest appropriate place. (smie-indent-virtual))) - (tokinfo - (if (and (= (point) pos) (smie-indent--bolp) + (t + (if (and (= (point) pos) (smie-bolp) (or (eq offset 'point) (and (consp offset) (memq 'point offset)))) ;; Since we started at BOL, we're not computing a virtual @@ -1209,7 +1187,7 @@ ;; Don't do it for virtual indentations. We should normally never be "in ;; front of a comment" when doing virtual-indentation anyway. And if we are ;; (as can happen in octave-mode), moving forward can lead to inf-loops. - (and (smie-indent--bolp) + (and (smie-bolp) (let ((pos (point))) (save-excursion (beginning-of-line) @@ -1254,27 +1232,18 @@ (save-excursion (let* ((pos (point)) (toklevel (smie-indent-backward-token)) - (tok (car toklevel)) - (tokinfo (assoc tok smie-indent-rules))) - ;; Set some default indent rules. - (if (and toklevel (null (cadr toklevel)) (null tokinfo)) - (setq tokinfo (list (car toklevel)))) - ;; (if (and tokinfo (null toklevel)) - ;; (error "Token %S has indent rule but has no parsing info" tok)) + (tok (car toklevel))) (when toklevel - (unless tokinfo - ;; The default indentation after a keyword/operator is 0 for - ;; infix and t for prefix. - ;; Using the BNF syntax, we could come up with better - ;; defaults, but we only have the precedence levels here. - (setq tokinfo (list tok 'default-rule - (if (cadr toklevel) 0 (smie-indent--offset t))))) (let ((offset - (or (smie-indent--offset-rule tokinfo pos) - (smie-indent--offset t)))) - (let ((before (point))) + (or (smie-indent--rule :after tok pos) + ;; The default indentation after a keyword/operator is + ;; 0 for infix and t for prefix. + (if (or (null (cadr toklevel)) + (rassoc tok smie-closer-alist)) + (smie-indent--offset 'basic) 0))) + (before (point))) (goto-char pos) - (smie-indent--column offset before))))))) + (smie-indent--column offset before)))))) (defun smie-indent-exps () ;; Indentation of sequences of simple expressions without @@ -1297,13 +1266,14 @@ arg) (while (and (null (car (smie-backward-sexp))) (push (point) positions) - (not (smie-indent--bolp)))) + (not (smie-bolp)))) (save-excursion ;; Figure out if the atom we just skipped is an argument rather ;; than a function. - (setq arg (or (null (car (smie-backward-sexp))) - (member (funcall smie-backward-token-function) - (cdr (assoc 'list-intro smie-indent-rules)))))) + (setq arg + (or (null (car (smie-backward-sexp))) + (funcall smie-rules-function :list-intro + (funcall smie-backward-token-function))))) (cond ((null positions) ;; We're the first expression of the list. In that case, the @@ -1362,18 +1332,51 @@ (save-excursion (indent-line-to indent)) (indent-line-to indent))))) -(defun smie-indent-debug () - "Show the rules used to compute indentation of current line." - (interactive) - (let ((smie-indent-debug-log '())) - (smie-indent-calculate) - ;; FIXME: please improve! - (message "%S" smie-indent-debug-log))) - -(defun smie-setup (op-levels indent-rules) - (set (make-local-variable 'smie-indent-rules) indent-rules) +(defun smie-setup (op-levels rules-function &rest keywords) + "Setup SMIE navigation and indentation. +OP-LEVELS is a grammar table generated by `smie-prec2-levels'. +RULES-FUNCTION is a set of indentation rules for use on `smie-rules-function'. +KEYWORDS are additional arguments, which can use the following keywords: +- :forward-token FUN +- :backward-token FUN" + (set (make-local-variable 'smie-rules-function) rules-function) (set (make-local-variable 'smie-op-levels) op-levels) - (set (make-local-variable 'indent-line-function) 'smie-indent-line)) + (set (make-local-variable 'indent-line-function) 'smie-indent-line) + (set (make-local-variable 'forward-sexp-function) + 'smie-forward-sexp-command) + (while keywords + (let ((k (pop keywords)) + (v (pop keywords))) + (case k + (:forward-token + (set (make-local-variable 'smie-forward-token-function) v)) + (:backward-token + (set (make-local-variable 'smie-backward-token-function) v)) + (t (message "smie-setup: ignoring unknown keyword %s" k))))) + (let ((ca (cdr (assq :smie-closer-alist op-levels)))) + (when ca + (set (make-local-variable 'smie-closer-alist) ca) + ;; Only needed for interactive calls to blink-matching-open. + (set (make-local-variable 'blink-matching-check-function) + #'smie-blink-matching-check) + (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 to blink, try to blink as + ;; soon as we type the last char of a block ender. + (let ((closers (sort (mapcar #'cdr smie-closer-alist) + #'string-lessp)) + (triggers ()) + closer) + (while (setq closer (pop closers)) + (unless (and closers + ;; FIXME: this eliminates prefixes of other + ;; closers, but we should probably elimnate + ;; prefixes of other keywords as well. + (string-prefix-p closer (car closers))) + (push (aref closer (1- (length closer))) triggers))) + (delete-dups triggers))))))) (provide 'smie) === modified file 'lisp/progmodes/octave-mod.el' --- lisp/progmodes/octave-mod.el 2010-10-27 14:26:01 +0000 +++ lisp/progmodes/octave-mod.el 2010-10-29 19:20:28 +0000 @@ -446,9 +446,6 @@ ;; (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 @@ -521,15 +518,18 @@ (t (smie-default-forward-token)))) -(defconst octave-smie-indent-rules - '((";" - (:parent ("function" "if" "while" "else" "elseif" "for" "otherwise" - "case" "try" "catch" "unwind_protect" "unwind_protect_cleanup") - ;; FIXME: don't hardcode 2. - (+ parent octave-block-offset)) - ;; (:parent "switch" 4) ;For (invalid) code between switch and case. - 0) - ((:before . "case") octave-block-offset))) +(defun octave-smie-rules (kind token) + (pcase (cons kind token) + (`(:elem . basic) octave-block-offset) + (`(:before . "case") octave-block-offset) + (`(:after . ";") + (if (smie-parent-p "function" "if" "while" "else" "elseif" "for" + "otherwise" "case" "try" "catch" "unwind_protect" + "unwind_protect_cleanup") + '(+ parent octave-block-offset) + ;; For (invalid) code between switch and case. + ;; (if (smie-parent-p "switch") 4) + 0)))) (defvar electric-indent-chars) @@ -619,32 +619,15 @@ including a reproducible test case and send the message." (setq local-abbrev-table octave-abbrev-table) - (smie-setup octave-smie-op-levels octave-smie-indent-rules) + (smie-setup octave-smie-op-levels #'octave-smie-rules + :forward-token #'octave-smie-forward-token + :backward-token #'octave-smie-backward-token) (set (make-local-variable 'smie-indent-basic) 'octave-block-offset) - (set (make-local-variable 'smie-backward-token-function) - 'octave-smie-backward-token) - (set (make-local-variable 'smie-forward-token-function) - 'octave-smie-forward-token) - (set (make-local-variable 'forward-sexp-function) - 'smie-forward-sexp-command) - (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)))))) + (cons ?\; smie-blink-matching-triggers)) + (unless octave-blink-matching-block + (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local)) (set (make-local-variable 'electric-indent-chars) (cons ?\; electric-indent-chars)) === modified file 'lisp/progmodes/prolog.el' --- lisp/progmodes/prolog.el 2010-09-20 14:22:16 +0000 +++ lisp/progmodes/prolog.el 2010-10-29 19:20:28 +0000 @@ -173,10 +173,11 @@ ) "Precedence levels of infix operators.") -(defconst prolog-smie-indent-rules - '((":-") - ("->")) - "Prolog indentation rules.") +(defun prolog-smie-rules (kind token) + (pcase (cons kind token) + (`(:elem . basic) prolog-indent-width) + (`(:after . ".") 0) ;; To work around smie-closer-alist. + (`(:after . ,(or `":-" `"->")) prolog-indent-width))) (defun prolog-mode-variables () (make-local-variable 'paragraph-separate) @@ -185,19 +186,17 @@ (setq paragraph-ignore-fill-prefix t) (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression '((nil "^\\sw+" 0))) - (smie-setup prolog-smie-op-levels prolog-smie-indent-rules) - (set (make-local-variable 'smie-forward-token-function) - #'prolog-smie-forward-token) - (set (make-local-variable 'smie-backward-token-function) - #'prolog-smie-backward-token) - (set (make-local-variable 'forward-sexp-function) - 'smie-forward-sexp-command) - (set (make-local-variable 'smie-indent-basic) prolog-indent-width) + + ;; Setup SMIE. + (smie-setup prolog-smie-op-levels #'prolog-smie-rules + :forward-token #'prolog-smie-forward-token + :backward-token #'prolog-smie-backward-token) (set (make-local-variable 'smie-blink-matching-triggers) '(?.)) (set (make-local-variable 'smie-closer-alist) '((t . "."))) (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local) ;; There's no real closer in Prolog anyway. (set (make-local-variable 'smie-blink-matching-inners) t) + (make-local-variable 'comment-start) (setq comment-start "%") (make-local-variable 'comment-start-skip) ------------------------------------------------------------ revno: 102152 author: Julien Danjou committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2010-10-29 13:51:15 +0000 message: gnus.el (gnus-buffers, gnus-group-buffer): Add docstrings. gnus.el (gnus-group-startup-message): Simplify/update code. gnus-ems.el (gnus-x-splash): Remove. gnus-start.el (gnus-1): Remove x-splash calls. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-10-29 11:24:23 +0000 +++ lisp/gnus/ChangeLog 2010-10-29 13:51:15 +0000 @@ -1,5 +1,11 @@ 2010-10-29 Julien Danjou + * gnus-start.el (gnus-1): Remove x-splash calls. + + * gnus-ems.el (gnus-x-splash): Remove. + + * gnus.el (gnus-group-startup-message): Simplify/update code. + * gnus-group.el (gnus-group-make-tool-bar): Check for display graphic capability before doing anything. (gnus-group-insert-group-line): Remove useless === modified file 'lisp/gnus/gnus-ems.el' --- lisp/gnus/gnus-ems.el 2010-10-04 00:17:16 +0000 +++ lisp/gnus/gnus-ems.el 2010-10-29 13:51:15 +0000 @@ -162,102 +162,6 @@ (autoload 'gnus-alive-p "gnus-util") (autoload 'mm-disable-multibyte "mm-util") -(defun gnus-x-splash () - "Show a splash screen using a pixmap in the current buffer." - (interactive) - (unless window-system - (error "`gnus-x-splash' requires running on the window system")) - (switch-to-buffer (gnus-get-buffer-create (if (or (gnus-alive-p) - (interactive-p)) - "*gnus-x-splash*" - gnus-group-buffer))) - (let ((inhibit-read-only t) - (file (nnheader-find-etc-directory "images/gnus/x-splash" t)) - pixmap fcw fch width height fringes sbars left yoffset top ls) - (erase-buffer) - (sit-for 0) ;; Necessary for measuring the window size correctly. - (when (and file - (ignore-errors - (let ((coding-system-for-read 'raw-text)) - (with-temp-buffer - (mm-disable-multibyte) - (insert-file-contents file) - (goto-char (point-min)) - (setq pixmap (read (current-buffer))))))) - (setq fcw (float (frame-char-width)) - fch (float (frame-char-height)) - width (/ (car pixmap) fcw) - height (/ (cadr pixmap) fch) - fringes (if (fboundp 'window-fringes) - (eval '(window-fringes)) - '(10 11 nil)) - sbars (frame-parameter nil 'vertical-scroll-bars)) - (cond ((eq sbars 'right) - (setq sbars - (cons 0 (/ (or (frame-parameter nil 'scroll-bar-width) 14) - fcw)))) - (sbars - (setq sbars - (cons (/ (or (frame-parameter nil 'scroll-bar-width) 14) - fcw) - 0))) - (t - (setq sbars '(0 . 0)))) - (setq left (- (* (round (/ (1- (/ (+ (window-width) - (car sbars) (cdr sbars) - (/ (+ (or (car fringes) 0) - (or (cadr fringes) 0)) - fcw)) - width)) - 2)) - width) - (car sbars) - (/ (or (car fringes) 0) fcw)) - yoffset (cadr (window-edges)) - top (max 0 (- (* (max (if (and (boundp 'tool-bar-mode) - tool-bar-mode - (not (featurep 'gtk)) - (eq (frame-first-window) - (selected-window))) - 1 0) - (round (/ (1- (/ (+ (1- (window-height)) - (* 2 yoffset)) - height)) - 2))) - height) - yoffset)) - ls (/ (or line-spacing 0) fch) - height (max 0 (- height ls))) - (cond ((>= (- top ls) 1) - (insert - (propertize - " " - 'display `(space :width 0 :ascent 100)) - "\n" - (propertize - " " - 'display `(space :width 0 :height ,(- top ls 1) :ascent 100)) - "\n")) - ((> (- top ls) 0) - (insert - (propertize - " " - 'display `(space :width 0 :height ,(- top ls) :ascent 100)) - "\n"))) - (if (and (> width 0) (> left 0)) - (insert (propertize - " " - 'display `(space :width ,left :height ,height :ascent 0))) - (setq width (+ width left))) - (when (> width 0) - (insert (propertize - " " - 'display `(space :width ,width :height ,height :ascent 0) - 'face `(gnus-splash :stipple ,pixmap)))) - (goto-char (if (<= (- top ls) 0) (1- (point)) (point-min))) - (redraw-frame (selected-frame)) - (sit-for 0)))) - ;;; Image functions. (defun gnus-image-type-available-p (type) === modified file 'lisp/gnus/gnus-start.el' --- lisp/gnus/gnus-start.el 2010-10-22 01:39:13 +0000 +++ lisp/gnus/gnus-start.el 2010-10-29 13:51:15 +0000 @@ -775,14 +775,6 @@ (if gnus-agent (gnus-agentize)) - (when gnus-simple-splash - (setq gnus-simple-splash nil) - (cond - ((featurep 'xemacs) - (gnus-xmas-splash)) - (window-system - (gnus-x-splash)))) - (let ((level (and (numberp arg) (> arg 0) arg)) did-connect) (unwind-protect === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2010-10-29 11:24:23 +0000 +++ lisp/gnus/gnus.el 2010-10-29 13:51:15 +0000 @@ -350,7 +350,6 @@ (list str)) line))) (defalias 'gnus-mode-line-buffer-identification 'identity)) - (defalias 'gnus-characterp 'numberp) (defalias 'gnus-deactivate-mark 'deactivate-mark) (defalias 'gnus-window-edges 'window-edges) (defalias 'gnus-key-press-event-p 'numberp) @@ -918,7 +917,8 @@ ;;; Gnus buffers ;;; -(defvar gnus-buffers nil) +(defvar gnus-buffers nil + "List of buffers handled by Gnus.") (defun gnus-get-buffer-create (name) "Do the same as `get-buffer-create', but store the created buffer." @@ -950,7 +950,8 @@ ;;; Splash screen. -(defvar gnus-group-buffer "*Group*") +(defvar gnus-group-buffer "*Group*" + "Name of the Gnus group buffer.") (defface gnus-splash '((((class color) @@ -989,8 +990,6 @@ (while (search-forward "\t" nil t) (replace-match " " t t)))))) -(defvar gnus-simple-splash nil) - ;;(format "%02x%02x%02x" 114 66 20) "724214" (defvar gnus-logo-color-alist @@ -1030,50 +1029,45 @@ "Insert startup message in current buffer." ;; Insert the message. (erase-buffer) - (cond - ((and - (fboundp 'find-image) - (display-graphic-p) - ;; Make sure the library defining `image-load-path' is loaded - ;; (`find-image' is autoloaded) (and discard the result). Else, we may - ;; get "defvar ignored because image-load-path is let-bound" when calling - ;; `find-image' below. - (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) - (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) - (image-load-path (cond (data-directory - (list data-directory)) - ((boundp 'image-load-path) - (symbol-value 'image-load-path)) - (t load-path))) - (image (find-image - `((:type xpm :file "gnus.xpm" - :color-symbols - (("thing" . ,(car gnus-logo-colors)) - ("shadow" . ,(cadr gnus-logo-colors)) - ("oort" . "#eeeeee") - ("background" . ,(face-background 'default)))) - (:type svg :file "gnus.svg") - (:type png :file "gnus.png") - (:type pbm :file "gnus.pbm" - ;; Account for the pbm's blackground. - :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)) - (:type xbm :file "gnus.xbm" - ;; Account for the xbm's blackground. - :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)))))) - (when image - (let ((size (image-size image))) - (insert-char ?\n (max 0 (round (- (window-height) - (or y (cdr size)) 1) 2))) - (insert-char ?\ (max 0 (round (- (window-width) - (or x (car size))) 2))) - (insert-image image)) - (setq gnus-simple-splash nil) - t)))) - (t + (unless (and + (fboundp 'find-image) + (display-graphic-p) + ;; Make sure the library defining `image-load-path' is loaded + ;; (`find-image' is autoloaded) (and discard the result). Else, we may + ;; get "defvar ignored because image-load-path is let-bound" when calling + ;; `find-image' below. + (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) + (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) + (image-load-path (cond (data-directory + (list data-directory)) + ((boundp 'image-load-path) + (symbol-value 'image-load-path)) + (t load-path))) + (image (find-image + `((:type xpm :file "gnus.xpm" + :color-symbols + (("thing" . ,(car gnus-logo-colors)) + ("shadow" . ,(cadr gnus-logo-colors)))) + (:type svg :file "gnus.svg") + (:type png :file "gnus.png") + (:type pbm :file "gnus.pbm" + ;; Account for the pbm's background. + :background ,(face-foreground 'gnus-splash) + :foreground ,(face-background 'default)) + (:type xbm :file "gnus.xbm" + ;; Account for the xbm's background. + :background ,(face-foreground 'gnus-splash) + :foreground ,(face-background 'default)))))) + (when image + (let ((size (image-size image))) + (insert-char ?\n (max 0 (round (- (window-height) + (or y (cdr size)) 1) 2))) + (insert-char ?\ (max 0 (round (- (window-width) + (or x (car size))) 2))) + (insert-image image)) + t))) (insert - (format " %s + (format " _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ @@ -1092,8 +1086,7 @@ _ __ -" - "")) +")) ;; And then hack it. (gnus-indent-rigidly (point-min) (point-max) (/ (max (- (window-width) (or x 46)) 0) 2)) @@ -1105,10 +1098,9 @@ (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ;; Fontify some. (put-text-property (point-min) (point-max) 'face 'gnus-splash) - (setq gnus-simple-splash t))) - (goto-char (point-min)) - (setq mode-line-buffer-identification (concat " " gnus-version)) - (set-buffer-modified-p t)) + (goto-char (point-min)) + (setq mode-line-buffer-identification (concat " " gnus-version)) + (set-buffer-modified-p t))) (eval-when (load) (let ((command (format "%s" this-command))) ------------------------------------------------------------ revno: 102151 author: Julien Danjou committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2010-10-29 11:24:23 +0000 message: gnus-group.el (gnus-group-make-tool-bar): Check for display graphic capability before doing anything. gnus-group.el (gnus-group-insert-group-line): Remove useless gnus-group-remove-excess-properties. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-10-29 07:13:33 +0000 +++ lisp/gnus/ChangeLog 2010-10-29 11:24:23 +0000 @@ -1,3 +1,10 @@ +2010-10-29 Julien Danjou + + * gnus-group.el (gnus-group-make-tool-bar): Check for display graphic + capability before doing anything. + (gnus-group-insert-group-line): Remove useless + gnus-group-remove-excess-properties. + 2010-10-29 Katsumi Yamaoka * gnus-art.el (gnus-article-goto-part): Work for article narrowed by ^L. === modified file 'lisp/gnus/gnus-group.el' --- lisp/gnus/gnus-group.el 2010-10-27 22:08:36 +0000 +++ lisp/gnus/gnus-group.el 2010-10-29 11:24:23 +0000 @@ -1090,8 +1090,7 @@ (when (and (not (featurep 'xemacs)) (boundp 'tool-bar-mode) tool-bar-mode - ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode). - ;; Why? --rsteib + (display-graphic-p) (or (not gnus-group-tool-bar-map) force)) (let* ((load-path (gmm-image-load-path-for-library "gnus" @@ -1607,9 +1606,7 @@ (when (inline (gnus-visual-p 'group-highlight 'highlight)) (gnus-group-highlight-line gnus-tmp-group beg end)) (gnus-run-hooks 'gnus-group-update-hook) - (forward-line) - ;; Allow XEmacs to remove front-sticky text properties. - (gnus-group-remove-excess-properties))) + (forward-line))) (defun gnus-group-update-eval-form (group list) "Eval `car' of each element of LIST, and return the first that return t. === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2010-10-21 02:44:47 +0000 +++ lisp/gnus/gnus.el 2010-10-29 11:24:23 +0000 @@ -308,9 +308,6 @@ :group 'gnus-start :type 'boolean) -(unless (fboundp 'gnus-group-remove-excess-properties) - (defalias 'gnus-group-remove-excess-properties 'ignore)) - (unless (featurep 'gnus-xmas) (defalias 'gnus-make-overlay 'make-overlay) (defalias 'gnus-delete-overlay 'delete-overlay) ------------------------------------------------------------ revno: 102150 committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2010-10-29 12:49:27 +0200 message: Fix doc/misc/makefile.w32.in like revno 102137 did with Makefile.in. makefile.w32-in (MAKEINFO): Add -I$(emacsdir). (ENVADD): Remove extra -I$(emacsdir), included in $(MAKEINFO). ($(infodir)/efaq): Remove -I$(emacsdir), included in $(MAKEINFO). ($(infodir)/calc, calc.dvi): Depend on $(emacsdir)/emacsver.texi. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-10-28 07:21:43 +0000 +++ doc/misc/ChangeLog 2010-10-29 10:49:27 +0000 @@ -1,3 +1,10 @@ +2010-10-29 Eli Zaretskii + + * makefile.w32-in (MAKEINFO): Add -I$(emacsdir). + (ENVADD): Remove extra -I$(emacsdir), included in $(MAKEINFO). + ($(infodir)/efaq): Remove -I$(emacsdir), included in $(MAKEINFO). + ($(infodir)/calc, calc.dvi): Depend on $(emacsdir)/emacsver.texi. + 2010-10-28 Glenn Morris * Makefile.in (MAKEINFO, ENVADD): Add $emacsdir to include path. === modified file 'doc/misc/makefile.w32-in' --- doc/misc/makefile.w32-in 2010-10-09 21:38:04 +0000 +++ doc/misc/makefile.w32-in 2010-10-29 10:49:27 +0000 @@ -32,7 +32,7 @@ emacsdir = $(srcdir)/../emacs # The makeinfo program is part of the Texinfo distribution. -MAKEINFO = makeinfo --force +MAKEINFO = makeinfo --force -I$(emacsdir) MULTI_INSTALL_INFO = $(srcdir)\..\..\nt\multi-install-info.bat INFO_TARGETS = $(infodir)/ccmode \ $(infodir)/cl $(infodir)/dbus $(infodir)/dired-x \ @@ -70,7 +70,7 @@ TEXI2DVI = texi2dvi ENVADD = $(srcdir)\..\..\nt\envadd.bat "TEXINPUTS=$(srcdir);$(TEXINPUTS)" \ - "MAKEINFO=$(MAKEINFO) -I$(srcdir) -I$(emacsdir)" /C + "MAKEINFO=$(MAKEINFO) -I$(srcdir)" /C info: $(INFO_TARGETS) @@ -218,7 +218,7 @@ $(ENVADD) $(TEXI2DVI) $(srcdir)/widget.texi $(infodir)/efaq: faq.texi $(emacsdir)/emacsver.texi - $(MAKEINFO) -I$(emacsdir) faq.texi + $(MAKEINFO) faq.texi faq.dvi: faq.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/faq.texi @@ -227,10 +227,10 @@ autotype.dvi: autotype.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/autotype.texi -$(infodir)/calc: calc.texi +$(infodir)/calc: calc.texi $(emacsdir)/emacsver.texi $(MAKEINFO) calc.texi -calc.dvi: calc.texi +calc.dvi: calc.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/calc.texi # This is produced with --no-split to avoid making files whose ------------------------------------------------------------ revno: 102149 committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2010-10-29 12:43:38 +0200 message: Fix revno 102144 for non-CLASH_DETECTION platforms. emacs.c (main): Call syms_of_filelock unconditionally. filelock.c (syms_of_filelock): Move out of #ifdef CLASH_DETECTION clause, but keep part of it conditioned on CLASH_DETECTION. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-10-29 07:04:09 +0000 +++ src/ChangeLog 2010-10-29 10:43:38 +0000 @@ -1,3 +1,10 @@ +2010-10-29 Eli Zaretskii + + * emacs.c (main): Call syms_of_filelock unconditionally. + + * filelock.c (syms_of_filelock): Move out of #ifdef CLASH_DETECTION + clause, but keep part of it conditioned on CLASH_DETECTION. + 2010-10-29 Glenn Morris * nsfns.m (Fx-display-save-under, Fx-open-connection) === modified file 'src/emacs.c' --- src/emacs.c 2010-10-24 16:00:57 +0000 +++ src/emacs.c 2010-10-29 10:43:38 +0000 @@ -1509,9 +1509,7 @@ syms_of_doc (); syms_of_editfns (); syms_of_emacs (); -#ifdef CLASH_DETECTION syms_of_filelock (); -#endif /* CLASH_DETECTION */ syms_of_indent (); syms_of_insdel (); /* syms_of_keymap (); */ === modified file 'src/filelock.c' --- src/filelock.c 2010-10-03 15:19:34 +0000 +++ src/filelock.c 2010-10-29 10:43:38 +0000 @@ -730,6 +730,8 @@ boot_time_initialized = 0; } +#endif /* CLASH_DETECTION */ + void syms_of_filelock (void) { @@ -737,12 +739,12 @@ doc: /* The directory for writing temporary files. */); Vtemporary_file_directory = Qnil; +#ifdef CLASH_DETECTION defsubr (&Sunlock_buffer); defsubr (&Slock_buffer); defsubr (&Sfile_locked_p); +#endif } -#endif /* CLASH_DETECTION */ - /* arch-tag: e062676d-50b2-4be0-ab96-197c81b181a1 (do not change this comment) */ ------------------------------------------------------------ revno: 102148 committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2010-10-29 07:22:52 +0000 message: gnus-art.el (gnus-article-goto-part): Fix last change. diff: === modified file 'lisp/gnus/gnus-art.el' --- lisp/gnus/gnus-art.el 2010-10-29 07:19:21 +0000 +++ lisp/gnus/gnus-art.el 2010-10-29 07:22:52 +0000 @@ -5590,10 +5590,10 @@ (setq part (cdr (assq (mm-preferred-alternative (nreverse (mapcar 'car handles))) - handles))))) - (if part - (goto-char (1+ part)) - start))) + handles)))) + (if part + (goto-char (1+ part)) + start)))) (when gnus-break-pages (gnus-narrow-to-page)))) ------------------------------------------------------------ revno: 102147 committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2010-10-29 07:19:21 +0000 message: gnus-art.el (gnus-article-goto-part): Fix last change. diff: === modified file 'lisp/gnus/gnus-art.el' --- lisp/gnus/gnus-art.el 2010-10-29 07:13:33 +0000 +++ lisp/gnus/gnus-art.el 2010-10-29 07:19:21 +0000 @@ -5563,36 +5563,39 @@ "Go to MIME part N." (when gnus-break-pages (widen)) - (let ((start (text-property-any (point-min) (point-max) 'gnus-part n)) - part handle end next handles) - (when start - (goto-char start) - (unless (setq handle (get-text-property start 'gnus-data)) - ;; Go to the displayed subpart, assuming this is multipart/alternative. - (setq part start - end (point-at-eol)) - (while (and (not handle) - part - (< part end) - (setq next (text-property-not-all part end - 'gnus-data nil))) - (setq part next - handle (get-text-property part 'gnus-data)) - (push (cons handle part) handles) - (unless (mm-handle-displayed-p handle) - (setq handle nil - part (text-property-any part end 'gnus-data nil)))) - (unless handle - ;; No subpart is displayed, so we find preferred one. - (setq part - (cdr (assq (mm-preferred-alternative - (nreverse (mapcar 'car handles))) - handles))))) - (when gnus-break-pages - (gnus-narrow-to-page)) - (if part - (goto-char (1+ part)) - start)))) + (prog1 + (let ((start (text-property-any (point-min) (point-max) 'gnus-part n)) + part handle end next handles) + (when start + (goto-char start) + (if (setq handle (get-text-property start 'gnus-data)) + start + ;; Go to the displayed subpart, assuming this is + ;; multipart/alternative. + (setq part start + end (point-at-eol)) + (while (and (not handle) + part + (< part end) + (setq next (text-property-not-all part end + 'gnus-data nil))) + (setq part next + handle (get-text-property part 'gnus-data)) + (push (cons handle part) handles) + (unless (mm-handle-displayed-p handle) + (setq handle nil + part (text-property-any part end 'gnus-data nil)))) + (unless handle + ;; No subpart is displayed, so we find preferred one. + (setq part + (cdr (assq (mm-preferred-alternative + (nreverse (mapcar 'car handles))) + handles))))) + (if part + (goto-char (1+ part)) + start))) + (when gnus-break-pages + (gnus-narrow-to-page)))) (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name ------------------------------------------------------------ revno: 102146 committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2010-10-29 07:13:33 +0000 message: gnus-art.el (gnus-article-goto-part): Work for article narrowed by ^L. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-10-28 22:03:15 +0000 +++ lisp/gnus/ChangeLog 2010-10-29 07:13:33 +0000 @@ -1,3 +1,7 @@ +2010-10-29 Katsumi Yamaoka + + * gnus-art.el (gnus-article-goto-part): Work for article narrowed by ^L. + 2010-10-28 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-rescan-group): Try to restore the window === modified file 'lisp/gnus/gnus-art.el' --- lisp/gnus/gnus-art.el 2010-10-28 06:37:35 +0000 +++ lisp/gnus/gnus-art.el 2010-10-29 07:13:33 +0000 @@ -5561,12 +5561,13 @@ (defun gnus-article-goto-part (n) "Go to MIME part N." + (when gnus-break-pages + (widen)) (let ((start (text-property-any (point-min) (point-max) 'gnus-part n)) part handle end next handles) (when start (goto-char start) - (if (setq handle (get-text-property start 'gnus-data)) - start + (unless (setq handle (get-text-property start 'gnus-data)) ;; Go to the displayed subpart, assuming this is multipart/alternative. (setq part start end (point-at-eol)) @@ -5586,10 +5587,12 @@ (setq part (cdr (assq (mm-preferred-alternative (nreverse (mapcar 'car handles))) - handles)))) - (if part - (goto-char (1+ part)) - start))))) + handles))))) + (when gnus-break-pages + (gnus-narrow-to-page)) + (if part + (goto-char (1+ part)) + start)))) (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name ------------------------------------------------------------ revno: 102145 committer: Glenn Morris branch nick: trunk timestamp: Fri 2010-10-29 00:04:09 -0700 message: Sync docs of some X, W32, NS C functions. * src/nsfns.m (Fx-display-save-under, Fx-open-connection) (Fxw-color-defined-p, Fxw-display-color-p, Fx-show-tip): * src/w32fns.c (Fxw_color_defined_p, Fx_open_connection): * src/xfns.c (Fxw_color_defined_p, Fx_open_connection): Sync docs between X, W32, NS. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-10-29 03:29:29 +0000 +++ src/ChangeLog 2010-10-29 07:04:09 +0000 @@ -1,5 +1,11 @@ 2010-10-29 Glenn Morris + * nsfns.m (Fx-display-save-under, Fx-open-connection) + (Fxw-color-defined-p, Fxw-display-color-p, Fx-show-tip): + * w32fns.c (Fxw_color_defined_p, Fx_open_connection): + * xfns.c (Fxw_color_defined_p, Fx_open_connection): + Sync docs between X, W32, NS. + * buffer.c (syms_of_buffer) : * frame.c (syms_of_frame) : Move doc here from Lisp. === modified file 'src/nsfns.m' --- src/nsfns.m 2010-10-01 12:25:21 +0000 +++ src/nsfns.m 2010-10-29 07:04:09 +0000 @@ -1,6 +1,7 @@ /* Functions for the NeXT/Open/GNUstep and MacOSX window system. - Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008, 2009, 2010 - Free Software Foundation, Inc. + +Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -1697,7 +1698,7 @@ DEFUN ("x-display-save-under", Fx_display_save_under, Sx_display_save_under, 0, 1, 0, - doc: /* Non-nil if the Nextstep display server supports the save-under feature. + doc: /* Return t if DISPLAY supports the save-under feature. The optional argument DISPLAY specifies which display to ask about. DISPLAY should be a frame, the display name as a string, or a terminal ID. If omitted or nil, the selected frame's display is used. */) @@ -1722,9 +1723,12 @@ DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 3, 0, - doc: /* Open a connection to a Nextstep display server. + doc: /* Open a connection to a display server. DISPLAY is the name of the display to connect to. -Optional arguments XRM-STRING and MUST-SUCCEED are currently ignored. */) +Optional second arg XRM-STRING is a string of resources in xrdb format. +If the optional third arg MUST-SUCCEED is non-nil, +terminate Emacs if we can't open the connection. +\(In the Nextstep version, the last two arguments are currently ignored.) */) (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed) { struct ns_display_info *dpyinfo; @@ -2201,8 +2205,8 @@ DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, - doc: /* Return t if the current Nextstep display supports the color COLOR. -The optional argument FRAME is currently ignored. */) + doc: /* Internal function called by `color-defined-p', which see. +\(Note that the Nextstep version of this function ignores FRAME.) */) (Lisp_Object color, Lisp_Object frame) { NSColor * col; @@ -2233,10 +2237,7 @@ DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, - doc: /* Return t if the Nextstep display supports color. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame, a display name (a string), or terminal ID. -If omitted or nil, that stands for the selected frame's display. */) + doc: /* Internal function called by `display-color-p', which see. */) (Lisp_Object display) { NSWindowDepth depth; @@ -2430,6 +2431,8 @@ doc: /* Show STRING in a \"tooltip\" window on frame FRAME. A tooltip window is a small window displaying a string. +This is an internal function; Lisp code should call `tooltip-show'. + FRAME nil or omitted means use the selected frame. PARMS is an optional list of frame parameters which can be used to @@ -2675,4 +2678,3 @@ } -// arch-tag: dc2a3f74-1123-4daa-8eed-fb78db6a5642 === modified file 'src/w32fns.c' --- src/w32fns.c 2010-10-24 22:45:10 +0000 +++ src/w32fns.c 2010-10-29 07:04:09 +0000 @@ -4511,7 +4511,8 @@ DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, - doc: /* Internal function called by `color-defined-p', which see. */) + doc: /* Internal function called by `color-defined-p', which see. +\(Note that the Nextstep version of this function ignores FRAME.) */) (Lisp_Object color, Lisp_Object frame) { XColor foo; @@ -4851,11 +4852,12 @@ } DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, - 1, 3, 0, doc: /* Open a connection to a server. + 1, 3, 0, doc: /* Open a connection to a display server. DISPLAY is the name of the display to connect to. Optional second arg XRM-STRING is a string of resources in xrdb format. If the optional third arg MUST-SUCCEED is non-nil, -terminate Emacs if we can't open the connection. */) +terminate Emacs if we can't open the connection. +\(In the Nextstep version, the last two arguments are currently ignored.) */) (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed) { unsigned char *xrm_option; @@ -7267,5 +7269,3 @@ return GetLastError (); } -/* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446 - (do not change this comment) */ === modified file 'src/xfns.c' --- src/xfns.c 2010-10-24 22:45:10 +0000 +++ src/xfns.c 2010-10-29 07:04:09 +0000 @@ -3581,7 +3581,8 @@ DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, - doc: /* Internal function called by `color-defined-p', which see. */) + doc: /* Internal function called by `color-defined-p', which see +.\(Note that the Nextstep version of this function ignores FRAME.) */) (Lisp_Object color, Lisp_Object frame) { XColor foo; @@ -4099,11 +4100,12 @@ DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 3, 0, - doc: /* Open a connection to an X server. + doc: /* Open a connection to a display server. DISPLAY is the name of the display to connect to. Optional second arg XRM-STRING is a string of resources in xrdb format. If the optional third arg MUST-SUCCEED is non-nil, -terminate Emacs if we can't open the connection. */) +terminate Emacs if we can't open the connection. +\(In the Nextstep version, the last two arguments are currently ignored.) */) (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed) { unsigned char *xrm_option; ------------------------------------------------------------ revno: 102144 committer: Glenn Morris branch nick: trunk timestamp: Thu 2010-10-28 23:51:36 -0700 message: Remove duplicate Lisp definition of temporary-file-directory, from filelock.c. * lisp/files.el (temporary-file-directory): Remove (already defined in C). * lisp/cus-start.el: Add temporary-file-directory. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-10-29 03:29:29 +0000 +++ lisp/ChangeLog 2010-10-29 06:51:36 +0000 @@ -1,5 +1,8 @@ 2010-10-29 Glenn Morris + * files.el (temporary-file-directory): Remove (already defined in C). + * cus-start.el: Add temporary-file-directory. + * abbrev.el (abbrev-mode): * composite.el (auto-composition-mode): * menu-bar.el (menu-bar-mode): === modified file 'lisp/cus-start.el' --- lisp/cus-start.el 2010-10-29 03:29:29 +0000 +++ lisp/cus-start.el 2010-10-29 06:51:36 +0000 @@ -174,6 +174,35 @@ ;; fileio.c (delete-by-moving-to-trash auto-save boolean "23.1") (auto-save-visited-file-name auto-save boolean) + ;; filelock.c + (temporary-file-directory + ;; Darwin section added 24.1, does not seem worth :version bump. + files directory nil + (file-name-as-directory + ;; FIXME ? Should there be Ftemporary_file_directory to do this + ;; more robustly (cf set_local_socket in emacsclient.c). + ;; It could be used elsewhere, eg Fcall_process_region, + ;; server-socket-dir. See bug#7135. + (cond ((memq system-type '(ms-dos windows-nt)) + (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") + "c:/temp")) + ((eq system-type 'darwin) + (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") + ;; See bug#7135. + (let ((tmp (ignore-errors + (shell-command-to-string + "getconf DARWIN_USER_TEMP_DIR")))) + (and (stringp tmp) + (setq tmp (replace-regexp-in-string + "\n\\'" "" tmp)) + ;; Handles "getconf: Unrecognized variable..." + (file-directory-p tmp) + tmp)) + "/tmp")) + (t + (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") + "/tmp")))) + :initialize custom-initialize-delay) ;; fns.c (use-dialog-box menu boolean "21.1") (use-file-dialog menu boolean "22.1") === modified file 'lisp/files.el' --- lisp/files.el 2010-10-18 21:02:00 +0000 +++ lisp/files.el 2010-10-29 06:51:36 +0000 @@ -188,32 +188,6 @@ "Non-nil if visited file was read-only when visited.") (make-variable-buffer-local 'buffer-file-read-only) -(defcustom temporary-file-directory - (file-name-as-directory - ;; FIXME ? Should there be Ftemporary_file_directory to do the - ;; following more robustly (cf set_local_socket in emacsclient.c). - ;; It could be used elsewhere, eg Fcall_process_region, server-socket-dir. - ;; See bug#7135. - (cond ((memq system-type '(ms-dos windows-nt)) - (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp")) - ((eq system-type 'darwin) - (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") - (let ((tmp (ignore-errors (shell-command-to-string ; bug#7135 - "getconf DARWIN_USER_TEMP_DIR")))) - (and (stringp tmp) - (setq tmp (replace-regexp-in-string "\n\\'" "" tmp)) - ;; This handles "getconf: Unrecognized variable..." - (file-directory-p tmp) - tmp)) - "/tmp")) - (t - (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) - "The directory for writing temporary files." - :group 'files - ;; Darwin section added 24.1, does not seem worth :version bump. - :initialize 'custom-initialize-delay - :type 'directory) - (defcustom small-temporary-file-directory (if (eq system-type 'ms-dos) (getenv "TMPDIR")) "The directory for writing small temporary files. @@ -6470,5 +6444,4 @@ (define-key ctl-x-5-map "r" 'find-file-read-only-other-frame) (define-key ctl-x-5-map "\C-o" 'display-buffer-other-frame) -;; arch-tag: bc68d3ea-19ca-468b-aac6-3a4a7766101f ;;; files.el ends here