Extend memory-info for remote systems

* doc/lispref/files.texi (Magic File Names): Add memory-info.

* doc/lispref/internals.texi (Garbage Collection): memory-info can
also retrieve values from remote systems.

* etc/NEWS: Document changes in memory-info.  Fix typos.

* lisp/files.el (warn-maybe-out-of-memory): Ensure local memory info.

* lisp/net/tramp.el (tramp-handle-memory-info): New defun.
(tramp-file-name-for-operation)
* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
* lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist):
* lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
* lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist):
* lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist):
* lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist):
* lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist)
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist):
Add 'memory-info'.

* lisp/net/tramp-sshfs.el (tramp-sshfs-handle-exec-path):
Let-bind `process-file-side-effects'.

* src/alloc.c (Fmemory_info): Support remote systems.
(Qmemory_info): Declare.

* test/lisp/net/tramp-tests.el (tramp-test31-memory-info): New test.
This commit is contained in:
Michael Albinus 2022-11-27 16:57:03 +01:00
commit 1cbf2655db
16 changed files with 153 additions and 49 deletions

View file

@ -3383,7 +3383,7 @@ first, before handlers for jobs such as remote file access.
@code{make-nearby-temp-file}, @code{make-nearby-temp-file},
@code{make-process}, @code{make-process},
@code{make-symbolic-link},@* @code{make-symbolic-link},@*
@code{process-attributes}, @code{process-file}, @code{memory-info}, @code{process-attributes}, @code{process-file},
@code{rename-file}, @code{set-file-acl}, @code{set-file-modes}, @code{rename-file}, @code{set-file-acl}, @code{set-file-modes},
@code{set-file-selinux-context}, @code{set-file-times}, @code{set-file-selinux-context}, @code{set-file-times},
@code{set-visited-file-modtime}, @code{shell-command}, @code{set-visited-file-modtime}, @code{shell-command},
@ -3445,7 +3445,7 @@ first, before handlers for jobs such as remote file access.
@code{make-nearby-temp-file}, @code{make-nearby-temp-file},
@code{make-process}, @code{make-process},
@code{make-symbolic-link}, @code{make-symbolic-link},
@code{process-attributes}, @code{process-file}, @code{memory-info}, @code{process-attributes}, @code{process-file},
@code{rename-file}, @code{set-file-acl}, @code{set-file-modes}, @code{rename-file}, @code{set-file-acl}, @code{set-file-modes},
@code{set-file-selinux-context}, @code{set-file-times}, @code{set-file-selinux-context}, @code{set-file-times},
@code{set-visited-file-modtime}, @code{shell-command}, @code{set-visited-file-modtime}, @code{shell-command},

View file

@ -622,6 +622,9 @@ a certain kind of object. See the documentation string for details.
@defun memory-info @defun memory-info
This functions returns an amount of total system memory and how much This functions returns an amount of total system memory and how much
of it is free. On an unsupported system, the value may be @code{nil}. of it is free. On an unsupported system, the value may be @code{nil}.
If @code{default-directory} points to a remote host, memory
information of that host is returned.
@end defun @end defun
@defvar gcs-done @defvar gcs-done

View file

@ -435,7 +435,7 @@ The user options 'url-gateway-rlogin-host',
are also obsolete. are also obsolete.
--- ---
** The user function 'url-irc-function' now takes a 'scheme' argument. ** The user function 'url-irc-function' now takes a SCHEME argument.
The user option 'url-irc-function' is now called with a sixth argument The user option 'url-irc-function' is now called with a sixth argument
corresponding to the scheme portion of the target URL. For example, corresponding to the scheme portion of the target URL. For example,
this would be "ircs" for a URL like "ircs://irc.libera.chat". this would be "ircs" for a URL like "ircs://irc.libera.chat".
@ -1388,7 +1388,7 @@ the QWERTY Slovak keyboards.
* Changes in Specialized Modes and Packages in Emacs 29.1 * Changes in Specialized Modes and Packages in Emacs 29.1
** ecomplete ** Ecomplete
--- ---
*** New commands 'ecomplete-edit' and 'ecomplete-remove'. *** New commands 'ecomplete-edit' and 'ecomplete-remove'.
@ -1510,6 +1510,7 @@ It is enabled by default, but requires that the external "shellcheck"
command is installed. command is installed.
** CC Mode ** CC Mode
--- ---
*** C++ Mode now supports most of the new features in the C++20 standard. *** C++ Mode now supports most of the new features in the C++20 standard.
@ -1593,32 +1594,32 @@ If no packages are marked, 'x' will install the package under point if
it isn't already, and remove it if it is installed. it isn't already, and remove it if it is installed.
+++ +++
*** New command 'package-vc-install' *** New command 'package-vc-install'.
Packages can now be installed directly from source by cloning from a Packages can now be installed directly from source by cloning from a
repository. repository.
+++ +++
*** New command 'package-vc-install-from-checkout' *** New command 'package-vc-install-from-checkout'.
An existing checkout can now be loaded via package.el, by creating a An existing checkout can now be loaded via package.el, by creating a
symbolic link from the usual package directory to the checkout. symbolic link from the usual package directory to the checkout.
+++ +++
*** New command 'package-vc-checkout' *** New command 'package-vc-checkout'.
Used to fetch the source of a package by cloning a repository without Used to fetch the source of a package by cloning a repository without
activating the package. activating the package.
+++ +++
*** New command 'package-vc-prepare-patch' *** New command 'package-vc-prepare-patch'.
This command allows you to send patches to package maintainers, for This command allows you to send patches to package maintainers, for
packages checked out using 'package-vc-install'. packages checked out using 'package-vc-install'.
+++ +++
*** New command 'package-report-bug' *** New command 'package-report-bug'.
This command helps you compose an email for sending bug reports to This command helps you compose an email for sending bug reports to
package maintainers. package maintainers.
+++ +++
*** New user option 'package-vc-selected-packages' *** New user option 'package-vc-selected-packages'.
By customizing this user option you can specify specific packages to By customizing this user option you can specify specific packages to
install. install.
@ -1764,7 +1765,7 @@ There are two new values to control the way the "*Completions*" buffer
behaves after pressing a 'TAB' if completion is not unique. The value behaves after pressing a 'TAB' if completion is not unique. The value
'always' updates or shows the "*Completions*" buffer after any attempt 'always' updates or shows the "*Completions*" buffer after any attempt
to complete. The value 'visual' is like 'always', but only updates to complete. The value 'visual' is like 'always', but only updates
the completions if they are already visible. The default value 't' the completions if they are already visible. The default value t
always hides the completion buffer after some completion is made. always hides the completion buffer after some completion is made.
*** New commands to complete the minibuffer history. *** New commands to complete the minibuffer history.
@ -1998,11 +1999,11 @@ It narrows to the current node.
** EUDC ** EUDC
+++ +++
*** New user option 'eudc-ignore-options-file' that defaults to 'nil' *** New user option 'eudc-ignore-options-file' that defaults to nil.
The 'eudc-ignore-options-file' user option can be configured to ignore The 'eudc-ignore-options-file' user option can be configured to ignore
the 'eudc-options-file' (typically "~/.emacs.d/eudc-options"). Most the 'eudc-options-file' (typically "~/.emacs.d/eudc-options"). Most
users should configure this to 't' and put EUDC configuration in the users should configure this to t and put EUDC configuration in the
main Emacs initialization file (".emacs" or "~/.emacs.d/init.el"). main Emacs initialization file ("~/.emacs" or "~/.emacs.d/init.el").
+++ +++
*** 'eudc-expansion-overwrites-query' to 'eudc-expansion-save-query-as-kill'. *** 'eudc-expansion-overwrites-query' to 'eudc-expansion-save-query-as-kill'.
@ -2051,15 +2052,15 @@ of attributes to use for queries, and delivers more attributes in
query results. query results.
+++ +++
*** New back-end for ecomplete *** New back-end for ecomplete.
A new back-end for ecomplete allows information from that database to A new back-end for ecomplete allows information from that database to
be queried by EUDC, too. The attributes present in the EUDC query are be queried by EUDC, too. The attributes present in the EUDC query are
used to select the entry type in the ecomplete database. used to select the entry type in the ecomplete database.
+++ +++
*** New back-end for mailabbrev *** New back-end for mailabbrev.
A new back-end for mailabbrev allows information from that database to A new back-end for mailabbrev allows information from that database to
be queried by EUDC, too. The attributes email, name, and firstname be queried by EUDC, too. The attributes 'email', 'name', and 'firstname'
are supported only. are supported only.
** EWW/SHR ** EWW/SHR
@ -2655,13 +2656,13 @@ customize this to "https" to always prefer HTTPS URLs.
--- ---
*** New user option 'browse-url-irc-function'. *** New user option 'browse-url-irc-function'.
This option specifies a function for opening irc:// links. It This option specifies a function for opening "irc://" links. It
defaults to the new function 'browse-url-irc'. defaults to the new function 'browse-url-irc'.
--- ---
*** New function 'browse-url-irc'. *** New function 'browse-url-irc'.
This multipurpose autoloaded function can be used for opening irc:// This multipurpose autoloaded function can be used for opening "irc://"
and ircs:// URLS by any caller that passes a URL string as an initial and "ircs://" URLS by any caller that passes a URL string as an initial
arg. arg.
--- ---
@ -2766,12 +2767,12 @@ error, and now expand to all directories recursively (following
symlinks in the latter case). symlinks in the latter case).
+++ +++
*** Lisp forms in Eshell now treat a 'nil' result as a failed exit status. *** Lisp forms in Eshell now treat a nil result as a failed exit status.
When executing a command that looks like '(lisp form)' and returns When executing a command that looks like '(lisp form)' and returns
'nil', Eshell will set the exit status (available in the '$?' nil, Eshell will set the exit status (available in the '$?'
variable) to 2. This allows commands like that to be used in variable) to 2. This allows commands like that to be used in
conditionals. To change this behavior, customize the new conditionals. To change this behavior, customize the new
'eshell-lisp-form-nil-is-failure' option. 'eshell-lisp-form-nil-is-failure' user option.
** Shell ** Shell
@ -2898,7 +2899,7 @@ remote host are shown. Alternatively, the user option
The old name is still available as an obsolete function alias. The old name is still available as an obsolete function alias.
--- ---
*** The url-irc library now understands ircs:// links. *** The url-irc library now understands "ircs://" links.
--- ---
*** New command 'world-clock-copy-time-as-kill' for 'M-x world-clock'. *** New command 'world-clock-copy-time-as-kill' for 'M-x world-clock'.
@ -2910,7 +2911,7 @@ The new face 'abbrev-table-name' is used to display the abbrev table
name. name.
--- ---
*** New key binding "O" in `M-x list-buffer'. *** New key binding 'O' in 'M-x list-buffer'.
This key is now bound to 'Buffer-menu-view-other-window', which will This key is now bound to 'Buffer-menu-view-other-window', which will
view this line's buffer in View mode in another window. view this line's buffer in View mode in another window.
@ -2968,7 +2969,6 @@ Emacs buffers, like indentation and the like. The new ert function
This is a lightweight variant of 'js-mode' that is used by default This is a lightweight variant of 'js-mode' that is used by default
when visiting JSON files. when visiting JSON files.
** New mode 'typescript-ts-mode'. ** New mode 'typescript-ts-mode'.
A major mode based on the tree-sitter library for editing programs A major mode based on the tree-sitter library for editing programs
in the TypeScript language. It includes support for font-locking, in the TypeScript language. It includes support for font-locking,
@ -4318,22 +4318,17 @@ asynchronous processes. The hitherto existing implementation has been
moved to 'internal-default-signal-process'. moved to 'internal-default-signal-process'.
+++ +++
** 'list-system-processes' now returns remote process IDs. ** Some system information functions honor remote systems now.
'list-system-processes' returns remote process IDs.
'memory-info' returns memory information of remote systems.
'process-attributes' expects a remote process ID.
This happens only when the current buffer's 'default-directory' is This happens only when the current buffer's 'default-directory' is
remote. In order to preserve the old behavior, apply remote. In order to preserve the old behavior, bind
'default-directory' to a local directory, like
(let ((default-directory temporary-file-directory)) (let ((default-directory temporary-file-directory))
(list-system-processes)) (list-system-processes))
+++
** 'process-attributes' expects a remote process ID now.
When current buffer's 'default-directory' is remote, the PID argument
of 'process-attributes' is regarded as a remote process ID. In order
to preserve the old behavior, apply
(let ((default-directory temporary-file-directory))
(process-attributes pid))
+++ +++
** New functions 'take' and 'ntake'. ** New functions 'take' and 'ntake'.
'(take N LIST)' returns the first N elements of LIST; 'ntake' does '(take N LIST)' returns the first N elements of LIST; 'ntake' does
@ -4420,11 +4415,3 @@ GNU General Public License for more details.
You should have received a copy of the GNU General Public License You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
coding: utf-8
mode: outline
mode: emacs-news
paragraph-separate: "[ ]"
end:

