Now on revision 112137. ------------------------------------------------------------ revno: 112137 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=13951 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-03-25 23:38:18 -0400 message: * lisp/desktop.el (desktop--v2s): Rename from desktop-internal-v2s. Change return value to be a sexp. Delay `get-buffer' to after restoring the desktop. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-03-26 02:49:05 +0000 +++ lisp/ChangeLog 2013-03-26 03:38:18 +0000 @@ -1,3 +1,9 @@ +2013-03-26 Stefan Monnier + + * desktop.el (desktop--v2s): Rename from desktop-internal-v2s. + Change return value to be a sexp. Delay `get-buffer' to after + restoring the desktop (bug#13951). + 2013-03-26 Leo Liu * register.el: Move semantic tag handling back to === modified file 'lisp/desktop.el' --- lisp/desktop.el 2013-01-02 16:13:04 +0000 +++ lisp/desktop.el 2013-03-26 03:38:18 +0000 @@ -697,83 +697,69 @@ ll))) ;; ---------------------------------------------------------------------------- -(defun desktop-internal-v2s (value) - "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. -TXT is a string that when read and evaluated yields VALUE. +(defun desktop--v2s (value) + "Convert VALUE to a pair (QUOTE . SEXP); (eval SEXP) gives VALUE. +SEXP is an sexp that when evaluated yields VALUE. QUOTE may be `may' (value may be quoted), `must' (value must be quoted), or nil (value must not be quoted)." (cond ((or (numberp value) (null value) (eq t value) (keywordp value)) - (cons 'may (prin1-to-string value))) + (cons 'may value)) ((stringp value) (let ((copy (copy-sequence value))) (set-text-properties 0 (length copy) nil copy) - ;; Get rid of text properties because we cannot read them - (cons 'may (prin1-to-string copy)))) + ;; Get rid of text properties because we cannot read them. + (cons 'may copy))) ((symbolp value) - (cons 'must (prin1-to-string value))) + (cons 'must value)) ((vectorp value) - (let* ((special nil) - (pass1 (mapcar - (lambda (el) - (let ((res (desktop-internal-v2s el))) - (if (null (car res)) - (setq special t)) - res)) - value))) + (let* ((pass1 (mapcar #'desktop--v2s value)) + (special (assq nil pass1))) (if special - (cons nil (concat "(vector " - (mapconcat (lambda (el) - (if (eq (car el) 'must) - (concat "'" (cdr el)) - (cdr el))) - pass1 - " ") - ")")) - (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]"))))) + (cons nil `(vector + ,@(mapcar (lambda (el) + (if (eq (car el) 'must) + `',(cdr el) (cdr el))) + pass1))) + (cons 'may `[,@(mapcar #'cdr pass1)])))) ((consp value) (let ((p value) newlist use-list* anynil) (while (consp p) - (let ((q.txt (desktop-internal-v2s (car p)))) - (or anynil (setq anynil (null (car q.txt)))) - (setq newlist (cons q.txt newlist))) + (let ((q.sexp (desktop--v2s (car p)))) + (push q.sexp newlist)) (setq p (cdr p))) - (if p - (let ((last (desktop-internal-v2s p))) - (or anynil (setq anynil (null (car last)))) - (or anynil - (setq newlist (cons '(must . ".") newlist))) - (setq use-list* t) - (setq newlist (cons last newlist)))) - (setq newlist (nreverse newlist)) - (if anynil + (when p + (let ((last (desktop--v2s p))) + (setq use-list* t) + (push last newlist))) + (if (assq nil newlist) (cons nil - (concat (if use-list* "(desktop-list* " "(list ") - (mapconcat (lambda (el) - (if (eq (car el) 'must) - (concat "'" (cdr el)) - (cdr el))) - newlist - " ") - ")")) + `(,(if use-list* 'desktop-list* 'list) + ,@(mapcar (lambda (el) + (if (eq (car el) 'must) + `',(cdr el) (cdr el))) + (nreverse newlist)))) (cons 'must - (concat "(" (mapconcat 'cdr newlist " ") ")"))))) + `(,@(mapcar #'cdr + (nreverse (if use-list* (cdr newlist) newlist))) + ,@(if use-list* (cdar newlist))))))) ((subrp value) - (cons nil (concat "(symbol-function '" - (substring (prin1-to-string value) 7 -1) - ")"))) + (cons nil `(symbol-function + ',(intern-soft (substring (prin1-to-string value) 7 -1))))) ((markerp value) - (let ((pos (prin1-to-string (marker-position value))) - (buf (prin1-to-string (buffer-name (marker-buffer value))))) - (cons nil (concat "(let ((mk (make-marker)))" - " (add-hook 'desktop-delay-hook" - " (list 'lambda '() (list 'set-marker mk " - pos " (get-buffer " buf ")))) mk)")))) - (t ; save as text - (cons 'may "\"Unprintable entity\"")))) + (let ((pos (marker-position value)) + (buf (buffer-name (marker-buffer value)))) + (cons nil + `(let ((mk (make-marker))) + (add-hook 'desktop-delay-hook + `(lambda () + (set-marker ,mk ,,pos (get-buffer ,,buf)))) + mk)))) + (t ; Save as text. + (cons 'may "Unprintable entity")))) ;; ---------------------------------------------------------------------------- (defun desktop-value-to-string (value) @@ -781,9 +767,11 @@ Not all types of values are supported." (let* ((print-escape-newlines t) (float-output-format nil) - (quote.txt (desktop-internal-v2s value)) - (quote (car quote.txt)) - (txt (cdr quote.txt))) + (quote.sexp (desktop--v2s value)) + (quote (car quote.sexp)) + (txt + (let ((print-quoted t)) + (prin1-to-string (cdr quote.sexp))))) (if (eq quote 'must) (concat "'" txt) txt))) ------------------------------------------------------------ revno: 112136 fixes bug: http://debbugs.gnu.org/14052 committer: Leo Liu branch nick: trunk timestamp: Tue 2013-03-26 10:49:05 +0800 message: * lisp/register.el: Move semantic tag handling back to cedet/semantic/senator.el. * lisp/cedet/semantic/senator.el (senator-copy-tag-to-register): Move register handling logic from register.el. (Bug#14052) diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-03-26 00:42:08 +0000 +++ lisp/ChangeLog 2013-03-26 02:49:05 +0000 @@ -1,3 +1,8 @@ +2013-03-26 Leo Liu + + * register.el: Move semantic tag handling back to + cedet/semantic/senator.el. (Bug#14052) + 2013-03-26 Stefan Monnier * eshell/em-prompt.el (eshell-emit-prompt): Make sure we can't insert === modified file 'lisp/cedet/ChangeLog' --- lisp/cedet/ChangeLog 2013-03-21 22:11:03 +0000 +++ lisp/cedet/ChangeLog 2013-03-26 02:49:05 +0000 @@ -1,3 +1,8 @@ +2013-03-26 Leo Liu + + * semantic/senator.el (senator-copy-tag-to-register): Move + register handling logic from register.el. (Bug#14052) + 2013-03-21 Eric Ludlam * semantic.el (navigate-menu): Yank Tag :enable. Make sure === modified file 'lisp/cedet/semantic/senator.el' --- lisp/cedet/semantic/senator.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/senator.el 2013-03-26 02:49:05 +0000 @@ -727,7 +727,13 @@ (semantic-fetch-tags) (let ((ft (semantic-obtain-foreign-tag))) (when ft - (set-register register ft) + (set-register + register (registerv-make + ft + :insert-func #'semantic-insert-foreign-tag + :jump-func (lambda (v) + (switch-to-buffer (semantic-tag-buffer v)) + (goto-char (semantic-tag-start v))))) (if kill-flag (kill-region (semantic-tag-start ft) (semantic-tag-end ft)))))) === modified file 'lisp/register.el' --- lisp/register.el 2013-01-01 09:11:05 +0000 +++ lisp/register.el 2013-03-26 02:49:05 +0000 @@ -31,10 +31,6 @@ (eval-when-compile (require 'cl-lib)) -(declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag)) -(declare-function semantic-tag-buffer "semantic/tag" (tag)) -(declare-function semantic-tag-start "semantic/tag" (tag)) - ;;; Code: (cl-defstruct @@ -174,11 +170,6 @@ (error "Register access aborted")) (find-file (nth 1 val)) (goto-char (nth 2 val))) - ((and (fboundp 'semantic-foreign-tag-p) - semantic-mode - (semantic-foreign-tag-p val)) - (switch-to-buffer (semantic-tag-buffer val)) - (goto-char (semantic-tag-start val))) (t (error "Register doesn't contain a buffer position or configuration"))))) @@ -349,10 +340,6 @@ (princ val (current-buffer))) ((and (markerp val) (marker-position val)) (princ (marker-position val) (current-buffer))) - ((and (fboundp 'semantic-foreign-tag-p) - semantic-mode - (semantic-foreign-tag-p val)) - (semantic-insert-foreign-tag val)) (t (error "Register does not contain text")))) (if (not arg) (exchange-point-and-mark))) ------------------------------------------------------------ revno: 112135 author: Andrew Cohen committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2013-03-26 02:26:53 +0000 message: lisp/gnus/ChangeLog: Update diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-03-25 22:40:58 +0000 +++ lisp/gnus/ChangeLog 2013-03-26 02:26:53 +0000 @@ -1,6 +1,10 @@ 2013-03-26 Andrew Cohen - * nnir.el: Major rewrite. Separate searching from group management. + * nnir.el: Major rewrite. Cleaner separation between searches and group + management. Marks are now shown in nnir summary buffers. Rudimentary + support for real (i.e. not ephemeral) nnir groups. + (gnus-summary-make-nnir-group): New function for initiating searches + from a summary buffer. 2013-03-18 Sam Steingold ------------------------------------------------------------ revno: 112134 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=13963 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-03-25 20:42:08 -0400 message: * lisp/eshell/em-prompt.el (eshell-emit-prompt): Make sure we can't insert into the prompt either. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-03-25 13:47:32 +0000 +++ lisp/ChangeLog 2013-03-26 00:42:08 +0000 @@ -1,3 +1,8 @@ +2013-03-26 Stefan Monnier + + * eshell/em-prompt.el (eshell-emit-prompt): Make sure we can't insert + into the prompt either (bug#13963). + 2013-03-25 Stefan Monnier * font-lock.el (lisp-font-lock-keywords-2): Don't highlight the "error" === modified file 'lisp/eshell/em-prompt.el' --- lisp/eshell/em-prompt.el 2013-01-01 09:11:05 +0000 +++ lisp/eshell/em-prompt.el 2013-03-26 00:42:08 +0000 @@ -122,6 +122,7 @@ (add-text-properties 0 (length prompt) '(read-only t face eshell-prompt + front-sticky (face read-only) rear-nonsticky (face read-only)) prompt)) (eshell-interactive-print prompt))) ------------------------------------------------------------ revno: 112133 author: Andrew Cohen committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2013-03-25 22:40:58 +0000 message: lisp/gnus/nnir.el: Major rewrite; Separate searching from group management diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-03-18 17:25:15 +0000 +++ lisp/gnus/ChangeLog 2013-03-25 22:40:58 +0000 @@ -1,3 +1,7 @@ +2013-03-26 Andrew Cohen + + * nnir.el: Major rewrite. Separate searching from group management. + 2013-03-18 Sam Steingold * message.el (message-bury): Minor cleanup. === modified file 'lisp/gnus/nnir.el' --- lisp/gnus/nnir.el 2013-03-05 17:13:01 +0000 +++ lisp/gnus/nnir.el 2013-03-25 22:40:58 +0000 @@ -29,10 +29,6 @@ ;;; Commentary: -;; TODO: Documentation in the Gnus manual - -;; Where in the existing gnus manual would this fit best? - ;; What does it do? Well, it allows you to search your mail using ;; some search engine (imap, namazu, swish-e, gmane and others -- see ;; later) by typing `G G' in the Group buffer. You will then get a @@ -136,17 +132,26 @@ ;; other backend. ;; The interface between the two layers consists of the single -;; function `nnir-run-query', which just selects the appropriate -;; function for the search engine one is using. The input to -;; `nnir-run-query' is a string, representing the query as input by -;; the user. The output of `nnir-run-query' is supposed to be a -;; vector, each element of which should in turn be a three-element -;; vector. The first element should be full group name of the article, -;; the second element should be the article number, and the third -;; element should be the Retrieval Status Value (RSV) as returned from -;; the search engine. An RSV is the score assigned to the document by -;; the search engine. For Boolean search engines, the -;; RSV is always 1000 (or 1 or 100, or whatever you like). +;; function `nnir-run-query', which dispatches the search to the +;; proper search function. The argument of `nnir-run-query' is an +;; alist with two keys: 'nnir-query-spec and 'nnir-group-spec. The +;; value for 'nnir-query-spec is an alist. The only required key/value +;; pair is (query . "query") specifying the search string to pass to +;; the query engine. Individual engines may have other elements. The +;; value of 'nnir-group-spec is a list with the specification of the +;; groups/servers to search. The format of the 'nnir-group-spec is +;; (("server1" ("group11" "group12")) ("server2" ("group21" +;; "group22"))). If any of the group lists is absent then all groups +;; on that server are searched. + +;; The output of `nnir-run-query' is supposed to be a vector, each +;; element of which should in turn be a three-element vector. The +;; first element should be full group name of the article, the second +;; element should be the article number, and the third element should +;; be the Retrieval Status Value (RSV) as returned from the search +;; engine. An RSV is the score assigned to the document by the search +;; engine. For Boolean search engines, the RSV is always 1000 (or 1 +;; or 100, or whatever you like). ;; The sorting order of the articles in the summary buffer created by ;; nnir is based on the order of the articles in the above mentioned @@ -179,26 +184,21 @@ ;;; Internal Variables: -(defvar nnir-current-query nil - "Internal: stores current query (= group name).") - -(defvar nnir-current-server nil - "Internal: stores current server (does it ever change?).") - -(defvar nnir-current-group-marked nil - "Internal: stores current list of process-marked groups.") +(defvar nnir-memo-query nil + "Internal: stores current query.") + +(defvar nnir-memo-server nil + "Internal: stores current server.") (defvar nnir-artlist nil "Internal: stores search result.") -(defvar nnir-tmp-buffer " *nnir*" - "Internal: temporary buffer.") - (defvar nnir-search-history () "Internal: the history for querying search options in nnir") -(defvar nnir-extra-parms nil - "Internal: stores request for extra search parms") +(defconst nnir-tmp-buffer " *nnir*" + "Internal: temporary buffer.") + ;; Imap variables @@ -290,14 +290,14 @@ (autoload 'nnimap-command "nnimap") (autoload 'nnimap-possibly-change-group "nnimap") (autoload 'nnimap-make-thread-query "nnimap") - (autoload 'gnus-registry-action "gnus-registry")) + (autoload 'gnus-registry-action "gnus-registry") + (autoload 'gnus-registry-get-id-key "gnus-registry") + (autoload 'gnus-group-topic-name "gnus-topic")) + (nnoo-declare nnir) (nnoo-define-basics nnir) -(defvoo nnir-address nil - "The address of the nnir server.") - (gnus-declare-backend "nnir" 'mail 'virtual) @@ -344,7 +344,7 @@ (defcustom nnir-imap-default-search-key "whole message" "*The default IMAP search key for an nnir search. Must be one of the keys in `nnir-imap-search-arguments'. To use raw imap queries - by default set this to \"Imap\"." + by default set this to \"imap\"." :version "24.1" :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) nnir-imap-search-arguments)) @@ -546,17 +546,17 @@ ,nnir-imap-default-search-key ; default ))) (gmane nnir-run-gmane - ((author . "Gmane Author: "))) + ((gmane-author . "Gmane Author: "))) (swish++ nnir-run-swish++ - ((group . "Swish++ Group spec: "))) + ((swish++-group . "Swish++ Group spec: "))) (swish-e nnir-run-swish-e - ((group . "Swish-e Group spec: "))) + ((swish-e-group . "Swish-e Group spec: "))) (namazu nnir-run-namazu ()) (notmuch nnir-run-notmuch ()) (hyrex nnir-run-hyrex - ((group . "Hyrex Group spec: "))) + ((hyrex-group . "Hyrex Group spec: "))) (find-grep nnir-run-find-grep ((grep-options . "Grep options: ")))) "Alist of supported search engines. @@ -576,69 +576,113 @@ Add an entry here when adding a new search engine.") -(defcustom nnir-method-default-engines - '((nnimap . imap) - (nntp . gmane)) +(defcustom nnir-method-default-engines '((nnimap . imap) (nttp . gmane)) "*Alist of default search engines keyed by server method." :version "24.1" + :group 'nnir :type `(repeat (cons (choice (const nnimap) (const nttp) (const nnspool) (const nneething) (const nndir) (const nnmbox) (const nnml) (const nnmh) (const nndraft) (const nnfolder) (const nnmaildir)) (choice ,@(mapcar (lambda (elem) (list 'const (car elem))) - nnir-engines)))) - :group 'nnir) + nnir-engines))))) ;; Gnus glue. -(defun gnus-group-make-nnir-group (nnir-extra-parms &optional parms) - "Create an nnir group. Asks for query." +(defun gnus-group-make-nnir-group (nnir-extra-parms &optional specs) + "Create an nnir group. Prompt for a search query and determine +the groups to search as follows: if called from the *Server* +buffer search all groups belonging to the server on the current +line; if called from the *Group* buffer search any marked groups, +or the group on the current line, or all the groups under the +current topic. Calling with a prefix-arg prompts for additional +search-engine specific constraints. A non-nil `specs' arg must be +an alist with `nnir-query-spec' and `nnir-group-spec' keys, and +skips all prompting." (interactive "P") - (setq nnir-current-query nil - nnir-current-server nil - nnir-current-group-marked nil - nnir-artlist nil) - (let* ((query (unless parms (read-string "Query: " nil 'nnir-search-history))) - (parms (or parms (list (cons 'query query)))) - (srv (or (cdr (assq 'server parms)) (gnus-server-server-name) "nnir"))) - (add-to-list 'parms (cons 'unique-id (message-unique-id)) t) + (let* ((group-spec + (or (cdr (assoc 'nnir-group-spec specs)) + (if (gnus-server-server-name) + (list (list (gnus-server-server-name))) + (nnir-categorize + (or gnus-group-marked + (if (gnus-group-group-name) + (list (gnus-group-group-name)) + (cdr (assoc (gnus-group-topic-name) gnus-topic-alist)))) + gnus-group-server)))) + (query-spec + (or (cdr (assoc 'nnir-query-spec specs)) + (apply + 'append + (list (cons 'query + (read-string "Query: " nil 'nnir-search-history))) + (when nnir-extra-parms + (mapcar + (lambda (x) + (nnir-read-parms (nnir-server-to-search-engine (car x)))) + group-spec)))))) (gnus-group-read-ephemeral-group - (concat "nnir:" (prin1-to-string parms)) (list 'nnir srv) t - (cons (current-buffer) gnus-current-window-configuration) - nil))) + (concat "nnir-" (message-unique-id)) + (list 'nnir "nnir") + nil +; (cons (current-buffer) gnus-current-window-configuration) + nil + nil nil + (list + (cons 'nnir-specs (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec))) + (cons 'nnir-artlist nil))))) + +(defun gnus-summary-make-nnir-group (nnir-extra-parms) + "Search a group from the summary buffer." + (interactive "P") + (gnus-warp-to-article) + (let ((spec + (list + (cons 'nnir-group-spec + (list (list + (gnus-group-server gnus-newsgroup-name) + (list gnus-newsgroup-name))))))) + (gnus-group-make-nnir-group nnir-extra-parms spec))) ;; Gnus backend interface functions. (deffoo nnir-open-server (server &optional definitions) ;; Just set the server variables appropriately. - (add-hook 'gnus-summary-mode-hook 'nnir-mode) - (nnoo-change-server 'nnir server definitions)) + (let ((backend (car (gnus-server-to-method server)))) + (if backend + (nnoo-change-server backend server definitions) + (add-hook 'gnus-summary-mode-hook 'nnir-mode) + (nnoo-change-server 'nnir server definitions)))) -(deffoo nnir-request-group (group &optional server fast info) - "GROUP is the query string." - (nnir-possibly-change-server server) - ;; Check for cache and return that if appropriate. - (if (and (equal group nnir-current-query) - (equal gnus-group-marked nnir-current-group-marked) - (or (null server) - (equal server nnir-current-server))) - nnir-artlist - ;; Cache miss. - (setq nnir-artlist (nnir-run-query group))) - (with-current-buffer nntp-server-buffer - (setq nnir-current-query group) - (when server (setq nnir-current-server server)) - (setq nnir-current-group-marked gnus-group-marked) - (if (zerop (length nnir-artlist)) - (nnheader-report 'nnir "Search produced empty results.") - ;; Remember data for cache. - (nnheader-insert "211 %d %d %d %s\n" - (nnir-artlist-length nnir-artlist) ; total # - 1 ; first # - (nnir-artlist-length nnir-artlist) ; last # - group)))) ; group name +(deffoo nnir-request-group (group &optional server dont-check info) + (nnir-possibly-change-group group server) + (let ((pgroup (if (gnus-group-prefixed-p group) + group + (gnus-group-prefixed-name group '(nnir "nnir")))) + length) + ;; Check for cached search result or run the query and cache the + ;; result. + (unless (and nnir-artlist dont-check) + (gnus-group-set-parameter + pgroup 'nnir-artlist + (setq nnir-artlist + (nnir-run-query + (gnus-group-get-parameter pgroup 'nnir-specs t)))) + (nnir-request-update-info pgroup (gnus-get-info pgroup))) + (with-current-buffer nntp-server-buffer + (if (zerop (setq length (nnir-artlist-length nnir-artlist))) + (progn + (nnir-close-group group) + (nnheader-report 'nnir "Search produced empty results.")) + (nnheader-insert "211 %d %d %d %s\n" + length ; total # + 1 ; first # + length ; last # + group)))) ; group name + nnir-artlist) (deffoo nnir-retrieve-headers (articles &optional group server fetch-old) (with-current-buffer nntp-server-buffer @@ -654,13 +698,7 @@ (server (gnus-group-server artgroup)) (gnus-override-method (gnus-server-to-method server)) parsefunc) - ;; (or (numberp art) - ;; (nnheader-report - ;; 'nnir - ;; "nnir-retrieve-headers doesn't grok message ids: %s" - ;; art)) - (nnir-possibly-change-server server) - ;; is this needed? + ;; (nnir-possibly-change-group nil server) (erase-buffer) (case (setq gnus-headers-retrieved-by (or @@ -694,6 +732,7 @@ 'nov))) (deffoo nnir-request-article (article &optional group server to-buffer) + (nnir-possibly-change-group group server) (if (and (stringp article) (not (eq 'nnimap (car (gnus-server-to-method server))))) (nnheader-report @@ -702,35 +741,35 @@ server) (save-excursion (let ((article article) - query) - (when (stringp article) - (setq gnus-override-method (gnus-server-to-method server)) - (setq query - (list - (cons 'query (format "HEADER Message-ID %s" article)) - (cons 'unique-id article) - (cons 'criteria "") - (cons 'shortcut t))) - (unless (and (equal query nnir-current-query) - (equal server nnir-current-server)) - (setq nnir-artlist (nnir-run-imap query server)) - (setq nnir-current-query query) - (setq nnir-current-server server)) - (setq article 1)) - (unless (zerop (length nnir-artlist)) - (let ((artfullgroup (nnir-article-group article)) - (artno (nnir-article-number article))) - (message "Requesting article %d from group %s" - artno artfullgroup) - (if to-buffer - (with-current-buffer to-buffer - (let ((gnus-article-decode-hook nil)) - (gnus-request-article-this-buffer artno artfullgroup))) - (gnus-request-article artno artfullgroup)) - (cons artfullgroup artno))))))) + query) + (when (stringp article) + (setq gnus-override-method (gnus-server-to-method server)) + (setq query + (list + (cons 'query (format "HEADER Message-ID %s" article)) + (cons 'criteria "") + (cons 'shortcut t))) + (unless (and nnir-artlist (equal query nnir-memo-query) + (equal server nnir-memo-server)) + (setq nnir-artlist (nnir-run-imap query server) + nnir-memo-query query + nnir-memo-server server)) + (setq article 1)) + (unless (zerop (nnir-artlist-length nnir-artlist)) + (let ((artfullgroup (nnir-article-group article)) + (artno (nnir-article-number article))) + (message "Requesting article %d from group %s" + artno artfullgroup) + (if to-buffer + (with-current-buffer to-buffer + (let ((gnus-article-decode-hook nil)) + (gnus-request-article-this-buffer artno artfullgroup))) + (gnus-request-article artno artfullgroup)) + (cons artfullgroup artno))))))) (deffoo nnir-request-move-article (article group server accept-form &optional last internal-move-group) + (nnir-possibly-change-group group server) (let* ((artfullgroup (nnir-article-group article)) (artno (nnir-article-number article)) (to-newsgroup (nth 1 accept-form)) @@ -751,6 +790,7 @@ (gnus-group-real-name to-newsgroup))))) (deffoo nnir-request-expire-articles (articles group &optional server force) + (nnir-possibly-change-group group server) (if force (let ((articles-by-group (nnir-categorize articles nnir-article-group nnir-article-ids)) @@ -772,20 +812,79 @@ articles)) (deffoo nnir-warp-to-article () + (nnir-possibly-change-group gnus-newsgroup-name) (let* ((cur (if (> (gnus-summary-article-number) 0) (gnus-summary-article-number) - (error "This is not a real article"))) + (error "Can't warp to a pseudo-article"))) (backend-article-group (nnir-article-group cur)) (backend-article-number (nnir-article-number cur)) (quit-config (gnus-ephemeral-group-p gnus-newsgroup-name))) - ;; first exit from the nnir summary buffer. - (gnus-summary-exit) + + ;; what should we do here? we could leave all the buffers around + ;; and assume that we have to exit from them one by one. or we can + ;; try to clean up directly + + ;;first exit from the nnir summary buffer. +; (gnus-summary-exit) ;; and if the nnir summary buffer in turn came from another ;; summary buffer we have to clean that summary up too. - (when (eq (cdr quit-config) 'summary) - (gnus-summary-exit)) + ; (when (not (eq (cdr quit-config) 'group)) +; (gnus-summary-exit)) (gnus-summary-read-group-1 backend-article-group t t nil - nil (list backend-article-number)))) + nil (list backend-article-number)))) + + +(deffoo nnir-request-update-info (group info &optional server) + (let ((articles-by-group + (nnir-categorize + (number-sequence 1 (nnir-artlist-length nnir-artlist)) + nnir-article-group nnir-article-ids))) + (gnus-set-active group + (cons 1 (nnir-artlist-length nnir-artlist))) + (while (not (null articles-by-group)) + (let* ((group-articles (pop articles-by-group)) + (articleids (reverse (cadr group-articles))) + (group-info (gnus-get-info (car group-articles))) + (marks (gnus-info-marks group-info)) + (read (gnus-info-read group-info))) + (gnus-info-set-read + info + (gnus-add-to-range + (gnus-info-read info) + (remove nil (mapcar (lambda (art) + (let ((num (cdr art))) + (when (gnus-member-of-range num read) + (car art)))) articleids)))) + (mapc (lambda (mark) + (let ((type (car mark)) + (range (cdr mark))) + (gnus-add-marked-articles + group + type + (remove nil + (mapcar + (lambda (art) + (let ((num (cdr art))) + (when (gnus-member-of-range num range) + (car art)))) + articleids))))) marks))))) + + +(deffoo nnir-close-group (group &optional server) + (let ((pgroup (if (gnus-group-prefixed-p group) + group + (gnus-group-prefixed-name group '(nnir "nnir"))))) + (when (and nnir-artlist (not (gnus-ephemeral-group-p pgroup))) + (gnus-group-set-parameter pgroup 'nnir-artlist nnir-artlist)) + (setq nnir-artlist nil) + (when (gnus-ephemeral-group-p pgroup) + (gnus-kill-ephemeral-group pgroup) + (setq gnus-ephemeral-servers + (delq (assq 'nnir gnus-ephemeral-servers) + gnus-ephemeral-servers))))) +;; (gnus-opened-servers-remove +;; (car (assoc '(nnir "nnir-ephemeral" (nnir-address "nnir")) +;; gnus-opened-servers)))) (nnoo-define-skeleton nnir) @@ -813,7 +912,7 @@ ;; remove trailing slash and, for nnmaildir, cur/new/tmp (setq dirnam (substring dirnam 0 - (if (string-match "^nnmaildir:" (gnus-group-server server)) + (if (string-match "\\`nnmaildir:" (gnus-group-server server)) -5 -1))) ;; Set group to dirnam without any leading dots or slashes, @@ -823,7 +922,7 @@ "[/\\]" "." t))) (vector (gnus-group-full-name group server) - (if (string-match "^nnmaildir:" (gnus-group-server server)) + (if (string-match "\\`nnmaildir:" (gnus-group-server server)) (nnmaildir-base-name-to-article-number (substring article 0 (string-match ":" article)) group nil) @@ -850,35 +949,36 @@ (apply 'vconcat (catch 'found - (mapcar - (lambda (group) - (let (artlist) - (condition-case () - (when (nnimap-possibly-change-group - (gnus-group-short-name group) server) - (with-current-buffer (nnimap-buffer) - (message "Searching %s..." group) - (let ((arts 0) - (result (nnimap-command "UID SEARCH %s" - (if (string= criteria "") - qstring - (nnir-imap-make-query - criteria qstring))))) - (mapc - (lambda (artnum) - (let ((artn (string-to-number artnum))) - (when (> artn 0) - (push (vector group artn 100) - artlist) - (when (assq 'shortcut query) - (throw 'found (list artlist))) - (setq arts (1+ arts))))) - (and (car result) (cdr (assoc "SEARCH" (cdr result))))) - (message "Searching %s... %d matches" group arts))) - (message "Searching %s...done" group)) - (quit nil)) - (nreverse artlist))) - groups)))))) + (mapcar + (lambda (group) + (let (artlist) + (condition-case () + (when (nnimap-possibly-change-group + (gnus-group-short-name group) server) + (with-current-buffer (nnimap-buffer) + (message "Searching %s..." group) + (let ((arts 0) + (result (nnimap-command "UID SEARCH %s" + (if (string= criteria "") + qstring + (nnir-imap-make-query + criteria qstring))))) + (mapc + (lambda (artnum) + (let ((artn (string-to-number artnum))) + (when (> artn 0) + (push (vector group artn 100) + artlist) + (when (assq 'shortcut query) + (throw 'found (list artlist))) + (setq arts (1+ arts))))) + (and (car result) + (cdr (assoc "SEARCH" (cdr result))))) + (message "Searching %s... %d matches" group arts))) + (message "Searching %s...done" group)) + (quit nil)) + (nreverse artlist))) + groups)))))) (defun nnir-imap-make-query (criteria qstring) "Parse the query string and criteria into an appropriate IMAP search @@ -1073,14 +1173,14 @@ (save-excursion (let ( (qstring (cdr (assq 'query query))) - (groupspec (cdr (assq 'group query))) + (groupspec (cdr (assq 'swish++-group query))) (prefix (nnir-read-server-parm 'nnir-swish++-remove-prefix server)) artlist ;; nnml-use-compressed-files might be any string, but probably this ;; is sufficient. Note that we can't only use the value of ;; nnml-use-compressed-files because old articles might have been ;; saved with a different value. - (article-pattern (if (string-match "^nnmaildir:" + (article-pattern (if (string-match "\\`nnmaildir:" (gnus-group-server server)) ":[0-9]+" "^[0-9]+\\(\\.[a-z0-9]+\\)?$")) @@ -1247,7 +1347,7 @@ (defun nnir-run-hyrex (query server &optional group) (save-excursion (let ((artlist nil) - (groupspec (cdr (assq 'group query))) + (groupspec (cdr (assq 'hyrex-group query))) (qstring (cdr (assq 'query query))) (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server)) score artno dirnam) @@ -1323,7 +1423,7 @@ ;; (when group ;; (error "The Namazu backend cannot search specific groups")) (save-excursion - (let ((article-pattern (if (string-match "^nnmaildir:" + (let ((article-pattern (if (string-match "\\`nnmaildir:" (gnus-group-server server)) ":[0-9]+" "^[0-9]+$")) @@ -1394,10 +1494,10 @@ (save-excursion (let ( (qstring (cdr (assq 'query query))) - (groupspec (cdr (assq 'group query))) + (groupspec (cdr (assq 'notmuch-group query))) (prefix (nnir-read-server-parm 'nnir-notmuch-remove-prefix server)) artlist - (article-pattern (if (string-match "^nnmaildir:" + (article-pattern (if (string-match "\\`nnmaildir:" (gnus-group-server server)) ":[0-9]+" "^[0-9]+$")) @@ -1467,24 +1567,23 @@ (directory (cadr (assoc sym (cddr method)))) (regexp (cdr (assoc 'query query))) (grep-options (cdr (assoc 'grep-options query))) - (grouplist (or grouplist (nnir-get-active server))) - artlist) + (grouplist (or grouplist (nnir-get-active server)))) (unless directory (error "No directory found in method specification of server %s" server)) (apply 'vconcat (mapcar (lambda (x) - (let ((group x)) + (let ((group x) + artlist) (message "Searching %s using find-grep..." (or group server)) (save-window-excursion (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) (if (> gnus-verbose 6) (pop-to-buffer (current-buffer))) (cd directory) ; Using relative paths simplifies - ; postprocessing. + ; postprocessing. (let ((group (if (not group) "." @@ -1507,7 +1606,8 @@ (save-excursion (apply 'call-process "find" nil t - "find" group "-type" "f" "-name" "[0-9]*" "-exec" + "find" group "-maxdepth" "1" "-type" "f" + "-name" "[0-9]*" "-exec" "grep" `("-l" ,@(and grep-options (split-string grep-options "\\s-" t)) @@ -1557,8 +1657,8 @@ (error "Can't search non-gmane groups: %s" x))) groups " ")) (authorspec - (if (assq 'author query) - (format "author:%s" (cdr (assq 'author query))) "")) + (if (assq 'gmane-author query) + (format "author:%s" (cdr (assq 'gmane-author query))) "")) (search (format "%s %s %s" qstring groupspec authorspec)) (gnus-inhibit-demon t) @@ -1594,11 +1694,10 @@ ;;; Util Code: -(defun nnir-read-parms (query nnir-search-engine) +(defun nnir-read-parms (nnir-search-engine) "Reads additional search parameters according to `nnir-engines'." (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines)))) - (append query - (mapcar 'nnir-read-parm parmspec)))) + (mapcar 'nnir-read-parm parmspec))) (defun nnir-read-parm (parmspec) "Reads a single search parameter. @@ -1612,46 +1711,23 @@ (cons sym (format (cdr mapping) result))) (cons sym (read-string prompt))))) -(autoload 'gnus-group-topic-name "gnus-topic") +(defun nnir-run-query (specs) + "Invoke appropriate search engine function (see `nnir-engines')." + (apply 'vconcat + (mapcar + (lambda (x) + (let* ((server (car x)) + (search-engine (nnir-server-to-search-engine server)) + (search-func (cadr (assoc search-engine nnir-engines)))) + (and search-func + (funcall search-func (cdr (assq 'nnir-query-spec specs)) + server (cadr x))))) + (cdr (assq 'nnir-group-spec specs))))) -(defun nnir-run-query (query) - "Invoke appropriate search engine function (see `nnir-engines'). - If some groups were process-marked, run the query for each of the groups - and concat the results." - (let ((q (car (read-from-string query))) - (groups (if (not (string= "nnir" nnir-address)) - (list (list nnir-address)) - (nnir-categorize - (or gnus-group-marked - (if (gnus-group-group-name) - (list (gnus-group-group-name)) - (cdr (assoc (gnus-group-topic-name) - gnus-topic-alist)))) - gnus-group-server)))) - (apply 'vconcat - (mapcar - (lambda (x) - (let* ((server (car x)) - (nnir-search-engine - (or (nnir-read-server-parm 'nnir-search-engine - server t) - (cdr (assoc (car - (gnus-server-to-method server)) - nnir-method-default-engines)))) - search-func) - (setq search-func (cadr (assoc nnir-search-engine - nnir-engines))) - (if search-func - (funcall - search-func - (if nnir-extra-parms - (or (and (eq nnir-search-engine 'imap) - (assq 'criteria q) q) - (setq q (nnir-read-parms q nnir-search-engine))) - q) - server (cadr x)) - nil))) - groups)))) +(defun nnir-server-to-search-engine (server) + (or (nnir-read-server-parm 'nnir-search-engine server t) + (cdr (assoc (car (gnus-server-to-method server)) + nnir-method-default-engines)))) (defun nnir-read-server-parm (key server &optional not-global) "Returns the parameter value corresponding to `key' for @@ -1663,36 +1739,43 @@ ((and (not not-global) (boundp key)) (symbol-value key)) (t nil)))) - -(defun nnir-possibly-change-server (server) - (unless (and server (nnir-server-opened server)) - (nnir-open-server server))) - +(defun nnir-possibly-change-group (group &optional server) + (or (not server) (nnir-server-opened server) (nnir-open-server server)) + (when (and group (string-match "\\`nnir" group)) + (setq nnir-artlist (gnus-group-get-parameter + (gnus-group-prefixed-name + (gnus-group-short-name group) '(nnir "nnir")) + 'nnir-artlist t)))) + +(defun nnir-server-opened (&optional server) + (let ((backend (car (gnus-server-to-method server)))) + (nnoo-current-server-p (or backend 'nnir) server))) (defun nnir-search-thread (header) - "Make an nnir group based on the thread containing the article header" - (let ((parm (list - (cons 'query - (nnimap-make-thread-query header)) - (cons 'criteria "") - (cons 'server (gnus-method-to-server - (gnus-find-method-for-group - gnus-newsgroup-name)))))) - (gnus-group-make-nnir-group nil parm) + "Make an nnir group based on the thread containing the article +header. The current server will be searched. If the registry is +installed, the server that the registry reports the current +article came from is also searched." + (let* ((query + (list (cons 'query (nnimap-make-thread-query header)) + (cons 'criteria ""))) + (server + (list (list (gnus-method-to-server + (gnus-find-method-for-group gnus-newsgroup-name))))) + (registry-group (and + (gnus-bound-and-true-p 'gnus-registry-enabled) + (car (gnus-registry-get-id-key + (mail-header-id header) 'group)))) + (registry-server + (and registry-group + (gnus-method-to-server + (gnus-find-method-for-group registry-group))))) + (when registry-server (add-to-list 'server (list registry-server))) + (gnus-group-make-nnir-group nil (list + (cons 'nnir-query-spec query) + (cons 'nnir-group-spec server))) (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header))))) -;; unused? -(defun nnir-artlist-groups (artlist) - "Returns a list of all groups in the given ARTLIST." - (let ((res nil) - (with-dups nil)) - ;; from each artitem, extract group component - (setq with-dups (mapcar 'nnir-artitem-group artlist)) - ;; remove duplicates from above - (mapc (function (lambda (x) (add-to-list 'res x))) - with-dups) - res)) - (defun nnir-get-active (srv) (let ((method (gnus-server-to-method srv)) groups) @@ -1758,6 +1841,46 @@ +(deffoo nnir-request-create-group (group &optional server args) + (message "Creating nnir group %s" group) + (let ((group (gnus-group-prefixed-name group '(nnir "nnir"))) + (query-spec + (list (cons 'query + (read-string "Query: " nil 'nnir-search-history)))) + (group-spec (list (list (read-string "Server: " nil nil))))) + (gnus-group-set-parameter + group 'nnir-specs + (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec))) + (gnus-group-set-parameter + group 'nnir-artlist + (setq nnir-artlist + (nnir-run-query + (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec))))) + (nnir-request-update-info group (gnus-get-info group))) + t) + +(deffoo nnir-request-delete-group (group &optional force server) + t) + +(deffoo nnir-request-list (&optional server) + t) + +(deffoo nnir-request-scan (group method) + (if group + (let ((pgroup (if (gnus-group-prefixed-p group) + group + (gnus-group-prefixed-name group '(nnir "nnir"))))) + (gnus-group-set-parameter + pgroup 'nnir-artlist + (setq nnir-artlist + (nnir-run-query + (gnus-group-get-parameter pgroup 'nnir-specs t)))) + (nnir-request-update-info pgroup (gnus-get-info pgroup))) + t)) + + ;; The end. (provide 'nnir) ------------------------------------------------------------ revno: 112132 committer: Jan D. branch nick: trunk timestamp: Mon 2013-03-25 18:59:59 +0100 message: Changelog for previous commit. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-03-24 12:59:45 +0000 +++ src/ChangeLog 2013-03-25 17:59:59 +0000 @@ -1,3 +1,8 @@ +2013-03-25 Jan Djärv + + * xterm.c: Include X11/XKBlib.h + (XTring_bell): Use XkbBell if HAVE_XKB (Bug#14041). + 2013-03-24 Andreas Schwab * alloc.c (xpalloc, Fgarbage_collect): Reorder conditions that are ------------------------------------------------------------ revno: 112131 fixes bug: http://debbugs.gnu.org/14041 committer: Jan D. branch nick: trunk timestamp: Mon 2013-03-25 18:58:35 +0100 message: * configure.ac (HAVE_XKB): Define if Xkb is present. * src/xterm.c: Include X11/XKBlib.h (XTring_bell): Use XkbBell if HAVE_XKB. diff: === modified file 'ChangeLog' --- ChangeLog 2013-03-24 00:49:50 +0000 +++ ChangeLog 2013-03-25 17:58:35 +0000 @@ -1,3 +1,7 @@ +2013-03-25 Jan Djärv + + * configure.ac (HAVE_XKB): Define if Xkb is present. + 2013-03-24 Paul Eggert Merge from gnulib, incorporating: === modified file 'configure.ac' --- configure.ac 2013-03-18 05:26:56 +0000 +++ configure.ac 2013-03-25 17:58:35 +0000 @@ -1822,6 +1822,7 @@ AC_MSG_RESULT($emacs_xkb) if test $emacs_xkb = yes; then AC_DEFINE(HAVE_XKBGETKEYBOARD, 1, [Define to 1 if you have the XkbGetKeyboard function.]) + AC_DEFINE(HAVE_XKB, 1, [Define to 1 if you have the Xkb extension.]) fi AC_CHECK_FUNCS(XrmSetDatabase XScreenResourceString \ === modified file 'src/xterm.c' --- src/xterm.c 2013-03-24 12:59:45 +0000 +++ src/xterm.c 2013-03-25 17:58:35 +0000 @@ -130,6 +130,10 @@ #include "bitmaps/gray.xbm" +#ifdef HAVE_XKB +#include +#endif + /* Default to using XIM if available. */ #ifdef USE_XIM int use_xim = 1; @@ -3218,7 +3222,11 @@ else { block_input (); +#ifdef HAVE_XKB + XkbBell (FRAME_X_DISPLAY (f), None, 0, None); +#else XBell (FRAME_X_DISPLAY (f), 0); +#endif XFlush (FRAME_X_DISPLAY (f)); unblock_input (); } ------------------------------------------------------------ revno: 112130 committer: Eli Zaretskii branch nick: trunk timestamp: Mon 2013-03-25 15:48:37 +0200 message: Fix incompatibilities between MinGW.org and MinGW64 headers Problems were reported by ׃scar Fuentes in http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00611.html. nt/inc/ms-w32.h (struct timespec): Don't define if _TIMESPEC_DEFINED is already defined. (sigset_t) [!_POSIX]: Typedef for MinGW64. (_WIN32_WINNT, WIN32_LEAN_AND_MEAN): Move definitions before including the first system header, to avoid redefinition if some system header defines a default value. nt/inc/sys/time.h (struct itimerval): Don't define if _TIMESPEC_DEFINED is already defined. diff: === modified file 'nt/ChangeLog' --- nt/ChangeLog 2013-03-16 08:55:38 +0000 +++ nt/ChangeLog 2013-03-25 13:48:37 +0000 @@ -1,3 +1,18 @@ +2013-03-25 Eli Zaretskii + + Fix incompatibilities between MinGW.org and MinGW64 headers + reported by Óscar Fuentes in + http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00611.html. + * inc/ms-w32.h (struct timespec): Don't define if + _TIMESPEC_DEFINED is already defined. + (sigset_t) [!_POSIX]: Typedef for MinGW64. + (_WIN32_WINNT, WIN32_LEAN_AND_MEAN): Move definitions before + including the first system header, to avoid redefinition if some + system header defines a default value. + + * inc/sys/time.h (struct itimerval): Don't define if + _TIMESPEC_DEFINED is already defined. + 2013-03-16 Eli Zaretskii Fix the MSVC build. (Bug#13939) === modified file 'nt/inc/ms-w32.h' --- nt/inc/ms-w32.h 2013-03-13 18:42:22 +0000 +++ nt/inc/ms-w32.h 2013-03-25 13:48:37 +0000 @@ -127,6 +127,15 @@ extern char *getenv (); #endif +/* Prevent accidental use of features unavailable in older Windows + versions we still support. MinGW64 defines this to a higher value + in its system headers, so define our override before including any + system headers. */ +#define _WIN32_WINNT 0x0400 + +/* Make a leaner executable. */ +#define WIN32_LEAN_AND_MEAN 1 + #ifdef HAVE_STRINGS_H #include "strings.h" #endif @@ -266,11 +275,14 @@ /* 'struct timespec' is used by time-related functions in lib/ and elsewhere, but we don't use lib/time.h where the structure is defined. */ +/* MinGW64 defines 'struct timespec' and _TIMESPEC_DEFINED in sys/types.h. */ +#ifndef _TIMESPEC_DEFINED struct timespec { time_t tv_sec; /* seconds */ long int tv_nsec; /* nanoseconds */ }; +#endif /* Required for functions in lib/time_r.c, since we don't use lib/time.h. */ extern struct tm *gmtime_r (time_t const * restrict, struct tm * restrict); @@ -321,6 +333,10 @@ typedef int ssize_t; #endif +#ifndef _POSIX /* MinGW64 */ +typedef _sigset_t sigset_t; +#endif + typedef void (_CALLBACK_ *signal_handler) (int); extern signal_handler sys_signal (int, signal_handler); @@ -366,13 +382,6 @@ #define _WINSOCKAPI_ 1 #define _WINSOCK_H -/* Prevent accidental use of features unavailable in - older Windows versions we still support. */ -#define _WIN32_WINNT 0x0400 - -/* Make a leaner executable. */ -#define WIN32_LEAN_AND_MEAN 1 - /* Defines size_t and alloca (). */ #ifdef emacs #define malloc e_malloc === modified file 'nt/inc/sys/time.h' --- nt/inc/sys/time.h 2012-09-30 15:49:05 +0000 +++ nt/inc/sys/time.h 2013-03-25 13:48:37 +0000 @@ -23,11 +23,14 @@ #define ITIMER_REAL 0 #define ITIMER_PROF 1 +/* MinGW64 defines 'struct itimerval' and _TIMESPEC_DEFINED in sys/types.h. */ +#ifndef _TIMESPEC_DEFINED struct itimerval { struct timeval it_interval; /* timer interval */ struct timeval it_value; /* current value */ }; +#endif int getitimer (int, struct itimerval *); int setitimer (int, struct itimerval *, struct itimerval *); ------------------------------------------------------------ revno: 112129 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-03-25 09:47:32 -0400 message: * lisp/font-lock.el (lisp-font-lock-keywords-2): Don't highlight the "error" part of "(error-foo)". diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-03-24 21:47:52 +0000 +++ lisp/ChangeLog 2013-03-25 13:47:32 +0000 @@ -1,3 +1,8 @@ +2013-03-25 Stefan Monnier + + * font-lock.el (lisp-font-lock-keywords-2): Don't highlight the "error" + part of "(error-foo)". + 2013-03-24 Juri Linkov * replace.el (list-matching-lines-prefix-face): New defcustom. @@ -24,8 +29,8 @@ 2013-03-23 Dmitry Gutov - * emacs-lisp/lisp-mode.el (emacs-lisp-docstring-fill-column): Make - it safe-local. + * emacs-lisp/lisp-mode.el (emacs-lisp-docstring-fill-column): + Make it safe-local. * vc/diff-mode.el (diff-mode-shared-map): Unbind "/" (Bug#14034). === modified file 'lisp/font-lock.el' --- lisp/font-lock.el 2013-02-27 15:25:55 +0000 +++ lisp/font-lock.el 2013-03-25 13:47:32 +0000 @@ -2323,12 +2323,12 @@ "\\_>") . 1) ;; Exit/Feature symbols as constants. - (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\>" + (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>" "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?") (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) ;; Erroneous structures. - ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|error\\|signal\\)\\>" 1 font-lock-warning-face) + ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|error\\|signal\\)\\_>" 1 font-lock-warning-face) ;; Words inside \\[] tend to be for `substitute-command-keys'. ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]" (1 font-lock-constant-face prepend)) ------------------------------------------------------------ revno: 112128 fixes bug: http://debbugs.gnu.org/14017 committer: Juri Linkov branch nick: trunk timestamp: Sun 2013-03-24 23:47:52 +0200 message: * lisp/replace.el (list-matching-lines-prefix-face): New defcustom. (occur-1): Pass `list-matching-lines-prefix-face' to the function `occur-engine' if `face-differs-from-default-p' returns t. (occur-engine): Add `,' inside backquote construct to evaluate `prefix-face'. Propertize the prefix with the `prefix-face' face. Pass `prefix-face' to the functions `occur-context-lines' and `occur-engine-add-prefix'. (occur-engine-add-prefix, occur-context-lines): Add optional arg `prefix-face' and propertize the prefix with `prefix-face'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-03-24 06:42:25 +0000 +++ lisp/ChangeLog 2013-03-24 21:47:52 +0000 @@ -1,3 +1,16 @@ +2013-03-24 Juri Linkov + + * replace.el (list-matching-lines-prefix-face): New defcustom. + (occur-1): Pass `list-matching-lines-prefix-face' to the function + `occur-engine' if `face-differs-from-default-p' returns t. + (occur-engine): Add `,' inside backquote construct to evaluate + `prefix-face'. Propertize the prefix with the `prefix-face' face. + Pass `prefix-face' to the functions `occur-context-lines' and + `occur-engine-add-prefix'. + (occur-engine-add-prefix, occur-context-lines): Add optional arg + `prefix-face' and propertize the prefix with `prefix-face'. + (Bug#14017) + 2013-03-24 Leo Liu * nxml/rng-valid.el (rng-validate-while-idle) === modified file 'lisp/replace.el' --- lisp/replace.el 2013-03-10 08:44:07 +0000 +++ lisp/replace.el 2013-03-24 21:47:52 +0000 @@ -1125,6 +1125,14 @@ :type 'face :group 'matching) +(defcustom list-matching-lines-prefix-face 'shadow + "Face used by \\[list-matching-lines] to show the prefix column. +If the face doesn't differ from the default face, +don't highlight the prefix with line numbers specially." + :type 'face + :group 'matching + :version "24.4") + (defcustom occur-excluded-properties '(read-only invisible intangible field mouse-face help-echo local-map keymap yank-handler follow-link) @@ -1334,7 +1342,9 @@ (isearch-no-upper-case-p regexp t) case-fold-search) list-matching-lines-buffer-name-face - nil list-matching-lines-face + (if (face-differs-from-default-p list-matching-lines-prefix-face) + list-matching-lines-prefix-face) + list-matching-lines-face (not (eq occur-excluded-properties t)))))) (let* ((bufcount (length active-bufs)) (diff (- (length bufs) bufcount))) @@ -1423,7 +1433,7 @@ (apply #'propertize (format "%7d:" lines) (append (when prefix-face - `(font-lock-face prefix-face)) + `(font-lock-face ,prefix-face)) `(occur-prefix t mouse-face (highlight) ;; Allow insertion of text at ;; the end of the prefix (for @@ -1447,7 +1457,9 @@ ;; of multi-line matches. (replace-regexp-in-string "\n" - "\n :" + (if prefix-face + (propertize "\n :" 'font-lock-face prefix-face) + "\n :") match-str) ;; Add marker at eol, but no mouse props. (propertize "\n" 'occur-target marker))) @@ -1458,7 +1470,8 @@ ;; The complex multi-line display style. (setq ret (occur-context-lines out-line nlines keep-props begpt endpt - lines prev-lines prev-after-lines)) + lines prev-lines prev-after-lines + prefix-face)) ;; Set first elem of the returned list to `data', ;; and the second elem to `prev-after-lines'. (setq prev-after-lines (nth 1 ret)) @@ -1482,7 +1495,7 @@ (when prev-after-lines (with-current-buffer out-buf (insert (apply #'concat (occur-engine-add-prefix - prev-after-lines))))))) + prev-after-lines prefix-face))))))) (when (not (zerop matches)) ;; is the count zero? (setq globalcount (+ globalcount matches)) (with-current-buffer out-buf @@ -1537,10 +1550,13 @@ str) (buffer-substring-no-properties beg end))) -(defun occur-engine-add-prefix (lines) +(defun occur-engine-add-prefix (lines &optional prefix-face) (mapcar #'(lambda (line) - (concat " :" line "\n")) + (concat (if prefix-face + (propertize " :" 'font-lock-face prefix-face) + " :") + line "\n")) lines)) (defun occur-accumulate-lines (count &optional keep-props pt) @@ -1569,7 +1585,8 @@ ;; Generate a list of lines, add prefixes to all but OUT-LINE, ;; then concatenate them all together. (defun occur-context-lines (out-line nlines keep-props begpt endpt - lines prev-lines prev-after-lines) + lines prev-lines prev-after-lines + &optional prefix-face) ;; Find after- and before-context lines of the current match. (let ((before-lines (nreverse (cdr (occur-accumulate-lines @@ -1609,10 +1626,13 @@ ;; Return a list where the first element is the output line. (apply #'concat (append - (and prev-after-lines - (occur-engine-add-prefix prev-after-lines)) - (and separator (list separator)) - (occur-engine-add-prefix before-lines) + (if prev-after-lines + (occur-engine-add-prefix prev-after-lines prefix-face)) + (if separator + (list (if prefix-face + (propertize separator 'font-lock-face prefix-face) + separator))) + (occur-engine-add-prefix before-lines prefix-face) (list out-line))) ;; And the second element is the list of context after-lines. (if (> nlines 0) after-lines))))