Now on revision 109897. 1 tag(s) updated. ------------------------------------------------------------ revno: 109897 committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2012-09-06 02:20:21 +0000 message: [Gnus] XEmacs 21.5 compilation fix * gnus-score.el (gnus-score-decode-text-parts): Use #' for mm-text-parts used in labels macro to make it work with XEmacs 21.5. * gnus-util.el (gnus-string-prefix-p): New function, an alias to string-prefix-p in Emacs >=23.2. * nnmaildir.el (nnmaildir--ensure-suffix, nnmaildir--add-flag) (nnmaildir--remove-flag, nnmaildir--scan): Use gnus-string-match-p instead of string-match-p. (nnmaildir--scan): Use gnus-string-prefix-p instead of string-prefix-p. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2012-09-06 01:49:15 +0000 +++ lisp/gnus/ChangeLog 2012-09-06 02:20:21 +0000 @@ -1,3 +1,16 @@ +2012-09-06 Katsumi Yamaoka + + * gnus-score.el (gnus-score-decode-text-parts): Use #' for + mm-text-parts used in labels macro to make it work with XEmacs 21.5. + + * gnus-util.el (gnus-string-prefix-p): New function, an alias to + string-prefix-p in Emacs >=23.2. + + * nnmaildir.el (nnmaildir--ensure-suffix, nnmaildir--add-flag) + (nnmaildir--remove-flag, nnmaildir--scan): Use gnus-string-match-p + instead of string-match-p. + (nnmaildir--scan): Use gnus-string-prefix-p instead of string-prefix-p. + 2012-09-06 Kenichi Handa * qp.el (quoted-printable-decode-region): Fix previous change; handle === modified file 'lisp/gnus/gnus-score.el' --- lisp/gnus/gnus-score.el 2012-09-05 22:35:32 +0000 +++ lisp/gnus/gnus-score.el 2012-09-06 02:20:21 +0000 @@ -1720,7 +1720,7 @@ (defun gnus-score-decode-text-parts () (labels ((mm-text-parts (handle) (cond ((stringp (car handle)) - (let ((parts (mapcan 'mm-text-parts (cdr handle)))) + (let ((parts (mapcan #'mm-text-parts (cdr handle)))) (if (equal "multipart/alternative" (car handle)) ;; pick the first supported alternative (list (car parts)) @@ -1730,7 +1730,7 @@ (when (string-match "^text/" (mm-handle-media-type handle)) (list handle))) - (t (mapcan 'mm-text-parts handle)))) + (t (mapcan #'mm-text-parts handle)))) (my-mm-display-part (handle) (when handle (save-restriction === modified file 'lisp/gnus/gnus-util.el' --- lisp/gnus/gnus-util.el 2012-07-24 22:17:17 +0000 +++ lisp/gnus/gnus-util.el 2012-09-06 02:20:21 +0000 @@ -1926,6 +1926,15 @@ (save-match-data (string-match regexp string start)))) +(if (fboundp 'string-prefix-p) + (defalias 'gnus-string-prefix-p 'string-prefix-p) + (defun gnus-string-prefix-p (str1 str2 &optional ignore-case) + "Return non-nil if STR1 is a prefix of STR2. +If IGNORE-CASE is non-nil, the comparison is done without paying attention +to case differences." + (eq t (compare-strings str1 nil nil + str2 0 (length str1) ignore-case)))) + (eval-and-compile (if (fboundp 'macroexpand-all) (defalias 'gnus-macroexpand-all 'macroexpand-all) === modified file 'lisp/gnus/nnmaildir.el' --- lisp/gnus/nnmaildir.el 2012-09-05 22:45:43 +0000 +++ lisp/gnus/nnmaildir.el 2012-09-06 02:20:21 +0000 @@ -100,14 +100,14 @@ (defun nnmaildir--ensure-suffix (filename) "Ensure that FILENAME contains the suffix \":2,\"." - (if (string-match-p ":2," filename) + (if (gnus-string-match-p ":2," filename) filename (concat filename ":2,"))) (defun nnmaildir--add-flag (flag suffix) "Return a copy of SUFFIX where FLAG is set. SUFFIX should start with \":2,\"." - (unless (string-match-p "^:2," suffix) + (unless (gnus-string-match-p "^:2," suffix) (error "Invalid suffix `%s'" suffix)) (let* ((flags (substring suffix 3)) (flags-as-list (append flags nil)) @@ -120,7 +120,7 @@ (defun nnmaildir--remove-flag (flag suffix) "Return a copy of SUFFIX where FLAG is cleared. SUFFIX should start with \":2,\"." - (unless (string-match-p "^:2," suffix) + (unless (gnus-string-match-p "^:2," suffix) (error "Invalid suffix `%s'" suffix)) (let* ((flags (substring suffix 3)) (flags-as-list (append flags nil)) @@ -856,11 +856,11 @@ (when (or ;; first look for marks in suffix, if it's valid... (when (and (stringp suffix) - (string-prefix-p ":2," suffix)) + (gnus-string-prefix-p ":2," suffix)) (or - (not (string-match-p + (not (gnus-string-match-p (string (nnmaildir--mark-to-flag 'read)) suffix)) - (string-match-p + (gnus-string-match-p (string (nnmaildir--mark-to-flag 'tick)) suffix))) ;; then look in marks directories (not (file-exists-p (concat cdir prefix))) ------------------------------------------------------------ revno: 109896 [merge] committer: Kenichi Handa branch nick: trunk timestamp: Thu 2012-09-06 10:49:56 +0900 message: qp.el (quoted-printable-decode-region): Fix previous change; handle lowercase a..f. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2012-09-05 22:45:43 +0000 +++ lisp/gnus/ChangeLog 2012-09-06 01:49:15 +0000 @@ -1,3 +1,8 @@ +2012-09-06 Kenichi Handa + + * qp.el (quoted-printable-decode-region): Fix previous change; handle + lowercase a..f. + 2012-09-05 Magnus Henoch * nnmaildir.el (nnmaildir--article-set-flags): Fix compilation error. === modified file 'lisp/gnus/qp.el' --- lisp/gnus/qp.el 2012-08-30 12:11:57 +0000 +++ lisp/gnus/qp.el 2012-09-06 01:45:33 +0000 @@ -55,8 +55,12 @@ ;; recognize them as the corresponding uppercase letters.'' (let ((case-fold-search t) (decode-hex #'(lambda (n1 n2) - (+ (* (if (<= n1 ?9) (- n1 ?0) (+ (- n1 ?A) 10)) 16) - (if (<= n2 ?9) (- n2 ?0) (+ (- n2 ?A) 10)))))) + (+ (* (if (<= n1 ?9) (- n1 ?0) + (if (<= n1 ?F) (+ (- n1 ?A) 10) + (+ (- n1 ?a) 10))) 16) + (if (<= n2 ?9) (- n2 ?0) + (if (<= n2 ?F) (+ (- n2 ?A) 10) + (+ (- n2 ?a) 10))))))) (narrow-to-region from to) ;; Do this in case we're called from Gnus, say, in a buffer ;; which already contains non-ASCII characters which would ------------------------------------------------------------ revno: 109895 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Wed 2012-09-05 22:45:43 +0000 message: Merge changes made in Gnus master 2012-09-05 Magnus Henoch * nnmaildir.el (nnmaildir--article-set-flags): Fix compilation error. 2012-09-05 Martin Stjernholm * gnus-demon.el (gnus-demon-init): Fixed regression when IDLE is t and TIME is set. 2012-09-05 Juri Linkov * gnus-group.el (gnus-read-ephemeral-bug-group): Allow opening more than one group at a time (bug#11961). diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2012-09-05 22:35:32 +0000 +++ lisp/gnus/ChangeLog 2012-09-05 22:45:43 +0000 @@ -1,3 +1,17 @@ +2012-09-05 Magnus Henoch + + * nnmaildir.el (nnmaildir--article-set-flags): Fix compilation error. + +2012-09-05 Martin Stjernholm + + * gnus-demon.el (gnus-demon-init): Fixed regression when IDLE is t and + TIME is set. + +2012-09-05 Juri Linkov + + * gnus-group.el (gnus-read-ephemeral-bug-group): Allow opening more + than one group at a time (bug#11961). + 2012-09-05 Julien Danjou * gnus-srvr.el (gnus-server-open-server): Don't message on failure: === modified file 'lisp/gnus/gnus-demon.el' --- lisp/gnus/gnus-demon.el 2012-08-06 11:56:36 +0000 +++ lisp/gnus/gnus-demon.el 2012-09-05 22:45:43 +0000 @@ -144,9 +144,12 @@ (* (gnus-demon-time-to-step time) gnus-demon-timestep)) (t (* time gnus-demon-timestep)))) - (idle (if (numberp idle) - (* idle gnus-demon-timestep) - idle)) + (idle (cond ((numberp idle) + (* idle gnus-demon-timestep)) + ((and (eq idle t) (numberp time)) + time) + (t + idle))) (timer (cond === modified file 'lisp/gnus/gnus-group.el' --- lisp/gnus/gnus-group.el 2012-09-05 22:35:32 +0000 +++ lisp/gnus/gnus-group.el 2012-09-05 22:45:43 +0000 @@ -2481,7 +2481,8 @@ "/.*$" "")))) (write-region (point-min) (point-max) tmpfile) (gnus-group-read-ephemeral-group - "gnus-read-ephemeral-bug" + (format "gnus-read-ephemeral-bug:%s" + (mapconcat 'number-to-string ids ",")) `(nndoc ,tmpfile (nndoc-article-type mbox)) nil window-conf)) === modified file 'lisp/gnus/nnmaildir.el' --- lisp/gnus/nnmaildir.el 2012-09-05 22:35:32 +0000 +++ lisp/gnus/nnmaildir.el 2012-09-05 22:45:43 +0000 @@ -127,16 +127,6 @@ (new-flags (concat (delq flag flags-as-list)))) (concat ":2," new-flags))) -(defun nnmaildir--article-set-flags (article new-suffix curdir) - (let* ((prefix (nnmaildir--art-prefix article)) - (suffix (nnmaildir--art-suffix article)) - (article-file (concat curdir prefix suffix)) - (new-name (concat curdir prefix new-suffix))) - (unless (file-exists-p article-file) - (error "Couldn't find article file %s" article-file)) - (rename-file article-file new-name 'replace) - (setf (nnmaildir--art-suffix article) new-suffix))) - (defvar nnmaildir-article-file-name nil "*The filename of the most recently requested article. This variable is set by nnmaildir-request-article.") @@ -212,6 +202,16 @@ (gnm nil) ;; flag: split from mail-sources? (target-prefix nil :type string)) ;; symlink target prefix +(defun nnmaildir--article-set-flags (article new-suffix curdir) + (let* ((prefix (nnmaildir--art-prefix article)) + (suffix (nnmaildir--art-suffix article)) + (article-file (concat curdir prefix suffix)) + (new-name (concat curdir prefix new-suffix))) + (unless (file-exists-p article-file) + (error "Couldn't find article file %s" article-file)) + (rename-file article-file new-name 'replace) + (setf (nnmaildir--art-suffix article) new-suffix))) + (defun nnmaildir--expired-article (group article) (setf (nnmaildir--art-nov article) nil) (let ((flist (nnmaildir--grp-flist group)) ------------------------------------------------------------ revno: 109894 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Wed 2012-09-05 22:35:32 +0000 message: Merge changes made in Gnus master 2012-09-05 Julien Danjou * gnus-srvr.el (gnus-server-open-server): Don't message on failure: this hide the real reason with a message giving absolutely no hint. 2012-09-05 Lars Ingebrigtsen * gnus-group.el (gnus-group-mark-article-read): Propagate the read mark to the backend (bug#11804). * message.el (message-insert-newsgroups): Don't insert newsgroup duplicates (bug#12275). 2012-09-05 John Wiegley * gnus.el (gnus-expand-group-parameters): Allow regexp substitutions in sieve rules. 2012-09-05 Jan Tatarik * gnus-score.el (gnus-score-decode-text-parts): Use #' for the local function. * gnus-logic.el (gnus-advanced-body): Allow scoring on decoded bodies. * gnus-score.el (gnus-score-decode-text-parts): Ditto. 2012-09-05 Magnus Henoch * nnmaildir.el: Make nnmaildir understand and write maildir flags. That is, rename files from "unique:2," to "unique:2,S" for "seen", etc. This should make nnmaildir more usable with offlineimap. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2012-09-05 06:56:55 +0000 +++ lisp/gnus/ChangeLog 2012-09-05 22:35:32 +0000 @@ -1,3 +1,36 @@ +2012-09-05 Julien Danjou + + * gnus-srvr.el (gnus-server-open-server): Don't message on failure: + this hide the real reason with a message giving absolutely no hint. + +2012-09-05 Lars Ingebrigtsen + + * gnus-group.el (gnus-group-mark-article-read): Propagate the read mark + to the backend (bug#11804). + + * message.el (message-insert-newsgroups): Don't insert newsgroup + duplicates (bug#12275). + +2012-09-05 John Wiegley + + * gnus.el (gnus-expand-group-parameters): Allow regexp substitutions in + sieve rules. + +2012-09-05 Jan Tatarik + + * gnus-score.el (gnus-score-decode-text-parts): Use #' for the local + function. + + * gnus-logic.el (gnus-advanced-body): Allow scoring on decoded bodies. + + * gnus-score.el (gnus-score-decode-text-parts): Ditto. + +2012-09-05 Magnus Henoch + + * nnmaildir.el: Make nnmaildir understand and write maildir flags. + That is, rename files from "unique:2," to "unique:2,S" for "seen", etc. + This should make nnmaildir more usable with offlineimap. + 2012-09-03 Lars Ingebrigtsen * gnus-notifications.el (gnus-notifications-notify): Use it. === modified file 'lisp/gnus/gnus-group.el' --- lisp/gnus/gnus-group.el 2012-07-24 22:17:17 +0000 +++ lisp/gnus/gnus-group.el 2012-09-05 22:35:32 +0000 @@ -4670,6 +4670,8 @@ (setq mark gnus-expirable-mark)) (setq mark (gnus-request-update-mark group article mark)) + (gnus-request-set-mark + group (list (list (list article) 'add '(read)))) (gnus-mark-article-as-read article mark) (setq gnus-newsgroup-active (gnus-active group)) (when active === modified file 'lisp/gnus/gnus-logic.el' --- lisp/gnus/gnus-logic.el 2012-01-19 07:21:25 +0000 +++ lisp/gnus/gnus-logic.el 2012-09-05 22:35:32 +0000 @@ -180,46 +180,51 @@ (setq header "article")) (with-current-buffer nntp-server-buffer (let* ((request-func (cond ((string= "head" header) - 'gnus-request-head) - ((string= "body" header) - 'gnus-request-body) - (t 'gnus-request-article))) - ofunc article) + 'gnus-request-head) + ;; We need to peek at the headers to detect the + ;; content encoding + ((string= "body" header) + 'gnus-request-article) + (t 'gnus-request-article))) + ofunc article handles) ;; Not all backends support partial fetching. In that case, we ;; just fetch the entire article. (unless (gnus-check-backend-function - (intern (concat "request-" header)) - gnus-newsgroup-name) - (setq ofunc request-func) - (setq request-func 'gnus-request-article)) + (intern (concat "request-" header)) + gnus-newsgroup-name) + (setq ofunc request-func) + (setq request-func 'gnus-request-article)) (setq article (mail-header-number gnus-advanced-headers)) (gnus-message 7 "Scoring article %s..." article) (when (funcall request-func article gnus-newsgroup-name) - (goto-char (point-min)) - ;; If just parts of the article is to be searched and the - ;; backend didn't support partial fetching, we just narrow to - ;; the relevant parts. - (when ofunc - (if (eq ofunc 'gnus-request-head) - (narrow-to-region - (point) - (or (search-forward "\n\n" nil t) (point-max))) - (narrow-to-region - (or (search-forward "\n\n" nil t) (point)) - (point-max)))) - (let* ((case-fold-search (not (eq (downcase (symbol-name type)) - (symbol-name type)))) - (search-func - (cond ((memq type '(r R regexp Regexp)) - 're-search-forward) - ((memq type '(s S string String)) - 'search-forward) - (t - (error "Invalid match type: %s" type))))) - (goto-char (point-min)) - (prog1 - (funcall search-func match nil t) - (widen))))))) + (when (string= "body" header) + (setq handles (gnus-score-decode-text-parts))) + (goto-char (point-min)) + ;; If just parts of the article is to be searched and the + ;; backend didn't support partial fetching, we just narrow to + ;; the relevant parts. + (when ofunc + (if (eq ofunc 'gnus-request-head) + (narrow-to-region + (point) + (or (search-forward "\n\n" nil t) (point-max))) + (narrow-to-region + (or (search-forward "\n\n" nil t) (point)) + (point-max)))) + (let* ((case-fold-search (not (eq (downcase (symbol-name type)) + (symbol-name type)))) + (search-func + (cond ((memq type '(r R regexp Regexp)) + 're-search-forward) + ((memq type '(s S string String)) + 'search-forward) + (t + (error "Invalid match type: %s" type))))) + (goto-char (point-min)) + (prog1 + (funcall search-func match nil t) + (widen))) + (when handles (mm-destroy-parts handles)))))) (provide 'gnus-logic) === modified file 'lisp/gnus/gnus-score.el' --- lisp/gnus/gnus-score.el 2012-07-24 22:17:17 +0000 +++ lisp/gnus/gnus-score.el 2012-09-05 22:35:32 +0000 @@ -1717,105 +1717,140 @@ (setq entries rest))))) nil) +(defun gnus-score-decode-text-parts () + (labels ((mm-text-parts (handle) + (cond ((stringp (car handle)) + (let ((parts (mapcan 'mm-text-parts (cdr handle)))) + (if (equal "multipart/alternative" (car handle)) + ;; pick the first supported alternative + (list (car parts)) + parts))) + + ((bufferp (car handle)) + (when (string-match "^text/" (mm-handle-media-type handle)) + (list handle))) + + (t (mapcan 'mm-text-parts handle)))) + (my-mm-display-part (handle) + (when handle + (save-restriction + (narrow-to-region (point) (point)) + (mm-display-inline handle) + (goto-char (point-max)))))) + + (let (;(mm-text-html-renderer 'w3m-standalone) + (handles (mm-dissect-buffer t))) + (save-excursion + (article-goto-body) + (delete-region (point) (point-max)) + (mapc #'my-mm-display-part (mm-text-parts handles)) + handles)))) + (defun gnus-score-body (scores header now expire &optional trace) - (if gnus-agent-fetching - nil - (save-excursion - (setq gnus-scores-articles - (sort gnus-scores-articles - (lambda (a1 a2) - (< (mail-header-number (car a1)) - (mail-header-number (car a2)))))) - (set-buffer nntp-server-buffer) - (save-restriction - (let* ((buffer-read-only nil) - (articles gnus-scores-articles) - (all-scores scores) - (request-func (cond ((string= "head" header) - 'gnus-request-head) - ((string= "body" header) - 'gnus-request-body) - (t 'gnus-request-article))) - entries alist ofunc article last) - (when articles - (setq last (mail-header-number (caar (last articles)))) - ;; Not all backends support partial fetching. In that case, - ;; we just fetch the entire article. - (unless (gnus-check-backend-function - (and (string-match "^gnus-" (symbol-name request-func)) - (intern (substring (symbol-name request-func) - (match-end 0)))) - gnus-newsgroup-name) - (setq ofunc request-func) - (setq request-func 'gnus-request-article)) - (while articles - (setq article (mail-header-number (caar articles))) - (gnus-message 7 "Scoring article %s of %s..." article last) - (widen) - (when (funcall request-func article gnus-newsgroup-name) - (goto-char (point-min)) - ;; If just parts of the article is to be searched, but the - ;; backend didn't support partial fetching, we just narrow - ;; to the relevant parts. - (when ofunc - (if (eq ofunc 'gnus-request-head) - (narrow-to-region - (point) - (or (search-forward "\n\n" nil t) (point-max))) - (narrow-to-region - (or (search-forward "\n\n" nil t) (point)) - (point-max)))) - (setq scores all-scores) - ;; Find matches. - (while scores - (setq alist (pop scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) - gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (case-fold-search - (not (or (eq type 'R) (eq type 'S) - (eq type 'Regexp) (eq type 'String)))) - (search-func - (cond ((or (eq type 'r) (eq type 'R) - (eq type 'regexp) (eq type 'Regexp)) - 're-search-forward) - ((or (eq type 's) (eq type 'S) - (eq type 'string) (eq type 'String)) - 'search-forward) - (t - (error "Invalid match type: %s" type))))) - (goto-char (point-min)) - (when (funcall search-func match nil t) - ;; Found a match, update scores. - (setcdr (car articles) (+ score (cdar articles))) - (setq found t) - (when trace - (push - (cons (car-safe (rassq alist gnus-score-cache)) - kill) - gnus-score-trace))) - ;; Update expire date - (unless trace - (cond - ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) - ;; Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries)))) - (setq entries rest))))) - (setq articles (cdr articles))))))) - nil)) + (if gnus-agent-fetching + nil + (save-excursion + (setq gnus-scores-articles + (sort gnus-scores-articles + (lambda (a1 a2) + (< (mail-header-number (car a1)) + (mail-header-number (car a2)))))) + (set-buffer nntp-server-buffer) + (save-restriction + (let* ((buffer-read-only nil) + (articles gnus-scores-articles) + (all-scores scores) + (request-func (cond ((string= "head" header) + 'gnus-request-head) + ;; We need to peek at the headers to detect + ;; the content encoding + ((string= "body" header) + 'gnus-request-article) + (t 'gnus-request-article))) + entries alist ofunc article last) + (when articles + (setq last (mail-header-number (caar (last articles)))) + ;; Not all backends support partial fetching. In that case, + ;; we just fetch the entire article. + (unless (gnus-check-backend-function + (and (string-match "^gnus-" (symbol-name request-func)) + (intern (substring (symbol-name request-func) + (match-end 0)))) + gnus-newsgroup-name) + (setq ofunc request-func) + (setq request-func 'gnus-request-article)) + (while articles + (setq article (mail-header-number (caar articles))) + (gnus-message 7 "Scoring article %s of %s..." article last) + (widen) + (let (handles) + (when (funcall request-func article gnus-newsgroup-name) + (when (string= "body" header) + (setq handles (gnus-score-decode-text-parts))) + (goto-char (point-min)) + ;; If just parts of the article is to be searched, but the + ;; backend didn't support partial fetching, we just narrow + ;; to the relevant parts. + (when ofunc + (if (eq ofunc 'gnus-request-head) + (narrow-to-region + (point) + (or (search-forward "\n\n" nil t) (point-max))) + (narrow-to-region + (or (search-forward "\n\n" nil t) (point)) + (point-max)))) + (setq scores all-scores) + ;; Find matches. + (while scores + (setq alist (pop scores) + entries (assoc header alist)) + (while (cdr entries) ;First entry is the header index. + (let* ((rest (cdr entries)) + (kill (car rest)) + (match (nth 0 kill)) + (type (or (nth 3 kill) 's)) + (score (or (nth 1 kill) + gnus-score-interactive-default-score)) + (date (nth 2 kill)) + (found nil) + (case-fold-search + (not (or (eq type 'R) (eq type 'S) + (eq type 'Regexp) (eq type 'String)))) + (search-func + (cond ((or (eq type 'r) (eq type 'R) + (eq type 'regexp) (eq type 'Regexp)) + 're-search-forward) + ((or (eq type 's) (eq type 'S) + (eq type 'string) (eq type 'String)) + 'search-forward) + (t + (error "Invalid match type: %s" type))))) + (goto-char (point-min)) + (when (funcall search-func match nil t) + ;; Found a match, update scores. + (setcdr (car articles) (+ score (cdar articles))) + (setq found t) + (when trace + (push + (cons (car-safe (rassq alist gnus-score-cache)) + kill) + gnus-score-trace))) + ;; Update expire date + (unless trace + (cond + ((null date)) ;Permanent entry. + ((and found gnus-update-score-entry-dates) + ;; Match, update date. + (gnus-score-set 'touched '(t) alist) + (setcar (nthcdr 2 kill) now)) + ((and expire (< date expire)) ;Old entry, remove. + (gnus-score-set 'touched '(t) alist) + (setcdr entries (cdr rest)) + (setq rest entries)))) + (setq entries rest)))) + (when handles (mm-destroy-parts handles)))) + (setq articles (cdr articles))))))) + nil)) (defun gnus-score-thread (scores header now expire &optional trace) (gnus-score-followup scores header now expire trace t)) === modified file 'lisp/gnus/gnus-srvr.el' --- lisp/gnus/gnus-srvr.el 2012-01-26 23:03:28 +0000 +++ lisp/gnus/gnus-srvr.el 2012-09-05 22:35:32 +0000 @@ -490,8 +490,7 @@ (error "No such server: %s" server)) (gnus-server-set-status method 'ok) (prog1 - (or (gnus-open-server method) - (progn (message "Couldn't open %s" server) nil)) + (gnus-open-server method) (gnus-server-update-server server) (gnus-server-position-point)))) === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2012-07-31 01:39:58 +0000 +++ lisp/gnus/gnus.el 2012-09-05 22:35:32 +0000 @@ -3824,12 +3824,28 @@ "Go through PARAMETERS and expand them according to the match data." (let (new) (dolist (elem parameters) - (if (and (stringp (cdr elem)) - (string-match "\\\\[0-9&]" (cdr elem))) - (push (cons (car elem) - (gnus-expand-group-parameter match (cdr elem) group)) - new) - (push elem new))) + (cond + ((and (stringp (cdr elem)) + (string-match "\\\\[0-9&]" (cdr elem))) + (push (cons (car elem) + (gnus-expand-group-parameter match (cdr elem) group)) + new)) + ;; For `sieve' group parameters, perform substitutions for every + ;; string within the match rule. This allows for parameters such + ;; as: + ;; ("list\\.\\(.*\\)" + ;; (sieve header :is "list-id" "<\\1.domain.org>")) + ((eq 'sieve (car elem)) + (push (mapcar (lambda (sieve-elem) + (if (and (stringp sieve-elem) + (string-match "\\\\[0-9&]" sieve-elem)) + (gnus-expand-group-parameter match sieve-elem + group) + sieve-elem)) + (cdr elem)) + new)) + (t + (push elem new)))) new)) (defun gnus-group-fast-parameter (group symbol &optional allow-list) @@ -3861,9 +3877,20 @@ (when this-result (setq result (car this-result)) ;; Expand if necessary. - (if (and (stringp result) (string-match "\\\\[0-9&]" result)) - (setq result (gnus-expand-group-parameter - (car head) result group))))))) + (cond + ((and (stringp result) (string-match "\\\\[0-9&]" result)) + (setq result (gnus-expand-group-parameter + (car head) result group))) + ;; For `sieve' group parameters, perform substitutions + ;; for every string within the match rule (see above). + ((eq symbol 'sieve) + (setq result + (mapcar (lambda (elem) + (if (stringp elem) + (gnus-expand-group-parameter (car head) + elem group) + elem)) + result)))))))) ;; Done. result)))) === modified file 'lisp/gnus/message.el' --- lisp/gnus/message.el 2012-09-01 01:04:26 +0000 +++ lisp/gnus/message.el 2012-09-05 22:35:32 +0000 @@ -3292,11 +3292,33 @@ (defun message-insert-newsgroups () "Insert the Newsgroups header from the article being replied to." (interactive) - (when (and (message-position-on-field "Newsgroups") - (mail-fetch-field "newsgroups") - (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups")))) - (insert ",")) - (insert (or (message-fetch-reply-field "newsgroups") ""))) + (let ((old-newsgroups (mail-fetch-field "newsgroups")) + (new-newsgroups (message-fetch-reply-field "newsgroups")) + (first t) + insert-newsgroups) + (message-position-on-field "Newsgroups") + (cond + ((not new-newsgroups) + (error "No Newsgroups to insert")) + ((not old-newsgroups) + (insert new-newsgroups)) + (t + (setq new-newsgroups (split-string new-newsgroups "[, ]+") + old-newsgroups (split-string old-newsgroups "[, ]+")) + (dolist (group new-newsgroups) + (unless (member group old-newsgroups) + (push group insert-newsgroups))) + (if (null insert-newsgroups) + (error "Newgroup%s already in the header" + (if (> (length new-newsgroups) 1) + "s" "")) + (when old-newsgroups + (setq first nil)) + (dolist (group insert-newsgroups) + (unless first + (insert ",")) + (setq first nil) + (insert group))))))) === modified file 'lisp/gnus/nnmaildir.el' --- lisp/gnus/nnmaildir.el 2012-06-10 22:16:03 +0000 +++ lisp/gnus/nnmaildir.el 2012-09-05 22:35:32 +0000 @@ -77,6 +77,66 @@ (defconst nnmaildir-version "Gnus") +(defconst nnmaildir-flag-mark-mapping + '((?F . tick) + (?R . reply) + (?S . read)) + "Alist mapping Maildir filename flags to Gnus marks. +Maildir filenames are of the form \"unique-id:2,FLAGS\", +where FLAGS are a string of characters in ASCII order. +Some of the FLAGS correspond to Gnus marks.") + +(defsubst nnmaildir--mark-to-flag (mark) + "Find the Maildir flag that corresponds to MARK (an atom). +Return a character, or `nil' if not found. +See `nnmaildir-flag-mark-mapping'." + (car (rassq mark nnmaildir-flag-mark-mapping))) + +(defsubst nnmaildir--flag-to-mark (flag) + "Find the Gnus mark that corresponds to FLAG (a character). +Return an atom, or `nil' if not found. +See `nnmaildir-flag-mark-mapping'." + (cdr (assq flag nnmaildir-flag-mark-mapping))) + +(defun nnmaildir--ensure-suffix (filename) + "Ensure that FILENAME contains the suffix \":2,\"." + (if (string-match-p ":2," filename) + filename + (concat filename ":2,"))) + +(defun nnmaildir--add-flag (flag suffix) + "Return a copy of SUFFIX where FLAG is set. +SUFFIX should start with \":2,\"." + (unless (string-match-p "^:2," suffix) + (error "Invalid suffix `%s'" suffix)) + (let* ((flags (substring suffix 3)) + (flags-as-list (append flags nil)) + (new-flags + (concat (gnus-delete-duplicates + ;; maildir flags must be sorted + (sort (cons flag flags-as-list) '<))))) + (concat ":2," new-flags))) + +(defun nnmaildir--remove-flag (flag suffix) + "Return a copy of SUFFIX where FLAG is cleared. +SUFFIX should start with \":2,\"." + (unless (string-match-p "^:2," suffix) + (error "Invalid suffix `%s'" suffix)) + (let* ((flags (substring suffix 3)) + (flags-as-list (append flags nil)) + (new-flags (concat (delq flag flags-as-list)))) + (concat ":2," new-flags))) + +(defun nnmaildir--article-set-flags (article new-suffix curdir) + (let* ((prefix (nnmaildir--art-prefix article)) + (suffix (nnmaildir--art-suffix article)) + (article-file (concat curdir prefix suffix)) + (new-name (concat curdir prefix new-suffix))) + (unless (file-exists-p article-file) + (error "Couldn't find article file %s" article-file)) + (rename-file article-file new-name 'replace) + (setf (nnmaildir--art-suffix article) new-suffix))) + (defvar nnmaildir-article-file-name nil "*The filename of the most recently requested article. This variable is set by nnmaildir-request-article.") @@ -208,29 +268,33 @@ (eval param)) (defmacro nnmaildir--with-nntp-buffer (&rest body) + (declare (debug (body))) `(with-current-buffer nntp-server-buffer ,@body)) (defmacro nnmaildir--with-work-buffer (&rest body) + (declare (debug (body))) `(with-current-buffer (get-buffer-create " *nnmaildir work*") ,@body)) (defmacro nnmaildir--with-nov-buffer (&rest body) + (declare (debug (body))) `(with-current-buffer (get-buffer-create " *nnmaildir nov*") ,@body)) (defmacro nnmaildir--with-move-buffer (&rest body) + (declare (debug (body))) `(with-current-buffer (get-buffer-create " *nnmaildir move*") ,@body)) -(defmacro nnmaildir--subdir (dir subdir) - `(file-name-as-directory (concat ,dir ,subdir))) -(defmacro nnmaildir--srvgrp-dir (srv-dir gname) - `(nnmaildir--subdir ,srv-dir ,gname)) -(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp")) -(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new")) -(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur")) -(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir")) -(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov")) -(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks")) -(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num")) +(defsubst nnmaildir--subdir (dir subdir) + (file-name-as-directory (concat dir subdir))) +(defsubst nnmaildir--srvgrp-dir (srv-dir gname) + (nnmaildir--subdir srv-dir gname)) +(defsubst nnmaildir--tmp (dir) (nnmaildir--subdir dir "tmp")) +(defsubst nnmaildir--new (dir) (nnmaildir--subdir dir "new")) +(defsubst nnmaildir--cur (dir) (nnmaildir--subdir dir "cur")) +(defsubst nnmaildir--nndir (dir) (nnmaildir--subdir dir ".nnmaildir")) +(defsubst nnmaildir--nov-dir (dir) (nnmaildir--subdir dir "nov")) +(defsubst nnmaildir--marks-dir (dir) (nnmaildir--subdir dir "marks")) +(defsubst nnmaildir--num-dir (dir) (nnmaildir--subdir dir "num")) (defmacro nnmaildir--unlink (file-arg) `(let ((file ,file-arg)) @@ -305,6 +369,7 @@ string) (defmacro nnmaildir--condcase (errsym body &rest handler) + (declare (debug (sexp form body))) `(condition-case ,errsym (let ((system-messages-locale "C")) ,body) (error . ,handler))) @@ -759,7 +824,7 @@ (dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort)) (setq x (concat ndir file)) (and (time-less-p (nth 5 (file-attributes x)) (current-time)) - (rename-file x (concat cdir file ":2,")))) + (rename-file x (concat cdir (nnmaildir--ensure-suffix file))))) (setf (nnmaildir--grp-new group) nattr)) (setq cattr (nth 5 (file-attributes cdir))) (if (equal cattr (nnmaildir--grp-cur group)) @@ -784,11 +849,23 @@ cdir (nnmaildir--marks-dir nndir) ndir (nnmaildir--subdir cdir "tick") cdir (nnmaildir--subdir cdir "read")) - (dolist (file files) - (setq file (car file)) - (if (or (not (file-exists-p (concat cdir file))) - (file-exists-p (concat ndir file))) - (setq num (1+ num))))) + (dolist (prefix-suffix files) + (let ((prefix (car prefix-suffix)) + (suffix (cdr prefix-suffix))) + ;; increase num for each unread or ticked article + (when (or + ;; first look for marks in suffix, if it's valid... + (when (and (stringp suffix) + (string-prefix-p ":2," suffix)) + (or + (not (string-match-p + (string (nnmaildir--mark-to-flag 'read)) suffix)) + (string-match-p + (string (nnmaildir--mark-to-flag 'tick)) suffix))) + ;; then look in marks directories + (not (file-exists-p (concat cdir prefix))) + (file-exists-p (concat ndir prefix))) + (incf num))))) (setf (nnmaildir--grp-cache group) (make-vector num nil)) (let ((inhibit-quit t)) (set (intern gname groups) group)) @@ -916,12 +993,15 @@ "\n"))))) 'group) -(defun nnmaildir-request-marks (gname info &optional server) - (let ((group (nnmaildir--prepare server gname)) - pgname flist always-marks never-marks old-marks dotfile num dir - markdirs marks mark ranges markdir article read end new-marks ls - old-mmth new-mmth mtime mark-sym existing missing deactivate-mark - article-list) +(defun nnmaildir-request-update-info (gname info &optional server) + (let* ((group (nnmaildir--prepare server gname)) + (curdir (nnmaildir--cur + (nnmaildir--srvgrp-dir + (nnmaildir--srv-dir nnmaildir--cur-server) gname))) + (curdir-mtime (nth 5 (file-attributes curdir))) + pgname flist always-marks never-marks old-marks dotfile num dir + all-marks marks mark ranges markdir read end new-marks ls + old-mmth new-mmth mtime mark-sym existing missing deactivate-mark) (catch 'return (unless group (setf (nnmaildir--srv-error nnmaildir--cur-server) @@ -950,34 +1030,71 @@ dir (nnmaildir--nndir dir) dir (nnmaildir--marks-dir dir) ls (nnmaildir--group-ls nnmaildir--cur-server pgname) - markdirs (funcall ls dir nil "\\`[^.]" 'nosort) - new-mmth (nnmaildir--up2-1 (length markdirs)) + all-marks (gnus-delete-duplicates + ;; get mark names from mark dirs and from flag + ;; mappings + (append + (mapcar 'cdr nnmaildir-flag-mark-mapping) + (mapcar 'intern (funcall ls dir nil "\\`[^.]" 'nosort)))) + new-mmth (nnmaildir--up2-1 (length all-marks)) new-mmth (make-vector new-mmth 0) old-mmth (nnmaildir--grp-mmth group)) - (dolist (mark markdirs) - (setq markdir (nnmaildir--subdir dir mark) - mark-sym (intern mark) + (dolist (mark all-marks) + (setq markdir (nnmaildir--subdir dir (symbol-name mark)) ranges nil) (catch 'got-ranges - (if (memq mark-sym never-marks) (throw 'got-ranges nil)) - (when (memq mark-sym always-marks) + (if (memq mark never-marks) (throw 'got-ranges nil)) + (when (memq mark always-marks) (setq ranges existing) (throw 'got-ranges nil)) - (setq mtime (nth 5 (file-attributes markdir))) - (set (intern mark new-mmth) mtime) - (when (equal mtime (symbol-value (intern-soft mark old-mmth))) - (setq ranges (assq mark-sym old-marks)) + ;; Find the mtime for this mark. If this mark can be expressed as + ;; a filename flag, get the later of the mtimes for markdir and + ;; curdir, otherwise only the markdir counts. + (setq mtime + (let ((markdir-mtime (nth 5 (file-attributes markdir)))) + (cond + ((null (nnmaildir--mark-to-flag mark)) + markdir-mtime) + ((null markdir-mtime) + curdir-mtime) + ((null curdir-mtime) + ;; this should never happen... + markdir-mtime) + ((time-less-p markdir-mtime curdir-mtime) + curdir-mtime) + (t + markdir-mtime)))) + (set (intern (symbol-name mark) new-mmth) mtime) + (when (equal mtime (symbol-value (intern-soft (symbol-name mark) old-mmth))) + (setq ranges (assq mark old-marks)) (if ranges (setq ranges (cdr ranges))) (throw 'got-ranges nil)) - (setq article-list nil) - (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort)) - (setq article (nnmaildir--flist-art flist prefix)) - (if article - (setq article-list - (cons (nnmaildir--art-num article) article-list)))) - (setq ranges (gnus-add-to-range ranges (sort article-list '<)))) - (if (eq mark-sym 'read) (setq read ranges) - (if ranges (setq marks (cons (cons mark-sym ranges) marks))))) + (let ((article-list nil)) + ;; Consider the article marked if it either has the flag in the + ;; filename, or is in the markdir. As you'd rarely remove a + ;; flag/mark, this should avoid losing information in the most + ;; common usage pattern. + (or + (let ((flag (nnmaildir--mark-to-flag mark))) + ;; If this mark has a corresponding maildir flag... + (when flag + (let ((regexp + (concat "\\`[^.].*:2,[A-Z]*" (string flag)))) + ;; ...then find all files with that flag. + (dolist (filename (funcall ls curdir nil regexp 'nosort)) + (let* ((prefix (car (split-string filename ":2,"))) + (article (nnmaildir--flist-art flist prefix))) + (when article + (push (nnmaildir--art-num article) article-list))))))) + ;; Also check Gnus-specific mark directory, if it exists. + (when (file-directory-p markdir) + (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort)) + (let ((article (nnmaildir--flist-art flist prefix))) + (when article + (push (nnmaildir--art-num article) article-list)))))) + (setq ranges (gnus-add-to-range ranges (sort article-list '<))))) + (if (eq mark 'read) (setq read ranges) + (if ranges (setq marks (cons (cons mark ranges) marks))))) (gnus-info-set-read info (gnus-range-add read missing)) (gnus-info-set-marks info marks 'extend) (setf (nnmaildir--grp-mmth group) new-mmth) @@ -1525,39 +1642,63 @@ didnt))) (defun nnmaildir-request-set-mark (gname actions &optional server) - (let ((group (nnmaildir--prepare server gname)) - (coding-system-for-write nnheader-file-coding-system) - (buffer-file-coding-system nil) - (file-coding-system-alist nil) - del-mark del-action add-action set-action marksdir nlist - ranges begin end article all-marks todo-marks mdir mfile - pgname ls permarkfile deactivate-mark) + (let* ((group (nnmaildir--prepare server gname)) + (curdir (nnmaildir--cur + (nnmaildir--srvgrp-dir + (nnmaildir--srv-dir nnmaildir--cur-server) + gname))) + (coding-system-for-write nnheader-file-coding-system) + (buffer-file-coding-system nil) + (file-coding-system-alist nil) + del-mark del-action add-action set-action marksdir nlist + ranges begin end article all-marks todo-marks mdir mfile + pgname ls permarkfile deactivate-mark) (setq del-mark (lambda (mark) - (setq mfile (nnmaildir--subdir marksdir (symbol-name mark)) - mfile (concat mfile (nnmaildir--art-prefix article))) - (nnmaildir--unlink mfile)) + (let ((prefix (nnmaildir--art-prefix article)) + (suffix (nnmaildir--art-suffix article)) + (flag (nnmaildir--mark-to-flag mark))) + (when flag + ;; If this mark corresponds to a flag, remove the flag from + ;; the file name. + (nnmaildir--article-set-flags + article (nnmaildir--remove-flag flag suffix) curdir)) + ;; We still want to delete the hardlink in the marks dir if + ;; present, regardless of whether this mark has a maildir flag or + ;; not, to avoid getting out of sync. + (setq mfile (nnmaildir--subdir marksdir (symbol-name mark)) + mfile (concat mfile prefix)) + (nnmaildir--unlink mfile))) del-action (lambda (article) (mapcar del-mark todo-marks)) add-action (lambda (article) (mapcar (lambda (mark) - (setq mdir (nnmaildir--subdir marksdir (symbol-name mark)) - permarkfile (concat mdir ":") - mfile (concat mdir (nnmaildir--art-prefix article))) - (nnmaildir--condcase err (add-name-to-file permarkfile mfile) - (cond - ((nnmaildir--eexist-p err)) - ((nnmaildir--enoent-p err) - (nnmaildir--mkdir mdir) - (nnmaildir--mkfile permarkfile) - (add-name-to-file permarkfile mfile)) - ((nnmaildir--emlink-p err) - (let ((permarkfilenew (concat permarkfile "{new}"))) - (nnmaildir--mkfile permarkfilenew) - (rename-file permarkfilenew permarkfile 'replace) - (add-name-to-file permarkfile mfile))) - (t (signal (car err) (cdr err)))))) + (let ((prefix (nnmaildir--art-prefix article)) + (suffix (nnmaildir--art-suffix article)) + (flag (nnmaildir--mark-to-flag mark))) + (if flag + ;; If there is a corresponding maildir flag, just rename + ;; the file. + (nnmaildir--article-set-flags + article (nnmaildir--add-flag flag suffix) curdir) + ;; Otherwise, use nnmaildir-specific marks dir. + (setq mdir (nnmaildir--subdir marksdir (symbol-name mark)) + permarkfile (concat mdir ":") + mfile (concat mdir prefix)) + (nnmaildir--condcase err (add-name-to-file permarkfile mfile) + (cond + ((nnmaildir--eexist-p err)) + ((nnmaildir--enoent-p err) + (nnmaildir--mkdir mdir) + (nnmaildir--mkfile permarkfile) + (add-name-to-file permarkfile mfile)) + ((nnmaildir--emlink-p err) + (let ((permarkfilenew (concat permarkfile "{new}"))) + (nnmaildir--mkfile permarkfilenew) + (rename-file permarkfilenew permarkfile 'replace) + (add-name-to-file permarkfile mfile))) + (t (signal (car err) (cdr err)))))))) todo-marks)) set-action (lambda (article) (funcall add-action article) @@ -1581,7 +1722,12 @@ pgname (nnmaildir--pgname nnmaildir--cur-server gname) ls (nnmaildir--group-ls nnmaildir--cur-server pgname) all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort) - all-marks (mapcar 'intern all-marks)) + all-marks (gnus-delete-duplicates + ;; get mark names from mark dirs and from flag + ;; mappings + (append + (mapcar 'cdr nnmaildir-flag-mark-mapping) + (mapcar 'intern all-marks)))) (dolist (action actions) (setq ranges (car action) todo-marks (caddr action)) ------------------------------------------------------------ revno: 109893 committer: Paul Eggert branch nick: trunk timestamp: Wed 2012-09-05 14:33:53 -0700 message: Fix race conditions with signal handlers and errno. Be more systematic about preserving errno whenever a signal handler returns, even if it's not in the main thread. Do this by renaming signal handlers to distinguish between signal delivery and signal handling. All uses changed. * atimer.c (deliver_alarm_signal): Rename from alarm_signal_handler. * data.c (deliver_arith_signal): Rename from arith_error. * dispnew.c (deliver_window_change_signal): Rename from window_change_signal. * emacs.c (deliver_error_signal): Rename from fatal_error_signal. (deliver_danger_signal) [SIGDANGER]: Rename from memory_warning_signal. * keyboard.c (deliver_input_available_signal): Rename from input_available_signal. (deliver_user_signal): Rename from handle_user_signal. (deliver_interrupt_signal): Rename from interrupt_signal. * process.c (deliver_pipe_signal): Rename from send_process_trap. (deliver_child_signal): Rename from sigchld_handler. * atimer.c (handle_alarm_signal): * data.c (handle_arith_signal): * dispnew.c (handle_window_change_signal): * emacs.c (handle_fatal_signal, handle_danger_signal): * keyboard.c (handle_input_available_signal): * keyboard.c (handle_user_signal, handle_interrupt_signal): * process.c (handle_pipe_signal, handle_child_signal): New functions, with the actual signal-handling code taken from the original respective signal handlers, sans the sporadic attempts to preserve errno, since that's now done by handle_on_main_thread. * atimer.c (alarm_signal_handler): Remove unnecessary decl. * emacs.c, floatfns.c, lisp.h: Remove unused FLOAT_CATCH_SIGKILL cruft. * emacs.c (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Move to sysdep.c. (main) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Move initialization of main_thread to sysdep.c's init_signals. * process.c (waitpid) [!WNOHANG]: #define to wait; that's good enough for our usage, and simplifies the mainline code. (record_child_status_change): New static function, as a helper for handle_child_signal, and with most of the old child handler's contents. (CAN_HANDLE_MULTIPLE_CHILDREN): New constant. (handle_child_signal): Use the above. * sysdep.c (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Moved here from emacs.c. (init_signals) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Initialize it; code moved here from emacs.c's main function. * sysdep.c, syssignal.h (handle_on_main_thread): New function, replacing the old SIGNAL_THREAD_CHECK. All uses changed. This lets callers save and restore errno properly. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-09-05 17:05:32 +0000 +++ src/ChangeLog 2012-09-05 21:33:53 +0000 @@ -1,3 +1,53 @@ +2012-09-05 Paul Eggert + + Fix race conditions with signal handlers and errno. + Be more systematic about preserving errno whenever a signal + handler returns, even if it's not in the main thread. Do this by + renaming signal handlers to distinguish between signal delivery + and signal handling. All uses changed. + * atimer.c (deliver_alarm_signal): Rename from alarm_signal_handler. + * data.c (deliver_arith_signal): Rename from arith_error. + * dispnew.c (deliver_window_change_signal): Rename from + window_change_signal. + * emacs.c (deliver_error_signal): Rename from fatal_error_signal. + (deliver_danger_signal) [SIGDANGER]: Rename from memory_warning_signal. + * keyboard.c (deliver_input_available_signal): Rename from + input_available_signal. + (deliver_user_signal): Rename from handle_user_signal. + (deliver_interrupt_signal): Rename from interrupt_signal. + * process.c (deliver_pipe_signal): Rename from send_process_trap. + (deliver_child_signal): Rename from sigchld_handler. + * atimer.c (handle_alarm_signal): + * data.c (handle_arith_signal): + * dispnew.c (handle_window_change_signal): + * emacs.c (handle_fatal_signal, handle_danger_signal): + * keyboard.c (handle_input_available_signal): + * keyboard.c (handle_user_signal, handle_interrupt_signal): + * process.c (handle_pipe_signal, handle_child_signal): + New functions, with the actual signal-handling code taken from the + original respective signal handlers, sans the sporadic attempts to + preserve errno, since that's now done by handle_on_main_thread. + * atimer.c (alarm_signal_handler): Remove unnecessary decl. + * emacs.c, floatfns.c, lisp.h: Remove unused FLOAT_CATCH_SIGKILL cruft. + * emacs.c (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]: + Move to sysdep.c. + (main) [FORWARD_SIGNAL_TO_MAIN_THREAD]: + Move initialization of main_thread to sysdep.c's init_signals. + * process.c (waitpid) [!WNOHANG]: #define to wait; that's good enough for + our usage, and simplifies the mainline code. + (record_child_status_change): New static function, as a helper + for handle_child_signal, and with most of the old child handler's + contents. + (CAN_HANDLE_MULTIPLE_CHILDREN): New constant. + (handle_child_signal): Use the above. + * sysdep.c (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]: + Moved here from emacs.c. + (init_signals) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Initialize it; + code moved here from emacs.c's main function. + * sysdep.c, syssignal.h (handle_on_main_thread): New function, + replacing the old SIGNAL_THREAD_CHECK. All uses changed. This + lets callers save and restore errno properly. + 2012-09-05 Dmitry Antipov Remove redundant or unused things here and there. === modified file 'src/atimer.c' --- src/atimer.c 2012-08-23 08:27:08 +0000 +++ src/atimer.c 2012-09-05 21:33:53 +0000 @@ -41,7 +41,7 @@ static struct atimer *atimers; -/* Non-zero means alarm_signal_handler has found ripe timers but +/* Non-zero means alarm signal handler has found ripe timers but interrupt_input_blocked was non-zero. In this case, timer functions are not called until the next UNBLOCK_INPUT because timer functions are expected to call X, and X cannot be assumed to be @@ -60,8 +60,6 @@ static void schedule_atimer (struct atimer *); static struct atimer *append_atimer_lists (struct atimer *, struct atimer *); -static void alarm_signal_handler (int signo); - /* Start a new atimer of type TYPE. TIME specifies when the timer is ripe. FN is the function to call when the timer fires. @@ -374,13 +372,9 @@ /* Signal handler for SIGALRM. SIGNO is the signal number, i.e. SIGALRM. */ -void -alarm_signal_handler (int signo) +static void +handle_alarm_signal (int sig) { -#ifndef SYNC_INPUT - SIGNAL_THREAD_CHECK (signo); -#endif - pending_atimers = 1; #ifdef SYNC_INPUT pending_signals = 1; @@ -389,8 +383,14 @@ #endif } - -/* Call alarm_signal_handler for pending timers. */ +static void +deliver_alarm_signal (int sig) +{ + handle_on_main_thread (sig, handle_alarm_signal); +} + + +/* Call alarm signal handler for pending timers. */ void do_pending_atimers (void) @@ -412,7 +412,7 @@ { if (on) { - signal (SIGALRM, alarm_signal_handler); + signal (SIGALRM, deliver_alarm_signal); set_alarm (); } else @@ -426,5 +426,5 @@ free_atimers = stopped_atimers = atimers = NULL; pending_atimers = 0; /* pending_signals is initialized in init_keyboard.*/ - signal (SIGALRM, alarm_signal_handler); + signal (SIGALRM, deliver_alarm_signal); } === modified file 'src/data.c' --- src/data.c 2012-09-04 17:34:54 +0000 +++ src/data.c 2012-09-05 21:33:53 +0000 @@ -3207,18 +3207,19 @@ XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1; } -#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD -_Noreturn -#endif -static void -arith_error (int signo) +static _Noreturn void +handle_arith_signal (int sig) { sigsetmask (SIGEMPTYMASK); - - SIGNAL_THREAD_CHECK (signo); xsignal0 (Qarith_error); } +static void +deliver_arith_signal (int sig) +{ + handle_on_main_thread (sig, handle_arith_signal); +} + void init_data (void) { @@ -3230,5 +3231,5 @@ if (!initialized) return; #endif /* CANNOT_DUMP */ - signal (SIGFPE, arith_error); + signal (SIGFPE, deliver_arith_signal); } === modified file 'src/dispnew.c' --- src/dispnew.c 2012-09-04 17:34:54 +0000 +++ src/dispnew.c 2012-09-05 21:33:53 +0000 @@ -5552,17 +5552,15 @@ #ifdef SIGWINCH +static void deliver_window_change_signal (int); + static void -window_change_signal (int signalnum) /* If we don't have an argument, */ - /* some compilers complain in signal calls. */ +handle_window_change_signal (int sig) { int width, height; - int old_errno = errno; - struct tty_display_info *tty; - signal (SIGWINCH, window_change_signal); - SIGNAL_THREAD_CHECK (signalnum); + signal (SIGWINCH, deliver_window_change_signal); /* The frame size change obviously applies to a single termcap-controlled terminal, but we can't decide which. @@ -5591,8 +5589,12 @@ change_frame_size (XFRAME (frame), height, width, 0, 1, 0); } } +} - errno = old_errno; +static void +deliver_window_change_signal (int sig) +{ + handle_on_main_thread (sig, handle_window_change_signal); } #endif /* SIGWINCH */ @@ -5604,7 +5606,7 @@ void do_pending_window_change (bool safe) { - /* If window_change_signal should have run before, run it now. */ + /* If window change signal handler should have run before, run it now. */ if (redisplaying_p && !safe) return; @@ -6173,7 +6175,7 @@ #ifndef CANNOT_DUMP if (initialized) #endif /* CANNOT_DUMP */ - signal (SIGWINCH, window_change_signal); + signal (SIGWINCH, deliver_window_change_signal); #endif /* SIGWINCH */ /* If running as a daemon, no need to initialize any frames/terminal. */ === modified file 'src/emacs.c' --- src/emacs.c 2012-09-04 18:29:04 +0000 +++ src/emacs.c 2012-09-05 21:33:53 +0000 @@ -275,14 +275,6 @@ /* True if handling a fatal error already. */ bool fatal_error_in_progress; -#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD -/* When compiled with GTK and running under Gnome, - multiple threads may be created. Keep track of our main - thread to make sure signals are delivered to it (see syssignal.h). */ - -pthread_t main_thread; -#endif - #ifdef HAVE_NS /* NS autrelease pool, for memory management. */ static void *ns_pool; @@ -291,16 +283,18 @@ /* Handle bus errors, invalid instruction, etc. */ -#ifndef FLOAT_CATCH_SIGILL -static -#endif -void -fatal_error_signal (int sig) +static void +handle_fatal_signal (int sig) { - SIGNAL_THREAD_CHECK (sig); fatal_error_backtrace (sig, 10); } +static void +deliver_fatal_signal (int sig) +{ + handle_on_main_thread (sig, handle_fatal_signal); +} + /* Report a fatal error due to signal SIG, output a backtrace of at most BACKTRACE_LIMIT lines, and exit. */ _Noreturn void @@ -340,17 +334,23 @@ #ifdef SIGDANGER /* Handler for SIGDANGER. */ -void -memory_warning_signal (int sig) +static void deliver_danger_signal (int); + +static void +handle_danger_signal (int sig) { - signal (sig, memory_warning_signal); - SIGNAL_THREAD_CHECK (sig); - + signal (sig, deliver_danger_signal); malloc_warning ("Operating system warns that virtual memory is running low.\n"); /* It might be unsafe to call do_auto_save now. */ force_auto_save_soon (); } + +static void +deliver_danger_signal (int sig) +{ + handle_on_main_thread (sig, handle_danger_signal); +} #endif /* Code for dealing with Lisp access to the Unix command line. */ @@ -851,10 +851,6 @@ # endif /* not SYNC_INPUT */ #endif /* not SYSTEM_MALLOC */ -#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD - main_thread = pthread_self (); -#endif /* FORWARD_SIGNAL_TO_MAIN_THREAD */ - #if defined (MSDOS) || defined (WINDOWSNT) /* We do all file input/output as binary files. When we need to translate newlines, we do that manually. */ @@ -1120,7 +1116,7 @@ That makes nohup work. */ if (! noninteractive || signal (SIGHUP, SIG_IGN) != SIG_IGN) - signal (SIGHUP, fatal_error_signal); + signal (SIGHUP, deliver_fatal_signal); sigunblock (sigmask (SIGHUP)); } @@ -1135,9 +1131,9 @@ /* Don't catch these signals in batch mode if dumping. On some machines, this sets static data that would make signal fail to work right when the dumped Emacs is run. */ - signal (SIGQUIT, fatal_error_signal); - signal (SIGILL, fatal_error_signal); - signal (SIGTRAP, fatal_error_signal); + signal (SIGQUIT, deliver_fatal_signal); + signal (SIGILL, deliver_fatal_signal); + signal (SIGTRAP, deliver_fatal_signal); #ifdef SIGUSR1 add_user_signal (SIGUSR1, "sigusr1"); #endif @@ -1145,68 +1141,68 @@ add_user_signal (SIGUSR2, "sigusr2"); #endif #ifdef SIGABRT - signal (SIGABRT, fatal_error_signal); + signal (SIGABRT, deliver_fatal_signal); #endif #ifdef SIGHWE - signal (SIGHWE, fatal_error_signal); + signal (SIGHWE, deliver_fatal_signal); #endif #ifdef SIGPRE - signal (SIGPRE, fatal_error_signal); + signal (SIGPRE, deliver_fatal_signal); #endif #ifdef SIGORE - signal (SIGORE, fatal_error_signal); + signal (SIGORE, deliver_fatal_signal); #endif #ifdef SIGUME - signal (SIGUME, fatal_error_signal); + signal (SIGUME, deliver_fatal_signal); #endif #ifdef SIGDLK - signal (SIGDLK, fatal_error_signal); + signal (SIGDLK, deliver_fatal_signal); #endif #ifdef SIGCPULIM - signal (SIGCPULIM, fatal_error_signal); + signal (SIGCPULIM, deliver_fatal_signal); #endif #ifdef SIGIOT /* This is missing on some systems - OS/2, for example. */ - signal (SIGIOT, fatal_error_signal); + signal (SIGIOT, deliver_fatal_signal); #endif #ifdef SIGEMT - signal (SIGEMT, fatal_error_signal); + signal (SIGEMT, deliver_fatal_signal); #endif - signal (SIGFPE, fatal_error_signal); + signal (SIGFPE, deliver_fatal_signal); #ifdef SIGBUS - signal (SIGBUS, fatal_error_signal); + signal (SIGBUS, deliver_fatal_signal); #endif - signal (SIGSEGV, fatal_error_signal); + signal (SIGSEGV, deliver_fatal_signal); #ifdef SIGSYS - signal (SIGSYS, fatal_error_signal); + signal (SIGSYS, deliver_fatal_signal); #endif /* May need special treatment on MS-Windows. See http://lists.gnu.org/archive/html/emacs-devel/2010-09/msg01062.html Please update the doc of kill-emacs, kill-emacs-hook, and NEWS if you change this. */ - if (noninteractive) signal (SIGINT, fatal_error_signal); - signal (SIGTERM, fatal_error_signal); + if (noninteractive) signal (SIGINT, deliver_fatal_signal); + signal (SIGTERM, deliver_fatal_signal); #ifdef SIGXCPU - signal (SIGXCPU, fatal_error_signal); + signal (SIGXCPU, deliver_fatal_signal); #endif #ifdef SIGXFSZ - signal (SIGXFSZ, fatal_error_signal); + signal (SIGXFSZ, deliver_fatal_signal); #endif /* SIGXFSZ */ #ifdef SIGDANGER /* This just means available memory is getting low. */ - signal (SIGDANGER, memory_warning_signal); + signal (SIGDANGER, deliver_danger_signal); #endif #ifdef AIX /* 20 is SIGCHLD, 21 is SIGTTIN, 22 is SIGTTOU. */ - signal (SIGXCPU, fatal_error_signal); - signal (SIGIOINT, fatal_error_signal); - signal (SIGGRANT, fatal_error_signal); - signal (SIGRETRACT, fatal_error_signal); - signal (SIGSOUND, fatal_error_signal); - signal (SIGMSG, fatal_error_signal); + signal (SIGXCPU, deliver_fatal_signal); + signal (SIGIOINT, deliver_fatal_signal); + signal (SIGGRANT, deliver_fatal_signal); + signal (SIGRETRACT, deliver_fatal_signal); + signal (SIGSOUND, deliver_fatal_signal); + signal (SIGMSG, deliver_fatal_signal); #endif /* AIX */ } === modified file 'src/floatfns.c' --- src/floatfns.c 2012-09-05 07:18:46 +0000 +++ src/floatfns.c 2012-09-05 21:33:53 +0000 @@ -37,9 +37,6 @@ Define FLOAT_CHECK_ERRNO if the float library routines set errno. This has no effect if HAVE_MATHERR is defined. - Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL. - (What systems actually do this? Please let us know.) - Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by either setting errno, or signaling SIGFPE/SIGILL. Otherwise, domain and range checking will happen before calling the float routines. This has @@ -99,10 +96,6 @@ # include #endif -#ifdef FLOAT_CATCH_SIGILL -static void float_error (); -#endif - /* True while executing in floating point. This tells float_error what to do. */ @@ -947,31 +940,6 @@ return make_float (d); } -#ifdef FLOAT_CATCH_SIGILL -static void -float_error (int signo) -{ - if (! in_float) - fatal_error_signal (signo); - -#ifdef BSD_SYSTEM - sigsetmask (SIGEMPTYMASK); -#else - /* Must reestablish handler each time it is called. */ - signal (SIGILL, float_error); -#endif /* BSD_SYSTEM */ - - SIGNAL_THREAD_CHECK (signo); - in_float = 0; - - xsignal1 (Qarith_error, float_error_arg); -} - -/* Another idea was to replace the library function `infnan' - where SIGILL is signaled. */ - -#endif /* FLOAT_CATCH_SIGILL */ - #ifdef HAVE_MATHERR int matherr (struct exception *x) @@ -1006,9 +974,6 @@ void init_floatfns (void) { -#ifdef FLOAT_CATCH_SIGILL - signal (SIGILL, float_error); -#endif in_float = 0; } === modified file 'src/keyboard.c' --- src/keyboard.c 2012-09-04 17:34:54 +0000 +++ src/keyboard.c 2012-09-05 21:33:53 +0000 @@ -449,9 +449,8 @@ static Lisp_Object apply_modifiers (int, Lisp_Object); static void clear_event (struct input_event *); static Lisp_Object restore_kboard_configuration (Lisp_Object); -static void interrupt_signal (int signalnum); #ifdef SIGIO -static void input_available_signal (int signo); +static void deliver_input_available_signal (int signo); #endif static void handle_interrupt (void); static _Noreturn void quit_throw_to_read_char (int); @@ -459,7 +458,7 @@ static void timer_start_idle (void); static void timer_stop_idle (void); static void timer_resume_idle (void); -static void handle_user_signal (int); +static void deliver_user_signal (int); static char *find_user_signal_name (int); static int store_user_signal_events (void); @@ -3833,7 +3832,7 @@ unhold_keyboard_input (); #ifdef SIGIO if (!noninteractive) - signal (SIGIO, input_available_signal); + signal (SIGIO, deliver_input_available_signal); #endif /* SIGIO */ start_polling (); } @@ -7236,12 +7235,8 @@ /* Note SIGIO has been undef'd if FIONREAD is missing. */ static void -input_available_signal (int signo) +handle_input_available_signal (int sig) { - /* Must preserve main program's value of errno. */ - int old_errno = errno; - SIGNAL_THREAD_CHECK (signo); - #ifdef SYNC_INPUT interrupt_input_pending = 1; pending_signals = 1; @@ -7253,8 +7248,12 @@ #ifndef SYNC_INPUT handle_async_input (); #endif +} - errno = old_errno; +static void +deliver_input_available_signal (int sig) +{ + handle_on_main_thread (sig, handle_input_available_signal); } #endif /* SIGIO */ @@ -7310,18 +7309,15 @@ p->next = user_signals; user_signals = p; - signal (sig, handle_user_signal); + signal (sig, deliver_user_signal); } static void handle_user_signal (int sig) { - int old_errno = errno; struct user_signal_info *p; const char *special_event_name = NULL; - SIGNAL_THREAD_CHECK (sig); - if (SYMBOLP (Vdebug_on_event)) special_event_name = SSDATA (SYMBOL_NAME (Vdebug_on_event)); @@ -7355,8 +7351,12 @@ } break; } +} - errno = old_errno; +static void +deliver_user_signal (int sig) +{ + handle_on_main_thread (sig, handle_user_signal); } static char * @@ -10776,17 +10776,10 @@ Otherwise, tell QUIT to kill Emacs. */ static void -interrupt_signal (int signalnum) /* If we don't have an argument, some */ - /* compilers complain in signal calls. */ +handle_interrupt_signal (int sig) { - /* Must preserve main program's value of errno. */ - int old_errno = errno; - struct terminal *terminal; - - SIGNAL_THREAD_CHECK (signalnum); - /* See if we have an active terminal on our controlling tty. */ - terminal = get_named_tty ("/dev/tty"); + struct terminal *terminal = get_named_tty ("/dev/tty"); if (!terminal) { /* If there are no frames there, let's pretend that we are a @@ -10807,9 +10800,14 @@ handle_interrupt (); } - - errno = old_errno; -} +} + +static void +deliver_interrupt_signal (int sig) +{ + handle_on_main_thread (sig, handle_interrupt_signal); +} + /* If Emacs is stuck because `inhibit-quit' is true, then keep track of the number of times C-g has been requested. If C-g is pressed @@ -11404,17 +11402,17 @@ SIGINT. There is special code in interrupt_signal to exit Emacs on SIGINT when there are no termcap frames on the controlling terminal. */ - signal (SIGINT, interrupt_signal); + signal (SIGINT, deliver_interrupt_signal); #ifndef DOS_NT /* For systems with SysV TERMIO, C-g is set up for both SIGINT and SIGQUIT and we can't tell which one it will give us. */ - signal (SIGQUIT, interrupt_signal); + signal (SIGQUIT, deliver_interrupt_signal); #endif /* not DOS_NT */ } /* Note SIGIO has been undef'd if FIONREAD is missing. */ #ifdef SIGIO if (!noninteractive) - signal (SIGIO, input_available_signal); + signal (SIGIO, deliver_input_available_signal); #endif /* SIGIO */ /* Use interrupt input by default, if it works and noninterrupt input === modified file 'src/lisp.h' --- src/lisp.h 2012-09-05 17:05:32 +0000 +++ src/lisp.h 2012-09-05 21:33:53 +0000 @@ -3256,9 +3256,6 @@ extern Lisp_Object decode_env_path (const char *, const char *); extern Lisp_Object empty_unibyte_string, empty_multibyte_string; extern Lisp_Object Qfile_name_handler_alist; -#ifdef FLOAT_CATCH_SIGILL -extern void fatal_error_signal (int); -#endif extern _Noreturn void fatal_error_backtrace (int, int); extern Lisp_Object Qkill_emacs; #if HAVE_SETLOCALE === modified file 'src/process.c' --- src/process.c 2012-09-04 17:34:54 +0000 +++ src/process.c 2012-09-05 21:33:53 +0000 @@ -124,6 +124,14 @@ #include "xgselect.h" #endif +#ifndef WNOHANG +# undef waitpid +# define waitpid(pid, status, options) wait (status) +#endif +#ifndef WUNTRACED +# define WUNTRACED 0 +#endif + /* Work around GCC 4.7.0 bug with strict overflow checking; see . These lines can be removed once the GCC bug is fixed. */ @@ -801,7 +809,7 @@ #ifdef SIGCHLD /* Fdelete_process promises to immediately forget about the process, but in reality, Emacs needs to remember those processes until they have been - treated by sigchld_handler; otherwise this handler would consider the + treated by the SIGCHLD handler; otherwise this handler would consider the process as being synchronous and say that the synchronous process is dead. */ static Lisp_Object deleted_pid_list; @@ -849,7 +857,8 @@ #endif { Fkill_process (process, Qnil); - /* Do this now, since remove_process will make sigchld_handler do nothing. */ + /* Do this now, since remove_process will make the + SIGCHLD handler do nothing. */ pset_status (p, Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil))); p->tick = ++process_tick; status_notify (p); @@ -1728,7 +1737,7 @@ if (inchannel > max_process_desc) max_process_desc = inchannel; - /* Until we store the proper pid, enable sigchld_handler + /* Until we store the proper pid, enable the SIGCHLD handler to recognize an unknown pid as standing for this process. It is very important not to let this `marker' value stay in the table after this function has returned; if it does @@ -4956,8 +4965,8 @@ if (p->pid == -2) { - /* If the EIO occurs on a pty, sigchld_handler's - waitpid() will not find the process object to + /* If the EIO occurs on a pty, the SIGCHLD handler's + waitpid call will not find the process object to delete. Do it here. */ p->tick = ++process_tick; pset_status (p, Qfailed); @@ -5422,18 +5431,19 @@ static jmp_buf send_process_frame; static Lisp_Object process_sent_to; -#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD -static _Noreturn void send_process_trap (int); -#endif - -static void -send_process_trap (int ignore) +static _Noreturn void +handle_pipe_signal (int sig) { - SIGNAL_THREAD_CHECK (SIGPIPE); sigunblock (sigmask (SIGPIPE)); _longjmp (send_process_frame, 1); } +static void +deliver_pipe_signal (int sig) +{ + handle_on_main_thread (sig, handle_pipe_signal); +} + /* In send_process, when a write fails temporarily, wait_reading_process_output is called. It may execute user code, e.g. timers, that attempts to write new data to the same process. @@ -5663,7 +5673,7 @@ /* Send this batch, using one or more write calls. */ ptrdiff_t written = 0; int outfd = p->outfd; - old_sigpipe = (void (*) (int)) signal (SIGPIPE, send_process_trap); + old_sigpipe = signal (SIGPIPE, deliver_pipe_signal); #ifdef DATAGRAM_SOCKETS if (DATAGRAM_CHAN_P (outfd)) { @@ -6397,143 +6407,135 @@ indirectly; if it does, that is a bug */ #ifdef SIGCHLD -static void -sigchld_handler (int signo) + +/* Record one child's changed status. Return true if a child was found. */ +static bool +record_child_status_change (void) { - int old_errno = errno; Lisp_Object proc; struct Lisp_Process *p; - - SIGNAL_THREAD_CHECK (signo); - - while (1) - { - pid_t pid; - int w; - Lisp_Object tail; - -#ifdef WNOHANG -#ifndef WUNTRACED -#define WUNTRACED 0 -#endif /* no WUNTRACED */ - /* Keep trying to get a status until we get a definitive result. */ - do - { - errno = 0; - pid = waitpid (-1, &w, WNOHANG | WUNTRACED); - } - while (pid < 0 && errno == EINTR); - - if (pid <= 0) - { - /* PID == 0 means no processes found, PID == -1 means a real - failure. We have done all our job, so return. */ - - errno = old_errno; - return; - } -#else - pid = wait (&w); -#endif /* no WNOHANG */ - - /* Find the process that signaled us, and record its status. */ - - /* The process can have been deleted by Fdelete_process. */ - for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object xpid = XCAR (tail); - if ((INTEGERP (xpid) && pid == XINT (xpid)) - || (FLOATP (xpid) && pid == XFLOAT_DATA (xpid))) - { - XSETCAR (tail, Qnil); - goto sigchld_end_of_loop; - } - } - - /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */ + pid_t pid; + int w; + Lisp_Object tail; + + do + pid = waitpid (-1, &w, WNOHANG | WUNTRACED); + while (pid < 0 && errno == EINTR); + + /* PID == 0 means no processes found, PID == -1 means a real failure. + Either way, we have done all our job. */ + if (pid <= 0) + return false; + + /* Find the process that signaled us, and record its status. */ + + /* The process can have been deleted by Fdelete_process. */ + for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object xpid = XCAR (tail); + if ((INTEGERP (xpid) && pid == XINT (xpid)) + || (FLOATP (xpid) && pid == XFLOAT_DATA (xpid))) + { + XSETCAR (tail, Qnil); + return true; + } + } + + /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */ + p = 0; + for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) + { + proc = XCDR (XCAR (tail)); + p = XPROCESS (proc); + if (EQ (p->type, Qreal) && p->pid == pid) + break; p = 0; - for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) - { - proc = XCDR (XCAR (tail)); - p = XPROCESS (proc); - if (EQ (p->type, Qreal) && p->pid == pid) - break; - p = 0; - } - - /* Look for an asynchronous process whose pid hasn't been filled - in yet. */ - if (p == 0) - for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) - { - proc = XCDR (XCAR (tail)); - p = XPROCESS (proc); - if (p->pid == -1) - break; - p = 0; - } - - /* Change the status of the process that was found. */ - if (p != 0) - { - int clear_desc_flag = 0; - - p->tick = ++process_tick; - p->raw_status = w; - p->raw_status_new = 1; - - /* If process has terminated, stop waiting for its output. */ - if ((WIFSIGNALED (w) || WIFEXITED (w)) - && p->infd >= 0) - clear_desc_flag = 1; - - /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */ - if (clear_desc_flag) - { - FD_CLR (p->infd, &input_wait_mask); - FD_CLR (p->infd, &non_keyboard_wait_mask); - } - - /* Tell wait_reading_process_output that it needs to wake up and - look around. */ - if (input_available_clear_time) - *input_available_clear_time = make_emacs_time (0, 0); - } - - /* There was no asynchronous process found for that pid: we have - a synchronous process. */ - else - { - synch_process_alive = 0; - - /* Report the status of the synchronous process. */ - if (WIFEXITED (w)) - synch_process_retcode = WEXITSTATUS (w); - else if (WIFSIGNALED (w)) - synch_process_termsig = WTERMSIG (w); - - /* Tell wait_reading_process_output that it needs to wake up and - look around. */ - if (input_available_clear_time) - *input_available_clear_time = make_emacs_time (0, 0); - } - - sigchld_end_of_loop: - ; - - /* On some systems, we must return right away. - If any more processes want to signal us, we will - get another signal. - Otherwise (on systems that have WNOHANG), loop around - to use up all the processes that have something to tell us. */ + } + + /* Look for an asynchronous process whose pid hasn't been filled + in yet. */ + if (! p) + for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) + { + proc = XCDR (XCAR (tail)); + p = XPROCESS (proc); + if (p->pid == -1) + break; + p = 0; + } + + /* Change the status of the process that was found. */ + if (p) + { + int clear_desc_flag = 0; + + p->tick = ++process_tick; + p->raw_status = w; + p->raw_status_new = 1; + + /* If process has terminated, stop waiting for its output. */ + if ((WIFSIGNALED (w) || WIFEXITED (w)) + && p->infd >= 0) + clear_desc_flag = 1; + + /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */ + if (clear_desc_flag) + { + FD_CLR (p->infd, &input_wait_mask); + FD_CLR (p->infd, &non_keyboard_wait_mask); + } + + /* Tell wait_reading_process_output that it needs to wake up and + look around. */ + if (input_available_clear_time) + *input_available_clear_time = make_emacs_time (0, 0); + } + /* There was no asynchronous process found for that pid: we have + a synchronous process. */ + else + { + synch_process_alive = 0; + + /* Report the status of the synchronous process. */ + if (WIFEXITED (w)) + synch_process_retcode = WEXITSTATUS (w); + else if (WIFSIGNALED (w)) + synch_process_termsig = WTERMSIG (w); + + /* Tell wait_reading_process_output that it needs to wake up and + look around. */ + if (input_available_clear_time) + *input_available_clear_time = make_emacs_time (0, 0); + } + + return true; +} + +/* On some systems, the SIGCHLD handler must return right away. If + any more processes want to signal us, we will get another signal. + Otherwise, loop around to use up all the processes that have + something to tell us. */ #if (defined WINDOWSNT \ || (defined USG && !defined GNU_LINUX \ && !(defined HPUX && defined WNOHANG))) - errno = old_errno; - return; -#endif /* USG, but not HPUX with WNOHANG */ - } -} +enum { CAN_HANDLE_MULTIPLE_CHILDREN = 1 }; +#else +enum { CAN_HANDLE_MULTIPLE_CHILDREN = 0 }; +#endif + +static void +handle_child_signal (int sig) +{ + while (record_child_status_change () && CAN_HANDLE_MULTIPLE_CHILDREN) + continue; +} + +static void +deliver_child_signal (int sig) +{ + handle_on_main_thread (sig, handle_child_signal); +} + #endif /* SIGCHLD */ @@ -7387,7 +7389,7 @@ #ifndef CANNOT_DUMP if (! noninteractive || initialized) #endif - signal (SIGCHLD, sigchld_handler); + signal (SIGCHLD, deliver_child_signal); #endif FD_ZERO (&input_wait_mask); === modified file 'src/sysdep.c' --- src/sysdep.c 2012-09-04 18:29:04 +0000 +++ src/sysdep.c 2012-09-05 21:33:53 +0000 @@ -1551,6 +1551,40 @@ return (old_mask); } +#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD +pthread_t main_thread; +#endif + +/* If we are on the main thread, handle the signal SIG with HANDLER. + Otherwise, redirect the signal to the main thread, blocking it from + this thread. POSIX says any thread can receive a signal that is + associated with a process, process group, or asynchronous event. + On GNU/Linux that is not true, but for other systems (FreeBSD at + least) it is. */ +void +handle_on_main_thread (int sig, signal_handler_t handler) +{ + /* Preserve errno, to avoid race conditions with signal handlers that + might change errno. Races can occur even in single-threaded hosts. */ + int old_errno = errno; + + bool on_main_thread = true; +#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD + if (! pthread_equal (pthread_self (), main_thread)) + { + sigset_t blocked; + sigemptyset (&blocked); + sigaddset (&blocked, sig); + pthread_sigmask (SIG_BLOCK, &blocked, 0); + pthread_kill (main_thread, sig); + on_main_thread = false; + } +#endif + if (on_main_thread) + handler (sig); + + errno = old_errno; +} #if !defined HAVE_STRSIGNAL && !HAVE_DECL_SYS_SIGLIST static char *my_sys_siglist[NSIG]; @@ -1565,6 +1599,10 @@ { sigemptyset (&empty_mask); +#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD + main_thread = pthread_self (); +#endif + #if !defined HAVE_STRSIGNAL && !HAVE_DECL_SYS_SIGLIST if (! initialized) { === modified file 'src/syssignal.h' --- src/syssignal.h 2012-07-13 01:19:06 +0000 +++ src/syssignal.h 2012-09-05 21:33:53 +0000 @@ -133,24 +133,5 @@ #ifdef FORWARD_SIGNAL_TO_MAIN_THREAD extern pthread_t main_thread; -#define SIGNAL_THREAD_CHECK(signo) \ - do { \ - if (!pthread_equal (pthread_self (), main_thread)) \ - { \ - /* POSIX says any thread can receive the signal. On GNU/Linux \ - that is not true, but for other systems (FreeBSD at least) \ - it is. So direct the signal to the correct thread and block \ - it from this thread. */ \ - sigset_t new_mask; \ - \ - sigemptyset (&new_mask); \ - sigaddset (&new_mask, signo); \ - pthread_sigmask (SIG_BLOCK, &new_mask, 0); \ - pthread_kill (main_thread, signo); \ - return; \ - } \ - } while (0) - -#else /* not FORWARD_SIGNAL_TO_MAIN_THREAD */ -#define SIGNAL_THREAD_CHECK(signo) -#endif /* not FORWARD_SIGNAL_TO_MAIN_THREAD */ +void handle_on_main_thread (int, signal_handler_t); +#endif ------------------------------------------------------------ revno: 109892 committer: Eli Zaretskii branch nick: trunk timestamp: Wed 2012-09-05 21:05:16 +0300 message: leim/quail/hebrew.el ("yiddish-royal"): Fix several bogus entries. diff: === modified file 'leim/ChangeLog' --- leim/ChangeLog 2012-08-28 16:01:59 +0000 +++ leim/ChangeLog 2012-09-05 18:05:16 +0000 @@ -1,3 +1,7 @@ +2012-09-05 Eli Zaretskii + + * quail/hebrew.el ("yiddish-royal"): Fix several bogus entries. + 2012-08-17 Daniel Bergey (tiny change) * quail/indian.el (quail-define-inscript-package): === modified file 'leim/quail/hebrew.el' --- leim/quail/hebrew.el 2011-12-31 01:27:15 +0000 +++ leim/quail/hebrew.el 2012-09-05 18:05:16 +0000 @@ -773,9 +773,9 @@ ("@" ?,Y%(B) ; Double Low-9 Quotation Mark ("(" ?\)) ; mirroring (")" ?\() ; mirroring - ("Q" ?,A=(B) ; Right Double Quotation Mark - ("W" ?,A<(B) - ("E" ?,A>(B) ; Yiddish Double Yod (x2) + ("Q" ?,Y4(B) ; Left Double Quotation Mark + ("W" ?,Y!(B) ; Right Double Quotation Mark + ("E" ?$,1-2(B) ; Yiddish Double Yod (x2) ("R" [ ",H`$,1,W(B" ]) ; Patah Alef (Pasekh Alef) ; ("T" "") ("Y" ?$,1-1(B) ; Ligature Yiddish Vav Yod (vov yud) ------------------------------------------------------------ revno: 109891 committer: Dmitry Antipov branch nick: trunk timestamp: Wed 2012-09-05 21:05:32 +0400 message: Remove redundant or unused things here and there. * lisp.h (CYCLE_CHECK, CHAR_TABLE_TRANSLATE): Remove. * conf_post.h (RE_TRANSLATE): Use char_table_translate. * editfns.c (Fcompare_buffer_substrings): Likewise. * frame.h (struct terminal, struct font_driver_list): Remove redundant declarations. * window.h (Qleft, Qright): Likewise. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-09-05 15:34:45 +0000 +++ src/ChangeLog 2012-09-05 17:05:32 +0000 @@ -1,5 +1,15 @@ 2012-09-05 Dmitry Antipov + Remove redundant or unused things here and there. + * lisp.h (CYCLE_CHECK, CHAR_TABLE_TRANSLATE): Remove. + * conf_post.h (RE_TRANSLATE): Use char_table_translate. + * editfns.c (Fcompare_buffer_substrings): Likewise. + * frame.h (struct terminal, struct font_driver_list): + Remove redundant declarations. + * window.h (Qleft, Qright): Likewise. + +2012-09-05 Dmitry Antipov + Do not mark objects from deleted buffers, windows and frames. * alloc.c (mark_buffer): Mark just the buffer if it is dead. (mark_object): Likewise for windows and frames. === modified file 'src/conf_post.h' --- src/conf_post.h 2012-09-04 17:34:54 +0000 +++ src/conf_post.h 2012-09-05 17:05:32 +0000 @@ -167,7 +167,7 @@ #ifdef emacs /* Don't do this for lib-src. */ /* Tell regex.c to use a type compatible with Emacs. */ #define RE_TRANSLATE_TYPE Lisp_Object -#define RE_TRANSLATE(TBL, C) CHAR_TABLE_TRANSLATE (TBL, C) +#define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C) #ifdef make_number /* If make_number is a macro, use it. */ #define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0))) === modified file 'src/editfns.c' --- src/editfns.c 2012-09-04 17:34:54 +0000 +++ src/editfns.c 2012-09-05 17:05:32 +0000 @@ -2783,8 +2783,8 @@ if (!NILP (trt)) { - c1 = CHAR_TABLE_TRANSLATE (trt, c1); - c2 = CHAR_TABLE_TRANSLATE (trt, c2); + c1 = char_table_translate (trt, c1); + c2 = char_table_translate (trt, c2); } if (c1 < c2) return make_number (- 1 - chars); === modified file 'src/frame.h' --- src/frame.h 2012-09-04 17:34:54 +0000 +++ src/frame.h 2012-09-05 17:05:32 +0000 @@ -81,9 +81,6 @@ #define FRAME_FOREGROUND_PIXEL(f) ((f)->foreground_pixel) #define FRAME_BACKGROUND_PIXEL(f) ((f)->background_pixel) -struct terminal; - -struct font_driver_list; struct frame { === modified file 'src/lisp.h' --- src/lisp.h 2012-09-05 07:18:46 +0000 +++ src/lisp.h 2012-09-05 17:05:32 +0000 @@ -909,14 +909,6 @@ (ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \ : char_table_ref ((CT), (IDX))) -/* Almost equivalent to Faref (CT, IDX). However, if the result is - not a character, return IDX. - - For these characters, do not check validity of CT - and do not follow parent. */ -#define CHAR_TABLE_TRANSLATE(CT, IDX) \ - char_table_translate (CT, IDX) - /* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and 8-bit European characters. Do not check validity of CT. */ #define CHAR_TABLE_SET(CT, IDX, VAL) \ @@ -3556,32 +3548,6 @@ #define make_fixnum_or_float(val) \ (FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_number (val)) - -/* Checks the `cycle check' variable CHECK to see if it indicates that - EL is part of a cycle; CHECK must be either Qnil or a value returned - by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of - elements after which a cycle might be suspected; after that many - elements, this macro begins consing in order to keep more precise - track of elements. - - Returns nil if a cycle was detected, otherwise a new value for CHECK - that includes EL. - - CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so - the caller should make sure that's ok. */ - -#define CYCLE_CHECK(check, el, suspicious) \ - (NILP (check) \ - ? make_number (0) \ - : (INTEGERP (check) \ - ? (XFASTINT (check) < (suspicious) \ - ? make_number (XFASTINT (check) + 1) \ - : Fcons (el, Qnil)) \ - : (!NILP (Fmemq ((el), (check))) \ - ? Qnil \ - : Fcons ((el), (check))))) - - /* SAFE_ALLOCA normally allocates memory on the stack, but if size is larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack. */ === modified file 'src/window.h' --- src/window.h 2012-09-05 07:18:46 +0000 +++ src/window.h 2012-09-05 17:05:32 +0000 @@ -27,8 +27,6 @@ # define WINDOW_INLINE INLINE #endif -extern Lisp_Object Qleft, Qright; - /* Windows are allocated as if they were vectors, but then the Lisp data type is changed to Lisp_Window. They are garbage collected along with the vectors. ------------------------------------------------------------ revno: 109890 committer: Dmitry Antipov branch nick: trunk timestamp: Wed 2012-09-05 19:34:45 +0400 message: Do not mark objects from deleted buffers, windows and frames. * alloc.c (mark_buffer): Mark just the buffer if it is dead. (mark_object): Likewise for windows and frames. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-09-05 12:55:03 +0000 +++ src/ChangeLog 2012-09-05 15:34:45 +0000 @@ -1,5 +1,11 @@ 2012-09-05 Dmitry Antipov + Do not mark objects from deleted buffers, windows and frames. + * alloc.c (mark_buffer): Mark just the buffer if it is dead. + (mark_object): Likewise for windows and frames. + +2012-09-05 Dmitry Antipov + * alloc.c (valid_lisp_object_p): Treat killed buffers, buffer_defaults and buffer_local_symbols as valid objects. Return special value to denote them. === modified file 'src/alloc.c' --- src/alloc.c 2012-09-05 12:55:03 +0000 +++ src/alloc.c 2012-09-05 15:34:45 +0000 @@ -5838,23 +5838,29 @@ static void mark_buffer (struct buffer *buffer) { - /* This is handled much like other pseudovectors... */ - mark_vectorlike ((struct Lisp_Vector *) buffer); - - /* ...but there are some buffer-specific things. */ - - MARK_INTERVAL_TREE (buffer_intervals (buffer)); - - /* For now, we just don't mark the undo_list. It's done later in - a special way just before the sweep phase, and after stripping - some of its elements that are not needed any more. */ - - mark_overlay (buffer->overlays_before); - mark_overlay (buffer->overlays_after); - - /* If this is an indirect buffer, mark its base buffer. */ - if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer)) - mark_buffer (buffer->base_buffer); + if (NILP (BVAR (buffer, name))) + /* If the buffer is killed, mark just the buffer itself. */ + VECTOR_MARK (buffer); + else + { + /* This is handled much like other pseudovectors... */ + mark_vectorlike ((struct Lisp_Vector *) buffer); + + /* ...but there are some buffer-specific things. */ + + MARK_INTERVAL_TREE (buffer_intervals (buffer)); + + /* For now, we just don't mark the undo_list. It's done later in + a special way just before the sweep phase, and after stripping + some of its elements that are not needed any more. */ + + mark_overlay (buffer->overlays_before); + mark_overlay (buffer->overlays_after); + + /* If this is an indirect buffer, mark its base buffer. */ + if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer)) + mark_buffer (buffer->base_buffer); + } } /* Determine type of generic Lisp_Object and mark it accordingly. */ @@ -5997,24 +6003,38 @@ case PVEC_FRAME: { - mark_vectorlike (ptr); - mark_face_cache (((struct frame *) ptr)->face_cache); + struct frame *f = (struct frame *) ptr; + + if (FRAME_LIVE_P (f)) + { + mark_vectorlike (ptr); + mark_face_cache (f->face_cache); + } + else + /* If the frame is deleted, mark just the frame itself. */ + VECTOR_MARK (ptr); } break; case PVEC_WINDOW: { struct window *w = (struct window *) ptr; + bool leaf = NILP (w->hchild) && NILP (w->vchild); - mark_vectorlike (ptr); - /* Mark glyphs for leaf windows. Marking window - matrices is sufficient because frame matrices - use the same glyph memory. */ - if (NILP (w->hchild) && NILP (w->vchild) - && w->current_matrix) + if (leaf && NILP (w->buffer)) + /* If the window is deleted, mark just the window itself. */ + VECTOR_MARK (ptr); + else { - mark_glyph_matrix (w->current_matrix); - mark_glyph_matrix (w->desired_matrix); + mark_vectorlike (ptr); + /* Mark glyphs for leaf windows. Marking window + matrices is sufficient because frame matrices + use the same glyph memory. */ + if (leaf && w->current_matrix) + { + mark_glyph_matrix (w->current_matrix); + mark_glyph_matrix (w->desired_matrix); + } } } break; ------------------------------------------------------------ revno: 109889 committer: Dmitry Antipov branch nick: trunk timestamp: Wed 2012-09-05 16:55:03 +0400 message: * alloc.c (valid_lisp_object_p): Treat killed buffers, buffer_defaults and buffer_local_symbols as valid objects. Return special value to denote them. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-09-05 07:18:46 +0000 +++ src/ChangeLog 2012-09-05 12:55:03 +0000 @@ -1,3 +1,9 @@ +2012-09-05 Dmitry Antipov + + * alloc.c (valid_lisp_object_p): Treat killed buffers, + buffer_defaults and buffer_local_symbols as valid objects. + Return special value to denote them. + 2012-09-05 Paul Eggert * fileio.c, filelock.c, floatfns.c, fns.c: Use bool for boolean. === modified file 'src/alloc.c' --- src/alloc.c 2012-09-04 18:29:04 +0000 +++ src/alloc.c 2012-09-05 12:55:03 +0000 @@ -4981,7 +4981,8 @@ #endif } -/* Return 1 if OBJ is a valid lisp object. +/* Return 2 if OBJ is a killed or special buffer object. + Return 1 if OBJ is a valid lisp object. Return 0 if OBJ is NOT a valid lisp object. Return -1 if we cannot validate OBJ. This function can be quite slow, @@ -5002,6 +5003,9 @@ if (PURE_POINTER_P (p)) return 1; + if (p == &buffer_defaults || p == &buffer_local_symbols) + return 2; + #if !GC_MARK_STACK return valid_pointer_p (p); #else @@ -5027,7 +5031,7 @@ return 0; case MEM_TYPE_BUFFER: - return live_buffer_p (m, p); + return live_buffer_p (m, p) ? 1 : 2; case MEM_TYPE_CONS: return live_cons_p (m, p); ------------------------------------------------------------ revno: 109888 committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-09-05 06:17:38 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/config.in' --- autogen/config.in 2012-09-04 10:17:39 +0000 +++ autogen/config.in 2012-09-05 10:17:38 +0000 @@ -1179,9 +1179,6 @@ `NO'. */ #undef NARROWPROTO -/* Do not define abort in emacs.c. */ -#undef NO_ABORT - /* Define if XEditRes should not be used. */ #undef NO_EDITRES === modified file 'autogen/configure' --- autogen/configure 2012-09-04 10:17:39 +0000 +++ autogen/configure 2012-09-05 10:17:38 +0000 @@ -14972,12 +14972,6 @@ $as_echo "#define BROKEN_PTY_READ_AFTER_EAGAIN 1" >>confdefs.h ;; - - darwin) - -$as_echo "#define NO_ABORT 1" >>confdefs.h - - ;; esac case $opsys in ------------------------------------------------------------ revno: 109887 committer: martin rudalics branch nick: trunk timestamp: Wed 2012-09-05 11:22:20 +0200 message: Provide support for fitting frames to buffers. * help.el (temp-buffer-max-height): New default value. (temp-buffer-resize-frames): New option. (resize-temp-buffer-window): Optionally resize frame. * window.el (fit-frame-to-buffer-bottom-margin): New option. (fit-frame-to-buffer): New function. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-09-04 21:21:00 +0000 +++ etc/NEWS 2012-09-05 09:22:20 +0000 @@ -645,6 +645,11 @@ *** New macro with-temp-buffer-window. +*** New option temp-buffer-resize-frames. + +*** New function fit-frame-to-buffer and new option + fit-frame-to-buffer-bottom-margin. + *** New display action function display-buffer-below-selected. *** New display action alist `inhibit-switch-frame', if non-nil, tells === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-09-05 07:05:56 +0000 +++ lisp/ChangeLog 2012-09-05 09:22:20 +0000 @@ -1,3 +1,12 @@ +2012-09-05 Martin Rudalics + + * help.el (temp-buffer-max-height): New default value. + (temp-buffer-resize-frames): New option. + (resize-temp-buffer-window): Optionally resize frame. + + * window.el (fit-frame-to-buffer-bottom-margin): New option. + (fit-frame-to-buffer): New function. + 2012-09-05 Glenn Morris * emulation/cua-rect.el (cua--init-rectangles): === modified file 'lisp/help.el' --- lisp/help.el 2012-09-03 08:54:25 +0000 +++ lisp/help.el 2012-09-05 09:22:20 +0000 @@ -962,7 +962,11 @@ result)) ;;; Automatic resizing of temporary buffers. -(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2)) +(defcustom temp-buffer-max-height + (lambda (buffer) + (if (eq (selected-window) (frame-root-window)) + (/ (x-display-pixel-height) (frame-char-height) 2) + (/ (- (frame-height) 2) 2))) "Maximum height of a window displaying a temporary buffer. This is effective only when Temp Buffer Resize mode is enabled. The value is the maximum height (in lines) which @@ -973,7 +977,16 @@ function is called, the window to be resized is selected." :type '(choice integer function) :group 'help - :version "20.4") + :version "24.2") + +(defcustom temp-buffer-resize-frames nil + "Non-nil means `temp-buffer-resize-mode' can resize frames. +A frame can be resized if and only if its root window is a live +window. The height of the root window is subject to the values of +`temp-buffer-max-height' and `window-min-height'." + :type 'boolean + :version "24.2" + :group 'help) (define-minor-mode temp-buffer-resize-mode "Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode). @@ -1008,9 +1021,21 @@ (with-selected-window window (funcall temp-buffer-max-height (window-buffer))) temp-buffer-max-height))) - (when (and (pos-visible-in-window-p (point-min) window) - (window-combined-p window)) - (fit-window-to-buffer window height)))) + (cond + ((and (pos-visible-in-window-p (point-min) window) + (window-combined-p window)) + (fit-window-to-buffer window height)) + ((and temp-buffer-resize-frames + (eq window (frame-root-window window)) + (memq (car (window-parameter window 'quit-restore)) + ;; If 'same is too strong, we might additionally check + ;; whether the second element is 'frame. + '(same frame))) + (let ((frame (window-frame window))) + (fit-frame-to-buffer + frame (+ (frame-height frame) + (- (window-total-size window)) + height))))))) ;;; Help windows. (defcustom help-window-select 'other === modified file 'lisp/window.el' --- lisp/window.el 2012-09-03 08:54:25 +0000 +++ lisp/window.el 2012-09-05 09:22:20 +0000 @@ -5918,6 +5918,88 @@ (error (setq delta nil))) delta)))) +(defcustom fit-frame-to-buffer-bottom-margin 4 + "Bottom margin for `fit-frame-to-buffer'. +This is the number of lines `fit-frame-to-buffer' leaves free at the +bottom of the display in order to not obscure the system task bar." + :type 'integer + :version "24.2" + :group 'windows) + +(defun fit-frame-to-buffer (&optional frame max-height min-height) + "Adjust height of FRAME to display its buffer's contents exactly. +FRAME can be any live frame and defaults to the selected one. + +Optional argument MAX-HEIGHT specifies the maximum height of +FRAME and defaults to the height of the display below the current +top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN. +Optional argument MIN-HEIGHT specifies the minimum height of +FRAME." + (interactive) + (setq frame (window-normalize-frame frame)) + (let* ((root (frame-root-window frame)) + (frame-min-height + (+ (- (frame-height frame) (window-total-size root)) + window-min-height)) + (frame-top (frame-parameter frame 'top)) + (top (if (consp frame-top) + (funcall (car frame-top) (cadr frame-top)) + frame-top)) + (frame-max-height + (- (/ (- (x-display-pixel-height frame) top) + (frame-char-height frame)) + fit-frame-to-buffer-bottom-margin)) + (compensate 0) + delta) + (when (and (window-live-p root) (not (window-size-fixed-p root))) + (with-selected-window root + (cond + ((not max-height) + (setq max-height frame-max-height)) + ((numberp max-height) + (setq max-height (min max-height frame-max-height))) + (t + (error "%s is an invalid maximum height" max-height))) + (cond + ((not min-height) + (setq min-height frame-min-height)) + ((numberp min-height) + (setq min-height (min min-height frame-min-height))) + (t + (error "%s is an invalid minimum height" min-height))) + ;; When tool-bar-mode is enabled and we have just created a new + ;; frame, reserve lines for toolbar resizing. This is needed + ;; because for reasons unknown to me Emacs (1) reserves one line + ;; for the toolbar when making the initial frame and toolbars + ;; are enabled, and (2) later adds the remaining lines needed. + ;; Our code runs IN BETWEEN (1) and (2). YMMV when you're on a + ;; system that behaves differently. + (let ((quit-restore (window-parameter root 'quit-restore)) + (lines (tool-bar-lines-needed frame))) + (when (and quit-restore (eq (car quit-restore) 'frame) + (not (zerop lines))) + (setq compensate (1- lines)))) + (message "%s" compensate) + (setq delta + ;; Always count a final newline - we don't do any + ;; post-processing, so let's play safe. + (+ (count-screen-lines nil nil t) + (- (window-body-size)) + compensate))) + ;; Move away from final newline. + (when (and (eobp) (bolp) (not (bobp))) + (set-window-point root (line-beginning-position 0))) + (set-window-start root (point-min)) + (set-window-vscroll root 0) + (condition-case nil + (set-frame-height + frame + (min (max (+ (frame-height frame) delta) + min-height) + max-height)) + (error (setq delta nil)))) + delta)) + (defun window-safely-shrinkable-p (&optional window) "Return t if WINDOW can be shrunk without shrinking other windows. WINDOW defaults to the selected window." ------------------------------------------------------------ revno: 109886 committer: Paul Eggert branch nick: trunk timestamp: Wed 2012-09-05 00:18:46 -0700 message: * fileio.c, filelock.c, floatfns.c, fns.c: Use bool for boolean. * fileio.c (auto_saving, auto_save_error_occurred, make_temp_name) (Fexpand_file_name, barf_or_query_if_file_exists, Fcopy_file) (file_name_absolute_p, Fsubstitute_in_file_name): (check_executable, check_writable, Ffile_accessible_directory_p) (Fset_file_selinux_context, Fdefault_file_modes) (Finsert_file_contents, choose_write_coding_system) (Fwrite_region, build_annotations, a_write, e_write) (Fdo_auto_save): * filelock.c (boot_time_initialized, get_boot_time) (get_boot_time_1, lock_file_1, within_one_second): * floatfns.c (in_float): * fns.c (concat, internal_equal, Frequire, base64_encode_1) (base64_decode_1, cmpfn_eql, cmpfn_user_defined) (sweep_weak_table, sweep_weak_hash_tables, secure_hash): * lisp.h (struct Lisp_Hash_Table.cmpfn): * window.c (compare_window_configurations): Use bool for booleans. * fileio.c (auto_saving_dir_umask, auto_saving_mode_bits) (Fdefault_file_modes): Now mode_t, not int, for modes. (Fdo_auto_save): Set a boolean to 1 rather than using ++. (internal_delete_file): Now returns void, not a (boolean) int, since nobody was looking at the return value. * lisp.h, window.h: Adjust to above API changes. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-09-05 03:37:32 +0000 +++ src/ChangeLog 2012-09-05 07:18:46 +0000 @@ -1,5 +1,30 @@ 2012-09-05 Paul Eggert + * fileio.c, filelock.c, floatfns.c, fns.c: Use bool for boolean. + * fileio.c (auto_saving, auto_save_error_occurred, make_temp_name) + (Fexpand_file_name, barf_or_query_if_file_exists, Fcopy_file) + (file_name_absolute_p, Fsubstitute_in_file_name): + (check_executable, check_writable, Ffile_accessible_directory_p) + (Fset_file_selinux_context, Fdefault_file_modes) + (Finsert_file_contents, choose_write_coding_system) + (Fwrite_region, build_annotations, a_write, e_write) + (Fdo_auto_save): + * filelock.c (boot_time_initialized, get_boot_time) + (get_boot_time_1, lock_file_1, within_one_second): + * floatfns.c (in_float): + * fns.c (concat, internal_equal, Frequire, base64_encode_1) + (base64_decode_1, cmpfn_eql, cmpfn_user_defined) + (sweep_weak_table, sweep_weak_hash_tables, secure_hash): + * lisp.h (struct Lisp_Hash_Table.cmpfn): + * window.c (compare_window_configurations): + Use bool for booleans. + * fileio.c (auto_saving_dir_umask, auto_saving_mode_bits) + (Fdefault_file_modes): Now mode_t, not int, for modes. + (Fdo_auto_save): Set a boolean to 1 rather than using ++. + (internal_delete_file): Now returns void, not a (boolean) int, + since nobody was looking at the return value. + * lisp.h, window.h: Adjust to above API changes. + * xdisp.c (set_message): Simplify and reindent last change. 2012-09-05 Juanma Barranquero === modified file 'src/fileio.c' --- src/fileio.c 2012-09-04 17:34:54 +0000 +++ src/fileio.c 2012-09-05 07:18:46 +0000 @@ -85,18 +85,18 @@ #include "commands.h" -/* Nonzero during writing of auto-save files. */ -static int auto_saving; +/* True during writing of auto-save files. */ +static bool auto_saving; /* Nonzero umask during creation of auto-save directories. */ -static int auto_saving_dir_umask; +static mode_t auto_saving_dir_umask; /* Set by auto_save_1 to mode of original file so Fwrite_region will create a new file with the same mode as the original. */ -static int auto_save_mode_bits; +static mode_t auto_save_mode_bits; /* Set by auto_save_1 if an error occurred during the last auto-save. */ -static int auto_save_error_occurred; +static bool auto_save_error_occurred; /* The symbol bound to coding-system-for-read when insert-file-contents is called for recovering a file. This is not @@ -145,10 +145,10 @@ static Lisp_Object Qcar_less_than_car; -static int a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, - Lisp_Object *, struct coding_system *); -static int e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, - struct coding_system *); +static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, + Lisp_Object *, struct coding_system *); +static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, + struct coding_system *); void @@ -595,7 +595,7 @@ which has no existing file. To make this work, PREFIX should be an absolute file name. - BASE64_P non-zero means add the pid as 3 characters in base64 + BASE64_P means add the pid as 3 characters in base64 encoding. In this case, 6 characters will be added to PREFIX to form the file name. Otherwise, if Emacs is running on a system with long file names, add the pid as a decimal number. @@ -604,7 +604,7 @@ generated. */ Lisp_Object -make_temp_name (Lisp_Object prefix, int base64_p) +make_temp_name (Lisp_Object prefix, bool base64_p) { Lisp_Object val; int len, clen; @@ -761,8 +761,8 @@ struct passwd *pw; #ifdef DOS_NT int drive = 0; - int collapse_newdir = 1; - int is_escaped = 0; + bool collapse_newdir = 1; + bool is_escaped = 0; #endif /* DOS_NT */ ptrdiff_t length; Lisp_Object handler, result, handled_name; @@ -920,10 +920,9 @@ /* If it turns out that the filename we want to return is just a suffix of FILENAME, we don't need to go through and edit things; we just need to construct a new string using data - starting at the middle of FILENAME. If we set lose to a - non-zero value, that means we've discovered that we can't do - that cool trick. */ - int lose = 0; + starting at the middle of FILENAME. If we set LOSE, that + means we've discovered that we can't do that cool trick. */ + bool lose = 0; char *p = nm; while (*p) @@ -1360,7 +1359,6 @@ ptrdiff_t tlen; unsigned char *target; struct passwd *pw; - int lose; CHECK_STRING (name); nm = SDATA (name); @@ -1369,8 +1367,8 @@ If no /./ or /../ we can return right away. */ if (nm[0] == '/') { + bool lose = 0; p = nm; - lose = 0; while (*p) { if (p[0] == '/' && p[1] == '/' @@ -1494,7 +1492,7 @@ #endif /* If /~ or // appears, discard everything through first slash. */ -static int +static bool file_name_absolute_p (const char *filename) { return @@ -1560,12 +1558,10 @@ those `/' is discarded. */) (Lisp_Object filename) { - char *nm; - - register char *s, *p, *o, *x, *endp; + char *nm, *s, *p, *o, *x, *endp; char *target = NULL; int total = 0; - int substituted = 0; + bool substituted = 0; bool multibyte; char *xnm; Lisp_Object handler; @@ -1780,7 +1776,7 @@ } /* Signal an error if the file ABSNAME already exists. - If INTERACTIVE is nonzero, ask the user whether to proceed, + If INTERACTIVE, ask the user whether to proceed, and bypass the error if the user says to go ahead. QUERYSTRING is a name for the action that is being considered to alter the file. @@ -1789,13 +1785,14 @@ If the file does not exist, STATPTR->st_mode is set to 0. If STATPTR is null, we don't store into it. - If QUICK is nonzero, we ask for y or n, not yes or no. */ + If QUICK, ask for y or n, not yes or no. */ static void barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring, - int interactive, struct stat *statptr, int quick) + bool interactive, struct stat *statptr, + bool quick) { - register Lisp_Object tem, encoded_filename; + Lisp_Object tem, encoded_filename; struct stat statbuf; struct gcpro gcpro1; @@ -1869,11 +1866,11 @@ Lisp_Object handler; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; ptrdiff_t count = SPECPDL_INDEX (); - int input_file_statable_p; + bool input_file_statable_p; Lisp_Object encoded_file, encoded_newname; #if HAVE_LIBSELINUX security_context_t con; - int fail, conlength = 0; + int conlength = 0; #endif encoded_file = encoded_newname = Qnil; @@ -1988,7 +1985,7 @@ S_IREAD | S_IWRITE); #else /* not MSDOS */ { - int new_mask = 0666; + mode_t new_mask = 0666; if (input_file_statable_p) { if (!NILP (preserve_uid_gid)) @@ -2018,7 +2015,7 @@ owner and group. */ if (input_file_statable_p) { - int mode_mask = 07777; + mode_t mode_mask = 07777; if (!NILP (preserve_uid_gid)) { /* Attempt to change owner and group. If that doesn't work @@ -2041,7 +2038,7 @@ if (conlength > 0) { /* Set the modified context back to the file. */ - fail = fsetfilecon (ofd, con); + bool fail = fsetfilecon (ofd, con) != 0; /* See http://debbugs.gnu.org/11245 for ENOTSUP. */ if (fail && errno != ENOTSUP) report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil)); @@ -2184,17 +2181,14 @@ return Qt; } -/* Delete file FILENAME, returning 1 if successful and 0 if failed. +/* Delete file FILENAME. This ignores `delete-by-moving-to-trash'. */ -int +void internal_delete_file (Lisp_Object filename) { - Lisp_Object tem; - - tem = internal_condition_case_2 (Fdelete_file, filename, Qnil, - Qt, internal_delete_file_1); - return NILP (tem); + internal_condition_case_2 (Fdelete_file, filename, Qnil, + Qt, internal_delete_file_1); } DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, @@ -2430,9 +2424,9 @@ return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil; } -/* Return nonzero if file FILENAME exists and can be executed. */ +/* Return true if file FILENAME exists and can be executed. */ -static int +static bool check_executable (char *filename) { #ifdef DOS_NT @@ -2452,9 +2446,9 @@ #endif /* not DOS_NT */ } -/* Return nonzero if file FILENAME exists and can be written. */ +/* Return true if file FILENAME exists and can be written. */ -static int +static bool check_writable (const char *filename) { #ifdef MSDOS @@ -2464,7 +2458,7 @@ return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode)); #else /* not MSDOS */ #ifdef HAVE_EUIDACCESS - int res = (euidaccess (filename, 2) >= 0); + bool res = (euidaccess (filename, 2) >= 0); #ifdef CYGWIN /* euidaccess may have returned failure because Cygwin couldn't determine the file's UID or GID; if so, we return success. */ @@ -2732,7 +2726,7 @@ (Lisp_Object filename) { Lisp_Object handler; - int tem; + bool tem; struct gcpro gcpro1; /* If the file name has special constructs in it, @@ -2868,7 +2862,8 @@ Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context))); Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context)))); security_context_t con; - int fail, conlength; + bool fail; + int conlength; context_t parsed_con; #endif @@ -2912,8 +2907,9 @@ } /* Set the modified context back to the file. */ - fail = lsetfilecon (SSDATA (encoded_absname), - context_str (parsed_con)); + fail = (lsetfilecon (SSDATA (encoded_absname), + context_str (parsed_con)) + != 0); /* See http://debbugs.gnu.org/11245 for ENOTSUP. */ if (fail && errno != ENOTSUP) report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil)); @@ -3004,7 +3000,7 @@ The value is an integer. */) (void) { - int realmask; + mode_t realmask; Lisp_Object value; BLOCK_INPUT; @@ -3246,29 +3242,29 @@ struct stat st; int file_status; EMACS_TIME mtime; - register int fd; + int fd; ptrdiff_t inserted = 0; - int nochange = 0; - register ptrdiff_t how_much; + bool nochange = 0; + ptrdiff_t how_much; off_t beg_offset, end_offset; - register int unprocessed; + int unprocessed; ptrdiff_t count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; Lisp_Object handler, val, insval, orig_filename, old_undo; Lisp_Object p; ptrdiff_t total = 0; - int not_regular = 0; + bool not_regular = 0; int save_errno = 0; char read_buf[READ_BUF_SIZE]; struct coding_system coding; char buffer[1 << 14]; - int replace_handled = 0; - int set_coding_system = 0; + bool replace_handled = 0; + bool set_coding_system = 0; Lisp_Object coding_system; - int read_quit = 0; + bool read_quit = 0; Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark; - int we_locked_file = 0; - int deferred_remove_unwind_protect = 0; + bool we_locked_file = 0; + bool deferred_remove_unwind_protect = 0; if (current_buffer->base_buffer && ! NILP (visit)) error ("Cannot do file visiting in an indirect buffer"); @@ -3569,9 +3565,9 @@ ptrdiff_t same_at_end = ZV_BYTE; ptrdiff_t overlap; /* There is still a possibility we will find the need to do code - conversion. If that happens, we set this variable to 1 to + conversion. If that happens, set this variable to give up on handling REPLACE in the optimized way. */ - int giveup_match_end = 0; + bool giveup_match_end = 0; if (beg_offset != 0) { @@ -4427,8 +4423,8 @@ If it is not set locally, we anyway have to convert EOL format if the default value of `buffer-file-coding-system' tells that it is not Unix-like (LF only) format. */ - int using_default_coding = 0; - int force_raw_text = 0; + bool using_default_coding = 0; + bool force_raw_text = 0; val = BVAR (current_buffer, buffer_file_coding_system); if (NILP (val) @@ -4537,8 +4533,8 @@ `write-region-post-annotation-function' at the end. */) (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append, Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew) { - register int desc; - int failure; + int desc; + bool ok; int save_errno = 0; const char *fn; struct stat st; @@ -4548,8 +4544,8 @@ Lisp_Object visit_file; Lisp_Object annotations; Lisp_Object encoded_filename; - int visiting = (EQ (visit, Qt) || STRINGP (visit)); - int quietly = !NILP (visit); + bool visiting = (EQ (visit, Qt) || STRINGP (visit)); + bool quietly = !NILP (visit); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; struct buffer *given_buffer; struct coding_system coding; @@ -4713,37 +4709,27 @@ UNGCPRO; - failure = 0; immediate_quit = 1; if (STRINGP (start)) - { - failure = 0 > a_write (desc, start, 0, SCHARS (start), - &annotations, &coding); - save_errno = errno; - } + ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding); else if (XINT (start) != XINT (end)) - { - failure = 0 > a_write (desc, Qnil, - XINT (start), XINT (end) - XINT (start), - &annotations, &coding); - save_errno = errno; - } + ok = a_write (desc, Qnil, XINT (start), XINT (end) - XINT (start), + &annotations, &coding); else { - /* If file was empty, still need to write the annotations */ + /* If file was empty, still need to write the annotations. */ coding.mode |= CODING_MODE_LAST_BLOCK; - failure = 0 > a_write (desc, Qnil, XINT (end), 0, &annotations, &coding); - save_errno = errno; + ok = a_write (desc, Qnil, XINT (end), 0, &annotations, &coding); } + save_errno = errno; - if (CODING_REQUIRE_FLUSHING (&coding) - && !(coding.mode & CODING_MODE_LAST_BLOCK) - && ! failure) + if (ok && CODING_REQUIRE_FLUSHING (&coding) + && !(coding.mode & CODING_MODE_LAST_BLOCK)) { /* We have to flush out a data. */ coding.mode |= CODING_MODE_LAST_BLOCK; - failure = 0 > e_write (desc, Qnil, 1, 1, &coding); + ok = e_write (desc, Qnil, 1, 1, &coding); save_errno = errno; } @@ -4760,13 +4746,13 @@ ignore EINVAL which happens when fsync is not supported on this file. */ if (errno != EINTR && errno != EINVAL) - failure = 1, save_errno = errno; + ok = 0, save_errno = errno; } #endif /* NFS can report a write failure now. */ if (emacs_close (desc) < 0) - failure = 1, save_errno = errno; + ok = 0, save_errno = errno; stat (fn, &st); @@ -4803,7 +4789,7 @@ current_buffer->modtime_size = st.st_size; } - if (failure) + if (! ok) error ("IO error writing %s: %s", SDATA (filename), emacs_strerror (save_errno)); @@ -4859,7 +4845,8 @@ Lisp_Object p, res; struct gcpro gcpro1, gcpro2; Lisp_Object original_buffer; - int i, used_global = 0; + int i; + bool used_global = 0; XSETBUFFER (original_buffer, current_buffer); @@ -4939,11 +4926,11 @@ We modify *ANNOT by discarding elements as we use them up. - The return value is negative in case of system call failure. */ + Return true if successful. */ -static int +static bool a_write (int desc, Lisp_Object string, ptrdiff_t pos, - register ptrdiff_t nchars, Lisp_Object *annot, + ptrdiff_t nchars, Lisp_Object *annot, struct coding_system *coding) { Lisp_Object tem; @@ -4965,29 +4952,29 @@ /* Output buffer text up to the next annotation's position. */ if (nextpos > pos) { - if (0 > e_write (desc, string, pos, nextpos, coding)) - return -1; + if (!e_write (desc, string, pos, nextpos, coding)) + return 0; pos = nextpos; } /* Output the annotation. */ tem = Fcdr (Fcar (*annot)); if (STRINGP (tem)) { - if (0 > e_write (desc, tem, 0, SCHARS (tem), coding)) - return -1; + if (!e_write (desc, tem, 0, SCHARS (tem), coding)) + return 0; } *annot = Fcdr (*annot); } - return 0; + return 1; } /* Write text in the range START and END into descriptor DESC, encoding them with coding system CODING. If STRING is nil, START and END are character positions of the current buffer, else they - are indexes to the string STRING. */ + are indexes to the string STRING. Return true if successful. */ -static int +static bool e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end, struct coding_system *coding) { @@ -5056,12 +5043,12 @@ coding->produced); if (coding->produced) - return -1; + return 0; } start += coding->consumed_char; } - return 0; + return 1; } DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, @@ -5300,12 +5287,12 @@ { struct buffer *old = current_buffer, *b; Lisp_Object tail, buf, hook; - int auto_saved = 0; + bool auto_saved = 0; int do_handled_files; Lisp_Object oquit; FILE *stream = NULL; ptrdiff_t count = SPECPDL_INDEX (); - int orig_minibuffer_auto_raise = minibuffer_auto_raise; + bool orig_minibuffer_auto_raise = minibuffer_auto_raise; bool old_message_p = 0; struct gcpro gcpro1, gcpro2; @@ -5452,7 +5439,7 @@ if (!auto_saved && NILP (no_message)) message1 ("Auto-saving..."); internal_condition_case (auto_save_1, Qt, auto_save_error); - auto_saved++; + auto_saved = 1; BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b); XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); set_buffer_internal (old); === modified file 'src/filelock.c' --- src/filelock.c 2012-08-03 23:36:11 +0000 +++ src/filelock.c 2012-09-05 07:18:46 +0000 @@ -100,10 +100,10 @@ /* Return the time of the last system boot. */ static time_t boot_time; -static int boot_time_initialized; +static bool boot_time_initialized; #ifdef BOOT_TIME -static void get_boot_time_1 (const char *, int); +static void get_boot_time_1 (const char *, bool); #endif static time_t @@ -170,7 +170,7 @@ { char cmd_string[sizeof WTMP_FILE ".19.gz"]; Lisp_Object tempname, filename; - int delete_flag = 0; + bool delete_flag = 0; filename = Qnil; @@ -225,13 +225,13 @@ If FILENAME is zero, use the same file as before; if no FILENAME has ever been specified, this is the utmp file. - Use the newest reboot record if NEWEST is nonzero, + Use the newest reboot record if NEWEST, the first reboot record otherwise. Ignore all reboot records on or before BOOT_TIME. Success is indicated by setting BOOT_TIME to a larger value. */ void -get_boot_time_1 (const char *filename, int newest) +get_boot_time_1 (const char *filename, bool newest) { struct utmp ut, *utp; int desc; @@ -331,11 +331,11 @@ } /* Lock the lock file named LFNAME. - If FORCE is nonzero, we do so even if it is already locked. - Return 1 if successful, 0 if not. */ + If FORCE, do so even if it is already locked. + Return true if successful. */ -static int -lock_file_1 (char *lfname, int force) +static bool +lock_file_1 (char *lfname, bool force) { int err; int symlink_errno; @@ -370,9 +370,9 @@ return err == 0; } -/* Return 1 if times A and B are no more than one second apart. */ +/* Return true if times A and B are no more than one second apart. */ -static int +static bool within_one_second (time_t a, time_t b) { return (a - b >= -1 && a - b <= 1); @@ -491,7 +491,7 @@ static int lock_if_free (lock_info_type *clasher, register char *lfname) { - while (lock_file_1 (lfname, 0) == 0) + while (! lock_file_1 (lfname, 0)) { int locker; === modified file 'src/floatfns.c' --- src/floatfns.c 2012-07-17 02:56:00 +0000 +++ src/floatfns.c 2012-09-05 07:18:46 +0000 @@ -103,10 +103,10 @@ static void float_error (); #endif -/* Nonzero while executing in floating point. +/* True while executing in floating point. This tells float_error what to do. */ -static int in_float; +static bool in_float; /* If an argument is out of range for a mathematical function, here is the actual argument value to use in the error message. === modified file 'src/fns.c' --- src/fns.c 2012-09-04 17:34:54 +0000 +++ src/fns.c 2012-09-05 07:18:46 +0000 @@ -51,7 +51,7 @@ static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512; -static int internal_equal (Lisp_Object , Lisp_Object, int, int); +static bool internal_equal (Lisp_Object, Lisp_Object, int, bool); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, doc: /* Return the argument unchanged. */) @@ -352,7 +352,7 @@ } static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args, - enum Lisp_Type target_type, int last_special); + enum Lisp_Type target_type, bool last_special); /* ARGSUSED */ Lisp_Object @@ -450,19 +450,19 @@ static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args, - enum Lisp_Type target_type, int last_special) + enum Lisp_Type target_type, bool last_special) { Lisp_Object val; - register Lisp_Object tail; - register Lisp_Object this; + Lisp_Object tail; + Lisp_Object this; ptrdiff_t toindex; ptrdiff_t toindex_byte = 0; - register EMACS_INT result_len; - register EMACS_INT result_len_byte; + EMACS_INT result_len; + EMACS_INT result_len_byte; ptrdiff_t argnum; Lisp_Object last_tail; Lisp_Object prev; - int some_multibyte; + bool some_multibyte; /* When we make a multibyte string, we can't copy text properties while concatenating each string because the length of resulting string can't be decided until we finish the whole concatenation. @@ -1988,10 +1988,10 @@ /* DEPTH is current depth of recursion. Signal an error if it gets too deep. - PROPS, if non-nil, means compare string text properties too. */ + PROPS means compare string text properties too. */ -static int -internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int props) +static bool +internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props) { if (depth > 200) error ("Stack overflow in equal"); @@ -2589,9 +2589,9 @@ The normal messages at start and end of loading FILENAME are suppressed. */) (Lisp_Object feature, Lisp_Object filename, Lisp_Object noerror) { - register Lisp_Object tem; + Lisp_Object tem; struct gcpro gcpro1, gcpro2; - int from_file = load_in_progress; + bool from_file = load_in_progress; CHECK_SYMBOL (feature); @@ -2917,8 +2917,8 @@ base64 characters. */ -static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, int, int); -static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, int, +static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool); +static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool, ptrdiff_t *); DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region, @@ -3026,7 +3026,7 @@ static ptrdiff_t base64_encode_1 (const char *from, char *to, ptrdiff_t length, - int line_break, int multibyte) + bool line_break, bool multibyte) { int counter = 0; ptrdiff_t i = 0; @@ -3133,7 +3133,7 @@ ptrdiff_t old_pos = PT; ptrdiff_t decoded_length; ptrdiff_t inserted_chars; - int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); + bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); USE_SAFE_ALLOCA; validate_region (&beg, &end); @@ -3218,13 +3218,13 @@ } /* Base64-decode the data at FROM of LENGTH bytes into TO. If - MULTIBYTE is nonzero, the decoded result should be in multibyte + MULTIBYTE, the decoded result should be in multibyte form. If NCHARS_RETURN is not NULL, store the number of produced characters in *NCHARS_RETURN. */ static ptrdiff_t base64_decode_1 (const char *from, char *to, ptrdiff_t length, - int multibyte, ptrdiff_t *nchars_return) + bool multibyte, ptrdiff_t *nchars_return) { ptrdiff_t i = 0; /* Used inside READ_QUADRUPLET_BYTE */ char *e = to; @@ -3340,7 +3340,7 @@ static struct Lisp_Hash_Table *check_hash_table (Lisp_Object); static ptrdiff_t get_key_arg (Lisp_Object, ptrdiff_t, Lisp_Object *, char *); static void maybe_resize_hash_table (struct Lisp_Hash_Table *); -static int sweep_weak_table (struct Lisp_Hash_Table *, int); +static bool sweep_weak_table (struct Lisp_Hash_Table *, bool); @@ -3432,10 +3432,10 @@ ***********************************************************************/ /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code - HASH2 in hash table H using `eql'. Value is non-zero if KEY1 and + HASH2 in hash table H using `eql'. Value is true if KEY1 and KEY2 are the same. */ -static int +static bool cmpfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key1, EMACS_UINT hash1, Lisp_Object key2, EMACS_UINT hash2) @@ -3447,10 +3447,10 @@ /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code - HASH2 in hash table H using `equal'. Value is non-zero if KEY1 and + HASH2 in hash table H using `equal'. Value is true if KEY1 and KEY2 are the same. */ -static int +static bool cmpfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key1, EMACS_UINT hash1, Lisp_Object key2, EMACS_UINT hash2) @@ -3460,10 +3460,10 @@ /* Compare KEY1 which has hash code HASH1, and KEY2 with hash code - HASH2 in hash table H using H->user_cmp_function. Value is non-zero + HASH2 in hash table H using H->user_cmp_function. Value is true if KEY1 and KEY2 are the same. */ -static int +static bool cmpfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key1, EMACS_UINT hash1, Lisp_Object key2, EMACS_UINT hash2) @@ -3923,16 +3923,16 @@ Weak Hash Tables ************************************************************************/ -/* Sweep weak hash table H. REMOVE_ENTRIES_P non-zero means remove +/* Sweep weak hash table H. REMOVE_ENTRIES_P means remove entries from the table that don't survive the current GC. - REMOVE_ENTRIES_P zero means mark entries that are in use. Value is - non-zero if anything was marked. */ + !REMOVE_ENTRIES_P means mark entries that are in use. Value is + true if anything was marked. */ -static int -sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p) +static bool +sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) { ptrdiff_t bucket, n; - int marked; + bool marked; n = ASIZE (h->index) & ~ARRAY_MARK_FLAG; marked = 0; @@ -3949,7 +3949,7 @@ ptrdiff_t i = XFASTINT (idx); bool key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i)); bool value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i)); - int remove_p; + bool remove_p; if (EQ (h->weak, Qkey)) remove_p = !key_known_to_survive_p; @@ -4022,7 +4022,7 @@ sweep_weak_hash_tables (void) { struct Lisp_Hash_Table *h, *used, *next; - int marked; + bool marked; /* Mark all keys and values that are in use. Keep on marking until there is no more change. This is necessary for cases like @@ -4674,7 +4674,7 @@ coding_system = Vcoding_system_for_write; else { - int force_raw_text = 0; + bool force_raw_text = 0; coding_system = BVAR (XBUFFER (object), buffer_file_coding_system); if (NILP (coding_system) === modified file 'src/lisp.h' --- src/lisp.h 2012-09-04 21:21:00 +0000 +++ src/lisp.h 2012-09-05 07:18:46 +0000 @@ -1205,9 +1205,9 @@ struct Lisp_Hash_Table *next_weak; /* C function to compare two keys. */ - int (*cmpfn) (struct Lisp_Hash_Table *, - Lisp_Object, EMACS_UINT, - Lisp_Object, EMACS_UINT); + bool (*cmpfn) (struct Lisp_Hash_Table *, + Lisp_Object, EMACS_UINT, + Lisp_Object, EMACS_UINT); /* C function to compute hash code. */ EMACS_UINT (*hashfn) (struct Lisp_Hash_Table *, Lisp_Object); @@ -3151,9 +3151,9 @@ extern Lisp_Object close_file_unwind (Lisp_Object); extern Lisp_Object restore_point_unwind (Lisp_Object); extern _Noreturn void report_file_error (const char *, Lisp_Object); -extern int internal_delete_file (Lisp_Object); +extern void internal_delete_file (Lisp_Object); extern void syms_of_fileio (void); -extern Lisp_Object make_temp_name (Lisp_Object, int); +extern Lisp_Object make_temp_name (Lisp_Object, bool); extern Lisp_Object Qdelete_file; /* Defined in search.c */ === modified file 'src/window.c' --- src/window.c 2012-09-04 17:34:54 +0000 +++ src/window.c 2012-09-05 07:18:46 +0000 @@ -6576,15 +6576,17 @@ /* Return 1 if window configurations CONFIGURATION1 and CONFIGURATION2 describe the same state of affairs. This is used by Fequal. - ignore_positions non-zero means ignore non-matching scroll positions + IGNORE_POSITIONS means ignore non-matching scroll positions and the like. This ignores a couple of things like the dedication status of window, combination_limit and the like. This might have to be fixed. */ -int -compare_window_configurations (Lisp_Object configuration1, Lisp_Object configuration2, int ignore_positions) +bool +compare_window_configurations (Lisp_Object configuration1, + Lisp_Object configuration2, + bool ignore_positions) { register struct save_window_data *d1, *d2; struct Lisp_Vector *sws1, *sws2; === modified file 'src/window.h' --- src/window.h 2012-08-26 10:04:27 +0000 +++ src/window.h 2012-09-05 07:18:46 +0000 @@ -973,7 +973,7 @@ extern Lisp_Object Vwindow_list; extern struct window *decode_live_window (Lisp_Object); -extern int compare_window_configurations (Lisp_Object, Lisp_Object, int); +extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool); extern void mark_window_cursors_off (struct window *); extern int window_internal_height (struct window *); extern int window_body_cols (struct window *w); ------------------------------------------------------------ revno: 109885 [merge] committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-09-05 00:05:56 -0700 message: Merge from emacs-24; up to r108129 diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-09-04 17:40:25 +0000 +++ lisp/ChangeLog 2012-09-05 07:05:56 +0000 @@ -1,3 +1,25 @@ +2012-09-05 Glenn Morris + + * emulation/cua-rect.el (cua--init-rectangles): + * textmodes/picture.el (picture-mode-map): + * play/blackbox.el (blackbox-mode-map): Remap right-char and left-char + like forward-char and backward-char. (Bug#12317) + +2012-09-05 Leo Liu + + * progmodes/flymake.el (flymake-warning-re): New variable. + (flymake-parse-line): Use it. + +2012-09-05 Glenn Morris + + * calendar/holidays.el (holiday-christian-holidays): + Rename an entry. (Bug#12289) + +2012-09-05 Stefan Monnier + + * progmodes/sh-script.el (sh-font-lock-paren): Don't burp at BOB + (bug#12222). + 2012-09-04 Stefan Monnier * loadup.el: Load macroexp. Remove hack. === modified file 'lisp/calendar/holidays.el' --- lisp/calendar/holidays.el 2012-08-20 18:13:03 +0000 +++ lisp/calendar/holidays.el 2012-09-05 07:05:56 +0000 @@ -250,7 +250,7 @@ (if calendar-christian-all-holidays-flag (append (holiday-fixed 1 6 "Epiphany") - (holiday-julian 12 25 "Eastern Orthodox Christmas") + (holiday-julian 12 25 "Christmas (Julian calendar)") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") (holiday-advent 0 "Advent"))))) === modified file 'lisp/emulation/cua-rect.el' --- lisp/emulation/cua-rect.el 2012-07-25 05:48:19 +0000 +++ lisp/emulation/cua-rect.el 2012-09-05 07:05:56 +0000 @@ -1423,7 +1423,9 @@ (define-key cua--rectangle-keymap [remap set-mark-command] 'cua-toggle-rectangle-mark) (define-key cua--rectangle-keymap [remap forward-char] 'cua-resize-rectangle-right) + (define-key cua--rectangle-keymap [remap right-char] 'cua-resize-rectangle-right) (define-key cua--rectangle-keymap [remap backward-char] 'cua-resize-rectangle-left) + (define-key cua--rectangle-keymap [remap left-char] 'cua-resize-rectangle-left) (define-key cua--rectangle-keymap [remap next-line] 'cua-resize-rectangle-down) (define-key cua--rectangle-keymap [remap previous-line] 'cua-resize-rectangle-up) (define-key cua--rectangle-keymap [remap end-of-line] 'cua-resize-rectangle-eol) === modified file 'lisp/play/blackbox.el' --- lisp/play/blackbox.el 2012-09-01 01:04:26 +0000 +++ lisp/play/blackbox.el 2012-09-05 07:05:56 +0000 @@ -97,7 +97,9 @@ (let ((map (make-keymap))) (suppress-keymap map t) (blackbox-redefine-key map 'backward-char 'bb-left) + (blackbox-redefine-key map 'left-char 'bb-left) (blackbox-redefine-key map 'forward-char 'bb-right) + (blackbox-redefine-key map 'right-char 'bb-right) (blackbox-redefine-key map 'previous-line 'bb-up) (blackbox-redefine-key map 'next-line 'bb-down) (blackbox-redefine-key map 'move-end-of-line 'bb-eol) === modified file 'lisp/progmodes/flymake.el' --- lisp/progmodes/flymake.el 2012-07-14 12:02:22 +0000 +++ lisp/progmodes/flymake.el 2012-09-05 07:05:56 +0000 @@ -977,6 +977,9 @@ ;; :type '(repeat (string number number number)) ;;) +(defvar flymake-warning-re "^[wW]arning" + "Regexp matching against err-text to detect a warning.") + (defun flymake-parse-line (line) "Parse LINE to see if it is an error or warning. Return its components if so, nil otherwise." @@ -997,7 +1000,7 @@ (match-string (nth 4 (car patterns)) line) (flymake-patch-err-text (substring line (match-end 0))))) (or err-text (setq err-text "")) - (if (and err-text (string-match "^[wW]arning" err-text)) + (if (and err-text (string-match flymake-warning-re err-text)) (setq err-type "w") ) (flymake-log 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" file-idx line-idx === modified file 'lisp/progmodes/sh-script.el' --- lisp/progmodes/sh-script.el 2012-08-28 16:01:59 +0000 +++ lisp/progmodes/sh-script.el 2012-09-05 07:05:56 +0000 @@ -1062,21 +1062,22 @@ (backward-char 1)) (when (eq (char-before) ?|) (backward-char 1) t))) - (when (progn (backward-char 2) - (if (> start (line-end-position)) - (put-text-property (point) (1+ start) - 'syntax-multiline t)) - ;; FIXME: The `in' may just be a random argument to - ;; a normal command rather than the real `in' keyword. - ;; I.e. we should look back to try and find the - ;; corresponding `case'. - (and (looking-at ";[;&]\\|\\_ (point) (1+ (point-min))) + (progn (backward-char 2) + (if (> start (line-end-position)) + (put-text-property (point) (1+ start) + 'syntax-multiline t)) + ;; FIXME: The `in' may just be a random argument to + ;; a normal command rather than the real `in' keyword. + ;; I.e. we should look back to try and find the + ;; corresponding `case'. + (and (looking-at ";[;&]\\|\\_ branch nick: trunk timestamp: Tue 2012-09-04 23:56:55 -0700 message: ChangeLog fixes diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2012-09-03 22:12:02 +0000 +++ lisp/gnus/ChangeLog 2012-09-05 06:56:55 +0000 @@ -1,7 +1,5 @@ 2012-09-03 Lars Ingebrigtsen - * dgnushack.el: XEmacs 21.5 compilation fix. - * gnus-notifications.el (gnus-notifications-notify): Use it. * gnus-fun.el (gnus-funcall-no-warning): New function to silence @@ -2300,8 +2298,6 @@ 2011-06-30 Lars Magne Ingebrigtsen - * dgnushack.el: Autoload sha1 on XEmacs. - * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Take an optional quit window configuration. ------------------------------------------------------------ Use --include-merged or -n0 to see merged revisions.