File: c-sig.el

package info (click to toggle)
c-sig 3.8-22
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 144 kB
  • sloc: lisp: 517; makefile: 7
file content (631 lines) | stat: -rw-r--r-- 19,052 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
;; c-sig.el		signature tool for news and mail

;; Copyright (C) 1995-1999 Free Software Foundation, Inc.

;; Author: Ken Shibata <kshibata@tky.3web.ne.jp>
;; Maintainer: Ken Shibata <kshibata@tky.3web.ne.jp>
;; Created: Sep 1995 - first release to internet
;; Modified: Jun 1999 - wrote English documents
;; Version: $Id: c-sig.el,v 3.8 1999/06/10 00:00:00 kshibata Exp kshibata $
;; Keywords: mail news signature

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

(provide 'c-sig)
(require 'mail-utils)

(defconst c-sig-version-number "3.8")

(defun c-sig-version ()
  (interactive)
  (message "Using c-sig version %s" c-sig-version-number))


(defvar sig-replace-string nil
  "non-nil, replace strings in signature.")

(defvar sig-insert-end nil
  "non-nil, insert signature at the of the mail.\n\
nil, insert signature before current line.")

(defvar sig-purge t
  "if non-nil, purge void line at the end of mail,\n\
and if the value is string, insert it there.")

(defvar sig-separator nil
  "if string is set, insert it before signature.")

(defvar sig-save-to-sig-name-alist t
  "if non-nil, activate sig-name-alist")

(defvar sig-default-name nil
  "default signature name")

(defvar sig-save-file-every-change t
  "if non-nil, save sig-alist-file every time you made changes.
if nil, save sig-alist-file in kill-emacs.")

(defvar sig-make-backup-files t
  "if t, make backup file for sig-alist-file")

(defvar sig-end-of-headers "^$\\|^--"
  "Regular expression to look for the end of headers")

(defvar sig-search-functions (list 'sig-search-name-alist 'sig-search-regexp)
  "")

(defvar sig-random-sig-list nil
  "list of random signature")

(defvar sig-replace-string-file (expand-file-name "~/.signature.replace")
  "File name for replace strings")

(defvar sig-alist-file (expand-file-name "~/.signature.alist")
  "File name for alists")

(defvar c-sig-load-hook nil
  "User definable hook. Runs after c-sig is loaded.")

(defvar sig-buffer-name "*sig-buffer*")
(defvar sig-editor-name "*sig-editor*")
(defvar sig-electric-mode-map nil
  "*Keymap for sig-electric-mode.")
(defvar sig-alist nil)
(defvar sig-name-alist nil)
(defvar sig-regexp-alist nil)

(setq sig-need-to-save nil)
(setq sig-delete-mode nil)
(setq sig-normal-mode t)

(if (file-exists-p sig-alist-file)
    (load sig-alist-file))

(if (not sig-save-file-every-change)
    (progn
      (if (not (fboundp 'c-sig-orig:kill-emacs))
	  (fset 'c-sig-orig:kill-emacs (symbol-function 'kill-emacs)))
      (defun c-sig:kill-emacs (&optional query)
	(interactive "P")
	(write-sig-file)
	(c-sig-orig:kill-emacs query))
      (fset 'kill-emacs
	    (symbol-function 'c-sig:kill-emacs))))

(if sig-electric-mode-map
    nil
  (setq sig-electric-mode-map (make-sparse-keymap))
  (define-key sig-electric-mode-map "p"     'sig-eref-prev)
  (define-key sig-electric-mode-map "P"     'sig-eref-prev)
  (define-key sig-electric-mode-map "n"     'sig-eref-next)
  (define-key sig-electric-mode-map "N"     'sig-eref-next)
  (define-key sig-electric-mode-map "q"     'sig-eref-abort)
  (define-key sig-electric-mode-map "Q"     'sig-eref-abort)
  (define-key sig-electric-mode-map "\r"    'sig-eref-exit)
  (define-key sig-electric-mode-map "\n"    'sig-eref-exit)
  (define-key sig-electric-mode-map "x"     'sig-eref-exit)
  (define-key sig-electric-mode-map "X"     'sig-eref-exit)
  )

(defvar sig-msg1 "Name of Signature: ")
(defvar sig-msg2 "Need to specify a name of the signature")
(defvar sig-msg3 "The signature name is already exists. Do you want to override it?")
(defvar sig-msg4 "Saving...")
(defvar sig-msg5 "Done")
(defvar sig-msg6 "No signature is registered.")
(defvar sig-msg7 "Are you sure ? ")
(defvar sig-msg8 "Regiser this signature for %s? ")

(defun insert-signature-eref (&optional arg)
  "Insert signature from signature alist.
If optinal argument ARG is non-nil, move selected signature
to the head of sig-alist."
  (interactive "P")
  (if sig-alist
      (let* ((sig-def-name "")
	     (sig-key nil)
	     (sig nil))
	(if (setq sig (sig-electric-mode
		       (setq sig-def-name
			     (sig-search-default-signature))))
	    (progn
	      (sig-insert-sig-internal (cdr sig))
	      (if arg
		  (progn
		    (asort 'sig-alist (car sig))
		    (setq sig-need-to-save t)))
	      (if (and sig-save-to-sig-name-alist
		       sig-key
		       (not (string= sig-def-name (car sig)))
		       (y-or-n-p (format sig-msg8 sig-key)))
		  (progn
		    (setq sig-need-to-save t)
		    (aput 'sig-name-alist sig-key (car sig))))
	      (if sig-save-file-every-change
		  (write-sig-file)))))))

(defun insert-signature-randomly ()
  "Insert signature from signature alist randomly."
  (interactive)
  (if sig-alist
      (sig-insert-sig-internal
       (cdr (assoc (sig-get-random-signature) sig-alist )))
    (message sig-msg6)))

(defun insert-signature-automatically ()
  "Insert signature automatically."
  (interactive)
  (let ((sig-key nil))
    (if sig-alist
	(let ((sig-name (sig-search-default-signature)))
	  (sig-insert-sig-internal (if sig-name
				       (cdr (assoc sig-name sig-alist))
				     "")))
      (message sig-msg6))))

(defun sig-insert-sig-internal (sig)
  (if sig
      (save-excursion
	(if sig-purge
	    (sig-purge-void-lines))
	(if (string= sig "")
	    nil
	  (if sig-normal-mode
	      (progn
		(if sig-replace-string
		    (setq sig (sig-replace-string-function sig)))
		(if (fboundp 'sig-filter-function)
		    (setq sig (sig-filter-function sig)))))
	  (if sig-insert-end
	      (goto-char (point-max))
	    (beginning-of-line))
	  (if sig-separator
	      (insert sig-separator))
	  (insert sig))
	(set-buffer-modified-p (buffer-modified-p)))))
  
(defun add-signature ()
  "add new signature into a signature alist."
  (interactive)
  (save-excursion
    (save-window-excursion
      (delete-other-windows)
      (pop-to-buffer sig-editor-name)
      (kill-all-local-variables)
      (local-set-key "\C-c\C-c" 'save-and-exit-signature)
      (local-set-key "\C-c\C-s" 'save-signature)
      (local-set-key "\C-c\C-i" (function
				 (lambda ()
				   (interactive)
				   (let ((sig-separator nil)
					 (sig-save-to-sig-name-alist nil)
					 (sig-normal-mode nil)
					 (sig-purge nil))
				     (insert-signature-eref)))))
      (local-set-key "\C-c\C-q" 'quit-signature)
      (local-set-key "\C-x\C-s" 'save-signature)
      (local-set-key "\C-xk" 'quit-signature)
      (recursive-edit)
      (kill-buffer sig-editor-name))))

(defun delete-signature ()
  "delete signature from signature alist."
  (interactive)
  (if sig-alist
      (let* ((sig (car (sig-electric-mode nil t))))
	(if sig
	    (progn
	      (save-excursion
		(adelete 'sig-alist sig)
		(setq sig-need-to-save t)
		(if sig-save-file-every-change
		    (write-sig-file))
		(message sig-msg5)))))
    (message sig-msg6)))

(defun sig-purge-void-lines ()
  "purge void line at the end of mail."
  (interactive)
  (save-excursion
    (save-restriction
      (let ((cur-pos (point)))
	(if (and (bolp)
		 (eolp)
		 (progn	
		   (while (eq (following-char) ?\n)
		     (forward-char))
		   (eobp)))
	    (delete-region cur-pos (point-max)))
	(goto-char (point-max))
	(if (bolp)
	    (progn
	      (backward-char)
	      (while (eq (preceding-char) ?\n)
		(delete-backward-char 1)))
	  (insert "\n"))
	(if (stringp sig-purge)
	    (progn
	      (goto-char (point-max))
	      (insert sig-purge)))))))


(defun read-sig-file ()
  "read signature database"
  (interactive)
  (load sig-alist-file)
  (setq sig-need-to-save nil))

(defun write-sig-file ()
  "write signature database"
  (interactive)
  (if sig-need-to-save
      (let ((make-backup-files sig-make-backup-files)
	    (version-control nil))
	(message sig-msg4)
	(set-buffer (get-buffer-create " *sig-alist*"))
	(erase-buffer)
;;;
;;; sig-alist
;;;
	(if sig-alist
	    (progn
	      (insert "(setq sig-alist '(\n")
	      (mapcar '(lambda (element)
			 (insert "( "
				 (prin1-to-string (car element))
				 " .\n"
				 (prin1-to-string (cdr element))
				 ")\n"))
		      sig-alist)
	      (insert "))\n\n"))
	  (insert "(setq sig-alist nil)\n\n"))
;;;
;;; sig-name-alist
;;;
	(if sig-name-alist
	    (progn
	      (insert "(setq sig-name-alist '(\n")
	      (mapcar '(lambda (element)
			 (insert (prin1-to-string element) "\n"))
		      sig-name-alist)
	      (insert "))\n"))
	    (insert "(setq sig-name-alist nil)\n"))
;;;
;;; sig-regexp-alist
;;;
	(if sig-regexp-alist
	    (progn
	      (insert "(setq sig-regexp-alist '(\n")
	      (mapcar '(lambda (element)
			 (insert "(" (prin1-to-string (car element)) "\n")
			 (mapcar '(lambda (element2)
				    (insert "\t" (prin1-to-string element2)
					      "\n"))
				 (cdr element))
			 (insert ")\n"))
		      sig-regexp-alist)
	      (insert "))\n"))
	    (insert "(setq sig-regexp-alist nil)\n"))
;;;
;;; file close
;;;
	(write-file sig-alist-file)
	(kill-buffer (current-buffer))
	(setq sig-need-to-save nil)
	(message sig-msg5))))

(defun sig-electric-mode (begin &optional arg)
  (let* ((signature nil)
	 (sig-cur-num 0)
	 (sig-max-num (length sig-alist))
	 (work sig-alist))
    (if (and begin (cdr (assoc begin sig-alist)))
	(while (not (string= (car (car work)) begin))
	  (setq sig-cur-num (1+ sig-cur-num))
	  (setq work (cdr work))))
    (save-excursion
      (save-window-excursion
	(get-buffer-create sig-buffer-name)
	(pop-to-buffer sig-buffer-name)
	(kill-all-local-variables)
	(setq mode-name "Sig"
	      major-mode 'sig-electric-mode)
	(use-local-map sig-electric-mode-map)
	(setq sig-delete-mode arg)
	(set-buffer sig-buffer-name)
	(setq buffer-read-only t)
	(sig-eref-show)
	(recursive-edit)
	(kill-buffer sig-buffer-name)))
    signature))

(defun sig-eref-show (&optional arg)
  "Show reference INDEX in sc-rewrite-header-list."
  (save-excursion
    (set-buffer sig-buffer-name)
    (let ((buffer-read-only nil))
      (erase-buffer)
      (goto-char (point-min))
      (insert (cdr (setq signature (nth sig-cur-num sig-alist))))
      (setq mode-line-process (concat " : " (car signature))))))

(defun sig-eref-next ()
  "Display next reference in other buffer."
  (interactive)
  (if (eq sig-max-num (setq sig-cur-num (1+ sig-cur-num)))
      (setq sig-cur-num 0))
  (sig-eref-show))

(defun sig-eref-prev ()
  "Display previous reference in other buffer."
  (interactive)
  (setq sig-cur-num (if (eq sig-cur-num 0)
			(1- sig-max-num)
		      (1- sig-cur-num)))
  (sig-eref-show))

(defun sig-eref-abort ()
  "Exit from electric reference mode without inserting reference."
  (interactive)
  (setq signature nil)
  (exit-recursive-edit))

(defun sig-eref-exit ()
  "Exit from electric reference mode and insert selected reference."
  (interactive)
  (if (and sig-delete-mode (not (y-or-n-p sig-msg7)))
      (message "")
    (exit-recursive-edit)))

(defun save-and-exit-signature ()
  ""
  (interactive)
  (save-signature)
  (exit-recursive-edit))

(defun quit-signature ()
  ""
  (interactive)
  (exit-recursive-edit))

(defun save-signature ()
  ""
  (interactive)
  (let* ((sig-name (read-input sig-msg1 "")))
    (if (string= sig-name "")
	(error sig-msg2)
      (if (and (cdr (assoc sig-name sig-alist))
	       (not (y-or-n-p sig-msg3)))
	  nil
	(aput 'sig-alist sig-name
	      (buffer-substring (point-min) (point-max)))
	(setq sig-need-to-save t)
	(if sig-save-file-every-change
	    (write-sig-file))))))

;;;
;;; functions for looking for default signature.
;;;
(defun sig-search-default-signature ()
  (let ((ret nil)
	(functions sig-search-functions))
    (while functions
      (if (setq ret (funcall (car functions)))
	  (setq functions nil)
	(setq functions (cdr functions))))
    (or ret sig-default-name)))

(defun sig-search-name-alist ()
  ""
  (let (key keys name pos work)
    (save-excursion
      (save-restriction
	(goto-char (point-min))
 	(if (not (re-search-forward sig-end-of-headers nil t))
	    (goto-char (point-max)))
	(beginning-of-line)
	(narrow-to-region (point-min) (point))
	(setq keys (mail-strip-quoted-names
		    (or (mail-fetch-field "to")
			(mail-fetch-field "newsgroups")
			"")))))
    (while (not (string= keys ""))
      (setq pos (string-match "[ \t\n]*,[ \t\n]*" keys))
      (setq key (substring keys 0 pos))
      (setq keys (if pos (substring keys (match-end 0)) ""))
      (if (setq name (cdr (assoc key sig-name-alist)))
	  (setq sig-key key
		keys "")
	(or sig-key (setq sig-key key))))
    name))

(defun sig-search-regexp ()
  (if sig-regexp-alist
      (let ((w-alist sig-regexp-alist)
	    keys key pos
	    (ret nil))
	(while w-alist
	  (setq keys (mail-strip-quoted-names
		      (mail-fetch-field (car (car w-alist)))))
	  (while keys
	    (setq pos (string-match "[ \t\n]*,[ \t\n]*" keys))
	    (setq key (substring keys 0 pos))
	    (setq keys (if pos (substring keys (match-end 0)) nil))
	    (let ((reg-alist (cdr (car w-alist))))
	      (while reg-alist
		(if (string-match (car (car reg-alist)) key)
		    (setq ret (cdr (car reg-alist))
			  sig-key (mail-strip-quoted-names key)
			  reg-alist nil
			  w-alist nil
			  keys nil)
		  (setq reg-alist (cdr reg-alist))))))
	  (setq w-alist (cdr w-alist)))
	ret)
    nil))

(defun sig-get-random-signature ()
  ""
      (let ((max)
	    (num (random)))
	(if sig-random-sig-list
	    (progn
	      (setq max (length sig-random-sig-list))
	      (setq num (% (if (< num 0) (- num) num) max))
	      (nth num sig-random-sig-list))
	  (setq max (length sig-alist))
	  (setq num (% (if (< num 0) (- num) num) max))
	  (car (nth num sig-alist)))))

(defun sig-replace-string-function (sig)
  ""
  (save-excursion
    (let ((sig-replace-list)
	  (work))
      (if (file-exists-p sig-replace-string-file)
	  (progn
	    (load sig-replace-string-file)
	    (set-buffer (get-buffer-create " *sig-temp*"))
	    (erase-buffer)
	    (insert sig)
	    (while sig-replace-list
	    (goto-char (point-min))
	    (setq work (car (cdr (car sig-replace-list))))
	    (replace-string
	     (car (car sig-replace-list))
;;;;;;
	     (cond
	      ((listp work) (nth (random (length work)) work))
	      ((fboundp work) (funcall work))
	      (t "")))
;;;;;;
	    (setq sig-replace-list (cdr sig-replace-list)))
	    (setq sig (buffer-substring (point-min) (point-max)))
	    (kill-buffer (current-buffer)))))
    sig))


;;; Following functions are taken from sc-alist.el Version 1.0.
;;; sc-alist.el is not included in SuperCite versions 3.X any more.

(defun asort (alist-symbol key)
  "Move a specified key-value pair to the head of an alist.
The alist is referenced by ALIST-SYMBOL. Key-value pair to move to
head is one matching KEY.  Returns the sorted list and doesn't affect
the order of any other key-value pair.  Side effect sets alist to new
sorted list."
  (set alist-symbol
       (sort (copy-alist (eval alist-symbol))
	     (function (lambda (a b) (equal (car a) key))))))


(defun aelement (key value)
  "Makes a list of a cons cell containing car of KEY and cdr of VALUE.
The returned list is suitable as an element of an alist."
  (list (cons key value)))


(defun aheadsym (alist)
  "Return the key symbol at the head of ALIST."
  (car (car alist)))


(defun anot-head-p (alist key)
  "Find out if a specified key-value pair is not at the head of an alist.
The alist to check is specified by ALIST and the key-value pair is the
one matching the supplied KEY.  Returns nil if ALIST is nil, or if
key-value pair is at the head of the alist.  Returns t if key-value
pair is not at the head of alist.  ALIST is not altered."
  (not (equal (aheadsym alist) key)))


(defun aput (alist-symbol key &optional value)
  "Inserts a key-value pair into an alist.
The alist is referenced by ALIST-SYMBOL. The key-value pair is made
from KEY and optionally, VALUE. Returns the altered alist or nil if
ALIST is nil.

If the key-value pair referenced by KEY can be found in the alist, and
VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
If VALUE is not supplied, or is nil, the key-value pair will not be
modified, but will be moved to the head of the alist. If the key-value
pair cannot be found in the alist, it will be inserted into the head
of the alist (with value nil if VALUE is nil or not supplied)."
  (let ((elem (aelement key value))
	alist)
    (asort alist-symbol key)
    (setq alist (eval alist-symbol))
    (cond ((null alist) (set alist-symbol elem))
	  ((anot-head-p alist key) (set alist-symbol (nconc elem alist)))
	  (value (setcar alist (car elem)))
	  (t alist))))


(defun adelete (alist-symbol key)
  "Delete a key-value pair from the alist.
Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
is pair matching KEY.  Returns the altered alist."
  (asort alist-symbol key)
  (let ((alist (eval alist-symbol)))
    (cond ((null alist) nil)
	  ((anot-head-p alist key) alist)
	  (t (set alist-symbol (cdr alist))))))


(defun aget (alist key &optional keynil-p)
  "Returns the value in ALIST that is associated with KEY.
Optional KEYNIL-P describes what to do if the value associated with
KEY is nil.  If KEYNIL-P is not supplied or is nil, and the value is
nil, then KEY is returned.  If KEYNIL-P is non-nil, then nil would be
returned.

If no key-value pair matching KEY could be found in ALIST, or ALIST is
nil then nil is returned. ALIST is not altered."
  (let ((copy (copy-alist alist)))
    (cond ((null alist) nil)
	  ((progn (asort 'copy key)
		  (anot-head-p copy key)) nil)
	  ((cdr (car copy)))
	  (keynil-p nil)
	  ((car (car copy)))
	  (t nil))))


(defun amake (alist-symbol keylist &optional valuelist)
  "Make an association list.
The association list is attached to the alist referenced by
ALIST-SYMBOL. Each element in the KEYLIST becomes a key and is
associated with the value in VALUELIST with the same index. If
VALUELIST is not supplied or is nil, then each key in KEYLIST is
associated with nil.

KEYLIST and VALUELIST should have the same number of elements, but
this isn't enforced.  If VALUELIST is smaller than KEYLIST, remaining
keys are associated with nil.  If VALUELIST is larger than KEYLIST,
extra values are ignored.  Returns the created alist."
  (let ((keycar (car keylist))
	(keycdr (cdr keylist))
	(valcar (car valuelist))
	(valcdr (cdr valuelist)))
    (cond ((null keycdr)
	   (aput alist-symbol keycar valcar))
	  (t
	   (amake alist-symbol keycdr valcdr)
	   (aput alist-symbol keycar valcar))))
  (eval alist-symbol))

(run-hooks 'c-sig-load-hook)