diff options
44 files changed, 1279 insertions, 793 deletions
diff --git a/autogen/config.in b/autogen/config.in index 59bc8dca231..b6f1ad1ed60 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -1179,9 +1179,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ `NO'. */ #undef NARROWPROTO -/* Do not define abort in emacs.c. */ -#undef NO_ABORT - /* Define if XEditRes should not be used. */ #undef NO_EDITRES diff --git a/autogen/configure b/autogen/configure index 885b6f4b471..5fbbf1185cc 100755 --- a/autogen/configure +++ b/autogen/configure @@ -14972,12 +14972,6 @@ $as_echo "#define BROKEN_GET_CURRENT_DIR_NAME 1" >>confdefs.h $as_echo "#define BROKEN_PTY_READ_AFTER_EAGAIN 1" >>confdefs.h ;; - - darwin) - -$as_echo "#define NO_ABORT 1" >>confdefs.h - - ;; esac case $opsys in @@ -645,6 +645,11 @@ now accept a third argument to avoid choosing the selected window. *** 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 diff --git a/leim/ChangeLog b/leim/ChangeLog index 5c29052d98b..6a67c99b5c0 100644 --- a/leim/ChangeLog +++ b/leim/ChangeLog @@ -1,3 +1,7 @@ +2012-09-05 Eli Zaretskii <eliz@gnu.org> + + * quail/hebrew.el ("yiddish-royal"): Fix several bogus entries. + 2012-08-17 Daniel Bergey <bergey@alum.mit.edu> (tiny change) * quail/indian.el (quail-define-inscript-package): diff --git a/leim/quail/hebrew.el b/leim/quail/hebrew.el index aed9910000a..307f7fa0c28 100644 --- a/leim/quail/hebrew.el +++ b/leim/quail/hebrew.el @@ -773,9 +773,9 @@ Better for yiddish than Hebrew methods. ("@" ?,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) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 64dda45276c..23cb32e1464 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,34 @@ +2012-09-05 Martin Rudalics <rudalics@gmx.at> + + * 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 <rgm@gnu.org> + + * 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 <sdl.web@gmail.com> + + * progmodes/flymake.el (flymake-warning-re): New variable. + (flymake-parse-line): Use it. + +2012-09-05 Glenn Morris <rgm@gnu.org> + + * calendar/holidays.el (holiday-christian-holidays): + Rename an entry. (Bug#12289) + +2012-09-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/sh-script.el (sh-font-lock-paren): Don't burp at BOB + (bug#12222). + 2012-09-04 Stefan Monnier <monnier@iro.umontreal.ca> * loadup.el: Load macroexp. Remove hack. diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 043d402f612..9643a1e2905 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -250,7 +250,7 @@ See the documentation for `calendar-holidays' for details." (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"))))) diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 39ce5901524..f63d79adf47 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -1423,7 +1423,9 @@ With prefix arg, indent to that column." (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) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index fe025210c2a..0a7866794a8 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -3,9 +3,54 @@ * qp.el (quoted-printable-decode-region): Fix previous change; handle lowercase a..f. -2012-09-03 Lars Ingebrigtsen <larsi@gnus.org> +2012-09-05 Magnus Henoch <magnus.henoch@gmail.com> + + * nnmaildir.el (nnmaildir--article-set-flags): Fix compilation error. + +2012-09-05 Martin Stjernholm <mast@lysator.liu.se> + + * gnus-demon.el (gnus-demon-init): Fixed regression when IDLE is t and + TIME is set. + +2012-09-05 Juri Linkov <juri@jurta.org> + + * gnus-group.el (gnus-read-ephemeral-bug-group): Allow opening more + than one group at a time (bug#11961). + +2012-09-05 Julien Danjou <julien@danjou.info> + + * 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 <larsi@gnus.org> + + * 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). - * dgnushack.el: XEmacs 21.5 compilation fix. +2012-09-05 John Wiegley <johnw@newartisans.com> + + * gnus.el (gnus-expand-group-parameters): Allow regexp substitutions in + sieve rules. + +2012-09-05 Jan Tatarik <jan.tatarik@gmail.com> + + * 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 <magnus.henoch@gmail.com> + + * 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 <larsi@gnus.org> * gnus-notifications.el (gnus-notifications-notify): Use it. @@ -2305,8 +2350,6 @@ 2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org> - * dgnushack.el: Autoload sha1 on XEmacs. - * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Take an optional quit window configuration. diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index 115c5777448..671c566d09f 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -144,9 +144,12 @@ marked with SPECIAL." (* (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 diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 2f6fc0ccd19..71af5792d2c 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2481,7 +2481,8 @@ the bug number, and browsing the URL must return mbox output." "/.*$" "")))) (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)) @@ -4670,6 +4671,8 @@ you the groups that have both dormant articles and cached articles." (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 diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el index 954295438c9..a440b779930 100644 --- a/lisp/gnus/gnus-logic.el +++ b/lisp/gnus/gnus-logic.el @@ -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) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index f24d889216e..bc35cf3dea5 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -1717,105 +1717,140 @@ score in `gnus-newsgroup-scored' by SCORE." (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)) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 66509c939dc..f58cb80311a 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -490,8 +490,7 @@ The following commands are available: (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)))) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 5862e7807a2..8fbde5c8ecc 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -3824,12 +3824,28 @@ You should probably use `gnus-find-method-for-group' instead." "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 @@ The function `gnus-group-find-parameter' will do that for you." (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)))) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 18088423eb0..42911ce0648 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -3292,11 +3292,33 @@ or in the synonym headers, defined by `message-header-synonyms'." (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))))))) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 7139a528e11..327649d41a1 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -77,6 +77,56 @@ (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))) + (defvar nnmaildir-article-file-name nil "*The filename of the most recently requested article. This variable is set by nnmaildir-request-article.") @@ -152,6 +202,16 @@ by nnmaildir-request-article.") (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)) @@ -208,29 +268,33 @@ by nnmaildir-request-article.") (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 @@ by nnmaildir-request-article.") 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 @@ by nnmaildir-request-article.") (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 @@ by nnmaildir-request-article.") 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 @@ by nnmaildir-request-article.") "\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 @@ by nnmaildir-request-article.") 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 @@ by nnmaildir-request-article.") 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 @@ by nnmaildir-request-article.") 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)) diff --git a/lisp/help.el b/lisp/help.el index 9740f8996c1..cacbf185963 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -962,7 +962,11 @@ is currently activated with completion." 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 @@ buffer, and should return a positive integer. At the time the 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 @@ view." (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 diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el index db2e18188e5..16189600156 100644 --- a/lisp/play/blackbox.el +++ b/lisp/play/blackbox.el @@ -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) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index ad285274928..10d5fdf9c64 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -977,6 +977,9 @@ from compile.el") ;; :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 @@ Return its components if so, nil otherwise." (match-string (nth 4 (car patterns)) line) (flymake-patch-err-text (substring line (match-end 0))))) (or err-text (setq err-text "<no error 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 diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index a422462775d..b4d550bcee0 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1062,21 +1062,22 @@ subshells can nest." (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 ";[;&]\\|\\_<in") - ;; ";; esac )" is a case that looks like a case-pattern - ;; but it's really just a close paren after a case - ;; statement. I.e. if we skipped over `esac' just now, - ;; we're not looking at a case-pattern. - (not (looking-at "..[ \t\n]+esac[^[:word:]_]")))) - sh-st-punc)))) + (and (> (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 ";[;&]\\|\\_<in") + ;; ";; esac )" is a case that looks like a case-pattern + ;; but it's really just a close paren after a case + ;; statement. I.e. if we skipped over `esac' just now, + ;; we're not looking at a case-pattern. + (not (looking-at "..[ \t\n]+esac[^[:word:]_]")))) + sh-st-punc)))) (defun sh-font-lock-backslash-quote () (if (eq (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) ?\') diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index 24a4ac1b033..e663c1b45f4 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -612,13 +612,15 @@ Leaves the region surrounding the rectangle." (define-key map [remap self-insert-command] 'picture-self-insert) (define-key map [remap self-insert-command] 'picture-self-insert) (define-key map [remap completion-separator-self-insert-command] - 'picture-self-insert) + 'picture-self-insert) (define-key map [remap completion-separator-self-insert-autofilling] - 'picture-self-insert) + 'picture-self-insert) (define-key map [remap forward-char] 'picture-forward-column) + (define-key map [remap right-char] 'picture-forward-column) (define-key map [remap backward-char] 'picture-backward-column) + (define-key map [remap left-char] 'picture-backward-column) (define-key map [remap delete-char] 'picture-clear-column) - ;; There are two possibilities for what is normally on DEL. + ;; There are two possibilities for what is normally on DEL. (define-key map [remap backward-delete-char-untabify] 'picture-backward-clear-column) (define-key map [remap delete-backward-char] 'picture-backward-clear-column) diff --git a/lisp/window.el b/lisp/window.el index f73c85e991b..66b86f45e77 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5918,6 +5918,88 @@ WINDOW was scrolled." (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." diff --git a/src/ChangeLog b/src/ChangeLog index 7922a92d0fc..24d290e163d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,104 @@ +2012-09-05 Paul Eggert <eggert@cs.ucla.edu> + + 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 <dmantipov@yandex.ru> + + 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 <dmantipov@yandex.ru> + + 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 <dmantipov@yandex.ru> + + * 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 <eggert@cs.ucla.edu> + + * 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 <lekktu@gmail.com> * makefile.w32-in ($(BLD)/sysdep.$(O)): Update dependencies. diff --git a/src/alloc.c b/src/alloc.c index 157d3a1d799..e90cca637df 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4981,7 +4981,8 @@ valid_pointer_p (void *p) #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 @@ valid_lisp_object_p (Lisp_Object obj) 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 @@ valid_lisp_object_p (Lisp_Object obj) 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); @@ -5834,23 +5838,29 @@ mark_overlay (struct Lisp_Overlay *ptr) static void mark_buffer (struct buffer *buffer) { - /* This is handled much like other pseudovectors... */ - mark_vectorlike ((struct Lisp_Vector *) 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. */ + /* ...but there are some buffer-specific things. */ - MARK_INTERVAL_TREE (buffer_intervals (buffer)); + 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. */ + /* 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); + 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 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. */ @@ -5993,24 +6003,38 @@ mark_object (Lisp_Object arg) 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; diff --git a/src/atimer.c b/src/atimer.c index eb3136ae55d..060dead9b17 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -41,7 +41,7 @@ static struct atimer *stopped_atimers; 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 set_alarm (void); 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 @@ run_timers (void) /* 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 @@ alarm_signal_handler (int signo) #endif } +static void +deliver_alarm_signal (int sig) +{ + handle_on_main_thread (sig, handle_alarm_signal); +} + -/* Call alarm_signal_handler for pending timers. */ +/* Call alarm signal handler for pending timers. */ void do_pending_atimers (void) @@ -412,7 +412,7 @@ turn_on_atimers (bool on) { if (on) { - signal (SIGALRM, alarm_signal_handler); + signal (SIGALRM, deliver_alarm_signal); set_alarm (); } else @@ -426,5 +426,5 @@ init_atimer (void) 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); } diff --git a/src/conf_post.h b/src/conf_post.h index ead7298e98d..cef55863752 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -167,7 +167,7 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ #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))) diff --git a/src/data.c b/src/data.c index 415a8962350..6151d815b29 100644 --- a/src/data.c +++ b/src/data.c @@ -3207,18 +3207,19 @@ syms_of_data (void) 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 @@ init_data (void) if (!initialized) return; #endif /* CANNOT_DUMP */ - signal (SIGFPE, arith_error); + signal (SIGFPE, deliver_arith_signal); } diff --git a/src/dispnew.c b/src/dispnew.c index 17e6c85ac75..e02b33000d8 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5552,17 +5552,15 @@ marginal_area_string (struct window *w, enum window_part part, #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 @@ window_change_signal (int signalnum) /* If we don't have an argument, */ 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 @@ window_change_signal (int signalnum) /* If we don't have an argument, */ 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 @@ init_display (void) #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. */ diff --git a/src/editfns.c b/src/editfns.c index 2d1a3cbfa0c..65baaf4e3f8 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2783,8 +2783,8 @@ determines whether case is significant or ignored. */) 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); diff --git a/src/emacs.c b/src/emacs.c index 18f249dc899..fc92b30af26 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -275,14 +275,6 @@ static int fatal_error_code; /* 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 @@ static void *ns_pool; /* 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 @@ fatal_error_backtrace (int sig, int backtrace_limit) #ifdef SIGDANGER /* Handler for SIGDANGER. */ -void -memory_warning_signal (int sig) -{ - signal (sig, memory_warning_signal); - SIGNAL_THREAD_CHECK (sig); +static void deliver_danger_signal (int); +static void +handle_danger_signal (int 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 @@ main (int argc, char **argv) # 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 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem 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 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem /* 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 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem 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 */ } diff --git a/src/fileio.c b/src/fileio.c index d193d2ed19f..f0b3f0cc2fd 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -85,18 +85,18 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #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 @@ Lisp_Object Qfile_name_history; 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 @@ static unsigned make_temp_name_count, make_temp_name_count_initialized_p; 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 @@ static unsigned make_temp_name_count, make_temp_name_count_initialized_p; 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 @@ filesystem tree, not (expand-file-name ".." dirname). */) 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 @@ filesystem tree, not (expand-file-name ".." dirname). */) /* 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 @@ See also the function `substitute-in-file-name'.") ptrdiff_t tlen; unsigned char *target; struct passwd *pw; - int lose; CHECK_STRING (name); nm = SDATA (name); @@ -1369,8 +1367,8 @@ See also the function `substitute-in-file-name'.") 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 @@ See also the function `substitute-in-file-name'.") #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 @@ If `//' appears, everything up to and including the first of 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 @@ expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir) } /* 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 @@ expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir) 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 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */) 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 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */) 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 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */) 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 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */) 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 @@ internal_delete_file_1 (Lisp_Object ignore) 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 @@ On Unix, this is a name starting with a `/' or a `~'. */) 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 @@ check_executable (char *filename) #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 @@ check_writable (const char *filename) 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 @@ searchable directory. */) (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 @@ compiled with SELinux support. */) 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 @@ compiled with SELinux support. */) } /* 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 @@ DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0, The value is an integer. */) (void) { - int realmask; + mode_t realmask; Lisp_Object value; BLOCK_INPUT; @@ -3246,29 +3242,29 @@ variable `last-coding-system-used' to the coding system actually used. */) 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 @@ variable `last-coding-system-used' to the coding system actually used. */) 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 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file 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 @@ This calls `write-region-annotate-functions' at the start, and `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 @@ This calls `write-region-annotate-functions' at the start, and 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 @@ This calls `write-region-annotate-functions' at the start, and 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 @@ This calls `write-region-annotate-functions' at the start, and 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 @@ This calls `write-region-annotate-functions' at the start, and 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 @@ build_annotations (Lisp_Object start, Lisp_Object end) 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 @@ build_annotations (Lisp_Object start, Lisp_Object end) 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 @@ a_write (int desc, Lisp_Object string, ptrdiff_t pos, /* 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 @@ e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end, 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 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) { 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 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) 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); diff --git a/src/filelock.c b/src/filelock.c index d21d8e7ba02..1f599c68912 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -100,10 +100,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* 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 @@ get_boot_time (void) { 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 @@ get_boot_time (void) 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 @@ fill_in_lock_file_name (register char *lockfile, register Lisp_Object fn) } /* 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 @@ lock_file_1 (char *lfname, int force) 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 @@ current_lock_owner (lock_info_type *owner, char *lfname) 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; diff --git a/src/floatfns.c b/src/floatfns.c index cad071f1e15..f59cf58228a 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -37,9 +37,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ 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,14 +96,10 @@ extern double logb (double); # include <errno.h> #endif -#ifdef FLOAT_CATCH_SIGILL -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. @@ -947,31 +940,6 @@ Rounds the value toward zero. */) 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 @@ matherr (struct exception *x) void init_floatfns (void) { -#ifdef FLOAT_CATCH_SIGILL - signal (SIGILL, float_error); -#endif in_float = 0; } diff --git a/src/fns.c b/src/fns.c index fc0044106cd..20770af67d4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -51,7 +51,7 @@ static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; 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 @@ Symbols are also allowed; their print names are used instead. */) } 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 @@ struct textprop_rec 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 @@ of strings. (`equal' ignores text properties.) */) /* 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 @@ Normally the return value is FEATURE. 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 @@ static const short base64_char_to_value[128] = 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 @@ into shorter lines. */) 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 @@ If the region can't be decoded, signal an error and don't modify the buffer. */ 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 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string, } /* 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 Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; 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 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) ***********************************************************************/ /* 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 @@ cmpfn_eql (struct Lisp_Hash_Table *h, /* 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 @@ cmpfn_equal (struct Lisp_Hash_Table *h, /* 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 @@ hash_clear (struct Lisp_Hash_Table *h) 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 @@ sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p) 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 @@ void 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 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_ 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) diff --git a/src/frame.h b/src/frame.h index 94498e9efcf..661ea2ea67c 100644 --- a/src/frame.h +++ b/src/frame.h @@ -81,9 +81,6 @@ enum fullscreen_type #define FRAME_FOREGROUND_PIXEL(f) ((f)->foreground_pixel) #define FRAME_BACKGROUND_PIXEL(f) ((f)->background_pixel) -struct terminal; - -struct font_driver_list; struct frame { diff --git a/src/keyboard.c b/src/keyboard.c index fe5372e008c..128f9280911 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -449,9 +449,8 @@ static void restore_getcjmp (jmp_buf); 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 process_special_events (void); 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 @@ kbd_buffer_get_event (KBOARD **kbp, 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 @@ process_pending_signals (void) /* 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 @@ input_available_signal (int signo) #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 @@ add_user_signal (int sig, const char *name) 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 @@ handle_user_signal (int sig) } 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 @@ clear_waiting_for_input (void) 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,10 +10800,15 @@ interrupt_signal (int signalnum) /* If we don't have an argument, some */ 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 enough times, then quit anyway. See bug#6585. */ @@ -11404,17 +11402,17 @@ init_keyboard (void) 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 diff --git a/src/lisp.h b/src/lisp.h index 78c418f3051..28e8c1cd1e8 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -909,14 +909,6 @@ enum (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) \ @@ -1205,9 +1197,9 @@ struct Lisp_Hash_Table 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 +3143,9 @@ EXFUN (Fread_file_name, 6); /* not a normal DEFUN */ 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 */ @@ -3264,9 +3256,6 @@ extern bool display_arg; 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 @@ -3556,32 +3545,6 @@ extern void init_system_name (void); #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. */ diff --git a/src/process.c b/src/process.c index 5677da36881..3a6615fb505 100644 --- a/src/process.c +++ b/src/process.c @@ -124,6 +124,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #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 <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>. These lines can be removed once the GCC bug is fixed. */ @@ -801,7 +809,7 @@ get_process (register Lisp_Object name) #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 @@ nil, indicating the current buffer's process. */) #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 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) 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 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, 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 @@ read_process_output (Lisp_Object proc, register int channel) 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_process (volatile Lisp_Object proc, const char *volatile buf, /* 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 @@ process has been transmitted to the serial port. */) 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; + pid_t pid; + int w; + Lisp_Object tail; - 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. */ + do + pid = waitpid (-1, &w, WNOHANG | WUNTRACED); + while (pid < 0 && errno == EINTR); - errno = old_errno; - return; - } -#else - pid = wait (&w); -#endif /* no WNOHANG */ + /* 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. */ + /* 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)) + /* 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))) { - 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; - } + XSETCAR (tail, Qnil); + return true; } + } - /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */ + /* 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; + /* 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; + } - /* If process has terminated, stop waiting for its output. */ - if ((WIFSIGNALED (w) || WIFEXITED (w)) - && p->infd >= 0) - clear_desc_flag = 1; + /* Change the status of the process that was found. */ + if (p) + { + int clear_desc_flag = 0; - /* 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); - } + p->tick = ++process_tick; + p->raw_status = w; + p->raw_status_new = 1; - /* 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); - } + /* If process has terminated, stop waiting for its output. */ + if ((WIFSIGNALED (w) || WIFEXITED (w)) + && p->infd >= 0) + clear_desc_flag = 1; - /* There was no asynchronous process found for that pid: we have - a synchronous process. */ - else + /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */ + if (clear_desc_flag) { - 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); + FD_CLR (p->infd, &input_wait_mask); + FD_CLR (p->infd, &non_keyboard_wait_mask); } - sigchld_end_of_loop: - ; + /* 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, 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. */ +/* 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 @@ init_process_emacs (void) #ifndef CANNOT_DUMP if (! noninteractive || initialized) #endif - signal (SIGCHLD, sigchld_handler); + signal (SIGCHLD, deliver_child_signal); #endif FD_ZERO (&input_wait_mask); diff --git a/src/sysdep.c b/src/sysdep.c index 1f4de194c64..42b8baf78e0 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1551,6 +1551,40 @@ sys_sigsetmask (sigset_t new_mask) 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 @@ init_signals (void) { sigemptyset (&empty_mask); +#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD + main_thread = pthread_self (); +#endif + #if !defined HAVE_STRSIGNAL && !HAVE_DECL_SYS_SIGLIST if (! initialized) { diff --git a/src/syssignal.h b/src/syssignal.h index 71151ed4c6a..504aff43083 100644 --- a/src/syssignal.h +++ b/src/syssignal.h @@ -133,24 +133,5 @@ char *strsignal (int); #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 diff --git a/src/window.c b/src/window.c index 08608e0d451..1869a3b65cf 100644 --- a/src/window.c +++ b/src/window.c @@ -6576,15 +6576,17 @@ freeze_window_starts (struct frame *f, int freeze_p) /* 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; diff --git a/src/window.h b/src/window.h index dfb88b2cf3c..a70bc55bac5 100644 --- a/src/window.h +++ b/src/window.h @@ -27,8 +27,6 @@ INLINE_HEADER_BEGIN # 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. @@ -973,7 +971,7 @@ extern Lisp_Object Qwindowp, Qwindow_live_p; 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); diff --git a/src/xdisp.c b/src/xdisp.c index 90a8de0be27..bec9ec91d2f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10601,12 +10601,12 @@ set_message (const char *s, Lisp_Object string, message_buf_print = 0; help_echo_showing_p = 0; - if (NILP (Vinhibit_debug_on_message) && - STRINGP (Vdebug_on_message) && - fast_string_match (Vdebug_on_message, string) >= 0) { - specbind (Qinhibit_debug_on_message, Qt); - call_debugger (Fcons (Qerror, Fcons (string, Qnil))); - } + if (NILP (Vinhibit_debug_on_message) && STRINGP (Vdebug_on_message) + && fast_string_match (Vdebug_on_message, string) >= 0) + { + specbind (Qinhibit_debug_on_message, Qt); + call_debugger (list2 (Qerror, string)); + } unbind_to (count, Qnil); } |