commit 7f11dea66298c2c9aeccab2b542ee8e73346f09f (HEAD, refs/remotes/origin/master) Author: Deneb Meketa Date: Thu May 27 01:21:59 2021 +0200 Fix filling of overlong first lines in Python doc strings * lisp/progmodes/python.el (python-fill-string): Fill overlong first lines correctly (bug#20860). Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 20ec339fff..f7267bdef2 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4239,6 +4239,11 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." (point))))) (num-quotes (python-syntax-count-quotes (char-after str-start-pos) str-start-pos)) + (str-line-start-pos + (save-excursion + (goto-char str-start-pos) + (beginning-of-line) + (point-marker))) (str-end-pos (save-excursion (goto-char (+ str-start-pos num-quotes)) @@ -4262,7 +4267,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." ('symmetric (and multi-line-p (cons 1 1))))) (fill-paragraph-function)) (save-restriction - (narrow-to-region str-start-pos str-end-pos) + (narrow-to-region str-line-start-pos str-end-pos) (fill-paragraph justify)) (save-excursion (when (and (python-info-docstring-p) python-fill-docstring-style) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 3e653cb568..1af579bb7a 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -5432,6 +5432,30 @@ buffer with overlapping strings." (run-python nil nil 'show) (should (eq buffer (current-buffer))))) +(ert-deftest python-tests--fill-long-first-line () + (should + (equal + (with-temp-buffer + (insert "def asdf(): + \"\"\"123 123 123 123 123 123 123 123 123 123 123 123 123 SHOULDBEWRAPPED 123 123 123 123 + + \"\"\" + a = 1 +") + (python-mode) + (goto-char (point-min)) + (forward-line 1) + (end-of-line) + (fill-paragraph) + (buffer-substring-no-properties (point-min) (point-max))) + "def asdf(): + \"\"\"123 123 123 123 123 123 123 123 123 123 123 123 123 + SHOULDBEWRAPPED 123 123 123 123 + + \"\"\" + a = 1 +"))) + (provide 'python-tests) ;; Local Variables: commit 0dfe193ec42160bfaa30933c5ebfa7ae91cde88b Author: Lars Ingebrigtsen Date: Thu May 27 01:05:35 2021 +0200 Improve the prompting in read-directory-name * lisp/dired-x.el (dired-virtual): Improve doc string and use `read-directory-name' (bug#20993). diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 5f31bc402f..56f7f4724a 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -576,7 +576,7 @@ files in the active region if `dired-mark-region' is non-nil." (defalias 'virtual-dired 'dired-virtual) (defun dired-virtual (dirname &optional switches) - "Put this buffer into Virtual Dired mode. + "Put this Dired buffer into Virtual Dired mode. In Virtual Dired mode, all commands that do not actually consult the filesystem will work. @@ -608,7 +608,8 @@ you can relist single subdirs using \\[dired-do-redisplay]." ;; hand if you want them. (interactive - (list (read-string "Virtual Dired directory: " (dired-virtual-guess-dir)))) + (list (read-directory-name "Virtual Dired directory: " + nil (dired-virtual-guess-dir)))) (goto-char (point-min)) (or (looking-at-p " ") ;; if not already indented, do it now: commit 462112ae0b64fa3ea062c4b2635a81495ec132a6 Author: Lars Ingebrigtsen Date: Thu May 27 00:38:33 2021 +0200 Fix ediff message parsing in non-English locales * lisp/vc/ediff-diff.el (ediff-exec-process): Run diff in the C locale to enable parsing the messages (bug#21387). diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index b93dfc814c..270c99ef1f 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -1146,7 +1146,10 @@ are ignored." (if (string-match "buffer" (symbol-name ediff-job-name)) ediff-coding-system-for-write ediff-coding-system-for-read)) - args) + (process-environment + ;; Avoid localization of messages so we can parse the output. + (cons "LC_MESSAGES=C" process-environment)) + args) (setq args (append (split-string options) (mapcar (lambda (file) (when (stringp file) commit 856e0ec2f81bfe2f6721369a1df9a26f41e6d1a4 Author: Juri Linkov Date: Thu May 27 01:19:36 2021 +0300 * lisp/vc/diff-mode.el (diff-hunk-text): Test-driven fix for newlines. * lisp/vc/diff-mode.el (diff-hunk-text): Fix handling of newlines to cover all test cases according to new test. * test/lisp/vc/diff-mode-tests.el (diff-mode-test-hunk-text-no-newline): New test to cover cases with no newline at end of file. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 4118a2ea06..a0093391c6 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1767,20 +1767,26 @@ char-offset in TEXT." (delete-region (point-min) keep)) ;; Remove line-prefix characters, and unneeded lines (unified diffs). ;; Also skip lines like "\ No newline at end of file" - (let ((kill-chars (list (if destp ?- ?+) ?\\))) + (let ((kill-chars (list (if destp ?- ?+) ?\\)) + curr-char last-char) (goto-char (point-min)) (while (not (eobp)) - (if (memq (char-after) kill-chars) + (setq curr-char (char-after)) + (if (memq curr-char kill-chars) (delete-region ;; Check for "\ No newline at end of file" - (if (and (eq (char-after) ?\\) + (if (and (eq curr-char ?\\) + (not (eq last-char (if destp ?- ?+))) (save-excursion - (forward-line 1) (eobp))) - (1- (point)) + (forward-line 1) + (or (eobp) (and (eq last-char ?-) + (eq (char-after) ?+))))) + (max (1- (point)) (point-min)) (point)) (progn (forward-line 1) (point))) (delete-char num-pfx-chars) - (forward-line 1))))) + (forward-line 1)) + (setq last-char curr-char)))) (let ((text (buffer-substring-no-properties (point-min) (point-max)))) (if char-offset (cons text (- (point) (point-min))) text)))))) diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el index f4e5c89afb..5bc4ad6dac 100644 --- a/test/lisp/vc/diff-mode-tests.el +++ b/test/lisp/vc/diff-mode-tests.el @@ -203,6 +203,148 @@ youthfulness (kill-buffer buf2) (delete-directory temp-dir 'recursive)))))) +(ert-deftest diff-mode-test-hunk-text-no-newline () + "Check output of `diff-hunk-text' with no newline at end of file." + + ;; First check unified change/remove/add cases with newline + (let ((hunk "\ +@@ -1 +1 @@ +-foo ++bar +")) + (should (equal (diff-hunk-text hunk nil nil) "\ +foo +")) + (should (equal (diff-hunk-text hunk t nil) "\ +bar +"))) + + (let ((hunk "\ +@@ -1 +0,0 @@ +-foo +")) + (should (equal (diff-hunk-text hunk nil nil) "\ +foo +")) + (should (equal (diff-hunk-text hunk t nil) "\ +"))) + + (let ((hunk "\ +@@ -0,0 +1 @@ ++bar +")) + (should (equal (diff-hunk-text hunk nil nil) "\ +")) + (should (equal (diff-hunk-text hunk t nil) "\ +bar +"))) + + ;; Check unified change/remove cases with no newline in old file + (let ((hunk "\ +@@ -1 +1 @@ +-foo +\\ No newline at end of file ++bar +")) + (should (equal (diff-hunk-text hunk nil nil) "\ +foo")) + (should (equal (diff-hunk-text hunk t nil) "\ +bar +"))) + + (let ((hunk "\ +@@ -1 +0,0 @@ +-foo +\\ No newline at end of file +")) + (should (equal (diff-hunk-text hunk nil nil) "\ +foo")) + (should (equal (diff-hunk-text hunk t nil) "\ +"))) + + ;; Check unified change/add cases with no newline in new file + (let ((hunk "\ +@@ -1 +1 @@ +-foo ++bar +\\ No newline at end of file +")) + (should (equal (diff-hunk-text hunk nil nil) "\ +foo +")) + (should (equal (diff-hunk-text hunk t nil) "\ +bar"))) + + (let ((hunk "\ +@@ -0,0 +1 @@ ++bar +\\ No newline at end of file +")) + (should (equal (diff-hunk-text hunk nil nil) "\ +")) + (should (equal (diff-hunk-text hunk t nil) "\ +bar"))) + + ;; Check unified change case with no newline in both old/new file + (let ((hunk "\ +@@ -1 +1 @@ +-foo +\\ No newline at end of file ++bar +\\ No newline at end of file +")) + (should (equal (diff-hunk-text hunk nil nil) "\ +foo")) + (should (equal (diff-hunk-text hunk t nil) "\ +bar"))) + + ;; Check context-after unified change case with no newline in both old/new file + (let ((hunk "\ +@@ -1,2 +1,2 @@ +-foo ++bar + baz +\\ No newline at end of file +")) + (should (equal (diff-hunk-text hunk nil nil) "\ +foo +baz")) + (should (equal (diff-hunk-text hunk t nil) "\ +bar +baz"))) + + (let ((hunk "\ +@@ -1,2 +1,2 @@ +-foo +-baz +\\ No newline at end of file ++bar ++baz +")) + (should (equal (diff-hunk-text hunk nil nil) "\ +foo +baz")) + (should (equal (diff-hunk-text hunk t nil) "\ +bar +baz +"))) + + (let ((hunk "\ +@@ -1,2 +1,2 @@ +-foo +-baz ++bar ++baz +\\ No newline at end of file +")) + (should (equal (diff-hunk-text hunk nil nil) "\ +foo +baz +")) + (should (equal (diff-hunk-text hunk t nil) "\ +bar +baz")))) + (ert-deftest diff-mode-test-font-lock () "Check font-locking of diff hunks." ;; See comments in diff-hunk-file-names about nonascii. commit 777d784d8fba1191d0f9ca22a336829e3e232668 Author: Alex Bochannek Date: Wed May 26 23:54:59 2021 +0200 Remove the base64 Face header repadding in Gnus * lisp/gnus/gnus-fun.el (gnus-convert-face-to-png): Remove call. * lisp/gnus/gnus-util.el (gnus-base64-repad): Remove. diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index c2e72aba93..8bca4ffe38 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -206,12 +206,11 @@ different input formats." (defun gnus-convert-face-to-png (face) "Convert FACE (which is base64-encoded) to a PNG. The PNG is returned as a string." - (let ((face (gnus-base64-repad face nil nil t))) - (mm-with-unibyte-buffer - (insert face) - (ignore-errors - (base64-decode-region (point-min) (point-max))) - (buffer-string)))) + (mm-with-unibyte-buffer + (insert face) + (ignore-errors + (base64-decode-region (point-min) (point-max))) + (buffer-string))) ;;;###autoload (defun gnus-convert-png-to-face (file) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index e558f639e4..be0284515d 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1291,61 +1291,6 @@ forbidden in URL encoding." (setq tmp (concat tmp str)) tmp)) -(defun gnus-base64-repad (str &optional reject-newlines line-length no-check) - "Take a base 64-encoded string and return it padded correctly. -Existing padding is ignored. - -If any combination of CR and LF characters are present and -REJECT-NEWLINES is nil, remove them; otherwise raise an error. -If LINE-LENGTH is set and the string (or any line in the string -if REJECT-NEWLINES is nil) is longer than that number, raise an -error. Common line length for input characters are 76 plus CRLF -\(RFC 2045 MIME), 64 plus CRLF (RFC 1421 PEM), and 1000 including -CRLF (RFC 5321 SMTP). - -If NOCHECK, don't check anything, but just repad." - ;; RFC 4648 specifies that: - ;; - three 8-bit inputs make up a 24-bit group - ;; - the 24-bit group is broken up into four 6-bit values - ;; - each 6-bit value is mapped to one character of the base 64 alphabet - ;; - if the final 24-bit quantum is filled with only 8 bits the output - ;; will be two base 64 characters followed by two "=" padding characters - ;; - if the final 24-bit quantum is filled with only 16 bits the output - ;; will be three base 64 character followed by one "=" padding character - ;; - ;; RFC 4648 section 3 considerations: - ;; - if reject-newlines is nil (default), concatenate multi-line - ;; input (3.1, 3.3) - ;; - if line-length is set, error on input exceeding the limit (3.1) - ;; - reject characters outside base encoding (3.3, also section 12) - ;; - ;; RFC 5322 section 2.2.3 consideration: - ;; Because base 64-encoded strings can appear in long header fields, remove - ;; folding whitespace while still observing the RFC 4648 decisions above. - (when no-check - (setq str (replace-regexp-in-string "[\n\r \t]+" "" str))); - (let ((splitstr (split-string str "[ \t]*[\r\n]+[ \t]?" t))) - (when (and reject-newlines (> (length splitstr) 1)) - (error "Invalid Base64 string")) - (dolist (substr splitstr) - (when (and line-length (> (length substr) line-length)) - (error "Base64 string exceeds line-length")) - (when (string-match "[^A-Za-z0-9+/=]" substr) - (error "Invalid Base64 string"))) - (let* ((str (string-join splitstr)) - (len (length str))) - (when (string-match "=" str) - (setq len (match-beginning 0))) - (concat - (substring str 0 len) - (make-string (/ - (- 24 - (pcase (mod (* len 6) 24) - (`0 24) - (n n))) - 6) - ?=))))) - (defun gnus-make-predicate (spec) "Transform SPEC into a function that can be called. SPEC is a predicate specifier that contains stuff like `or', `and', diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el index 959be7987d..f8d30f6373 100644 --- a/test/lisp/gnus/gnus-util-tests.el +++ b/test/lisp/gnus/gnus-util-tests.el @@ -132,41 +132,4 @@ (should (equal '("1") (gnus-setdiff '(2 "1" 2) '(2)))) (should (equal '("1" "1") (gnus-setdiff '(2 "1" 2 "1") '(2))))) -(ert-deftest gnus-base64-repad () - (should-error (gnus-base64-repad 1) - :type 'wrong-type-argument) - - ;; RFC4648 test vectors - (should (equal "" (gnus-base64-repad ""))) - (should (equal "Zg==" (gnus-base64-repad "Zg=="))) - (should (equal "Zm8=" (gnus-base64-repad "Zm8="))) - (should (equal "Zm9v" (gnus-base64-repad "Zm9v"))) - (should (equal "Zm9vYg==" (gnus-base64-repad "Zm9vYg=="))) - (should (equal "Zm9vYmE=" (gnus-base64-repad "Zm9vYmE="))) - (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9vYmFy"))) - - (should (equal "Zm8=" (gnus-base64-repad "Zm8"))) - (should (equal "Zg==" (gnus-base64-repad "Zg"))) - (should (equal "Zg==" (gnus-base64-repad "Zg===="))) - - (should-error (gnus-base64-repad " ") - :type 'error) - (should-error (gnus-base64-repad "Zg== ") - :type 'error) - (should-error (gnus-base64-repad "Z?\x00g==") - :type 'error) - ;; line-length - (should-error (gnus-base64-repad "Zg====" nil 4) - :type 'error) - ;; reject-newlines - (should-error (gnus-base64-repad "Zm9v\r\nYmFy" t) - :type 'error) - (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9vYmFy" t))) - (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy"))) - (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy\n"))) - (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\n YmFy\r\n"))) - (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v \r\n\tYmFy"))) - (should-error (gnus-base64-repad "Zm9v\r\nYmFy" nil 3) - :type 'error)) - ;;; gnustest-gnus-util.el ends here commit c4e8d1dbe2e79824c8696b4c7adc510ac4e5515e Author: Karl Fogel Date: Wed May 26 14:28:11 2021 -0500 Improve some doc strings in bookmark.el * lisp/bookmark.el (bookmark-bmenu-load): Describe prefix argument behavior. Refer to related functions for more information. (bookmark-bmenu-save): Likewise refer to related functions. As discussed in this thread: https://lists.gnu.org/archive/html/emacs-devel/2021-05/msg00389.html From: Karl Fogel To: Eli Zaretskii Cc: Matthias Meulien, Drew Adams, Lars Ingebrigtsen, Stefan Monnier, Emacs Devel Subject: Re: [External] : Re: [PATCH] When deleting in bookmark menu, prompt for confirmation. Date: Sun, 09 May 2021 13:37:52 -0500 Message-ID: <87h7jboirj.fsf@red-bean.com> diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 64b467adfa..31e41a9273 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -2054,7 +2054,10 @@ You can mark bookmarks with the \\\\[bookmark-bmenu-mar (defun bookmark-bmenu-save () "Save the current list into a bookmark file. -With a prefix arg, prompts for a file to save them in." +With a prefix arg, prompts for a file to save them in. + +See also the related behaviors of `bookmark-load' and +`bookmark-bmenu-load'." (interactive nil bookmark-bmenu-mode) (save-excursion (save-window-excursion @@ -2063,7 +2066,19 @@ With a prefix arg, prompts for a file to save them in." (defun bookmark-bmenu-load () - "Load the bookmark file and rebuild the bookmark menu-buffer." + "Load bookmarks from a file and rebuild the bookmark menu-buffer. +Prompt for a file, with the default choice being the value of +`bookmark-default-file'. + +With a prefix argument, replace the current ambient bookmarks +(i.e., the ones in `bookmark-alist') with the ones from the selected +file and make that file be the new value of `bookmark-default-file'. +In other words, a prefix argument means \"switch over to the bookmark +universe defined in the loaded file\". Without a prefix argument, +just add the loaded bookmarks into the current ambient set. + +See the documentation for `bookmark-load' for more details; see also +the related behaviors of `bookmark-save' and `bookmark-bmenu-save'." (interactive nil bookmark-bmenu-mode) (bookmark-bmenu-ensure-position) (save-excursion commit 85da7b57bc204c4cc6953156c1a9a4dc6e875541 Author: Eli Zaretskii Date: Wed May 26 20:08:47 2021 +0300 Make 'string-width' auto-composition aware * src/composite.c (find_automatic_composition): Now extern. (char_composable_p): Don't assume 'unicode-category-table' is always available. * src/composite.h (find_automatic_composition): Add prototype. * src/character.c (lisp_string_width): Support automatic compositions; call 'find_automatic_composition' when 'auto-composition-mode' is ON. diff --git a/src/character.c b/src/character.c index 41abb83a48..e0978bb39f 100644 --- a/src/character.c +++ b/src/character.c @@ -361,6 +361,23 @@ lisp_string_width (Lisp_Object string, ptrdiff_t from, ptrdiff_t to, chars = end - i; bytes = string_char_to_byte (string, end) - i_byte; } + else if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) + && ! NILP (Vauto_composition_mode) + && find_automatic_composition (i, -1, &ignore, &end, &val, string) + && end > i) + { + int j; + for (thiswidth = 0, j = 0; j < LGSTRING_GLYPH_LEN (val); j++) + { + Lisp_Object g = LGSTRING_GLYPH (val, j); + + if (NILP (g)) + break; + thiswidth += char_width (LGLYPH_CHAR (g), dp); + } + chars = end - i; + bytes = string_char_to_byte (string, end) - i_byte; + } else { int c; diff --git a/src/composite.c b/src/composite.c index f1c011223b..17d5914e63 100644 --- a/src/composite.c +++ b/src/composite.c @@ -953,8 +953,12 @@ char_composable_p (int c) Lisp_Object val; return (c >= ' ' && (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER - || (val = CHAR_TABLE_REF (Vunicode_category_table, c), - (FIXNUMP (val) && (XFIXNUM (val) <= UNICODE_CATEGORY_Zs))))); + /* unicode-category-table may not be available during + dumping. */ + || (CHAR_TABLE_P (Vunicode_category_table) + && (val = CHAR_TABLE_REF (Vunicode_category_table, c), + (FIXNUMP (val) + && (XFIXNUM (val) <= UNICODE_CATEGORY_Zs)))))); } /* Update cmp_it->stop_pos to the next position after CHARPOS (and @@ -1475,7 +1479,7 @@ struct position_record representing the composition, and return true. Otherwise, *GSTRING to Qnil, and return false. */ -static bool +bool find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, ptrdiff_t *start, ptrdiff_t *end, Lisp_Object *gstring, Lisp_Object string) diff --git a/src/composite.h b/src/composite.h index c5d3c0faab..75e5f9b9ec 100644 --- a/src/composite.h +++ b/src/composite.h @@ -320,6 +320,10 @@ extern bool composition_gstring_p (Lisp_Object); extern int composition_gstring_width (Lisp_Object, ptrdiff_t, ptrdiff_t, struct font_metrics *); +extern bool find_automatic_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t *, + ptrdiff_t *, Lisp_Object *, + Lisp_Object); + extern void composition_compute_stop_pos (struct composition_it *, ptrdiff_t, ptrdiff_t, ptrdiff_t, Lisp_Object); commit d5d4e826919d4d09a12ecb92dc8658243bdd87ad Author: Filipp Gunbin Date: Wed May 26 17:20:55 2021 +0300 * src/sysdep.c (system_process_attributes): Fix misspelled Qttname for FreeBSD diff --git a/src/sysdep.c b/src/sysdep.c index f899bb7532..51d8b5eeed 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3626,7 +3626,7 @@ system_process_attributes (Lisp_Object pid) ttyname = proc.ki_tdev == NODEV ? NULL : devname (proc.ki_tdev, S_IFCHR); unblock_input (); if (ttyname) - attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs); + attrs = Fcons (Fcons (Qttname, build_string (ttyname)), attrs); attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.ki_tpgid)), attrs); attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (proc.ki_rusage.ru_minflt)), commit 6d51805154ef7591917c5727b905b4080e18b888 Author: Filipp Gunbin Date: Thu May 20 23:32:59 2021 +0300 Improve system_process_attributes on macOS (Bug#48548) * src/sysdep.c (system_process_attributes): Fix misprint in 'tty' attr - should be 'ttname' instead. Change 'utime', 'stime', 'time', 'majflt' attrs to obtain them from proc_pid_rusage, as sysctl call used before doesn't give correct values; remove 'minflt' because it's not available. Obtain 'vsize' / 'rss' / 'thcount' from proc_pidinfo. Use sysctl with KERN_PROCARGS2 to obtain args: value contains both argc and argv, so argv can be reliably cut out. diff --git a/src/sysdep.c b/src/sysdep.c index d940acc4e0..f899bb7532 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3898,20 +3898,19 @@ system_process_attributes (Lisp_Object pid) Lisp_Object system_process_attributes (Lisp_Object pid) { - int proc_id; + int proc_id, i; struct passwd *pw; struct group *gr; char *ttyname; struct timeval starttime; struct timespec t, now; - struct rusage *rusage; dev_t tdev; uid_t uid; gid_t gid; int mib[4] = {CTL_KERN, KERN_PROC, KERN_PROC_PID}; struct kinfo_proc proc; - size_t proclen = sizeof proc; + size_t len = sizeof proc; Lisp_Object attrs = Qnil; Lisp_Object decoded_comm; @@ -3920,7 +3919,7 @@ system_process_attributes (Lisp_Object pid) CONS_TO_INTEGER (pid, int, proc_id); mib[3] = proc_id; - if (sysctl (mib, 4, &proc, &proclen, NULL, 0) != 0 || proclen == 0) + if (sysctl (mib, 4, &proc, &len, NULL, 0) != 0 || len == 0) return attrs; uid = proc.kp_eproc.e_ucred.cr_uid; @@ -3957,8 +3956,8 @@ system_process_attributes (Lisp_Object pid) decoded_comm = (code_convert_string_norecord (build_unibyte_string (comm), Vlocale_coding_system, 0)); - attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs); + { char state[2] = {'\0', '\0'}; switch (proc.kp_proc.p_stat) @@ -3994,27 +3993,24 @@ system_process_attributes (Lisp_Object pid) ttyname = tdev == NODEV ? NULL : devname (tdev, S_IFCHR); unblock_input (); if (ttyname) - attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs); + attrs = Fcons (Fcons (Qttname, build_string (ttyname)), attrs); attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.kp_eproc.e_tpgid)), attrs); - rusage = proc.kp_proc.p_ru; - if (rusage) + rusage_info_current ri; + if (proc_pid_rusage(proc_id, RUSAGE_INFO_CURRENT, (rusage_info_t *) &ri) == 0) { - attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (rusage->ru_minflt)), - attrs); - attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (rusage->ru_majflt)), - attrs); - - attrs = Fcons (Fcons (Qutime, make_lisp_timeval (rusage->ru_utime)), - attrs); - attrs = Fcons (Fcons (Qstime, make_lisp_timeval (rusage->ru_stime)), - attrs); - t = timespec_add (timeval_to_timespec (rusage->ru_utime), - timeval_to_timespec (rusage->ru_stime)); - attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs); - } + struct timespec utime = make_timespec (ri.ri_user_time / TIMESPEC_HZ, + ri.ri_user_time % TIMESPEC_HZ); + struct timespec stime = make_timespec (ri.ri_system_time / TIMESPEC_HZ, + ri.ri_system_time % TIMESPEC_HZ); + attrs = Fcons (Fcons (Qutime, make_lisp_time (utime)), attrs); + attrs = Fcons (Fcons (Qstime, make_lisp_time (stime)), attrs); + attrs = Fcons (Fcons (Qtime, make_lisp_time (timespec_add (utime, stime))), attrs); + + attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (ri.ri_pageins)), attrs); + } starttime = proc.kp_proc.p_starttime; attrs = Fcons (Fcons (Qnice, make_fixnum (proc.kp_proc.p_nice)), attrs); @@ -4024,6 +4020,50 @@ system_process_attributes (Lisp_Object pid) t = timespec_sub (now, timeval_to_timespec (starttime)); attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs); + struct proc_taskinfo taskinfo; + if (proc_pidinfo (proc_id, PROC_PIDTASKINFO, 0, &taskinfo, sizeof (taskinfo)) > 0) + { + attrs = Fcons (Fcons (Qvsize, make_fixnum (taskinfo.pti_virtual_size / 1024)), attrs); + attrs = Fcons (Fcons (Qrss, make_fixnum (taskinfo.pti_resident_size / 1024)), attrs); + attrs = Fcons (Fcons (Qthcount, make_fixnum (taskinfo.pti_threadnum)), attrs); + } + +#ifdef KERN_PROCARGS2 + char args[ARG_MAX]; + mib[1] = KERN_PROCARGS2; + mib[2] = proc_id; + len = sizeof args; + + if (sysctl (mib, 3, &args, &len, NULL, 0) == 0 && len != 0) + { + char *start, *end; + + int argc = *(int*)args; /* argc is the first int */ + start = args + sizeof (int); + + start += strlen (start) + 1; /* skip executable name and any '\0's */ + while ((start - args < len) && ! *start) start++; + + /* skip argv to find real end */ + for (i = 0, end = start; i < argc && (end - args) < len; i++) + { + end += strlen (end) + 1; + } + + len = end - start; + for (int i = 0; i < len; i++) + { + if (! start[i] && i < len - 1) + start[i] = ' '; + } + + AUTO_STRING (comm, start); + decoded_comm = code_convert_string_norecord (comm, + Vlocale_coding_system, 0); + attrs = Fcons (Fcons (Qargs, decoded_comm), attrs); + } +#endif /* KERN_PROCARGS2 */ + return attrs; } commit 5a762c946eac106e60bb55d8175b32decdbf7d5e Author: Protesilaos Stavrou Date: Wed May 26 12:08:01 2021 +0300 Remove modus-themes.org build date (bug#48661) * modus-themes.org: Delete Org macro of the current export date. This makes the manual reproducible between Emacs builds. diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index e6bcc743d8..9b1a0014ca 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -8,7 +8,6 @@ #+macro: stable-version 1.4.0 #+macro: release-date 2021-05-25 #+macro: development-version 1.5.0-dev -#+macro: export-date (eval (format-time-string "%F %R %z" (current-time))) #+macro: file @@texinfo:@file{@@$1@@texinfo:}@@ #+macro: space @@texinfo:@: @@ #+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@ @@ -33,8 +32,7 @@ The documentation furnished herein corresponds to stable version feature which does not yet form part of the latest tagged commit, is explicitly marked as such. -Current development target is {{{development-version}}}. This manual was -built on {{{export-date}}}. +Current development target is {{{development-version}}}. #+toc: headlines 8 insert TOC here, with eight headline levels