View file

@ -2308,7 +2308,8 @@ it returns nil or exits non-locally."
"Warn if an attempt to open file of SIZE bytes may run out of memory." "Warn if an attempt to open file of SIZE bytes may run out of memory."
(when (and (numberp size) (not (zerop size)) (when (and (numberp size) (not (zerop size))
(integerp out-of-memory-warning-percentage)) (integerp out-of-memory-warning-percentage))
(let ((meminfo (memory-info))) (let* ((default-directory temporary-file-directory)
(meminfo (memory-info)))
(when (consp meminfo) (when (consp meminfo)
(let ((total-free-memory (float (+ (nth 1 meminfo) (nth 3 meminfo))))) (let ((total-free-memory (float (+ (nth 1 meminfo) (nth 3 meminfo)))))
(when (> (/ size 1024) (when (> (/ size 1024)

View file

@ -168,6 +168,7 @@ It is used for TCP/IP devices."
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-adb-handle-make-process) (make-process . tramp-adb-handle-make-process)
(make-symbolic-link . tramp-handle-make-symbolic-link) (make-symbolic-link . tramp-handle-make-symbolic-link)
(memory-info . tramp-handle-memory-info)
(process-attributes . tramp-handle-process-attributes) (process-attributes . tramp-handle-process-attributes)
(process-file . tramp-adb-handle-process-file) (process-file . tramp-adb-handle-process-file)
(rename-file . tramp-adb-handle-rename-file) (rename-file . tramp-adb-handle-rename-file)

View file

@ -297,6 +297,7 @@ It must be supported by libarchive(3).")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore) (make-process . ignore)
(make-symbolic-link . tramp-archive-handle-not-implemented) (make-symbolic-link . tramp-archive-handle-not-implemented)
;; `memory-info' performed by default handler.
(process-attributes . ignore) (process-attributes . ignore)
(process-file . ignore) (process-file . ignore)
(rename-file . tramp-archive-handle-not-implemented) (rename-file . tramp-archive-handle-not-implemented)

View file

@ -219,6 +219,7 @@ If NAME doesn't belong to an encrypted remote directory, return nil."
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore) (make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link) (make-symbolic-link . tramp-handle-make-symbolic-link)
(memory-info . ignore)
(process-attributes . ignore) (process-attributes . ignore)
(process-file . ignore) (process-file . ignore)
(rename-file . tramp-crypt-handle-rename-file) (rename-file . tramp-crypt-handle-rename-file)

View file

@ -813,6 +813,7 @@ It has been changed in GVFS 1.14.")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore) (make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link) (make-symbolic-link . tramp-handle-make-symbolic-link)
(memory-info . ignore)
(process-attributes . ignore) (process-attributes . ignore)
(process-file . ignore) (process-file . ignore)
(rename-file . tramp-gvfs-handle-rename-file) (rename-file . tramp-gvfs-handle-rename-file)

View file

@ -133,6 +133,7 @@
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore) (make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link) (make-symbolic-link . tramp-handle-make-symbolic-link)
(memory-info . ignore)
(process-attributes . ignore) (process-attributes . ignore)
(process-file . ignore) (process-file . ignore)
(rename-file . tramp-rclone-handle-rename-file) (rename-file . tramp-rclone-handle-rename-file)

View file

@ -1103,6 +1103,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-sh-handle-make-process) (make-process . tramp-sh-handle-make-process)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link) (make-symbolic-link . tramp-sh-handle-make-symbolic-link)
(memory-info . tramp-handle-memory-info)
(process-attributes . tramp-handle-process-attributes) (process-attributes . tramp-handle-process-attributes)
(process-file . tramp-sh-handle-process-file) (process-file . tramp-sh-handle-process-file)
(rename-file . tramp-sh-handle-rename-file) (rename-file . tramp-sh-handle-rename-file)

View file

@ -284,6 +284,7 @@ See `tramp-actions-before-shell' for more info.")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore) (make-process . ignore)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link) (make-symbolic-link . tramp-smb-handle-make-symbolic-link)
(memory-info . ignore)
(process-attributes . ignore) (process-attributes . ignore)
(process-file . tramp-smb-handle-process-file) (process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file) (rename-file . tramp-smb-handle-rename-file)

View file

@ -139,6 +139,7 @@
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-handle-make-process) (make-process . tramp-handle-make-process)
(make-symbolic-link . tramp-handle-make-symbolic-link) (make-symbolic-link . tramp-handle-make-symbolic-link)
(memory-info . tramp-handle-memory-info)
(process-attributes . tramp-handle-process-attributes) (process-attributes . tramp-handle-process-attributes)
(process-file . tramp-sshfs-handle-process-file) (process-file . tramp-sshfs-handle-process-file)
(rename-file . tramp-sshfs-handle-rename-file) (rename-file . tramp-sshfs-handle-rename-file)
@ -214,7 +215,8 @@ arguments to pass to the OPERATION."
(with-parsed-tramp-file-name default-directory nil (with-parsed-tramp-file-name default-directory nil
(with-tramp-connection-property (tramp-get-process v) "remote-path" (with-tramp-connection-property (tramp-get-process v) "remote-path"
(with-temp-buffer (with-temp-buffer
(process-file "getconf" nil t nil "PATH") (let (process-file-side-effects)
(process-file "getconf" nil t nil "PATH"))
(split-string (split-string
(progn (progn
;; Read the expression. ;; Read the expression.

View file

@ -129,6 +129,7 @@ See `tramp-actions-before-shell' for more info.")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore) (make-process . ignore)
(make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link) (make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link)
(memory-info . ignore)
(process-attributes . ignore) (process-attributes . ignore)
(process-file . ignore) (process-file . ignore)
(rename-file . tramp-sudoedit-handle-rename-file) (rename-file . tramp-sudoedit-handle-rename-file)

View file

@ -2656,7 +2656,7 @@ Must be handled by the callers."
;; Emacs 27+ only. ;; Emacs 27+ only.
exec-path make-process exec-path make-process
;; Emacs 29+ only. ;; Emacs 29+ only.
list-system-processes process-attributes)) list-system-processes memory-info process-attributes))
default-directory) default-directory)
;; PROC. ;; PROC.
((member operation '(file-notify-rm-watch file-notify-valid-p)) ((member operation '(file-notify-rm-watch file-notify-valid-p))
@ -4884,6 +4884,84 @@ support symbolic links."
(tramp-dissect-file-name (expand-file-name linkname)) 'file-error (tramp-dissect-file-name (expand-file-name linkname)) 'file-error
"make-symbolic-link not supported")) "make-symbolic-link not supported"))
(defun tramp-handle-memory-info ()
"Like `memory-info' for Tramp files."
(let ((result '(0 0 0 0))
process-file-side-effects)
(with-temp-buffer
(cond
;; GNU/Linux.
((zerop (process-file "cat" nil '(t) nil "/proc/meminfo"))
(goto-char (point-min))
(when
(re-search-forward
(rx bol "MemTotal:" (* space) (group (+ digit)) (* space) "kB" eol)
nil 'noerror)
(setcar (nthcdr 0 result) (string-to-number (match-string 1))))
(goto-char (point-min))
(when
(re-search-forward
(rx bol "MemFree:" (* space) (group (+ digit)) (* space) "kB" eol)
nil 'noerror)
(setcar (nthcdr 1 result) (string-to-number (match-string 1))))
(goto-char (point-min))
(when
(re-search-forward
(rx bol "SwapTotal:" (* space) (group (+ digit)) (* space) "kB" eol)
nil 'noerror)
(setcar (nthcdr 2 result) (string-to-number (match-string 1))))
(goto-char (point-min))
(when
(re-search-forward
(rx bol "SwapFree:" (* space) (group (+ digit)) (* space) "kB" eol)
nil 'noerror)
(setcar (nthcdr 3 result) (string-to-number (match-string 1)))))
;; BSD.
;; https://raw.githubusercontent.com/ocochard/myscripts/master/FreeBSD/freebsd-memory.sh
((zerop (process-file "sysctl" nil '(t) nil "-a"))
(goto-char (point-min))
(when
(re-search-forward
(rx bol "hw.pagesize:" (* space) (group (+ digit)) eol)
nil 'noerror)
(let ((pagesize (string-to-number (match-string 1))))
(goto-char (point-min))
(when
(re-search-forward
(rx bol "vm.stats.vm.v_page_count:" (* space)
(group (+ digit)) eol)
nil 'noerror)
(setcar
(nthcdr 0 result)
(/ (* (string-to-number (match-string 1)) pagesize) 1024)))
(goto-char (point-min))
(when
(re-search-forward
(rx bol "vm.stats.vm.v_free_count:" (* space)
(group (+ digit)) eol)
nil 'noerror)
(setcar
(nthcdr 1 result)
(/ (* (string-to-number (match-string 1)) pagesize) 1024)))))
(erase-buffer)
(when (zerop (process-file "swapctl" nil '(t) nil "-sk"))
(goto-char (point-min))
(when
(re-search-forward
(rx bol "Total:" (* space)
(group (+ digit)) (* space) (group (+ digit)) eol)
nil 'noerror)
(setcar (nthcdr 2 result) (string-to-number (match-string 1)))
(setcar
(nthcdr 3 result)
(- (string-to-number (match-string 1))
(string-to-number (match-string 2)))))))))
;; Return result.
(unless (equal result '(0 0 0 0))
result)))
(defun tramp-handle-process-attributes (pid) (defun tramp-handle-process-attributes (pid)
"Like `process-attributes' for Tramp files." "Like `process-attributes' for Tramp files."
(catch 'result (catch 'result

View file

@ -7435,9 +7435,17 @@ DEFUN ("memory-info", Fmemory_info, Smemory_info, 0, 0, 0,
doc: /* Return a list of (TOTAL-RAM FREE-RAM TOTAL-SWAP FREE-SWAP). doc: /* Return a list of (TOTAL-RAM FREE-RAM TOTAL-SWAP FREE-SWAP).
All values are in Kbytes. If there is no swap space, All values are in Kbytes. If there is no swap space,
last two values are zero. If the system is not supported last two values are zero. If the system is not supported
or memory information can't be obtained, return nil. */) or memory information can't be obtained, return nil.
If `default-directory is remote, return memory information of the
respective remote host. */)
(void) (void)
{ {
Lisp_Object handler
= Ffind_file_name_handler (BVAR (current_buffer, directory),
Qmemory_info);
if (!NILP (handler))
return call1 (handler, Qmemory_info);
#if defined HAVE_LINUX_SYSINFO #if defined HAVE_LINUX_SYSINFO
struct sysinfo si; struct sysinfo si;
uintmax_t units; uintmax_t units;
@ -7859,6 +7867,8 @@ do hash-consing of the objects allocated to pure space. */);
doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
Vmemory_full = Qnil; Vmemory_full = Qnil;
DEFSYM (Qmemory_info, "memory-info");
DEFSYM (Qconses, "conses"); DEFSYM (Qconses, "conses");
DEFSYM (Qsymbols, "symbols"); DEFSYM (Qsymbols, "symbols");
DEFSYM (Qstrings, "strings"); DEFSYM (Qstrings, "strings");

View file

@ -5388,6 +5388,21 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Cleanup. ;; Cleanup.
(ignore-errors (delete-process proc))))) (ignore-errors (delete-process proc)))))
(ert-deftest tramp-test31-memory-info ()
"Check `memory-info'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
;; `memory-info' is supported since Emacs 29.1.
(skip-unless (tramp--test-emacs29-p))
(when-let ((default-directory ert-remote-temporary-file-directory)
(mi (memory-info)))
(should (consp mi))
(should (= (length mi) 4))
(dotimes (i (length mi))
(should (natnump (nth i mi))))))
(defun tramp--test-async-shell-command (defun tramp--test-async-shell-command
(command output-buffer &optional error-buffer input) (command output-buffer &optional error-buffer input)
"Like `async-shell-command', reading the output. "Like `async-shell-command', reading the output.