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:
parent
ca42ff5f0e
commit
1cbf2655db
16 changed files with 153 additions and 49 deletions
|
@ -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},
|
||||||
|
|
|
@ -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
|
||||||
|
|
73
etc/NEWS
73
etc/NEWS
|
@ -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:
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
12
src/alloc.c
12
src/alloc.c
|
@ -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");
|
||||||
|
|
|
@ -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.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue