fun-names.el --- avoid function duplication

fun-names.el --- avoid function duplication

[Emanuel Berg]

Another idea I just wrote - see the examples what it does.

I wrote it in the style Mr. Kaludercic prefers, let's see if
he can still find things to improve :)

;;; fun-names.el --- avoid function duplication -*- lexical-binding: t -*-
;;
;; Author: Emanuel Berg <incal@dataswamp.org>
;; Created: 2024-07-27
;; Keywords: matching
;; License: GPL3+
;; URL: https://dataswamp.org/~incal/emacs-init/fun-names.el
;; Version: 1.0.0
;;
;;; Commentary:
;;
;; Avoid function duplication based on function names.
;;
;; Use the function `fun-names' like below to find out what
;; other functions already use the same words in their names,
;; and to what degree.
;;
;; (fun-names #'fn--string-words)
;; -> nil
;;
;; (fun-names #'gnus-group-mark-buffer)
;; -> ((gnus-group-mark-group  0.875)
;;     (gnus-group-mark-regexp 0.75 )
;;     (gnus-group-mark-region 0.75 )
;;      ... )
;;
;;; Code:

(require 'cl-lib)

(defun fun-names (fun &optional limit)
  (unless (stringp fun)
    (setq fun (symbol-name fun)))
  (unless limit
    (setq limit 0.70))
  (let ((similar)
        (ratio))
    (obarray-map
      (lambda (e)
        (when (functionp e)
          (setq ratio (fn--same-words fun (symbol-name e)))
          (when (< limit ratio)
            (push (list e ratio) similar))))
      obarray)
    (cdr (cl-sort similar #'> :key #'cadr))))

(defun fn--string-words (str &optional no-sort keep-case)
  (unless keep-case
    (setq str (downcase str)))
  (let ((words (split-string str "[-[:space:]()]+" t "[[:punct:]]+")))
    (if no-sort
        words
      (sort words))))

(defun fn--same-words (s1 s2)
  (let* ((w1 (fn--string-words s1))
         (w2 (fn--string-words s2))
         (num (+ (length w1) (length w2)))
         (com (- num (length (cl-set-exclusive-or w1 w2 :test #'string=)))))
    (/ com num 1.0)))

(provide 'fun-names)
;;; fun-names.el ends here

-- 
underground experts united
https://dataswamp.org/~incal

Re: fun-names.el --- avoid function duplication

[Emanuel Berg]

> https://dataswamp.org/~incal/emacs-init/fun-names.el

Check out version 1.2.4, same place.

It can now output a neat table, so if one searches for
gnus-group-mark-buffer, you get in *fun-names*

 1. gnus-group-mark-group            0.88
 2. gnus-group-mark-regexp           0.75
 3. gnus-group-mark-region           0.75
 4. gnus-group-setup-buffer          0.75
 5. gnus-uu-mark-buffer              0.75
 6. gnus-group-remove-mark           0.75
 7. gnus-group-mark-update           0.75
 8. gnus-group-set-mark              0.75
 9. gnus-update-group-mark-positions 0.67
10. gnus-summary-walk-group-buffer   0.67

-- 
underground experts united
https://dataswamp.org/~incal

Re: fun-names.el --- avoid function duplication

[Philip Kaludercic]

Emanuel Berg <incal@dataswamp.org> writes:

> The following message is a courtesy copy of an article
> that has been posted to gmane.emacs.devel as well.
>
> Another idea I just wrote - see the examples what it does.
>
> I wrote it in the style Mr. Kaludercic prefers, let's see if
> he can still find things to improve :)

I assume you mean the file structure?  That's just (elisp) Library
Headers, or what M-x auto-insert generates for you.

> ;;; fun-names.el --- avoid function duplication -*- lexical-binding: t -*-
> ;;
> ;; Author: Emanuel Berg <incal@dataswamp.org>
> ;; Created: 2024-07-27
> ;; Keywords: matching
> ;; License: GPL3+
> ;; URL: https://dataswamp.org/~incal/emacs-init/fun-names.el
> ;; Version: 1.0.0
> ;;
> ;;; Commentary:
> ;;
> ;; Avoid function duplication based on function names.
> ;;
> ;; Use the function `fun-names' like below to find out what
> ;; other functions already use the same words in their names,
> ;; and to what degree.
> ;;
> ;; (fun-names #'fn--string-words)
> ;; -> nil
> ;;
> ;; (fun-names #'gnus-group-mark-buffer)
> ;; -> ((gnus-group-mark-group  0.875)
> ;;     (gnus-group-mark-regexp 0.75 )
> ;;     (gnus-group-mark-region 0.75 )
> ;;      ... )
> ;;
> ;;; Code:
>
> (require 'cl-lib)
>
> (defun fun-names (fun &optional limit)
>   (unless (stringp fun)
>     (setq fun (symbol-name fun)))
>   (unless limit
>     (setq limit 0.70))
>   (let ((similar)
>         (ratio))
>     (obarray-map

Why not use `mapatoms'?  Doesn't make much of a difference in the end.

>       (lambda (e)
>         (when (functionp e)
>           (setq ratio (fn--same-words fun (symbol-name e)))
>           (when (< limit ratio)
>             (push (list e ratio) similar))))
>       obarray)
>     (cdr (cl-sort similar #'> :key #'cadr))))

Sort has recently acquired a :key keyword that you can use, depending on
what the oldest version of Emacs is that you want to support.

>
> (defun fn--string-words (str &optional no-sort keep-case)
>   (unless keep-case
>     (setq str (downcase str)))
>   (let ((words (split-string str "[-[:space:]()]+" t "[[:punct:]]+")))
                                   ^
                                   why not use [^[:alnum:]] here?
>     (if no-sort
>         words
>       (sort words))))
>
> (defun fn--same-words (s1 s2)
>   (let* ((w1 (fn--string-words s1))
>          (w2 (fn--string-words s2))

Why sort the words, if you are doing a set operation afterwards?

>          (num (+ (length w1) (length w2)))
>          (com (- num (length (cl-set-exclusive-or w1 w2 :test #'string=)))))
>     (/ com num 1.0)))
>
> (provide 'fun-names)
> ;;; fun-names.el ends here

-- 
	Philip Kaludercic on peregrine

Re: fun-names.el --- avoid function duplication

[Emanuel Berg]

Philip Kaludercic wrote:

>> I wrote it in the style Mr. Kaludercic prefers, let's see
>> if he can still find things to improve :)
>
> I assume you mean the file structure?

Oh, a lot of things! See your own diff from the other day what
changes you made :)

Now the software can output a list like this:

search for: gnus-group-mark-buffer

 1. gnus-group-mark-group            0.88
 2. gnus-group-mark-regexp           0.75
 3. gnus-group-mark-region           0.75
 4. gnus-group-setup-buffer          0.75
 5. gnus-uu-mark-buffer              0.75
 6. gnus-group-remove-mark           0.75
 7. gnus-group-mark-update           0.75
 8. gnus-group-set-mark              0.75
 9. gnus-update-group-mark-positions 0.67
10. gnus-summary-walk-group-buffer   0.67

Compare with `apropos', which I think is what most people
are thinking.

Do M-x apropos RET gnus group mark buffer RET and you get
3864 hits, starting with `Buffer-menu--unmark' and ending with
`w3m-bookmark-save-buffer'.

Do M-x apropos-function RET gnus group mark buffer RET and you
get 1615 lines of output, endpoints as above.

Do M-x apropos-function RET gnus-group-mark-buffer RET you get
1 hit: `gnus-group-mark-buffer'.

See version: 1.2.4, same URL:

  https://dataswamp.org/~incal/emacs-init/fun-names.el

We can take this by mail-only if we don't want to bother the
list with details.

-- 
underground experts united
https://dataswamp.org/~incal

Re: fun-names.el --- avoid function duplication

[Emanuel Berg]

Philip Kaludercic wrote:

> Why not use `mapatoms'?  [...]
> why not use [^[:alnum:]] here? [...]
> Why sort the words

OK! Fixed.

But I'm keeping `cl-sort'.

;;; fun-names.el --- avoid function duplication -*- lexical-binding: t -*-
;;
;; Author: Emanuel Berg <incal@dataswamp.org>
;; Created: 2024-07-27
;; Keywords: matching
;; License: GPL3+
;; URL: https://dataswamp.org/~incal/emacs-init/fun-names.el
;; Version: 1.3.5
;;
;;; Commentary:
;;
;; Avoid function duplication based on function names.
;;
;; Use the function `fun-names' like in the below examples to
;; find out what other functions already use the same words in
;; their names, and to what degree.
;;
;; (fun-names #'fn--string-words) ; nil
;;
;; (fun-names #'gnus-group-mark-buffer)
;;
;;   ((gnus-group-mark-group  0.875)
;;    (gnus-group-mark-regexp 0.75 )
;;    (gnus-group-mark-region 0.75 ) ... )
;;
;; output a report:
;;
;; (fun-names #'gnus-group-mark-buffer 0.65 t)  ; all
;; (fun-names #'gnus-group-mark-buffer 0.65 10) ; top 10
;;
;;   1. gnus-group-mark-group   0.88
;;   2. gnus-group-mark-regexp  0.75
;;   3. gnus-group-mark-region  0.75
;;   4. gnus-group-setup-buffer 0.75
;;   5. gnus-uu-mark-buffer     0.75 ...
;;
;;; Code:

(require 'cl-lib)
(require 'subr-x)

(defun fun-names (fun &optional limit report)
  (unless (stringp fun)
    (setq fun (symbol-name fun)))
  (unless limit
    (setq limit 0.7))
  (let ((similar)
        (ratio))
    (mapatoms
      (lambda (e)
        (when (functionp e)
          (setq ratio (fn--same-words fun (symbol-name e)))
          (when (and (<= limit ratio)
                     (<  ratio 1))
            (push (list e ratio) similar)))))
    (let ((sorted (cl-sort similar #'> :key #'cadr)))
      (if report
          (fn--report sorted report fun)
        sorted))))

(defun fn--report (data &optional max strs)
  (when (numberp max)
    (setq data (take max data)))
  (let ((buf (get-buffer-create "*fun-names*"))
        (pad (1+ (apply #'max (mapcar (lambda (e) (length (symbol-name (car e)))) data)))))
    (with-current-buffer buf
      (erase-buffer)
      (insert (format "search: %s\n\n" strs))
      (cl-loop
        for i from 1
        for (n r) in data
        do (insert (format "%2d. %s%.2f\n" i (string-pad (symbol-name n) pad) r)))
      (goto-char (point-min)))
    (pop-to-buffer buf)))

(defun fn--string-words (str &optional sort keep-case)
  (unless keep-case
    (setq str (downcase str)))
  (let ((words (split-string str "[^[:alnum:]]+" t "[[:punct:]]+")))
    (if sort
        (sort words)
      words)))

(defun fn--same-words (s1 s2)
  (let* ((w1 (fn--string-words s1))
         (w2 (fn--string-words s2))
         (num (+ (length w1) (length w2)))
         (com (- num (length (cl-set-exclusive-or w1 w2 :test #'string=)))))
    (/ com num 1.0)))

(provide 'fun-names)
;;; fun-names.el ends here

-- 
underground experts united
https://dataswamp.org/~incal

Re: fun-names.el --- avoid function duplication

[Emanuel Berg]

>> Why not use `mapatoms'?  [...]
>> why not use [^[:alnum:]] here? [...]
>> Why sort the words
>
> OK! Fixed.
>
> But I'm keeping `cl-sort' [...]

Right, one shouldn't develop things on a mailing list!
Now I remember.

Just publish when it is done. I knew that, now it
has surfaced.

But I always think, "now it is done, now I can post it".
But when I think that the first time, I think something closer
to 25% is done.

Mistake, don't be annoyed.

Now it really is done, version 1.6.12:

  https://dataswamp.org/~incal/emacs-init/fun-names.el

[ *shop closed* No more on this then! \o/ ]

-- 
underground experts united
https://dataswamp.org/~incal

Re: fun-names.el --- avoid function duplication

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

It is an interestng feature, but the name led me to think
it was just for amusement ;-{.

I suggest considering variables as well as functions, and renaming the
command to "related-names" or something like that.

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

Re: fun-names.el --- avoid function duplication

[Emanuel Berg]

Richard Stallman wrote:

> It is an interestng feature, but the name led me to think it
> was just for amusement ;-{.
>
> I suggest considering variables as well as functions, and
> renaming the command to "related-names" or something
> like that.

Variables are planned for ... here is the most recent version:

;;; fun-names.el --- duplicate hunter -*- lexical-binding: t -*-
;;
;; Author: Emanuel Berg <incal@dataswamp.org>
;; Created: 2024-07-27
;; Git: git clone https://dataswamp.org/~incal/fun-names.git
;; Keywords: matching
;; License: GPL3+
;; URL: https://dataswamp.org/~incal/elpa/fun-names.el
;; Version: 6.0.3
;;
;;; Commentary:
;;
;; __________________________________________________________
;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-
;;
;;   fun-names.el -- duplicate hunter            incal 2024
;;
;; __________________________________________________________
;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-
;;
;; Use `fun-names' with a function symbol, a function name or
;; just an arbitrary sequence of words. It will then show you
;; a table of other functions that are currently defined that
;; have the same words in their names. The table have data to
;; quantify to what degree the names are similar.
;;
;; Here is how the table will look for all varieties of "gnus
;; group mark buffer", #'gnus-group-mark-buffer, and so on:
;;
;;    1. gnus-group-mark-group         0.88  3  +9
;;    2. gnus-group-mark-regexp        0.75  3  +9
;;    3. gnus-group-mark-region        0.75  3  +9
;;    4. gnus-group-mark-update        0.75  3  +9
;;    5. gnus-group-setup-buffer       0.75  3  +8
;;    6. gnus-uu-mark-buffer           0.75  3  +7
;;    7. gnus-group-remove-mark        0.75  2  +7
;;    8. gnus-group-set-mark           0.75  2  +7
;;    9. gnus-group-mark-line-p        0.67  3  +9
;;   10. gnus-group-mark-article-read  0.67  3  +9
;;
;; One use case can be for you to find such functions and put
;; them to use instead of writing new ones that are the same,
;; often.
;;
;; Also available is `fun-names-short' - it is faster, output
;; is shown in the echo area, there is no report compiled nor
;; is there a change of buffer (less disruptive). In practice
;; `fun-names-short' is often enough.
;;
;; ----------------------------------------------------------
;;
;; Basic interactive use:
;;
;;   M-x fun-names       RET split string buffer RET
;;   M-x fun-names-short RET kill-current-buffer RET
;;
;; Special interactive use:
;;
;;   M-x     fun-names RET RET ; input `symbol-at-point'
;;   C-u M-x fun-names RET RET ; change default settings
;;
;; ----------------------------------------------------------
;;
;; Let's compare `fun-names-short' to `apropos-function' used
;; with the same indata. First `apropos-function' then:
;;
;;   M-x apropos-function RET use-package-ensure-elpa RET
;;   "No apropos matches for use-package-ensure-elpa"
;;
;; And now we do `fun-names-short':
;;
;;   M-x fun-names-short RET use-package-ensure-elpa RET
;;   "use-package-normalize/:ensure  0.75  2  +7"
;;
;; ----------------------------------------------------------
;;
;; We can also compare the above result table with the result
;; from `apropos-function'. The search string for `fun-names'
;; was then "gnus group mark buffer", and for that the number
;; one hit was `gnus-group-mark-group', a 88% match.
;;
;; We do the same with `apropos-function'
;;
;;   M-x apropos-function RET gnus group mark buffer RET
;;
;; and we get 704 results. Sorted in ABC order from the first
;; Buffer-menu--unmark to the final w3m-bookmark-save-buffer.
;;
;; ----------------------------------------------------------
;;
;;; Code:

(require 'cl-lib)
(require 'pcase)
(require 'subr-x)
(require 'thingatpt)

(let ((fun-last   #'fun-names-short)
      (limit-def  0.5)
      (report-def 10))

  (defun funa--interface ()
    (when current-prefix-arg
      (setq limit-def  (read-number "limit: " limit-def))
      (setq report-def (read-number "lines: " report-def)))
    (let* ((def (or (symbol-at-point) fun-last))
           (ps  (format "fun words%s: " (if def (format " [%s]" def) "")))
           (fun (read-string ps nil nil def)))
      (when fun
        (setq fun-last fun))
      (list fun limit-def report-def)))

  (defun fun-names (fun &optional limit report)
    "Examine if the words in FUN appear in any function names.

If the proximity is higher than LIMIT (which defaults to 0.5),
then function function is included in the computation.

If REPORT is

  0   - no report, only return data
  8   - make a report, 8 lines long
  nil - make a report, default size
  t   - make a report, the full one

To set default options do:

   \\[universal-argument] \\[execute-extended-command] fun-names RET

Also try: `fun-names-short'

Proximity is based on the same words appearing in the same order."
    (interactive (funa--interface))
    (when (symbolp fun)
      (setq fun (symbol-name fun)))
    (unless limit
      (setq limit limit-def))
    (unless report
      (setq report report-def))
    (let ((similar)
          (estr)
          (ratio)
          (bonus))
      (mapatoms
        (lambda (e)
          (when (functionp e)
            (setq estr  (symbol-name e))
            (setq ratio (funa--words-same fun estr))
            (when (and (<= limit ratio)
                       (<  ratio 1))
              (setq bonus (funa--words-same-pos fun estr))
              (push `(,e ,ratio ,@bonus) similar)))))
      (let* ((sorted (cl-sort similar #'funa--words>)))
        (if (and (numberp report) (zerop report))
            sorted
          (funa--report sorted fun report)))))

  (declare-function funa--interface nil)
  (declare-function fun-names nil))

(defun fun-names-short (fun &optional _limit _report)
  "Echo what function has a name the closest to FUN.

See `fun-names'."
  (interactive (funa--interface))
  (let ((rec (car (fun-names fun nil 0))))
    (if rec
        (pcase-let ((`(,n ,r ,b ,p) rec))
          (message (funa--data-string 0 n r b p)))
      (message "unique"))))

(defun funa--data-string (i n r b p &optional pad)
  (unless pad
    (setq pad 0))
  (unless (stringp n)
    (setq n (symbol-name n)) )
  (let ((bp   (if (< 0 b) (format "  %d  %+d" b p) ""))
        (npad (string-pad n pad)))
    (if (zerop i)
        (format "%s  %.2f%s" n r bp)
      (format "%2d. %s %.2f%s\n" i npad r bp))))

(defun funa--report (data strs &optional lines)
  (when data
    (when (numberp lines)
      (setq data (take lines data)))
    (let ((buf (get-buffer-create "*fun-names*"))
          (pad (1+ (apply #'max (mapcar (lambda (e) (length (symbol-name (car e)))) data)))))
      (with-current-buffer buf
        (erase-buffer)
        (insert (format "search: %s\n\n" strs))
        (cl-loop
          for i from 1
          for (n r b p) in data
          do (insert (funa--data-string i n r b p pad)))
        (goto-char (point-min)))
      (pop-to-buffer buf))))

;; __________________________________________________________
;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-
;;
;;                       NEW WORD ORDER
;;
;;    String proximity by words, a non-strict total order.
;; __________________________________________________________
;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-

(defun funa--words-from-string (s)
  (split-string (downcase s) "[^[:alnum:]]+" t))

(defun funa--words (s1 s2)
  (unless (listp s1)
    (setq s1 (funa--words-from-string s1)))
  (unless (listp s2)
    (setq s2 (funa--words-from-string s2)))
  `(,(funa--words-same s1 s2) ,@(funa--words-same-pos s1 s2)))

(defun funa--words-same (s1 s2)
  (unless (listp s1)
    (setq s1 (funa--words-from-string s1)))
  (unless (listp s2)
    (setq s2 (funa--words-from-string s2)))
  (if (and s1 s2)
      (let* ((num (+ (length s1) (length s2)))
             (com (- num (length (cl-set-exclusive-or s1 s2 :test #'string=)))))
        (/ com num 1.0))
    0.0))

(defun funa--words-same-pos (s1 s2)
  (unless (listp s1)
    (setq s1 (funa--words-from-string s1)))
  (unless (listp s2)
    (setq s2 (funa--words-from-string s2)))
  (cl-loop
    with short  = (min (length s1) (length s2))
    with hits = 0
    with pnts = 0
    for i downfrom short
    for a in s1
    for b in s2
    do (when (string= a b)
         (cl-incf hits)
         (cl-incf pnts i))
    finally return (list hits pnts)))

(defun funa--words< (p1 p2)
  (pcase-let ((`(,r1 ,b1 ,e1) (last p1 3))
              (`(,r2 ,b2 ,e2) (last p2 3)))
    (or
      (< r1 r2)
      (and (= r1 r2) (< b1 b2))
      (and (= r1 r2) (= b1 b2) (< e1 e2)))))

(defun funa--words<= (p1 p2)
  (funa--words< p2 p1))

(defun funa--words= (p1 p2)
  (or (funa--words< p1 p2)
      (funa--words< p2 p1)))

(defun funa--words>= (p1 p2)
  (funa--words< p2 p1))

(defun funa--words> (p1 p2)
  (funa--words< p2 p1))

(provide 'fun-names)
;;; fun-names.el ends here

-- 
underground experts united
https://dataswamp.org/~incal

Re: fun-names.el --- avoid function duplication

[Emanuel Berg]

>> It is an interestng feature, but the name led me to think
>> it was just for amusement ;-{.
>>
>> I suggest considering variables as well as functions, and
>> renaming the command to "related-names" or something
>> like that.
>
> Variables are planned for [...]

Now variables are included (with `boundp'), also everything in
the obarray can be included (with `always').

The new functions are `fun-names-all', `fun-names-all-short',
`fun-names-vars', `fun-names-vars-short'.

So a lot of fun names there are :)

;;; fun-names.el --- duplicate hunter -*- lexical-binding: t -*-
;;
;; Author: Emanuel Berg <incal@dataswamp.org>
;; Created: 2024-07-27
;; Git: git clone https://dataswamp.org/~incal/fun-names.git
;; Keywords: matching
;; License: GPL3+
;; URL: https://dataswamp.org/~incal/elpa/fun-names.el
;; Version: 6.0.14
;;
;;; Commentary:
;;
;; __________________________________________________________
;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-
;;
;;              fun-names.el -- duplicate hunter
;;
;; __________________________________________________________
;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-
;;
;; Use `fun-names' with a function symbol, a function name or
;; just an arbitrary sequence of words. It will then show you
;; a table of other functions that are currently defined that
;; have the same words in their names. The table have data to
;; quantify to what degree the names are similar.
;;
;; Here is how the table will look for all varieties of "gnus
;; group mark buffer", #'gnus-group-mark-buffer, and so on:
;;
;;    1. gnus-group-mark-group         0.88  3  +9
;;    2. gnus-group-mark-regexp        0.75  3  +9
;;    3. gnus-group-mark-region        0.75  3  +9
;;    4. gnus-group-mark-update        0.75  3  +9
;;    5. gnus-group-setup-buffer       0.75  3  +8
;;    6. gnus-uu-mark-buffer           0.75  3  +7
;;    7. gnus-group-remove-mark        0.75  2  +7
;;    8. gnus-group-set-mark           0.75  2  +7
;;    9. gnus-group-mark-line-p        0.67  3  +9
;;   10. gnus-group-mark-article-read  0.67  3  +9
;;
;; One use case can be for you to find such functions and put
;; them to use instead of writing new ones that are the same.
;;
;; Also available is `fun-names-short' - it is faster, output
;; is shown in the echo area, there is no report compiled nor
;; is there a change of buffer, so it can be less disruptive.
;;
;; Also see: `fun-names-all', `fun-names-all-short'
;;           `fun-names-vars', `fun-names-vars-short'
;;
;; ----------------------------------------------------------
;;
;; Basic interactive use:
;;
;;   M-x fun-names       RET split string buffer RET
;;   M-x fun-names-short RET kill-current-buffer RET
;;
;; Special interactive use:
;;
;;   M-x     fun-names RET RET ; input `symbol-at-point'
;;   C-u M-x fun-names RET RET ; change default settings
;;
;; ----------------------------------------------------------
;;
;;; Code:

(require 'cl-lib)
(require 'pcase)
(require 'subr-x)
(require 'thingatpt)

(let ((fun-last   #'fun-names-short)
      (limit-def  0.5)
      (report-def 10))

  (defun funa--interface ()
    (when current-prefix-arg
      (setq limit-def  (read-number "limit: " limit-def))
      (setq report-def (read-number "lines: " report-def)))
    (let* ((def (or (symbol-at-point) fun-last))
           (ps  (format "fun words%s: " (if def (format " [%s]" def) "")))
           (fun (read-string ps nil nil def)))
      (when fun
        (setq fun-last fun))
      (list fun limit-def report-def)))

  (defun fun-names (fun &optional limit report pred)
    "Examine if the words in FUN appear in any function names.

If the proximity is higher than LIMIT (which defaults to 0.5),
then function function is included in the computation.

If REPORT is

  0   - no report, only return data
  8   - make a report, 8 lines long
  nil - make a report, default size
  t   - make a report, the full one

PRED is the function to sort the obarray, it is by default
`functionp'.

To set default options do:

   \\[universal-argument] \\[execute-extended-command] fun-names RET

Also try: `fun-names-short'

Proximity is based on the same words appearing in the same order."
    (interactive (funa--interface))
    (when (symbolp fun)
      (setq fun (symbol-name fun)))
    (unless limit
      (setq limit limit-def))
    (unless report
      (setq report report-def))
    (unless pred
      (setq pred #'functionp))
    (let ((similar)
          (estr)
          (ratio)
          (bonus))
      (mapatoms
        (lambda (e)
          (when (funcall pred e)
            (setq estr  (symbol-name e))
            (setq ratio (funa--words-same fun estr))
            (when (and (<= limit ratio)
                       (<  ratio 1))
              (setq bonus (funa--words-same-pos fun estr))
              (push `(,e ,ratio ,@bonus) similar)))))
      (let* ((sorted (cl-sort similar #'funa--words>)))
        (if (and (numberp report) (zerop report))
            sorted
          (funa--report sorted fun report)))))

  (declare-function fun-names       nil)
  (declare-function funa--interface nil))

(defun fun-names-all (fun &optional limit report _pred)
  (interactive (funa--interface))
  (fun-names fun limit report #'always))

(defun fun-names-all-short (fun &optional limit report _pred)
  (interactive (funa--interface))
  (fun-names-short fun limit report #'always))

(defun fun-names-vars (fun &optional limit report _pred)
  (interactive (funa--interface))
  (fun-names fun limit report #'boundp))

(defun fun-names-vars-short (fun &optional limit report _pred)
  (interactive (funa--interface))
  (fun-names-short fun limit report #'boundp))

(defun fun-names-short (fun &optional _limit _report pred)
  "Echo what function has a name the closest to FUN.

See `fun-names'."
  (interactive (funa--interface))
  (let ((rec (car (fun-names fun nil 0 pred))))
    (if rec
        (pcase-let ((`(,n ,r ,b ,p) rec))
          (message (funa--data-string 0 n r b p)))
      (message "unique"))))

(defun funa--data-string (i n r b p &optional pad)
  (unless pad
    (setq pad 0))
  (unless (stringp n)
    (setq n (symbol-name n)) )
  (let ((bp   (if (< 0 b) (format "  %d  %+d" b p) ""))
        (npad (string-pad n pad)))
    (if (zerop i)
        (format "%s  %.2f%s" n r bp)
      (format "%2d. %s %.2f%s\n" i npad r bp))))

(defun funa--report (data strs &optional lines)
  (when data
    (when (numberp lines)
      (setq data (take lines data)))
    (let ((buf (get-buffer-create "*fun-names*"))
          (pad (1+ (apply #'max (mapcar (lambda (e) (length (symbol-name (car e)))) data)))))
      (with-current-buffer buf
        (erase-buffer)
        (insert (format "search: %s\n\n" strs))
        (cl-loop
          for i from 1
          for (n r b p) in data
          do (insert (funa--data-string i n r b p pad)))
        (goto-char (point-min)))
      (pop-to-buffer buf))))

;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;         New word order
;;
;;   String proximity by words
;;   as a non-strict total order.
;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(defun funa--words-from-string (s)
  (split-string (downcase s) "[^[:alnum:]]+" t))

(defun funa--words (s1 s2)
  (unless (listp s1)
    (setq s1 (funa--words-from-string s1)))
  (unless (listp s2)
    (setq s2 (funa--words-from-string s2)))
  `(,(funa--words-same s1 s2) ,@(funa--words-same-pos s1 s2)))

(defun funa--words-same (s1 s2)
  (unless (listp s1)
    (setq s1 (funa--words-from-string s1)))
  (unless (listp s2)
    (setq s2 (funa--words-from-string s2)))
  (if (and s1 s2)
      (let* ((num (+ (length s1) (length s2)))
             (com (- num (length (cl-set-exclusive-or s1 s2 :test #'string=)))))
        (/ com num 1.0))
    0.0))

(defun funa--words-same-pos (s1 s2)
  (unless (listp s1)
    (setq s1 (funa--words-from-string s1)))
  (unless (listp s2)
    (setq s2 (funa--words-from-string s2)))
  (cl-loop
    with short  = (min (length s1) (length s2))
    with hits = 0
    with pnts = 0
    for i downfrom short
    for a in s1
    for b in s2
    do (when (string= a b)
         (cl-incf hits)
         (cl-incf pnts i))
    finally return (list hits pnts)))

(defun funa--words< (p1 p2)
  (pcase-let ((`(,r1 ,b1 ,e1) (last p1 3))
              (`(,r2 ,b2 ,e2) (last p2 3)))
    (or
      (< r1 r2)
      (and (= r1 r2) (< b1 b2))
      (and (= r1 r2) (= b1 b2) (< e1 e2)))))

(defun funa--words<= (p1 p2)
  (funa--words< p2 p1))

(defun funa--words= (p1 p2)
  (or (funa--words< p1 p2)
      (funa--words< p2 p1)))

(defun funa--words>= (p1 p2)
  (funa--words< p2 p1))

(defun funa--words> (p1 p2)
  (funa--words< p2 p1))

(provide 'fun-names)
;;; fun-names.el ends here

-- 
underground experts united
https://dataswamp.org/~incal

Re: fun-names.el --- avoid function duplication

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > > I suggest considering variables as well as functions, and
  > > renaming the command to "related-names" or something
  > > like that.

  > Variables are planned for ... here is the most recent version:

Since the point is to see what related names are already in use,
I suggest always searching ALL the various namespaces that could
be pertinent to making a good choice of a new name.

So if you're looking for a new name, whether it is for a function or a
variable or a custom group or something else, you would like to know
about functions and variables and custom groups.

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

Re: fun-names.el --- avoid function duplication

[Emanuel Berg]

> https://dataswamp.org/~incal/elpa/fun-names.el
> git clone https://dataswamp.org/~incal/fun-names.git

Now at version: 6.3.7
(That is 2467 updates!)

Now outputs a very good-looking table!

(scrambled up? blame your client and go here:
  https://dataswamp.org/~incal/emacs-data/fun-names.txt )

Unless there is any new ideas from anyone, I think I'll close
this as well then.

That means - it is all finally done? :O

Maybe! \o/

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
POS            SYMBOL             WRDS  H  P
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1. gnus-group-mark-group         0.88  3  9
 2. gnus-group-mark-regexp        0.75  3  9
 3. gnus-group-mark-region        0.75  3  9
 4. gnus-group-mark-update        0.75  3  9
 5. gnus-group-setup-buffer       0.75  3  8
 6. gnus-uu-mark-buffer           0.75  3  7
 7. gnus-group-remove-mark        0.75  2  7
 8. gnus-group-set-mark           0.75  2  7
 9. gnus-group-mark-line-p        0.67  3  9
10. gnus-group-mark-article-read  0.67  3  9
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

-- 
underground experts united
https://dataswamp.org/~incal