diff options
| author | Michael Albinus | 2022-11-27 16:57:03 +0100 |
|---|---|---|
| committer | Michael Albinus | 2022-11-27 16:57:03 +0100 |
| commit | 1cbf2655db40cd474411b77ece57a287eb85ea2c (patch) | |
| tree | 51c1eb45d553033f76e7d36837cfbaa20778c7b2 | |
| parent | ca42ff5f0ee757f0a70f603863c83e85eef683b9 (diff) | |
| download | emacs-1cbf2655db40cd474411b77ece57a287eb85ea2c.tar.gz emacs-1cbf2655db40cd474411b77ece57a287eb85ea2c.zip | |
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.
| -rw-r--r-- | doc/lispref/files.texi | 4 | ||||
| -rw-r--r-- | doc/lispref/internals.texi | 3 | ||||
| -rw-r--r-- | etc/NEWS | 73 | ||||
| -rw-r--r-- | lisp/files.el | 3 | ||||
| -rw-r--r-- | lisp/net/tramp-adb.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-archive.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-crypt.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-rclone.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-sshfs.el | 4 | ||||
| -rw-r--r-- | lisp/net/tramp-sudoedit.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 80 | ||||
| -rw-r--r-- | src/alloc.c | 12 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 15 |
16 files changed, 153 insertions, 49 deletions
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 183b2786eae..4b45d89f9d0 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi | |||
| @@ -3383,7 +3383,7 @@ first, before handlers for jobs such as remote file access. | |||
| 3383 | @code{make-nearby-temp-file}, | 3383 | @code{make-nearby-temp-file}, |
| 3384 | @code{make-process}, | 3384 | @code{make-process}, |
| 3385 | @code{make-symbolic-link},@* | 3385 | @code{make-symbolic-link},@* |
| 3386 | @code{process-attributes}, @code{process-file}, | 3386 | @code{memory-info}, @code{process-attributes}, @code{process-file}, |
| 3387 | @code{rename-file}, @code{set-file-acl}, @code{set-file-modes}, | 3387 | @code{rename-file}, @code{set-file-acl}, @code{set-file-modes}, |
| 3388 | @code{set-file-selinux-context}, @code{set-file-times}, | 3388 | @code{set-file-selinux-context}, @code{set-file-times}, |
| 3389 | @code{set-visited-file-modtime}, @code{shell-command}, | 3389 | @code{set-visited-file-modtime}, @code{shell-command}, |
| @@ -3445,7 +3445,7 @@ first, before handlers for jobs such as remote file access. | |||
| 3445 | @code{make-nearby-temp-file}, | 3445 | @code{make-nearby-temp-file}, |
| 3446 | @code{make-process}, | 3446 | @code{make-process}, |
| 3447 | @code{make-symbolic-link}, | 3447 | @code{make-symbolic-link}, |
| 3448 | @code{process-attributes}, @code{process-file}, | 3448 | @code{memory-info}, @code{process-attributes}, @code{process-file}, |
| 3449 | @code{rename-file}, @code{set-file-acl}, @code{set-file-modes}, | 3449 | @code{rename-file}, @code{set-file-acl}, @code{set-file-modes}, |
| 3450 | @code{set-file-selinux-context}, @code{set-file-times}, | 3450 | @code{set-file-selinux-context}, @code{set-file-times}, |
| 3451 | @code{set-visited-file-modtime}, @code{shell-command}, | 3451 | @code{set-visited-file-modtime}, @code{shell-command}, |
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 4640b6d7591..c4e724d761c 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi | |||
| @@ -622,6 +622,9 @@ a certain kind of object. See the documentation string for details. | |||
| 622 | @defun memory-info | 622 | @defun memory-info |
| 623 | This functions returns an amount of total system memory and how much | 623 | This functions returns an amount of total system memory and how much |
| 624 | of it is free. On an unsupported system, the value may be @code{nil}. | 624 | of it is free. On an unsupported system, the value may be @code{nil}. |
| 625 | |||
| 626 | If @code{default-directory} points to a remote host, memory | ||
| 627 | information of that host is returned. | ||
| 625 | @end defun | 628 | @end defun |
| 626 | 629 | ||
| 627 | @defvar gcs-done | 630 | @defvar gcs-done |
| @@ -435,7 +435,7 @@ The user options 'url-gateway-rlogin-host', | |||
| 435 | are also obsolete. | 435 | are also obsolete. |
| 436 | 436 | ||
| 437 | --- | 437 | --- |
| 438 | ** The user function 'url-irc-function' now takes a 'scheme' argument. | 438 | ** The user function 'url-irc-function' now takes a SCHEME argument. |
| 439 | The user option 'url-irc-function' is now called with a sixth argument | 439 | The user option 'url-irc-function' is now called with a sixth argument |
| 440 | corresponding to the scheme portion of the target URL. For example, | 440 | corresponding to the scheme portion of the target URL. For example, |
| 441 | this would be "ircs" for a URL like "ircs://irc.libera.chat". | 441 | this would be "ircs" for a URL like "ircs://irc.libera.chat". |
| @@ -1388,7 +1388,7 @@ the QWERTY Slovak keyboards. | |||
| 1388 | 1388 | ||
| 1389 | * Changes in Specialized Modes and Packages in Emacs 29.1 | 1389 | * Changes in Specialized Modes and Packages in Emacs 29.1 |
| 1390 | 1390 | ||
| 1391 | ** ecomplete | 1391 | ** Ecomplete |
| 1392 | 1392 | ||
| 1393 | --- | 1393 | --- |
| 1394 | *** New commands 'ecomplete-edit' and 'ecomplete-remove'. | 1394 | *** New commands 'ecomplete-edit' and 'ecomplete-remove'. |
| @@ -1510,6 +1510,7 @@ It is enabled by default, but requires that the external "shellcheck" | |||
| 1510 | command is installed. | 1510 | command is installed. |
| 1511 | 1511 | ||
| 1512 | ** CC Mode | 1512 | ** CC Mode |
| 1513 | |||
| 1513 | --- | 1514 | --- |
| 1514 | *** C++ Mode now supports most of the new features in the C++20 standard. | 1515 | *** C++ Mode now supports most of the new features in the C++20 standard. |
| 1515 | 1516 | ||
| @@ -1593,32 +1594,32 @@ If no packages are marked, 'x' will install the package under point if | |||
| 1593 | it isn't already, and remove it if it is installed. | 1594 | it isn't already, and remove it if it is installed. |
| 1594 | 1595 | ||
| 1595 | +++ | 1596 | +++ |
| 1596 | *** New command 'package-vc-install' | 1597 | *** New command 'package-vc-install'. |
| 1597 | Packages can now be installed directly from source by cloning from a | 1598 | Packages can now be installed directly from source by cloning from a |
| 1598 | repository. | 1599 | repository. |
| 1599 | 1600 | ||
| 1600 | +++ | 1601 | +++ |
| 1601 | *** New command 'package-vc-install-from-checkout' | 1602 | *** New command 'package-vc-install-from-checkout'. |
| 1602 | An existing checkout can now be loaded via package.el, by creating a | 1603 | An existing checkout can now be loaded via package.el, by creating a |
| 1603 | symbolic link from the usual package directory to the checkout. | 1604 | symbolic link from the usual package directory to the checkout. |
| 1604 | 1605 | ||
| 1605 | +++ | 1606 | +++ |
| 1606 | *** New command 'package-vc-checkout' | 1607 | *** New command 'package-vc-checkout'. |
| 1607 | Used to fetch the source of a package by cloning a repository without | 1608 | Used to fetch the source of a package by cloning a repository without |
| 1608 | activating the package. | 1609 | activating the package. |
| 1609 | 1610 | ||
| 1610 | +++ | 1611 | +++ |
| 1611 | *** New command 'package-vc-prepare-patch' | 1612 | *** New command 'package-vc-prepare-patch'. |
| 1612 | This command allows you to send patches to package maintainers, for | 1613 | This command allows you to send patches to package maintainers, for |
| 1613 | packages checked out using 'package-vc-install'. | 1614 | packages checked out using 'package-vc-install'. |
| 1614 | 1615 | ||
| 1615 | +++ | 1616 | +++ |
| 1616 | *** New command 'package-report-bug' | 1617 | *** New command 'package-report-bug'. |
| 1617 | This command helps you compose an email for sending bug reports to | 1618 | This command helps you compose an email for sending bug reports to |
| 1618 | package maintainers. | 1619 | package maintainers. |
| 1619 | 1620 | ||
| 1620 | +++ | 1621 | +++ |
| 1621 | *** New user option 'package-vc-selected-packages' | 1622 | *** New user option 'package-vc-selected-packages'. |
| 1622 | By customizing this user option you can specify specific packages to | 1623 | By customizing this user option you can specify specific packages to |
| 1623 | install. | 1624 | install. |
| 1624 | 1625 | ||
| @@ -1764,7 +1765,7 @@ There are two new values to control the way the "*Completions*" buffer | |||
| 1764 | behaves after pressing a 'TAB' if completion is not unique. The value | 1765 | behaves after pressing a 'TAB' if completion is not unique. The value |
| 1765 | 'always' updates or shows the "*Completions*" buffer after any attempt | 1766 | 'always' updates or shows the "*Completions*" buffer after any attempt |
| 1766 | to complete. The value 'visual' is like 'always', but only updates | 1767 | to complete. The value 'visual' is like 'always', but only updates |
| 1767 | the completions if they are already visible. The default value 't' | 1768 | the completions if they are already visible. The default value t |
| 1768 | always hides the completion buffer after some completion is made. | 1769 | always hides the completion buffer after some completion is made. |
| 1769 | 1770 | ||
| 1770 | *** New commands to complete the minibuffer history. | 1771 | *** New commands to complete the minibuffer history. |
| @@ -1998,11 +1999,11 @@ It narrows to the current node. | |||
| 1998 | ** EUDC | 1999 | ** EUDC |
| 1999 | 2000 | ||
| 2000 | +++ | 2001 | +++ |
| 2001 | *** New user option 'eudc-ignore-options-file' that defaults to 'nil' | 2002 | *** New user option 'eudc-ignore-options-file' that defaults to nil. |
| 2002 | The 'eudc-ignore-options-file' user option can be configured to ignore | 2003 | The 'eudc-ignore-options-file' user option can be configured to ignore |
| 2003 | the 'eudc-options-file' (typically "~/.emacs.d/eudc-options"). Most | 2004 | the 'eudc-options-file' (typically "~/.emacs.d/eudc-options"). Most |
| 2004 | users should configure this to 't' and put EUDC configuration in the | 2005 | users should configure this to t and put EUDC configuration in the |
| 2005 | main Emacs initialization file (".emacs" or "~/.emacs.d/init.el"). | 2006 | main Emacs initialization file ("~/.emacs" or "~/.emacs.d/init.el"). |
| 2006 | 2007 | ||
| 2007 | +++ | 2008 | +++ |
| 2008 | *** 'eudc-expansion-overwrites-query' to 'eudc-expansion-save-query-as-kill'. | 2009 | *** '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 | |||
| 2051 | query results. | 2052 | query results. |
| 2052 | 2053 | ||
| 2053 | +++ | 2054 | +++ |
| 2054 | *** New back-end for ecomplete | 2055 | *** New back-end for ecomplete. |
| 2055 | A new back-end for ecomplete allows information from that database to | 2056 | A new back-end for ecomplete allows information from that database to |
| 2056 | be queried by EUDC, too. The attributes present in the EUDC query are | 2057 | be queried by EUDC, too. The attributes present in the EUDC query are |
| 2057 | used to select the entry type in the ecomplete database. | 2058 | used to select the entry type in the ecomplete database. |
| 2058 | 2059 | ||
| 2059 | +++ | 2060 | +++ |
| 2060 | *** New back-end for mailabbrev | 2061 | *** New back-end for mailabbrev. |
| 2061 | A new back-end for mailabbrev allows information from that database to | 2062 | A new back-end for mailabbrev allows information from that database to |
| 2062 | be queried by EUDC, too. The attributes email, name, and firstname | 2063 | be queried by EUDC, too. The attributes 'email', 'name', and 'firstname' |
| 2063 | are supported only. | 2064 | are supported only. |
| 2064 | 2065 | ||
| 2065 | ** EWW/SHR | 2066 | ** EWW/SHR |
| @@ -2655,13 +2656,13 @@ customize this to "https" to always prefer HTTPS URLs. | |||
| 2655 | 2656 | ||
| 2656 | --- | 2657 | --- |
| 2657 | *** New user option 'browse-url-irc-function'. | 2658 | *** New user option 'browse-url-irc-function'. |
| 2658 | This option specifies a function for opening irc:// links. It | 2659 | This option specifies a function for opening "irc://" links. It |
| 2659 | defaults to the new function 'browse-url-irc'. | 2660 | defaults to the new function 'browse-url-irc'. |
| 2660 | 2661 | ||
| 2661 | --- | 2662 | --- |
| 2662 | *** New function 'browse-url-irc'. | 2663 | *** New function 'browse-url-irc'. |
| 2663 | This multipurpose autoloaded function can be used for opening irc:// | 2664 | This multipurpose autoloaded function can be used for opening "irc://" |
| 2664 | and ircs:// URLS by any caller that passes a URL string as an initial | 2665 | and "ircs://" URLS by any caller that passes a URL string as an initial |
| 2665 | arg. | 2666 | arg. |
| 2666 | 2667 | ||
| 2667 | --- | 2668 | --- |
| @@ -2766,12 +2767,12 @@ error, and now expand to all directories recursively (following | |||
| 2766 | symlinks in the latter case). | 2767 | symlinks in the latter case). |
| 2767 | 2768 | ||
| 2768 | +++ | 2769 | +++ |
| 2769 | *** Lisp forms in Eshell now treat a 'nil' result as a failed exit status. | 2770 | *** Lisp forms in Eshell now treat a nil result as a failed exit status. |
| 2770 | When executing a command that looks like '(lisp form)' and returns | 2771 | When executing a command that looks like '(lisp form)' and returns |
| 2771 | 'nil', Eshell will set the exit status (available in the '$?' | 2772 | nil, Eshell will set the exit status (available in the '$?' |
| 2772 | variable) to 2. This allows commands like that to be used in | 2773 | variable) to 2. This allows commands like that to be used in |
| 2773 | conditionals. To change this behavior, customize the new | 2774 | conditionals. To change this behavior, customize the new |
| 2774 | 'eshell-lisp-form-nil-is-failure' option. | 2775 | 'eshell-lisp-form-nil-is-failure' user option. |
| 2775 | 2776 | ||
| 2776 | ** Shell | 2777 | ** Shell |
| 2777 | 2778 | ||
| @@ -2898,7 +2899,7 @@ remote host are shown. Alternatively, the user option | |||
| 2898 | The old name is still available as an obsolete function alias. | 2899 | The old name is still available as an obsolete function alias. |
| 2899 | 2900 | ||
| 2900 | --- | 2901 | --- |
| 2901 | *** The url-irc library now understands ircs:// links. | 2902 | *** The url-irc library now understands "ircs://" links. |
| 2902 | 2903 | ||
| 2903 | --- | 2904 | --- |
| 2904 | *** New command 'world-clock-copy-time-as-kill' for 'M-x world-clock'. | 2905 | *** 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 | |||
| 2910 | name. | 2911 | name. |
| 2911 | 2912 | ||
| 2912 | --- | 2913 | --- |
| 2913 | *** New key binding "O" in `M-x list-buffer'. | 2914 | *** New key binding 'O' in 'M-x list-buffer'. |
| 2914 | This key is now bound to 'Buffer-menu-view-other-window', which will | 2915 | This key is now bound to 'Buffer-menu-view-other-window', which will |
| 2915 | view this line's buffer in View mode in another window. | 2916 | view this line's buffer in View mode in another window. |
| 2916 | 2917 | ||
| @@ -2968,7 +2969,6 @@ Emacs buffers, like indentation and the like. The new ert function | |||
| 2968 | This is a lightweight variant of 'js-mode' that is used by default | 2969 | This is a lightweight variant of 'js-mode' that is used by default |
| 2969 | when visiting JSON files. | 2970 | when visiting JSON files. |
| 2970 | 2971 | ||
| 2971 | |||
| 2972 | ** New mode 'typescript-ts-mode'. | 2972 | ** New mode 'typescript-ts-mode'. |
| 2973 | A major mode based on the tree-sitter library for editing programs | 2973 | A major mode based on the tree-sitter library for editing programs |
| 2974 | in the TypeScript language. It includes support for font-locking, | 2974 | in the TypeScript language. It includes support for font-locking, |
| @@ -4318,23 +4318,18 @@ asynchronous processes. The hitherto existing implementation has been | |||
| 4318 | moved to 'internal-default-signal-process'. | 4318 | moved to 'internal-default-signal-process'. |
| 4319 | 4319 | ||
| 4320 | +++ | 4320 | +++ |
| 4321 | ** 'list-system-processes' now returns remote process IDs. | 4321 | ** Some system information functions honor remote systems now. |
| 4322 | 'list-system-processes' returns remote process IDs. | ||
| 4323 | 'memory-info' returns memory information of remote systems. | ||
| 4324 | 'process-attributes' expects a remote process ID. | ||
| 4322 | This happens only when the current buffer's 'default-directory' is | 4325 | This happens only when the current buffer's 'default-directory' is |
| 4323 | remote. In order to preserve the old behavior, apply | 4326 | remote. In order to preserve the old behavior, bind |
| 4327 | 'default-directory' to a local directory, like | ||
| 4324 | 4328 | ||
| 4325 | (let ((default-directory temporary-file-directory)) | 4329 | (let ((default-directory temporary-file-directory)) |
| 4326 | (list-system-processes)) | 4330 | (list-system-processes)) |
| 4327 | 4331 | ||
| 4328 | +++ | 4332 | +++ |
| 4329 | ** 'process-attributes' expects a remote process ID now. | ||
| 4330 | When current buffer's 'default-directory' is remote, the PID argument | ||
| 4331 | of 'process-attributes' is regarded as a remote process ID. In order | ||
| 4332 | to preserve the old behavior, apply | ||
| 4333 | |||
| 4334 | (let ((default-directory temporary-file-directory)) | ||
| 4335 | (process-attributes pid)) | ||
| 4336 | |||
| 4337 | +++ | ||
| 4338 | ** New functions 'take' and 'ntake'. | 4333 | ** New functions 'take' and 'ntake'. |
| 4339 | '(take N LIST)' returns the first N elements of LIST; 'ntake' does | 4334 | '(take N LIST)' returns the first N elements of LIST; 'ntake' does |
| 4340 | the same but works by modifying LIST destructively. | 4335 | the same but works by modifying LIST destructively. |
| @@ -4420,11 +4415,3 @@ GNU General Public License for more details. | |||
| 4420 | 4415 | ||
| 4421 | You should have received a copy of the GNU General Public License | 4416 | You should have received a copy of the GNU General Public License |
| 4422 | along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | 4417 | along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. |
| 4423 | |||
| 4424 | |||
| 4425 | Local variables: | ||
| 4426 | coding: utf-8 | ||
| 4427 | mode: outline | ||
| 4428 | mode: emacs-news | ||
| 4429 | paragraph-separate: "[ ]" | ||
| 4430 | end: | ||
diff --git a/lisp/files.el b/lisp/files.el index f1f890430f1..cd35fe38350 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -2308,7 +2308,8 @@ it returns nil or exits non-locally." | |||
| 2308 | "Warn if an attempt to open file of SIZE bytes may run out of memory." | 2308 | "Warn if an attempt to open file of SIZE bytes may run out of memory." |
| 2309 | (when (and (numberp size) (not (zerop size)) | 2309 | (when (and (numberp size) (not (zerop size)) |
| 2310 | (integerp out-of-memory-warning-percentage)) | 2310 | (integerp out-of-memory-warning-percentage)) |
| 2311 | (let ((meminfo (memory-info))) | 2311 | (let* ((default-directory temporary-file-directory) |
| 2312 | (meminfo (memory-info))) | ||
| 2312 | (when (consp meminfo) | 2313 | (when (consp meminfo) |
| 2313 | (let ((total-free-memory (float (+ (nth 1 meminfo) (nth 3 meminfo))))) | 2314 | (let ((total-free-memory (float (+ (nth 1 meminfo) (nth 3 meminfo))))) |
| 2314 | (when (> (/ size 1024) | 2315 | (when (> (/ size 1024) |
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 49cbf526ec3..90020fbb1b6 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el | |||
| @@ -168,6 +168,7 @@ It is used for TCP/IP devices." | |||
| 168 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) | 168 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) |
| 169 | (make-process . tramp-adb-handle-make-process) | 169 | (make-process . tramp-adb-handle-make-process) |
| 170 | (make-symbolic-link . tramp-handle-make-symbolic-link) | 170 | (make-symbolic-link . tramp-handle-make-symbolic-link) |
| 171 | (memory-info . tramp-handle-memory-info) | ||
| 171 | (process-attributes . tramp-handle-process-attributes) | 172 | (process-attributes . tramp-handle-process-attributes) |
| 172 | (process-file . tramp-adb-handle-process-file) | 173 | (process-file . tramp-adb-handle-process-file) |
| 173 | (rename-file . tramp-adb-handle-rename-file) | 174 | (rename-file . tramp-adb-handle-rename-file) |
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 0a8c574d84c..1a64689c53d 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el | |||
| @@ -297,6 +297,7 @@ It must be supported by libarchive(3).") | |||
| 297 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) | 297 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) |
| 298 | (make-process . ignore) | 298 | (make-process . ignore) |
| 299 | (make-symbolic-link . tramp-archive-handle-not-implemented) | 299 | (make-symbolic-link . tramp-archive-handle-not-implemented) |
| 300 | ;; `memory-info' performed by default handler. | ||
| 300 | (process-attributes . ignore) | 301 | (process-attributes . ignore) |
| 301 | (process-file . ignore) | 302 | (process-file . ignore) |
| 302 | (rename-file . tramp-archive-handle-not-implemented) | 303 | (rename-file . tramp-archive-handle-not-implemented) |
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 09732581574..fa40f968180 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el | |||
| @@ -219,6 +219,7 @@ If NAME doesn't belong to an encrypted remote directory, return nil." | |||
| 219 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) | 219 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) |
| 220 | (make-process . ignore) | 220 | (make-process . ignore) |
| 221 | (make-symbolic-link . tramp-handle-make-symbolic-link) | 221 | (make-symbolic-link . tramp-handle-make-symbolic-link) |
| 222 | (memory-info . ignore) | ||
| 222 | (process-attributes . ignore) | 223 | (process-attributes . ignore) |
| 223 | (process-file . ignore) | 224 | (process-file . ignore) |
| 224 | (rename-file . tramp-crypt-handle-rename-file) | 225 | (rename-file . tramp-crypt-handle-rename-file) |
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 477f8fb3fdd..73f773e8f4d 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -813,6 +813,7 @@ It has been changed in GVFS 1.14.") | |||
| 813 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) | 813 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) |
| 814 | (make-process . ignore) | 814 | (make-process . ignore) |
| 815 | (make-symbolic-link . tramp-handle-make-symbolic-link) | 815 | (make-symbolic-link . tramp-handle-make-symbolic-link) |
| 816 | (memory-info . ignore) | ||
| 816 | (process-attributes . ignore) | 817 | (process-attributes . ignore) |
| 817 | (process-file . ignore) | 818 | (process-file . ignore) |
| 818 | (rename-file . tramp-gvfs-handle-rename-file) | 819 | (rename-file . tramp-gvfs-handle-rename-file) |
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 9e379da8c1e..8e583cc4025 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el | |||
| @@ -133,6 +133,7 @@ | |||
| 133 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) | 133 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) |
| 134 | (make-process . ignore) | 134 | (make-process . ignore) |
| 135 | (make-symbolic-link . tramp-handle-make-symbolic-link) | 135 | (make-symbolic-link . tramp-handle-make-symbolic-link) |
| 136 | (memory-info . ignore) | ||
| 136 | (process-attributes . ignore) | 137 | (process-attributes . ignore) |
| 137 | (process-file . ignore) | 138 | (process-file . ignore) |
| 138 | (rename-file . tramp-rclone-handle-rename-file) | 139 | (rename-file . tramp-rclone-handle-rename-file) |
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index cfecd32aba5..df5800f4e9d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -1103,6 +1103,7 @@ Format specifiers \"%s\" are replaced before the script is used.") | |||
| 1103 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) | 1103 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) |
| 1104 | (make-process . tramp-sh-handle-make-process) | 1104 | (make-process . tramp-sh-handle-make-process) |
| 1105 | (make-symbolic-link . tramp-sh-handle-make-symbolic-link) | 1105 | (make-symbolic-link . tramp-sh-handle-make-symbolic-link) |
| 1106 | (memory-info . tramp-handle-memory-info) | ||
| 1106 | (process-attributes . tramp-handle-process-attributes) | 1107 | (process-attributes . tramp-handle-process-attributes) |
| 1107 | (process-file . tramp-sh-handle-process-file) | 1108 | (process-file . tramp-sh-handle-process-file) |
| 1108 | (rename-file . tramp-sh-handle-rename-file) | 1109 | (rename-file . tramp-sh-handle-rename-file) |
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index e55f6bb6ee5..c720b33b5f2 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el | |||
| @@ -284,6 +284,7 @@ See `tramp-actions-before-shell' for more info.") | |||
| 284 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) | 284 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) |
| 285 | (make-process . ignore) | 285 | (make-process . ignore) |
| 286 | (make-symbolic-link . tramp-smb-handle-make-symbolic-link) | 286 | (make-symbolic-link . tramp-smb-handle-make-symbolic-link) |
| 287 | (memory-info . ignore) | ||
| 287 | (process-attributes . ignore) | 288 | (process-attributes . ignore) |
| 288 | (process-file . tramp-smb-handle-process-file) | 289 | (process-file . tramp-smb-handle-process-file) |
| 289 | (rename-file . tramp-smb-handle-rename-file) | 290 | (rename-file . tramp-smb-handle-rename-file) |
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 3c67fa6ea2f..44c55041ff8 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el | |||
| @@ -139,6 +139,7 @@ | |||
| 139 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) | 139 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) |
| 140 | (make-process . tramp-handle-make-process) | 140 | (make-process . tramp-handle-make-process) |
| 141 | (make-symbolic-link . tramp-handle-make-symbolic-link) | 141 | (make-symbolic-link . tramp-handle-make-symbolic-link) |
| 142 | (memory-info . tramp-handle-memory-info) | ||
| 142 | (process-attributes . tramp-handle-process-attributes) | 143 | (process-attributes . tramp-handle-process-attributes) |
| 143 | (process-file . tramp-sshfs-handle-process-file) | 144 | (process-file . tramp-sshfs-handle-process-file) |
| 144 | (rename-file . tramp-sshfs-handle-rename-file) | 145 | (rename-file . tramp-sshfs-handle-rename-file) |
| @@ -214,7 +215,8 @@ arguments to pass to the OPERATION." | |||
| 214 | (with-parsed-tramp-file-name default-directory nil | 215 | (with-parsed-tramp-file-name default-directory nil |
| 215 | (with-tramp-connection-property (tramp-get-process v) "remote-path" | 216 | (with-tramp-connection-property (tramp-get-process v) "remote-path" |
| 216 | (with-temp-buffer | 217 | (with-temp-buffer |
| 217 | (process-file "getconf" nil t nil "PATH") | 218 | (let (process-file-side-effects) |
| 219 | (process-file "getconf" nil t nil "PATH")) | ||
| 218 | (split-string | 220 | (split-string |
| 219 | (progn | 221 | (progn |
| 220 | ;; Read the expression. | 222 | ;; Read the expression. |
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index bc8739c4d6c..fcc27dd8343 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el | |||
| @@ -129,6 +129,7 @@ See `tramp-actions-before-shell' for more info.") | |||
| 129 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) | 129 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) |
| 130 | (make-process . ignore) | 130 | (make-process . ignore) |
| 131 | (make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link) | 131 | (make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link) |
| 132 | (memory-info . ignore) | ||
| 132 | (process-attributes . ignore) | 133 | (process-attributes . ignore) |
| 133 | (process-file . ignore) | 134 | (process-file . ignore) |
| 134 | (rename-file . tramp-sudoedit-handle-rename-file) | 135 | (rename-file . tramp-sudoedit-handle-rename-file) |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e9f30bea7bf..33e5e80d05f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -2656,7 +2656,7 @@ Must be handled by the callers." | |||
| 2656 | ;; Emacs 27+ only. | 2656 | ;; Emacs 27+ only. |
| 2657 | exec-path make-process | 2657 | exec-path make-process |
| 2658 | ;; Emacs 29+ only. | 2658 | ;; Emacs 29+ only. |
| 2659 | list-system-processes process-attributes)) | 2659 | list-system-processes memory-info process-attributes)) |
| 2660 | default-directory) | 2660 | default-directory) |
| 2661 | ;; PROC. | 2661 | ;; PROC. |
| 2662 | ((member operation '(file-notify-rm-watch file-notify-valid-p)) | 2662 | ((member operation '(file-notify-rm-watch file-notify-valid-p)) |
| @@ -4884,6 +4884,84 @@ support symbolic links." | |||
| 4884 | (tramp-dissect-file-name (expand-file-name linkname)) 'file-error | 4884 | (tramp-dissect-file-name (expand-file-name linkname)) 'file-error |
| 4885 | "make-symbolic-link not supported")) | 4885 | "make-symbolic-link not supported")) |
| 4886 | 4886 | ||
| 4887 | (defun tramp-handle-memory-info () | ||
| 4888 | "Like `memory-info' for Tramp files." | ||
| 4889 | (let ((result '(0 0 0 0)) | ||
| 4890 | process-file-side-effects) | ||
| 4891 | (with-temp-buffer | ||
| 4892 | (cond | ||
| 4893 | ;; GNU/Linux. | ||
| 4894 | ((zerop (process-file "cat" nil '(t) nil "/proc/meminfo")) | ||
| 4895 | (goto-char (point-min)) | ||
| 4896 | (when | ||
| 4897 | (re-search-forward | ||
| 4898 | (rx bol "MemTotal:" (* space) (group (+ digit)) (* space) "kB" eol) | ||
| 4899 | nil 'noerror) | ||
| 4900 | (setcar (nthcdr 0 result) (string-to-number (match-string 1)))) | ||
| 4901 | (goto-char (point-min)) | ||
| 4902 | (when | ||
| 4903 | (re-search-forward | ||
| 4904 | (rx bol "MemFree:" (* space) (group (+ digit)) (* space) "kB" eol) | ||
| 4905 | nil 'noerror) | ||
| 4906 | (setcar (nthcdr 1 result) (string-to-number (match-string 1)))) | ||
| 4907 | (goto-char (point-min)) | ||
| 4908 | (when | ||
| 4909 | (re-search-forward | ||
| 4910 | (rx bol "SwapTotal:" (* space) (group (+ digit)) (* space) "kB" eol) | ||
| 4911 | nil 'noerror) | ||
| 4912 | (setcar (nthcdr 2 result) (string-to-number (match-string 1)))) | ||
| 4913 | (goto-char (point-min)) | ||
| 4914 | (when | ||
| 4915 | (re-search-forward | ||
| 4916 | (rx bol "SwapFree:" (* space) (group (+ digit)) (* space) "kB" eol) | ||
| 4917 | nil 'noerror) | ||
| 4918 | (setcar (nthcdr 3 result) (string-to-number (match-string 1))))) | ||
| 4919 | |||
| 4920 | ;; BSD. | ||
| 4921 | ;; https://raw.githubusercontent.com/ocochard/myscripts/master/FreeBSD/freebsd-memory.sh | ||
| 4922 | ((zerop (process-file "sysctl" nil '(t) nil "-a")) | ||
| 4923 | (goto-char (point-min)) | ||
| 4924 | (when | ||
| 4925 | (re-search-forward | ||
| 4926 | (rx bol "hw.pagesize:" (* space) (group (+ digit)) eol) | ||
| 4927 | nil 'noerror) | ||
| 4928 | (let ((pagesize (string-to-number (match-string 1)))) | ||
| 4929 | (goto-char (point-min)) | ||
| 4930 | (when | ||
| 4931 | (re-search-forward | ||
| 4932 | (rx bol "vm.stats.vm.v_page_count:" (* space) | ||
| 4933 | (group (+ digit)) eol) | ||
| 4934 | nil 'noerror) | ||
| 4935 | (setcar | ||
| 4936 | (nthcdr 0 result) | ||
| 4937 | (/ (* (string-to-number (match-string 1)) pagesize) 1024))) | ||
| 4938 | (goto-char (point-min)) | ||
| 4939 | (when | ||
| 4940 | (re-search-forward | ||
| 4941 | (rx bol "vm.stats.vm.v_free_count:" (* space) | ||
| 4942 | (group (+ digit)) eol) | ||
| 4943 | nil 'noerror) | ||
| 4944 | (setcar | ||
| 4945 | (nthcdr 1 result) | ||
| 4946 | (/ (* (string-to-number (match-string 1)) pagesize) 1024))))) | ||
| 4947 | (erase-buffer) | ||
| 4948 | (when (zerop (process-file "swapctl" nil '(t) nil "-sk")) | ||
| 4949 | (goto-char (point-min)) | ||
| 4950 | (when | ||
| 4951 | (re-search-forward | ||
| 4952 | (rx bol "Total:" (* space) | ||
| 4953 | (group (+ digit)) (* space) (group (+ digit)) eol) | ||
| 4954 | nil 'noerror) | ||
| 4955 | (setcar (nthcdr 2 result) (string-to-number (match-string 1))) | ||
| 4956 | (setcar | ||
| 4957 | (nthcdr 3 result) | ||
| 4958 | (- (string-to-number (match-string 1)) | ||
| 4959 | (string-to-number (match-string 2))))))))) | ||
| 4960 | |||
| 4961 | ;; Return result. | ||
| 4962 | (unless (equal result '(0 0 0 0)) | ||
| 4963 | result))) | ||
| 4964 | |||
| 4887 | (defun tramp-handle-process-attributes (pid) | 4965 | (defun tramp-handle-process-attributes (pid) |
| 4888 | "Like `process-attributes' for Tramp files." | 4966 | "Like `process-attributes' for Tramp files." |
| 4889 | (catch 'result | 4967 | (catch 'result |
diff --git a/src/alloc.c b/src/alloc.c index 0653f2e0ccc..980085d3292 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -7435,9 +7435,17 @@ DEFUN ("memory-info", Fmemory_info, Smemory_info, 0, 0, 0, | |||
| 7435 | doc: /* Return a list of (TOTAL-RAM FREE-RAM TOTAL-SWAP FREE-SWAP). | 7435 | doc: /* Return a list of (TOTAL-RAM FREE-RAM TOTAL-SWAP FREE-SWAP). |
| 7436 | All values are in Kbytes. If there is no swap space, | 7436 | All values are in Kbytes. If there is no swap space, |
| 7437 | last two values are zero. If the system is not supported | 7437 | last two values are zero. If the system is not supported |
| 7438 | or memory information can't be obtained, return nil. */) | 7438 | or memory information can't be obtained, return nil. |
| 7439 | If `default-directory’ is remote, return memory information of the | ||
| 7440 | respective remote host. */) | ||
| 7439 | (void) | 7441 | (void) |
| 7440 | { | 7442 | { |
| 7443 | Lisp_Object handler | ||
| 7444 | = Ffind_file_name_handler (BVAR (current_buffer, directory), | ||
| 7445 | Qmemory_info); | ||
| 7446 | if (!NILP (handler)) | ||
| 7447 | return call1 (handler, Qmemory_info); | ||
| 7448 | |||
| 7441 | #if defined HAVE_LINUX_SYSINFO | 7449 | #if defined HAVE_LINUX_SYSINFO |
| 7442 | struct sysinfo si; | 7450 | struct sysinfo si; |
| 7443 | uintmax_t units; | 7451 | uintmax_t units; |
| @@ -7859,6 +7867,8 @@ do hash-consing of the objects allocated to pure space. */); | |||
| 7859 | doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); | 7867 | doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); |
| 7860 | Vmemory_full = Qnil; | 7868 | Vmemory_full = Qnil; |
| 7861 | 7869 | ||
| 7870 | DEFSYM (Qmemory_info, "memory-info"); | ||
| 7871 | |||
| 7862 | DEFSYM (Qconses, "conses"); | 7872 | DEFSYM (Qconses, "conses"); |
| 7863 | DEFSYM (Qsymbols, "symbols"); | 7873 | DEFSYM (Qsymbols, "symbols"); |
| 7864 | DEFSYM (Qstrings, "strings"); | 7874 | DEFSYM (Qstrings, "strings"); |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index a79c47be723..6ffb8a65292 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -5388,6 +5388,21 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." | |||
| 5388 | ;; Cleanup. | 5388 | ;; Cleanup. |
| 5389 | (ignore-errors (delete-process proc))))) | 5389 | (ignore-errors (delete-process proc))))) |
| 5390 | 5390 | ||
| 5391 | (ert-deftest tramp-test31-memory-info () | ||
| 5392 | "Check `memory-info'." | ||
| 5393 | :tags '(:expensive-test) | ||
| 5394 | (skip-unless (tramp--test-enabled)) | ||
| 5395 | (skip-unless (tramp--test-supports-processes-p)) | ||
| 5396 | ;; `memory-info' is supported since Emacs 29.1. | ||
| 5397 | (skip-unless (tramp--test-emacs29-p)) | ||
| 5398 | |||
| 5399 | (when-let ((default-directory ert-remote-temporary-file-directory) | ||
| 5400 | (mi (memory-info))) | ||
| 5401 | (should (consp mi)) | ||
| 5402 | (should (= (length mi) 4)) | ||
| 5403 | (dotimes (i (length mi)) | ||
| 5404 | (should (natnump (nth i mi)))))) | ||
| 5405 | |||
| 5391 | (defun tramp--test-async-shell-command | 5406 | (defun tramp--test-async-shell-command |
| 5392 | (command output-buffer &optional error-buffer input) | 5407 | (command output-buffer &optional error-buffer input) |
| 5393 | "Like `async-shell-command', reading the output. | 5408 | "Like `async-shell-command', reading the output. |