code.delx.au - gnu-emacs-elpa/blob - packages/realgud/realgud/common/helper.el

   1 ;;; Copyright (C) 2010, 2014 Rocky Bernstein <rocky@gnu.org>
   2 ;;; Miscellaneous utility functions
   3 (require 'load-relative)
   4
   5 (defun fn-p-to-fn?-alias (fn-sym)
   6   "FN-SYM is assumed to be a symbol which is a function.  If it
   7 ends in a 'p' or '-p', that suffix is stripped; in either case, a
   8 suffix with '?' is added this name is a new alias for that
   9 function FN-SYM."
  10   (if (and (symbolp fn-sym) (functionp fn-sym))
  11       (let*
  12           ((fn-str (symbol-name fn-sym))
  13            (new-fn-str
  14              (cond
  15               ((and (> (length fn-str) 2) (equal "-p" (substring fn-str -2)))
  16                (substring fn-str 0 -2))
  17               ((and (> (length fn-str) 1) (equal "p" (substring fn-str -1)))
  18                (substring fn-str 0 -1))
  19               (t fn-str)))
  20            (new-fn-sym (intern (concat new-fn-str "?"))))
  21         (defalias new-fn-sym fn-sym))))
  22
  23 ;; FIXME push the special casing into the debuggers themselves.
  24 (defun realgud:debugger-name-transform (debugger-name)
  25   "In some cases we need to prefix a short debugger name, like
  26 'gdb' with 'realgud:'. This does that."
  27   (let ((debugger-name-short
  28          (file-name-sans-extension (file-name-nondirectory debugger-name))))
  29     (cond
  30      ((equal debugger-name-short "gdb") "realgud:gdb")
  31      ((equal debugger-name-short "jdb") "realgud:jdb")
  32      ((equal debugger-name-short "tortoise") "gub")
  33      ((or (equal debugger-name "trepan.pl")
  34           (equal debugger-name-short "trepanpl"))
  35       "realgud:trepanpl")
  36      ('t debugger-name-short))))
  37
  38 (defun buffer-killed? (buffer)
  39   "Return t if BUFFER is killed."
  40   (not (buffer-name buffer)))
  41
  42 (defmacro with-current-buffer-safe (buffer &rest body)
  43   "Check that BUFFER has not been deleted before calling
  44 `with-current-buffer'. If it has been deleted return nil."
  45   (declare (indent 1) (debug t))
  46   `(if (or (not ,buffer) (buffer-killed? ,buffer))
  47        nil
  48      (with-current-buffer ,buffer
  49        ,@body)))
  50
  51
  52 ;; FIXME: prepend realgud- onto the beginning of struct-symbol
  53 (defmacro realgud-sget (struct-symbol struct-field)
  54   "Simplified access to a field of a `defstruct'
  55 variable. STRUCT-SYMBOL is a defstruct symbol name. STRUCT-FIELD
  56 is a field in that. Access (STRUCT-SYMBOL-STRUCT-FIELD STRUCT-SYMBOL)"
  57   (declare (indent 1) (debug t))
  58   `(let* ((realgud-symbol-str
  59            (concat "realgud-" (symbol-name ,struct-symbol)))
  60           (realgud-field-access
  61            (intern (concat realgud-symbol-str "-" (symbol-name, struct-field)))))
  62     (funcall realgud-field-access (eval (intern realgud-symbol-str)))))
  63
  64
  65 (defmacro realgud-struct-field-setter (variable-name field)
  66   "Creates an defstruct setter method for field FIELD with
  67 of defstruct variable VARIABLE-NAME. For example:
  68
  69   (realgud-struct-field-setter \"realgud-srcbuf-info\" \"short-key?\")
  70 gives:
  71   (defun realgud-srcbuf-info-short-key?=(value)
  72     (setf (realgud-srcbuf-info-short-key? realgud-srcbuf-info) value))
  73 "
  74   (declare (indent 1) (debug t))
  75   `(defun ,(intern (concat variable-name "-" field "=")) (value)
  76      ;; FIXME: figure out how to add docstring
  77      ;; ,(concat "Sets field" ,field " of " ,variable-name " to VALUE")
  78      (if ,(intern variable-name)
  79          (setf (,(intern (concat variable-name "-" field))
  80                 ,(intern variable-name)) value))
  81     ))
  82
  83 ;; (defun realgud-struct-field (var-sym field-sym)
  84 ;;   (setq var-str (symbol-name var-sym))
  85 ;;   (setq field-str (symbol-name field-sym))
  86 ;;   (funcall (symbol-function (intern (concat var-str "-" field-str)))
  87 ;;         (eval (intern var-str))))
  88
  89 (provide-me "realgud-")