Re: Interactive specs of C functions.

[Michaël Cadilhac]

Richard Stallman <address@hidden> writes:

> Your change in callint.c is the right idea.  How about writing
> documentation and then installing it in the trunk?

I made the doc change in lisp.h, and renamed the `prompt' field of the
Lisp_Subr struct to `intspec' (interactive spec):

Index: lisp.h
===================================================================
RCS file: /sources/emacs/emacs/src/lisp.h,v
retrieving revision 1.583
diff -c -r1.583 lisp.h
*** lisp.h      29 Aug 2007 21:50:08 -0000      1.583
--- lisp.h      9 Sep 2007 20:37:51 -0000
***************
*** 891,897 ****
      Lisp_Object (*function) ();
      short min_args, max_args;
      char *symbol_name;
!     char *prompt;
      char *doc;
    };
  
--- 891,897 ----
      Lisp_Object (*function) ();
      short min_args, max_args;
      char *symbol_name;
!     char *intspec;
      char *doc;
    };
  
***************
*** 1669,1698 ****
         followed by the address of a vector of Lisp_Objects
         which contains the argument values.
      UNEVALLED means pass the list of unevaluated arguments
!  `prompt' says how to read arguments for an interactive call.
!     See the doc string for `interactive'.
      A null string means call interactively with no arguments.
   `doc' is documentation for the user.  */
  
  #if (!defined (__STDC__) && !defined (PROTOTYPES)) \
      || defined (USE_NONANSI_DEFUN)
  
! #define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc)    \
    Lisp_Object fnname ();                                              \
    DECL_ALIGN (struct Lisp_Subr, sname) =                              \
      { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)),   \
!       fnname, minargs, maxargs, lname, prompt, 0};                    \
    Lisp_Object fnname
  
  #else
  
  /* This version of DEFUN declares a function prototype with the right
     arguments, so we can catch errors with maxargs at compile-time.  */
! #define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc)    \
    Lisp_Object fnname DEFUN_ARGS_ ## maxargs ;                         \
    DECL_ALIGN (struct Lisp_Subr, sname) =                              \
      { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)),   \
!       fnname, minargs, maxargs, lname, prompt, 0};                    \
    Lisp_Object fnname
  
  /* Note that the weird token-substitution semantics of ANSI C makes
--- 1669,1701 ----
         followed by the address of a vector of Lisp_Objects
         which contains the argument values.
      UNEVALLED means pass the list of unevaluated arguments
!  `intspec' says how interactive arguments are to be fetched.
!     If the string starts with a `(', `intspec' is evaluated and the resulting
!     list is the list of arguments.
!     If it's a string that doesn't start with `(', the value should follow
!     the one of the doc string for `interactive'.
      A null string means call interactively with no arguments.
   `doc' is documentation for the user.  */
  
  #if (!defined (__STDC__) && !defined (PROTOTYPES)) \
      || defined (USE_NONANSI_DEFUN)
  
! #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc)   \
    Lisp_Object fnname ();                                              \
    DECL_ALIGN (struct Lisp_Subr, sname) =                              \
      { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)),   \
!       fnname, minargs, maxargs, lname, intspec, 0};                   \
    Lisp_Object fnname
  
  #else
  
  /* This version of DEFUN declares a function prototype with the right
     arguments, so we can catch errors with maxargs at compile-time.  */
! #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc)   \
    Lisp_Object fnname DEFUN_ARGS_ ## maxargs ;                         \
    DECL_ALIGN (struct Lisp_Subr, sname) =                              \
      { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)),   \
!       fnname, minargs, maxargs, lname, intspec, 0};                   \
    Lisp_Object fnname
  
  /* Note that the weird token-substitution semantics of ANSI C makes
Index: callint.c
===================================================================
RCS file: /sources/emacs/emacs/src/callint.c,v
retrieving revision 1.154
diff -c -r1.154 callint.c
*** callint.c   29 Aug 2007 05:27:56 -0000      1.154
--- callint.c   9 Sep 2007 20:37:52 -0000
***************
*** 334,345 ****
  
    if (SUBRP (fun))
      {
!       string = (unsigned char *) XSUBR (fun)->prompt;
        if (!string)
        {
        lose:
          wrong_type_argument (Qcommandp, function);
        }
      }
    else if (COMPILEDP (fun))
      {
--- 334,353 ----
  
    if (SUBRP (fun))
      {
!       string = (unsigned char *) XSUBR (fun)->intspec;
        if (!string)
        {
        lose:
          wrong_type_argument (Qcommandp, function);
        }
+       /* The function has an interactive spec to evaluate.  */
+       if (*string == '(')
+       {
+         specs =
+           Fcar (Fread_from_string (make_string (string, strlen (string)),
+                                    Qnil, Qnil));
+         string = 0;
+       }
      }
    else if (COMPILEDP (fun))
      {
Index: data.c
===================================================================
RCS file: /sources/emacs/emacs/src/data.c,v
retrieving revision 1.277
diff -c -r1.277 data.c
*** data.c      29 Aug 2007 05:27:58 -0000      1.277
--- data.c      9 Sep 2007 20:37:53 -0000
***************
*** 770,777 ****
  
    if (SUBRP (fun))
      {
!       if (XSUBR (fun)->prompt)
!       return list2 (Qinteractive, build_string (XSUBR (fun)->prompt));
      }
    else if (COMPILEDP (fun))
      {
--- 770,777 ----
  
    if (SUBRP (fun))
      {
!       if (XSUBR (fun)->intspec)
!       return list2 (Qinteractive, build_string (XSUBR (fun)->intspec));
      }
    else if (COMPILEDP (fun))
      {
Index: eval.c
===================================================================
RCS file: /sources/emacs/emacs/src/eval.c,v
retrieving revision 1.287
diff -c -r1.287 eval.c
*** eval.c      29 Aug 2007 05:27:57 -0000      1.287
--- eval.c      9 Sep 2007 20:37:54 -0000
***************
*** 2078,2084 ****
    /* Emacs primitives are interactive if their DEFUN specifies an
       interactive spec.  */
    if (SUBRP (fun))
!     return XSUBR (fun)->prompt ? Qt : if_prop;
  
    /* Bytecode objects are interactive if they are long enough to
       have an element whose index is COMPILED_INTERACTIVE, which is
--- 2078,2084 ----
    /* Emacs primitives are interactive if their DEFUN specifies an
       interactive spec.  */
    if (SUBRP (fun))
!     return XSUBR (fun)->intspec ? Qt : if_prop;
  
    /* Bytecode objects are interactive if they are long enough to
       have an element whose index is COMPILED_INTERACTIVE, which is

> As for Fset_file_modes, if we want to make it interactive it really
> should handle chmod-style args to specify the modes, not just numbers.

I revamped the code I first proposed (which was my very first proposal
to Emacs! :-)), here are the changes to files.el and fileio.c :

Index: lisp/files.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/files.el,v
retrieving revision 1.927
diff -c -B -w -r1.927 files.el
*** lisp/files.el       31 Aug 2007 13:29:34 -0000      1.927
--- lisp/files.el       9 Sep 2007 20:42:43 -0000
***************
*** 5407,5412 ****
--- 5407,5503 ----
          (t
           (apply operation arguments)))))
  
+
+ ;; Symbolic modes and read-file-modes.
+ 
+ (defun char-to-who (char)
+   "Convert CHAR to a who-mask from a symbolic mode notation.
+ CHAR is in [ugoa] and represents the users on which rights are applied."
+   (cond ((= char ?u) #o4700)
+       ((= char ?g) #o2070)
+       ((= char ?o) #o1007)
+       ((= char ?a) #o7777)
+       (t (error "%c: bad `who' character" char))))
+ 
+ (defun char-to-right (char &optional from)
+   "Convert CHAR to a right-mask from a symbolic mode notation.
+ CHAR is in [rwxXstugo] and represents a right.
+ If CHAR is in [Xugo], the value is extracted from FROM (or 0 if nil)."
+   (or from (setq from 0))
+   (cond ((= char ?r) #o0444)
+       ((= char ?w) #o0222)
+       ((= char ?x) #o0111)
+       ((= char ?s) #o1000)
+       ((= char ?t) #o6000)
+       ;; Rights relative to the previous file modes.
+       ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
+       ((= char ?u) (let ((uright (logand #o4700 from)))
+                      (+ uright (/ uright #o10) (/ uright #o100))))
+       ((= char ?g) (let ((gright (logand #o2070 from)))
+                      (+ gright (/ gright #o10) (* gright #o10))))
+       ((= char ?o) (let ((oright (logand #o1007 from)))
+                      (+ oright (* oright #o10) (* oright #o100))))
+       (t (error "%c: bad right character" char))))
+ 
+ (defun right-string-to-number (rights who-mask &optional from)
+   "Convert a right string to a right-mask from a symbolic modes notation.
+ RIGHTS is the right string, it should match \"([+=-][rwxXstugo]+)+\".
+ WHO-MASK is the mask number of the users on which the rights are to be 
applied.
+ FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed."
+   (let* ((num-rights (or from 0))
+        (list-rights (string-to-list rights))
+        (op (pop list-rights)))
+     (while (memq op '(?+ ?- ?=))
+       (let ((num-right 0)
+           char-right)
+       (while (memq (setq char-right (pop list-rights))
+                    '(?r ?w ?x ?X ?s ?t ?u ?g ?o))
+         (setq num-right
+               (logior num-right (char-to-right char-right num-rights))))
+       (setq num-right (logand who-mask num-right)
+             num-rights
+             (cond ((= op ?+) (logior num-rights num-right))
+                   ((= op ?-) (logand num-rights (lognot num-right)))
+                   (t (logior (logand num-rights (lognot who-mask)) 
num-right)))
+             op char-right)))
+     num-rights))
+ 
+ (defun symbolic-file-modes-to-number (modes &optional from)
+   "Convert symbolic file modes to numeric file modes.
+ MODES is the string to convert, it should match
+ \"[ugoa]*([+-=][rwxXstugo]+)+,...\".
+ See (info \"(coreutils)File permissions\") for more information on this
+ notation.
+ FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed."
+   (save-match-data
+     (let ((case-fold-search nil)
+         (num-modes (or from 0)))
+       (while (/= (string-to-char modes) 0)
+       (if (string-match "^\\([ugoa]*\\)\\([+=-][rwxXstugo]+\\)+\\(,\\|\\)" 
modes)
+           (let ((num-who (apply 'logior 0
+                                 (mapcar 'char-to-who (match-string 1 
modes)))))
+             (when (= num-who 0)
+               (setq num-who (default-file-modes)))
+             (setq num-modes
+                   (right-string-to-number (substring modes (match-end 1))
+                                           num-who num-modes)
+                   modes (substring modes (match-end 3))))
+         (error "Parse error in modes near %s" (substring modes 0))))
+       num-modes)))
+ 
+ (defun read-file-modes (&optional prompt orig-file)
+   "Read file modes in octal or symbolic notation.
+ PROMPT is used as the prompt, default to `File modes (octal or symbolic): '.
+ ORIG-FILE is the original file of which modes will be change."
+   (let* ((modes (or (if orig-file (file-modes orig-file) 0)
+                   (error "File not found")))
+        (value (read-string (or prompt "File modes (octal or symbolic): "))))
+     (save-match-data
+       (if (string-match "^[0-7]+" value)
+         (string-to-number value 8)
+       (symbolic-file-modes-to-number value modes)))))
+ 
+
  (define-key ctl-x-map "\C-f" 'find-file)
  (define-key ctl-x-map "\C-r" 'find-file-read-only)
  (define-key ctl-x-map "\C-v" 'find-alternate-file)
Index: src/fileio.c
===================================================================
RCS file: /sources/emacs/emacs/src/fileio.c,v
retrieving revision 1.590
diff -c -B -w -r1.590 fileio.c
*** src/fileio.c        29 Aug 2007 05:27:58 -0000      1.590
--- src/fileio.c        9 Sep 2007 20:42:46 -0000
***************
*** 3435,3441 ****
    return make_number (st.st_mode & 07777);
  }
  
! DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0,
         doc: /* Set mode bits of file named FILENAME to MODE (an integer).
  Only the 12 low bits of MODE are used.  */)
    (filename, mode)
--- 3435,3443 ----
    return make_number (st.st_mode & 07777);
  }
  
! DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2,
!        "(let ((file (read-file-name \"File: \")))                     \
!         (list file (read-file-modes nil file)))",
         doc: /* Set mode bits of file named FILENAME to MODE (an integer).
  Only the 12 low bits of MODE are used.  */)
    (filename, mode)

And why not change dired-do-chmod to use set-file-modes together with
the symbolic mode parsing functions?

Index: lisp/dired-aux.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/dired-aux.el,v
retrieving revision 1.154
diff -c -r1.154 dired-aux.el
*** lisp/dired-aux.el   13 Aug 2007 13:41:07 -0000      1.154
--- lisp/dired-aux.el   9 Sep 2007 20:23:25 -0000
***************
*** 253,261 ****
  ;;;###autoload
  (defun dired-do-chmod (&optional arg)
    "Change the mode of the marked (or next ARG) files.
! This calls chmod, thus symbolic modes like `g+w' are allowed."
    (interactive "P")
!   (dired-do-chxxx "Mode" dired-chmod-program 'chmod arg))
  
  ;;;###autoload
  (defun dired-do-chgrp (&optional arg)
--- 253,272 ----
  ;;;###autoload
  (defun dired-do-chmod (&optional arg)
    "Change the mode of the marked (or next ARG) files.
! Symbolic modes like `g+w' are allowed."
    (interactive "P")
!   (let* ((files (dired-get-marked-files t arg))
!        (modes (dired-mark-read-string
!                "Change mode of %s to: " nil
!                'chmod arg files))
!        (num-modes (if (string-match "^[0-7]+" modes)
!                       (string-to-number modes 8))))
!     (dolist (file files)
!       (set-file-modes
!        file
!        (if num-modes num-modes
!        (symbolic-file-modes-to-number modes (file-modes file)))))
!     (dired-do-redisplay arg)))
  
  ;;;###autoload
  (defun dired-do-chgrp (&optional arg)

-- 
 |   Michaël `Micha' Cadilhac       |   An error can become exact            |
 |   http://michael.cadilhac.name   |     as the one who committed it        |
 |   JID/MSN:                       |  made a mistake or not.                |
 `----  address@hidden  |          -- Pierre Dac            -  --'

pgpRxEW5FjS9E.pgp
Description: PGP signature